V3FIT
strip_comments.f
1  SUBROUTINE strip_comments(input_file)
2  USE safe_open_mod
3  IMPLICIT NONE
4 !
5 ! strips comment lines (starting with '!') from input_file
6 ! renames clean file input_file // '.stripped'
7 !
8 C-----------------------------------------------
9 C D u m m y A r g u m e n t s
10 C-----------------------------------------------
11  CHARACTER(LEN=*) :: input_file
12 C-----------------------------------------------
13 C L o c a l V a r i a b l e s
14 C-----------------------------------------------
15  INTEGER, PARAMETER :: unit_strip = 20
16  INTEGER :: istat, iustrip, iunew
17  CHARACTER(LEN=500) :: line
18  LOGICAL :: lex
19  INTEGER :: getcwd
20 C-----------------------------------------------
21  INQUIRE (file=input_file, exist=lex, iostat=istat)
22  IF (istat.ne.0 .or. .not. lex) THEN
23  istat = getcwd(line)
24  print *,trim(input_file),' does not exist in directory: ',
25  1 trim(line)
26  stop
27  END IF
28 
29  iustrip = unit_strip
30  CALL safe_open(iustrip, istat, input_file, 'old','formatted')
31  IF (istat .ne. 0) THEN
32  line = 'error opening ' // trim(input_file) //
33  1 ' in STRIP_COMMENTS'
34  print *, line
35  print *,'istat = ', istat
36  stop
37  END IF
38  iunew = iustrip + 1
39  CALL safe_open(iunew, istat, trim(input_file) // '.stripped',
40  1 'replace', 'formatted')
41  IF (istat .ne. 0) THEN
42  line = 'error opening ' // trim(input_file) //
43  1 '.stripped in STRIP_COMMENTS'
44  print *, line
45  print *,'istat = ', istat
46  stop
47  END IF
48  DO
49  READ(iustrip, '(a)', END=100) line
50  line = adjustl(line)
51  IF (line(1:1) == '!') cycle
52  WRITE(iunew, '(a)') trim(line)
53  END DO
54 
55  100 CONTINUE
56 
57  CLOSE(iustrip)
58  CLOSE(iunew)
59 
60  END SUBROUTINE strip_comments