V3FIT
parse_extension.f
1  SUBROUTINE parse_extension(file_to_parse, file_or_extension, lnc)
2  IMPLICIT NONE
3 !-----------------------------------------------
4 ! D u m m y A r g u m e n t s
5 !-----------------------------------------------
6  CHARACTER(LEN=*), INTENT(in) :: file_or_extension
7  CHARACTER(LEN=*), INTENT(inout) :: file_to_parse
8  LOGICAL, INTENT(out) :: lnc
9 !-----------------------------------------------
10 ! L o c a l V a r i a b l e s
11 !-----------------------------------------------
12  INTEGER :: index_path, index_comp, index_nc, istat=0
13  LOGICAL :: ltxt
14  CHARACTER(len=LEN(file_to_parse)) :: path
15  CHARACTER(len=LEN(file_to_parse)) :: temp !!Assumes file_to_parse can store it all
16  CHARACTER(LEN=1), PARAMETER :: ch_test = '.'
17 !-----------------------------------------------
18 !
19 ! FIRST CHECK IF FILE_OR_EXTENSION IS A FILENAME (FILE_TO_PARSE EMBEDDED)
20 ! OR AN EXTENSION
21 !
22  index_path = index(file_or_extension, trim(file_to_parse))
23  index_comp = index_path
24 
25  IF (index_path .gt. 0) THEN
26 !
27 ! MUST BE <FILENAME>. OR <FILENAME>_
28 !
29  index_nc = index_path + len_trim(file_to_parse)
30  index_path = index(file_or_extension(index_nc:),ch_test)
31 !SPH032510 IF ((ch_test.ne.'.') .and. (ch_test.ne.'_')) index_path = 0
32  END IF
33 
34  IF (index_path .gt. 0) THEN
35  file_to_parse = file_or_extension
36 !
37 ! CHECK FOR netcdf FILE EXTENSION (*.nc)
38 !
39  index_nc = index(file_to_parse,".nc",back=.true.)
40  lnc = (index_nc .eq. (len_trim(file_to_parse)-2))
41 !
42 ! MAY HAVE PASSED FILE NAME EXTENSION WITHOUT .nc; CHECK IF FILE_TO_PARSE EXISTS
43  IF (.not.lnc) THEN
44  INQUIRE(file=file_to_parse, exist=ltxt, iostat=istat)
45  IF (istat.ne.0 .or. .not.ltxt) THEN
46  file_to_parse = trim(file_to_parse) // ".nc"
47  lnc = .true.
48  END IF
49  END IF
50 
51  ELSE
52 !
53 ! CHECK IF TEXT (.txt) OR NETCDF (.nc) FILE EXISTS
54 !
55  path = file_to_parse
56  IF (file_or_extension(1:1) == '.' .or.
57  1 file_or_extension(1:1) == '_') THEN
58  temp = trim(path) // file_or_extension
59  ELSE IF (index_comp == 0) THEN
60  temp = trim(path) // '_' // file_or_extension
61  ELSE
62  temp = trim(file_or_extension)
63  END IF
64 
65 !
66 ! FIRST LOOK FOR FILE WITH .nc SUFFIX IN file_or_extension
67 !
68  file_to_parse = trim(temp)
69  index_nc = index(file_to_parse,".nc",back=.true.)
70  lnc = (index_nc .eq. (len_trim(file_to_parse)-2))
71 !
72 ! NEXT LOOK FOR .txt SUFFIX
73 !
74  IF (.not.lnc) THEN
75  index_nc = index(file_to_parse,".txt",back=.true.)
76  ltxt = (index_nc .eq. (len_trim(file_to_parse)-3))
77 !
78 ! CHECK IF file_or_extension WAS GIVEN WITHOUT EXPLICIT .nc OR .txt SUFFIX
79 !
80  IF (.not.ltxt) THEN
81  file_to_parse = trim(temp) // '.nc'
82  INQUIRE (file=file_to_parse, exist=lnc, iostat=istat)
83  IF (istat.ne.0 .or. .not.lnc) THEN
84  file_to_parse = trim(path) // '.'
85  1 // trim(file_or_extension) // '.nc'
86  INQUIRE (file=file_to_parse, exist=lnc, iostat=istat)
87  IF (istat.ne.0 .or. .not.lnc) THEN
88  file_to_parse = trim(temp) // '.txt'
89  INQUIRE (file=file_to_parse, exist=ltxt,
90  1 iostat=istat)
91  IF (.not.ltxt) THEN
92  file_to_parse = trim(path) // '.' //
93  1 trim(file_or_extension) // '.txt'
94  INQUIRE (file=file_to_parse, exist=ltxt,
95  1 iostat=istat)
96  END IF
97  END IF
98  END IF
99  END IF
100 !
101 ! DEFAULT (OLD STYLE) FILE NAME WHEN NONE OF THE ABOVE EXIST
102 !
103  IF ((istat.ne.0 .or. .not.ltxt) .and. .not.lnc) THEN
104  file_to_parse = trim(path) // '.' // file_or_extension
105  END IF
106 
107  END IF
108 
109  END IF
110 
111  END SUBROUTINE parse_extension