1 !***********************************************************************
2 !* GNU Lesser General Public License
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
22 !> @ingroup fms_io_mod
24 !>For an inputted file name, check if it or any of its variants exist.
25 !!For a file named "foo", variants checked (in order) include:
29 !! foo.<domain_tile_id_string>.nc
30 !! foo.nc.<IO_domain_tile_id_string>
31 !! foo.<domain_tile_id_string>.nc.<IO_domain_tile_id_string>
33 !! foo.<ensemble_id>.nc
34 !! foo.<ensemble_id>.<domain_tile_id_string>.nc
35 !! foo.<ensemble_id>.nc.<IO_domain_tile_id_string>
36 !! foo.<ensemble_id>.<domain_tile_id_string>.nc.<IO_domain_tile_id_string>
38 !!If a match is found, the value true is returned for the "does_file_exist"
39 !!flag. In addition, the actual file name is returned and the "read_dist"
40 !!flag, which tells whether or not the filename contains the
41 !!IO_domain_tile_id_string appended.
43 !!Should this be a subroutine instead of a funtion for clarity since it
44 !!returns more than one value?
45 function fms_io_unstructured_get_file_name(orig_file, &
49 result(does_file_exist)
52 character(len=*),intent(in) :: orig_file !<The name of file we're looking for.
53 character(len=*),intent(out) :: actual_file !<Name of the file we found.
54 logical(INT_KIND),intent(out) :: read_dist !<Flag telling if the file is "distributed"
55 !! (has IO domain tile id appended onto the end).
56 type(domainUG),intent(in) :: domain !<Unstructured mpp domain.
57 logical(INT_KIND) :: does_file_exist !<Flag telling if the inputted file exists or one its variants.
60 logical(INT_KIND) :: fexist !<Flag that tells if a file exists.
61 type(domainUG),pointer :: io_domain !<Pointer to an unstructured I/O domain.
62 integer(INT_KIND) :: io_tile_id !<Tile id for the I/O domain.
63 character(len=256) :: fname !<A character buffer used to test different file names.
64 character(len=512) :: actual_file_tmp !<A character buffer used to test different file names.
66 !Set the default return values for the function.
68 does_file_exist = .false.
71 !Check if the file name does not contain ".nc".
73 if (index(orig_file,".nc",back=.true.) .eq. 0) then
74 inquire(file=trim(orig_file),exist=fexist)
76 actual_file = orig_file
77 does_file_exist = .true.
82 !If necessary, add the correct domain ".tilexxxx" string to the inputted
83 !file name. For a file named foo.nc, this would become foo.tilexxxx.nc.
84 !Check if the new file name exists.
85 call get_mosaic_tile_file_ug(orig_file, &
88 inquire(file=trim(actual_file),exist=fexist)
90 does_file_exist = .true.
94 !Point to the I/O domain for the unstructured grid. This function call
95 !will throw a fatal error if the I/O domain does not exist.
97 io_domain => mpp_get_UG_io_domain(domain)
99 !Get the tile id for the I/O domain.
100 io_tile_id = mpp_get_UG_domain_tile_id(io_domain)
103 !Check if the file has the I/O domain's tile id appended to the end of its
104 !name. For a file named foo.nc, this would become foo.nc.yyyy, where
105 !"yyyy" would in reality be the I/O domain's tile id. If the file exists,
106 !then set the read_dist and does_file_exist flags to true and return.
107 write(fname,'(a,i4.4)') trim(actual_file)//'.',io_tile_id
108 inquire(file=trim(fname),exist=fexist)
109 if (.not. fexist) then
110 write(fname,'(a,i6.6)') trim(actual_file)//'.',io_tile_id
111 inquire(file=trim(fname),exist=fexist)
115 does_file_exist = .true.
119 !Check if the file is part of an ensemble.
120 !filename_appendix is a module variable.
121 if (len_trim(filename_appendix) .gt. 0) then
122 call get_instance_filename(orig_file, &
124 if (index(orig_file,'.nc',back=.true.) .eq. 0) then
125 inquire(file=trim(actual_file),exist=fexist)
127 does_file_exist = .true.
132 !Make a local copy of "actual_file", and the use the local copy to
133 !add the domain ".tilexxxx" string to "actual_file".
134 actual_file_tmp = actual_file
135 call get_mosaic_tile_file_ug(actual_file_tmp, &
138 inquire(file=trim(actual_file),exist=fexist)
140 does_file_exist = .true.
144 !Point to the I/O domain for the unstructured grid. This function call
145 !will throw a fatal error if the I/O domain does not exist.
146 io_domain => mpp_get_UG_io_domain(domain)
148 !Get the tile id for the I/O domain.
149 io_tile_id = mpp_get_UG_domain_tile_id(io_domain)
152 !Check if the file has the I/O domain's tile id appended to the end of
153 !its name. If it does then set the read_dist and does_file_exist flags
155 write(fname,'(a,i4.4)') trim(actual_file)//'.',io_tile_id
156 inquire(file=trim(fname),exist=fexist)
157 if (.not. fexist) then
158 write(fname,'(a,i6.6)') trim(actual_file)//'.',io_tile_id
159 inquire(file=trim(fname),exist=fexist)
163 does_file_exist = .true.
169 end function fms_io_unstructured_get_file_name
171 !------------------------------------------------------------------------------