| blob | f0e749d465212c74138a3437acf3621ec0b0059d |
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
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.
10 !*
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
14 !* for more details.
15 !*
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 !***********************************************************************
19 !> @defgroup diag_table_mod diag_table_mod
20 !> @ingroup diag_manager
21 !! @brief <TT>diag_table_mod</TT> is a set of subroutines use to parse out the data from a
22 !! <TT>diag_table</TT>. This module
23 !! will also setup the arrays required to store the information by counting the number of
24 !! input fields, output files, and
25 !! files.
26 !! @author Seth Underwood
27 !!
28 !! <TT>diag_table_mod</TT> parses the <TT>diag_table</TT> file, and sets up the required arrays to hold the information
29 !! needed for the <TT>diag_manager_mod</TT> to correctly write out the model history files.
30 !!
31 !! The <I>diagnostics table</I> allows users to specify sampling rates and the choice of fields at run time. The
32 !! <TT>diag_table</TT> file consists of comma-separated ASCII values. The <TT>diag_table</TT>
33 !! essentially has three sections:
34 !! <B>Global</B>, <B>File</B>, and <B>Field</B> sections. The <B>Global</B> section must
35 !! be the first two lines of the file,
36 !! whereas the <B>File</B> and <B>Field</B> sections can be inter mixed to allow the file to be organized as desired.
37 !! Comments can be added to the <TT>diag_table</TT> file by using the hash symbol (#) as
38 !! the first character in the line.
39 !!
40 !! All errors in the <TT>diag_table</TT> will throw a <TT>FATAL</TT> error. A simple utility
41 !! <TT>diag_table_chk</TT>has been
42 !! added to the FRE tools suite to check a <TT>diag_table</TT> for errors. A brief usage
43 !! statement can be obtained by running
44 !! <TT>diag_table_chk --help</TT>, and a man page like description can views by running <TT>perldoc
45 !! diag_table_chk</TT>.
46 !!
47 !! Below is a description of the three sections.
48 !! <OL>
49 !! <LI>
50 !! <B>Global Section:</B> The first two lines of the <TT>diag_table</TT> must contain
51 !! the <I>title</I> and the <I>base
52 !! date</I> of the experiment respectively. The <I>title</I> must be a Fortran CHARACTER
53 !! string. The <I>base date</I>
54 !! is the reference time used for the time units, and must be greater than or equal to the model start time.
55 !! The <I>base date</I> consists of six space-separated integer in the following format.<BR />
56 !! <TT> year month day hour minute second </TT><BR />
57 !! </LI>
58 !! <LI>
59 !! <B>File Section:</B> File lines contain 6 required and 5 optional fields (optional fields are surrounded with
60 !! square brackets ([]). File lines can be intermixed with the field lines, but the
61 !! file must be defined before any
62 !! fields that are to be written to the file. File lines have the following format:<BR />
63 !! "file_name", output_freq, "output_freq_units", file_format, "time_axis_units", "time_axis_name"
64 !! [, new_file_freq, "new_file_freq_units"[, "start_time"[, file_duration, "file_duration_units"]]]
65 !! <BR />
66 !! with the following descriptions.
67 !! <DL>
68 !! <DT><TT>CHARACTER(len=128) :: file_name</TT></DT>
69 !! <DD>
70 !! Output file name without the trailing <TT>".nc"</TT>.
71 !!
72 !! A single file description can produce multiple files using special time string
73 !! suffix keywords. This time string
74 !! will append the time strings to the base file name each time a new file is opened.
75 !! They syntax for the time string
76 !! suffix keywords are <TT>%#tt</TT> Where <TT>#</TT> is a mandatory single digit
77 !! number specifying the width of the
78 !! field, and <TT>tt</TT> can be as follows:
79 !! <UL>
80 !! <LI><TT>yr</TT> Years</LI>
81 !! <LI><TT>mo</TT> Months</LI>
82 !! <LI><TT>dy</TT> Days</LI>
83 !! <LI><TT>hr</TT> Hours</LI>
84 !! <LI><TT>mi</TT> Minutes</LI>
85 !! <LI><TT>sc</TT> Seconds</LI>
86 !! </UL>
87 !! Thus, a file name of <TT>file2_yr_dy%1yr%3dy</TT> will have a base file name of
88 !! <TT>file2_yr_dy_1_001</TT> if the
89 !! file is created on year 1 day 1 of the model run. <B><I>NOTE:</I></B> The time
90 !! suffix keywords must be used if the
91 !! optional fields <TT>new_file_freq</TT> and <TT>new_file_freq_units</TT> are used,
92 !! otherwise a <TT>FATAL</TT> error
93 !! will occur.
94 !! </DD>
95 !!
96 !! <DT><TT>INTEGER :: output_freq</TT></DT>
97 !! <DD>How often to write fields to file.
98 !! <UL>
99 !! <LI><TT>> 0</TT> <EN /> Output frequency in <TT>output_freq_units</TT>.</LI>
100 !! <LI><TT>= 0</TT> <EN /> Output frequency every time set. (<TT>output_freq_units</TT> is ignored.)</LI>
101 !! <LI><TT>=-1</TT> <EN /> Output at end of run only. (<TT>output_freq_units</TT> is ignored.)</LI>
102 !! </UL>
103 !! </DD>
104 !! <DT><TT>CHARACTER(len=10) :: output_freq_units</TT></DT>
105 !! <DD>
106 !! Time units for output. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>, <TT>minutes</TT>,
107 !! <TT>hours</TT>, or <TT>seconds</TT>.
108 !! </DD>
109 !! <DT><TT>INTEGER :: file_format</TT></DT>
110 !! <DD>
111 !! Output file format. Currently only the <I>netCDF</I> file format is supported.
112 !! <UL>
113 !! <LI><TT>= 1</TT> <EN /> netCDF</LI>
114 !! </UL>
115 !! </DD>
116 !! <DT><TT>CHARACTER(len=10) :: time_axis_units</TT></DT>
117 !! <DD>
118 !! Time units for the output file time axis. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>,
119 !! <TT>minutes</TT>, <TT>hours</TT>, or <TT>seconds</TT>.
120 !! </DD>
121 !! <DT><TT>CHARACTER(len=128) :: time_axis_name</TT></DT>
122 !! <DD>
123 !! Axis name for the output file time axis. The character sting must contain the
124 !! string 'time'. (mixed upper and
125 !! lowercase allowed.)
126 !! </DD>
127 !! <DT><TT>INTEGER, OPTIONAL :: new_file_freq</TT></DT>
128 !! <DD>
129 !! Frequency for closing the existing file, and creating a new file in <TT>new_file_freq_units</TT>.
130 !! </DD>
131 !! <DT><TT>CHARACTER(len=10), OPTIONAL :: new_file_freq_units</TT></DT>
132 !! <DD>
133 !! Time units for creating a new file. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>,
134 !! <TT>minutes</TT>, <TT>hours</TT>, or <TT>seconds</TT>. <B><I>NOTE:</I></B> If
135 !! the <TT>new_file_freq</TT> field is
136 !! present, then this field must also be present.
137 !! </DD>
138 !! <DT><TT>CHARACTER(len=25), OPTIONAL :: start_time</TT></DT>
139 !! <DD>
140 !! Time to start the file for the first time. The format of this string is the same
141 !! as the <I>global date</I>. <B><I>
142 !! NOTE:</I></B> The <TT>new_file_freq</TT> and the <TT>new_file_freq_units</TT>
143 !! fields must be present to use this field.
144 !! </DD>
145 !! <DT><TT>INTEGER, OPTIONAL :: file_duration</TT></DT>
146 !! <DD>
147 !! How long file should receive data after start time in <TT>file_duration_units</TT>.
148 !! This optional field can only
149 !! be used if the <TT>start_time</TT> field is present. If this field is absent,
150 !! then the file duration will be equal
151 !! to the frequency for creating new files. <B><I>NOTE:</I></B> The <TT>file_duration_units</TT>
152 !! field must also be
153 !! present if this field is present.
154 !! </DD>
155 !! <DT><TT>CHARACTER(len=10), OPTIONAL :: file_duration_units</TT></DT>
156 !! <DD>
157 !! File duration units. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>,
158 !! <TT>minutes</TT>, <TT>hours</TT>, or <TT>seconds</TT>. <B><I>NOTE:</I></B> If
159 !! the <TT>file_duration</TT> field is
160 !! present, then this field must also be present.
161 !! </DD>
162 !! </DL>
163 !! </LI>
164 !! <LI>
165 !! <B>Field Section:</B> Field lines contain 8 fields. Field lines can be intermixed
166 !! with file lines. Fields line can contain
167 !! fields that are not written to any files. The file name for these fields is <TT>null</TT>.
168 !!
169 !! Field lines have the following format:<BR />
170 !! <PRE>
171 !! "module_name", "field_name", "output_name", "file_name", "time_sampling", "reduction_method",
172 !! "regional_section", packing
173 !! </PRE>
174 !! with the following descriptions.
175 !! <DL>
176 !! <DT><TT>CHARACTER(len=128) :: module_name</TT></DT>
177 !! <DD>Module that contains the <TT>field_name</TT> variable. (e.g. <TT>atmos_mod</TT>, <TT>land_mod</TT>)</DD>
178 !! <DT><TT>CHARACTER(len=128) :: field_name</TT></DT>
179 !! <DD>Module variable name that has data to be written to file.</DD>
180 !! <DT><TT>CHARACTER(len=128) :: output_name</TT></DT>
181 !! <DD>Name of the field as written in <TT>file_name</TT>.</DD>
182 !! <DT><TT>CHARACTER(len=128) :: file_name</TT></DT>
183 !! <DD>
184 !! Name of the file where the field is to be written. <B><I>NOTE:</I></B> The file <TT>file_name</TT> must be
185 !! defined first.
186 !! </DD>
187 !! <DT><TT>CHARACTER(len=50) :: time_sampling</TT></DT>
188 !! <DD>Currently not used. Please use the string "all".</DD>
189 !! <DT><TT>CHARACTER(len=50) :: reduction_method</TT></DT>
190 !! <DD>
191 !! The data reduction method to perform prior to writing data to disk. Valid options
192 !! are (redundant names are
193 !! separated with commas):
194 !! <DL>
195 !! <DT><TT>.TRUE.</TT>, average, avg, mean</DT>
196 !! <DD>Average from the last time written to the current time.</DD>
197 !! <DT><TT>.FALSE.</TT>, none</DT>
198 !! <DD>No reduction performed. Write current time step value only.</DD>
199 !! <DT>rms</DT> <DD>Calculate the root mean square from the last time written to the current time.</DD>
200 !! <DT>pow##</DT> <DD>Calculate the mean of the power ## from the last time written
201 !! to the current time.</DD>
202 !! <DT>min</DT> <DD>Minimum value from last write to current time.</DD>
203 !! <DT>max</DT> <DD>Maximum value from last write to current time.</DD>
204 !! <DT>diurnal##</DT> <DD>## diurnal averages</DD>
205 !! </DL>
206 !! </DD>
207 !! <DT><TT>CHARACTER(len=50) :: regional_section</TT></DT>
208 !! <DD>
209 !! Bounds of the regional section to capture. A value of <TT>none</TT> indicates
210 !! a global region. The regional
211 !! section has the following format:<BR />
212 !! <TT>lat_min, lat_max, lon_min, lon_max, vert_min, vert_max</TT><BR />
213 !! Use <TT>vert_min = -1</TT> and <TT>vert_max = -1</TT> to get the entire vertical
214 !! axis. <B><I>NOTE:</I></B>
215 !! Currently, the defined region <I>MUST</I> be confined to a single tile.
216 !! </DD>
217 !! <DT><TT>INTEGER :: packing</TT></DT>
218 !! <DD>
219 !! Fortran number <TT>KIND</TT> of the data written. Valid values:
220 !! - <TT>= 1</TT> <EN /> double precision
221 !! - <TT>= 2</TT> <EN /> float
222 !! - <LI><TT>= 4</TT> <EN /> packed 16-bit integers
223 !! - <TT>= 8</TT> <EN /> packed 1-byte (not tested)
224 !! </DD>
225 !! </DL>
226 !! </LI>
227 !! </OL>
228 !!
229 !! <H4><B>Sample <TT>diag_table</TT></B></H4>
230 !! <LI>
231 !! <PRE>
232 !! "diag manager test"
233 !! 1999 1 1 0 0 0
234 !!
235 !! #output files
236 !! 10_days, 10, "days", 1, "hours", "Time"
237 !! "file1_hr%hr3", 5, "days", 1, "hours", "Time", 15, "days"
238 !! "file2_yr_dy%yr1%dy3", 5, "days", 1, "hours", "Time", 10, "days", "1 1 7 0 0 0"
239 !! "file3_yr_dy%yr1%dy3", 5, "days", 1, "hours", "Time", 20, "days", "1 1 7 0 0 0", 5, "years"
240 !!
241 !! #output variables
242 !! "ice_mod", "ice", "ice", "10_days", "all", .false., "none", 2
243 !!
244 !! # temp_local file and fields.
245 !! temp_local, 1, "days", 1, "hours", "Time"
246 !! "ocean_mod", "temp", "temp", "temp_local", "all", .FALSE., "5 259.5 -59.5 59.5 1 1", 2
247 !! </PRE>
248 !! </LI>
250 MODULE diag_table_mod
252 USE fms2_io_mod, ONLY: ascii_read
253 USE fms_mod, ONLY: fms_error_handler, error_mesg, mpp_pe, mpp_root_pe, FATAL, WARNING, lowercase
254 USE time_manager_mod, ONLY: set_date, time_type
255 USE diag_data_mod, ONLY: global_descriptor, get_base_time, set_base_time, &
256 & DIAG_OTHER, DIAG_OCEAN, DIAG_ALL, coord_type, append_pelist_name, pelist_name
257 USE diag_util_mod, ONLY: init_file, check_duplicate_output_fields, init_input_field, init_output_field
258 USE platform_mod, ONLY: FMS_FILE_LEN
260 IMPLICIT NONE
262 PRIVATE
263 PUBLIC :: parse_diag_table
265 !> Private type to hold field information for the diag table
266 !> @ingroup diag_table_mod
267 TYPE field_description_type
268 CHARACTER(len=128) :: module_name, field_name, output_name, file_name
269 CHARACTER(len=50) :: time_sampling
270 CHARACTER(len=50) :: time_method
271 CHARACTER(len=50) :: spatial_ops
272 TYPE(coord_type) :: regional_coords
273 INTEGER :: pack
274 END TYPE field_description_type
276 !> Private type to hold file information for the diag table
277 !> @ingroup diag_table_mod
278 TYPE file_description_type
279 INTEGER :: output_freq
280 INTEGER :: file_format
281 INTEGER :: new_file_freq
282 INTEGER :: file_duration
283 INTEGER :: iTime_units
284 INTEGER :: iOutput_freq_units
285 INTEGER :: iNew_file_freq_units
286 INTEGER :: iFile_duration_units
287 CHARACTER(len=FMS_FILE_LEN) :: file_name
288 CHARACTER(len=10) :: output_freq_units
289 CHARACTER(len=10) :: time_units
290 CHARACTER(len=128) :: long_name
291 CHARACTER(len=10) :: new_file_freq_units
292 CHARACTER(len=25) :: start_time_s
293 CHARACTER(len=10) :: file_duration_units
294 CHARACTER(len=10) :: filename_time_bounds
295 TYPE(time_type) :: start_time
296 END TYPE file_description_type
298 !> @addtogroup diag_table_mod
299 !> @{
301 CHARACTER(len=*), PARAMETER :: UNALLOWED_QTE = "'"//'"'
302 CHARACTER(len=*), PARAMETER :: UNALLOWED_ALL = UNALLOWED_QTE//","
304 CONTAINS
306 !> @brief Parse the <TT>diag_table</TT> in preparation for diagnostic output.
307 !! @details <TT>parse_diag_table</TT> is the public interface to parse the diag_table, and
308 !! setup the arrays needed to store the
309 !! requested diagnostics from the <TT>diag_table</TT>. <TT>parse_diag_table</TT> will
310 !! return a non-zero <TT>istat</TT> if
311 !! a problem parsing the <TT>diag_table</TT>.
312 !!
313 !! NOT YET IMPLEMENTED: <TT>parse_diag_table</TT> will parse through the <TT>diag_table</TT>
314 !! twice. The first pass, will be
315 !! to get a good "guess" of array sizes. These arrays, that will hold the requested
316 !! diagnostic fields and files, will then be
317 !! allocated to the size of the "guess" plus a slight increase.
318 SUBROUTINE parse_diag_table(diag_subset, istat, err_msg)
319 INTEGER, INTENT(in), OPTIONAL :: diag_subset !< Diagnostic sampling subset.
320 INTEGER, INTENT(out), OPTIONAL, TARGET :: istat !< Status of parsing the <TT>diag_table</TT>.
321 !! A non-zero status indicates a problem parsing the table.
322 CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< Error message corresponding to the
323 !! <TT>istat</TT> return value.
325 INTEGER, PARAMETER :: DT_LINE_LENGTH = 256
327 INTEGER :: record_len !< String length of the diag_table line read in.
328 INTEGER :: num_lines !< Number of lines in diag_table
329 INTEGER :: line_num !< Integer representation of the line number.
330 INTEGER :: commentStart !< Index location of first '#' on line
331 INTEGER :: diag_subset_output !< local value of diag_subset
332 INTEGER :: nfields, nfiles !< Number of fields and files. Not used yet.
333 INTEGER :: npass !< number of passes done while parsing the diag_table (1 for files, 2 for fields)
334 INTEGER, TARGET :: mystat !< variable to hold return status of function/subroutine calls.
335 INTEGER, POINTER :: pstat !< pointer that points to istat if preset, otherwise, points to mystat.
337 CHARACTER(len=5) :: line_number !< String representation of the line number.
338 CHARACTER(len=256) :: record_line !< Current line from the diag_table.
339 CHARACTER(len=256) :: local_err_msg !< Sting to hold local error messages.
340 CHARACTER(len=:), DIMENSION(:), ALLOCATABLE :: diag_table
341 integer :: base_time_int(6) !< The base time as read in from the table [year month day hour min sec]
343 TYPE(file_description_type) :: temp_file
344 TYPE(field_description_type) :: temp_field
346 ! set up the pstat pointer
347 IF ( PRESENT(istat) ) THEN
348 pstat => istat
349 ELSE
350 pstat => mystat
351 END IF
352 ! Default return value (success)
353 pstat = 0
355 IF ( PRESENT(diag_subset) ) THEN
356 diag_subset_output = diag_subset
357 ELSE
358 diag_subset_output = DIAG_ALL
359 END IF
361 call ascii_read('diag_table', diag_table, num_lines=num_lines)
363 ! Read in the global file labeling string
364 READ (UNIT=diag_table(1), FMT=*, IOSTAT=mystat) global_descriptor
365 IF ( mystat /= 0 ) THEN
366 pstat = mystat
367 IF ( fms_error_handler('diag_table_mod::parse_diag_table', &
368 'Error reading the global descriptor from the diagnostic table.', err_msg) ) RETURN
369 END IF
371 ! Read in the base date
372 READ (UNIT=diag_table(2), FMT=*, IOSTAT=mystat) base_time_int
373 IF ( mystat /= 0 ) THEN
374 pstat = mystat
375 IF ( fms_error_handler('diag_manager_init', 'Error reading the base date from the diagnostic table.', &
376 & err_msg) ) RETURN
377 END IF
379 call set_base_time(base_time_int)
381 nfiles=0
382 nfields=0
383 pass: DO npass = 1, 2
384 parser: DO line_num=3, num_lines
385 ! Read in the entire line from the file.
386 ! If there is a read error, give a warning, and
387 ! cycle the parser loop.
388 READ (diag_table(line_num), FMT='(A)', IOSTAT=mystat) record_line
389 ! Increase line counter, and put in string for use in warning/error messages.
390 WRITE (line_number, '(I5)') line_num
392 IF ( mystat > 0 ) THEN
393 IF ( mpp_pe() == mpp_root_pe() ) &
394 & CALL error_mesg("diag_table_mod::parse_diag_table",&
395 & "Problem reading the diag_table (line:" //line_number//").", FATAL)
396 CYCLE parser
397 ELSE IF ( mystat < 0 ) THEN
398 EXIT parser
399 END IF
401 ! How long is the read in string?
402 record_len = LEN_TRIM(record_line)
404 ! ignore blank lines and lines with comments only (comment marker '#')
405 commentStart = INDEX(record_line,'#')
406 IF ( commentStart .NE. 0 ) record_line = record_line(1:commentStart-1)
407 IF ( LEN_TRIM(record_line) == 0 .OR. record_len == 0 ) CYCLE parser
409 init: IF ( npass == 1 ) THEN ! Checking for files only
410 IF ( is_a_file(TRIM(record_line)) ) THEN
411 temp_file = parse_file_line(LINE=record_line, ISTAT=mystat, ERR_MSG=local_err_msg)
413 IF ( mystat > 0 ) THEN
414 CALL error_mesg("diag_table_mod::parse_diag_table",&
415 & TRIM(local_err_msg)//" (line:" //TRIM(line_number)//").", FATAL)
416 ELSE IF ( mystat < 0 ) THEN
417 IF ( mpp_pe() == mpp_root_pe() )&
418 & CALL error_mesg("diag_table_mod::parse_diag_table",&
419 & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").", WARNING)
420 CYCLE parser
421 ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX(lowercase(temp_file%file_name), "ocean").NE.0)&
422 & .OR. (diag_subset_output == DIAG_OCEAN .AND. INDEX(lowercase(temp_file%file_name), "ocean").EQ.0)&
423 & ) THEN
424 CYCLE parser
425 ELSE IF ( temp_file%new_file_freq > 0 ) THEN ! Call the init_file subroutine. The '1'
426 !! is for the tile_count
427 CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, &
428 & temp_file%file_format, temp_file%iTime_units, temp_file%long_name, 1, &
429 & temp_file%new_file_freq, temp_file%iNew_file_freq_units,&
430 & temp_file%start_time, temp_file%file_duration, temp_file%iFile_duration_units, &
431 & temp_file%filename_time_bounds)
432 ELSE
433 CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, &
434 & temp_file%file_format, temp_file%iTime_units, temp_file%long_name, 1)
435 END IF
437 ! Increment number of files
438 nfiles = nfiles + 1
439 END IF
440 ELSE ! Looking for fields
441 IF ( .NOT.is_a_file(TRIM(record_line)) ) THEN
442 temp_field = parse_field_line(LINE=record_line, ISTAT=mystat, ERR_MSG=local_err_msg)
444 ! Check for errors, then initialize the input and output field
445 IF ( mystat > 0 ) THEN
446 CALL error_mesg("diag_table_mod::parse_diag_table",&
447 & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").",FATAL)
448 ELSE IF ( mystat < 0 ) THEN
449 IF ( mpp_pe() == mpp_root_pe() )&
450 & CALL error_mesg("diag_table_mod::Parse_diag_table",&
451 & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").",WARNING)
452 CYCLE parser
453 ELSE IF ((diag_subset_output == DIAG_OTHER .AND. INDEX(lowercase(temp_field%file_name), "ocean").NE.0)&
454 &.OR. (diag_subset_output == DIAG_OCEAN .AND. INDEX(lowercase(temp_field%file_name), "ocean").EQ.0)&
455 & ) THEN
456 CYCLE parser
457 ELSE IF ( lowercase(TRIM(temp_field%spatial_ops)) == 'none' ) THEN
458 CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)
459 CALL init_output_field(temp_field%module_name, temp_field%field_name, temp_field%output_name, &
460 & temp_field%file_name, temp_field%time_method, temp_field%pack, 1)
461 ELSE
462 CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)
463 CALL init_output_field(temp_field%module_name, temp_field%field_name, temp_field%output_name, &
464 & temp_field%file_name, temp_field%time_method, temp_field%pack, 1, temp_field%regional_coords)
465 END IF
467 ! Increment number of fields
468 nfields = nfields + 1
469 END IF
470 END IF init
471 END DO parser
472 END DO pass
474 ! Close the diag_table file.
475 DEALLOCATE(diag_table)
477 ! check duplicate output_fields in the diag_table
478 CALL check_duplicate_output_fields(ERR_MSG=local_err_msg)
479 IF ( local_err_msg /= '' ) THEN
480 pstat = 1
481 IF ( fms_error_handler('diag_table_mod::parse_diag_table', TRIM(local_err_msg), err_msg) ) RETURN
482 END IF
484 END SUBROUTINE parse_diag_table
486 !> @brief <TT>parse_file_line</TT> parses a file description line from the <TT>diag_table</TT> file, and returns a
487 !! <TT>TYPE(file_description_type)</TT>. The calling function, would then need to call
488 !! the <TT>init_file</TT> to initialize
489 !! the diagnostic output file.
490 !! @return file_description_type parse_file_line
491 TYPE(file_description_type) FUNCTION parse_file_line(line, istat, err_msg)
492 CHARACTER(len=*), INTENT(in) :: line !< Line to parse from the <TT>diag_table</TT> file.
493 INTEGER, INTENT(out), OPTIONAL, TARGET :: istat !< Return state of the function. A value of 0 indicates success.
494 !! A positive value indicates a <TT>FATAL</TT> error occurred,
495 !! and a negative value indicates a <TT>WARNING</TT>
496 !! should be issued.
497 CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< Error string to include in the <TT>FATAL</TT>
498 !! or <TT>WARNING</TT> message.
500 INTEGER, TARGET :: mystat
501 INTEGER, POINTER :: pstat
502 INTEGER :: year, month, day, hour, minute, second
503 CHARACTER(len=256) :: local_err_msg !< Hold the return error message from routine calls.
505 IF ( PRESENT(istat) ) THEN
506 pstat => istat
507 ELSE
508 pstat => mystat
509 END IF
510 pstat = 0 ! default success return value
512 ! Initialize the optional file description fields.
513 parse_file_line%new_file_freq = 0
514 parse_file_line%new_file_freq_units = ''
515 parse_file_line%start_time_s = ''
516 parse_file_line%file_duration = 0
517 parse_file_line%file_duration_units = ''
518 parse_file_line%filename_time_bounds = ''
520 ! Read in the file description line..
521 READ (line, FMT=*, IOSTAT=mystat) parse_file_line%file_name, parse_file_line%output_freq, &
522 & parse_file_line%output_freq_units,&
523 & parse_file_line%file_format, parse_file_line%time_units, parse_file_line%long_name,&
524 & parse_file_line%new_file_freq, parse_file_line%new_file_freq_units, parse_file_line%start_time_s,&
525 & parse_file_line%file_duration, parse_file_line%file_duration_units, parse_file_line%filename_time_bounds
526 IF ( mystat > 0 ) THEN
527 pstat = mystat
528 IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Incorrect file description format in diag_table.', &
529 & err_msg) ) RETURN
530 END IF
532 ! Check for unallowed characters in strings
533 IF ( SCAN(parse_file_line%file_name, UNALLOWED_ALL) > 0 ) THEN
534 pstat = 1
535 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
536 & 'Unallowed character in file_name in the diag_table.', err_msg) ) RETURN
537 END IF
538 IF ( SCAN(parse_file_line%output_freq_units, UNALLOWED_ALL) > 0 ) THEN
539 pstat = 1
540 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
541 & 'Unallowed character in output_freq_units in the diag_table.', err_msg) ) RETURN
542 END IF
543 IF ( SCAN(parse_file_line%time_units, UNALLOWED_ALL) > 0 ) THEN
544 pstat = 1
545 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
546 & 'Unallowed character in time_units in the diag_table.', err_msg) ) RETURN
547 END IF
548 IF ( SCAN(parse_file_line%long_name, UNALLOWED_ALL) > 0 ) THEN
549 pstat = 1
550 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
551 & 'Unallowed character in long_name in the diag_table.', err_msg) ) RETURN
552 END IF
553 IF ( SCAN(parse_file_line%new_file_freq_units, UNALLOWED_ALL) > 0 ) THEN
554 pstat = 1
555 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
556 & 'Unallowed character in new_file_freq_units in the diag_table.', err_msg) ) RETURN
557 END IF
558 IF ( SCAN(parse_file_line%start_time_s, UNALLOWED_ALL) > 0 ) THEN
559 pstat = 1
560 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
561 & 'Unallowed character in start_time_s in the diag_table.', err_msg) ) RETURN
562 END IF
563 IF ( SCAN(parse_file_line%file_duration_units, UNALLOWED_ALL) > 0 ) THEN
564 pstat = 1
565 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
566 & 'Unallowed character in file_duration_units in the diag_table.', err_msg) ) RETURN
567 END IF
570 ! Fix the file name
571 parse_file_line%file_name = fix_file_name(TRIM(parse_file_line%file_name))
573 ! Verify values / formats are correct
574 IF ( parse_file_line%file_format > 2 .OR. parse_file_line%file_format < 1 ) THEN
575 pstat = 1
576 IF ( fms_error_handler('diag_table_mod::parse_file_line', &
577 & 'Invalid file format for file description in the diag_table.',&
578 & err_msg) ) RETURN
579 END IF
581 ! check for known units
582 parse_file_line%iTime_units = find_unit_ivalue(parse_file_line%time_units)
583 parse_file_line%iOutput_freq_units = find_unit_ivalue(parse_file_line%output_freq_units)
584 parse_file_line%iNew_file_freq_units = find_unit_ivalue(parse_file_line%new_file_freq_units)
585 parse_file_line%iFile_duration_units = find_unit_ivalue(parse_file_line%file_duration_units)
586 ! Verify the units are valid
587 IF ( parse_file_line%iTime_units < 0 ) THEN
588 pstat = 1
589 IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid time axis units in diag_table.', err_msg) )&
590 & RETURN
591 END IF
592 IF ( parse_file_line%iOutput_freq_units < 0 ) THEN
593 pstat = 1
594 IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid output frequency units in diag_table.', &
595 & err_msg) ) RETURN
596 END IF
597 IF ( parse_file_line%iNew_file_freq_units < 0 .AND. parse_file_line%new_file_freq > 0 ) THEN
598 pstat = 1
599 IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid new file frequency units in diag_table.', &
600 & err_msg) ) RETURN
601 END IF
602 IF ( parse_file_line%iFile_duration_units < 0 .AND. parse_file_line%file_duration > 0 ) THEN
603 pstat = 1
604 IF (fms_error_handler('diag_table_mod::parse_file_line', 'Invalid file duration units in diag_table.',err_msg))&
605 & RETURN
606 END IF
608 !::sdu::
609 !::sdu:: Here is where we would want to parse the regional/global string
610 !::sdu::
612 ! Check for file frequency, start time and duration presence.
613 ! This will determine how the init subroutine is called.
614 new_file_freq_present: IF ( parse_file_line%new_file_freq > 0 ) THEN ! New file frequency present.
615 IF ( LEN_TRIM(parse_file_line%start_time_s) > 0 ) THEN ! start time present
616 READ (parse_file_line%start_time_s, FMT=*, IOSTAT=mystat) year, month, day, hour, minute, second
617 IF ( mystat /= 0 ) THEN
618 pstat = 1
619 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
620 & 'Invalid start time in the file description in diag_table.', err_msg) ) RETURN
621 END IF
622 parse_file_line%start_time = set_date(year, month, day, hour, minute, second, err_msg=local_err_msg)
623 IF ( local_err_msg /= '' ) THEN
624 pstat = 1
625 IF ( fms_error_handler('diag_table_mod::parse_file_line', local_err_msg, err_msg) ) RETURN
626 END IF
627 IF ( parse_file_line%file_duration <= 0 ) THEN ! file_duration not present
628 parse_file_line%file_duration = parse_file_line%new_file_freq
629 parse_file_line%iFile_duration_units = parse_file_line%iNew_file_freq_units
630 END IF
631 ELSE
632 parse_file_line%start_time = get_base_time()
633 parse_file_line%file_duration = parse_file_line%new_file_freq
634 parse_file_line%iFile_duration_units = parse_file_line%iNew_file_freq_units
635 END IF
636 END IF new_file_freq_present
638 !< If filename_time_bounds is empty using defaults
639 IF (trim(parse_file_line%filename_time_bounds) == "") THEN
640 parse_file_line%filename_time_bounds = "middle"
641 ELSE
642 !< Check if the filename_time_bounds is one of the accepted values
643 IF (trim(parse_file_line%filename_time_bounds) /= "begin" .or. &
644 & trim(parse_file_line%filename_time_bounds) /= "middle" .or. &
645 & trim(parse_file_line%filename_time_bounds) /= "end") THEN
646 IF ( fms_error_handler('diag_table_mod::parse_file_line',&
647 & 'filename_time_bounds must be "begin", "middle", "end".', err_msg) ) RETURN
648 ENDIF
649 ENDIF
651 END FUNCTION parse_file_line
653 !> @brief Parse a field description line from the <TT>diag_table</TT> file.
654 !! @return field_description_type parse_field_line
655 !! @details <TT>parse_field_line</TT> parses a field description line from the <TT>diag_table</TT>
656 !! file, and returns a
657 !! <TT>TYPE(field_description_type)</TT>. The calling function, would then need to call
658 !! the <TT>init_input_field</TT> and
659 !! <TT>init_output_field</TT> to initialize the diagnostic output field.
660 TYPE(field_description_type) FUNCTION parse_field_line(line, istat, err_msg)
661 CHARACTER(len=*), INTENT(in) :: line !< Line to parse from the <TT>diag_table</TT> file.
662 INTEGER, INTENT(out), OPTIONAL, TARGET :: istat !< Return state of the function. A value of 0 indicates success.
663 !! A positive value indicates a <TT>FATAL</TT> error occurred,
664 !! and a negative value indicates a <TT>WARNING</TT>
665 !! should be issued.
666 CHARACTER(len=*), OPTIONAL, INTENT(out) :: err_msg !< Error string to include in the <TT>FATAL</TT>
667 !! or <TT>WARNING</TT> message.
669 INTEGER, TARGET :: mystat
670 INTEGER, POINTER :: pstat
672 IF ( PRESENT(istat) ) THEN
673 pstat => istat
674 ELSE
675 pstat => mystat
676 END IF
677 pstat = 0 ! default success return value
679 READ (line, FMT=*, IOSTAT=mystat) parse_field_line%module_name, parse_field_line%field_name, &
680 & parse_field_line%output_name, parse_field_line%file_name, parse_field_line%time_sampling, &
681 & parse_field_line%time_method, parse_field_line%spatial_ops, parse_field_line%pack
682 IF ( mystat /= 0 ) THEN
683 pstat = 1
684 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
685 & 'Field description format is incorrect in diag_table.', err_msg) ) RETURN
686 END IF
688 ! Check for unallowed characters in the string
689 IF ( SCAN(parse_field_line%module_name, UNALLOWED_ALL) > 0 ) THEN
690 pstat = 1
691 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
692 & 'Unallowed character in module_name in the diag_table.', err_msg) ) RETURN
693 END IF
694 IF ( SCAN(parse_field_line%field_name, UNALLOWED_ALL) > 0 ) THEN
695 pstat = 1
696 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
697 & 'Unallowed character in field_name in the diag_table.', err_msg) ) RETURN
698 END IF
699 IF ( SCAN(parse_field_line%output_name, UNALLOWED_ALL) > 0 ) THEN
700 pstat = 1
701 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
702 & 'Unallowed character in output_name in the diag_table.', err_msg) ) RETURN
703 END IF
704 IF ( SCAN(parse_field_line%file_name, UNALLOWED_ALL) > 0 ) THEN
705 pstat = 1
706 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
707 & 'Unallowed character in file_name in the diag_table.', err_msg) ) RETURN
708 END IF
709 IF ( SCAN(parse_field_line%time_sampling, UNALLOWED_ALL) > 0 ) THEN
710 pstat = 1
711 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
712 & 'Unallowed character in time_sampling in the diag_table.', err_msg) ) RETURN
713 END IF
714 IF ( SCAN(parse_field_line%time_method, UNALLOWED_ALL) > 0 ) THEN
715 pstat = 1
716 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
717 & 'Unallowed character in time_method in the diag_table.', err_msg) ) RETURN
718 END IF
719 IF ( SCAN(parse_field_line%spatial_ops, UNALLOWED_QTE) > 0 ) THEN
720 pstat = 1
721 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
722 & 'Unallowed character in spatial_ops in the diag_table.', err_msg) ) RETURN
723 END IF
725 ! Fix the file name
726 ! Removes any added '.nc' and appends additional information.
727 parse_field_line%file_name = fix_file_name(TRIM(parse_field_line%file_name))
729 IF ( parse_field_line%pack > 8 .OR. parse_field_line%pack < 1 ) THEN
730 pstat = 1
731 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
732 & 'Packing is out of range for the field description in diag_table.', err_msg) ) RETURN
733 END IF
735 IF ( lowercase(TRIM(parse_field_line%spatial_ops)) /= 'none' ) THEN
736 READ (parse_field_line%spatial_ops, FMT=*, IOSTAT=mystat) parse_field_line%regional_coords
737 IF ( mystat /= 0 ) THEN
738 IF ( fms_error_handler('diag_table_mod::parse_field_line',&
739 & 'Error in regional output description for field description in diag_table.', err_msg) ) RETURN
740 END IF
741 END IF
742 END FUNCTION parse_field_line
744 !> @brief Determines if a line from the diag_table file is a file
745 !! @return Logical is_a_file
746 !! @details <TT>is_a_file</TT> checks a diag_table line to determine if the line describes
747 !! a file. If the line describes a file, the
748 !! <TT>is_a_file</TT> will return <TT>.TRUE.</TT>. Otherwise, it will return <TT>.FALSE.</TT>
749 PURE LOGICAL FUNCTION is_a_file(line)
750 CHARACTER(len=*), INTENT(in) :: line !< String containing the <TT>diag_table</TT> line.
752 CHARACTER(len=5) :: first
753 INTEGER :: second
754 INTEGER :: mystat !< IO status from read
756 #if defined __PATHSCALE__ || defined _CRAYFTN
757 ! This portion is to 'fix' pathscale's and Cray's Fortran compilers inability to handle
758 ! the FMT=* correctly in the read
759 ! statement.
760 CHARACTER(len=10) :: secondString
761 INTEGER :: comma1, comma2, linelen
763 linelen = LEN(line)
764 comma1 = INDEX(line,',') + 1 ! +1 to go past the comma
765 comma2 = INDEX(line(comma1:linelen),',') + comma1 - 2 ! -2 to get rid of +1 in comma1 and to get
766 !! 1 character before the comma
768 secondString = ADJUSTL(line(comma1:comma2))
769 READ (UNIT=secondString, FMT='(I)', IOSTAT=mystat) second
770 #else
771 READ (UNIT=line, FMT=*, IOSTAT=mystat) first, second
772 #endif
774 ! The line is a file if my status is zero after the read.
775 is_a_file = mystat == 0
776 END FUNCTION is_a_file
778 !> @brief Fixes the file name for use with diagnostic file and field initializations.
779 !! @return Character(len=128) fix_file_name
780 PURE CHARACTER(len=128) FUNCTION fix_file_name(file_name_string)
781 CHARACTER(len=*), INTENT(IN) :: file_name_string !< String containing the file name from the <TT>diag_table</TT>.
783 INTEGER :: file_name_len
785 fix_file_name = file_name_string ! Default return value
787 file_name_len = LEN_TRIM(file_name_string)
789 ! Remove trailing '.nc' from the file_name, and append suffixes
790 IF ( file_name_len > 2 ) THEN
791 IF ( file_name_string(file_name_len-2:file_name_len) == '.nc' ) THEN
792 fix_file_name = file_name_string(1:file_name_len-3)
793 file_name_len = file_name_len - 3
794 END IF
795 END IF
797 ! Add the optional suffix based on the pe list name if the
798 ! append_pelist_name == .TRUE.
799 IF ( append_pelist_name ) THEN
800 fix_file_name(file_name_len+1:) = TRIM(pelist_name)
801 END IF
802 END FUNCTION fix_file_name
804 !> @brief Return the integer value for the given time unit.
805 !! @return Integer find_unit_ivalue
806 !! @details Returns the corresponding integer value for the given time unit.
807 !! <UL>
808 !! <LI> seconds = 1 </LI>
809 !! <LI> minutes = 2 </LI>
810 !! <LI> hours = 3 </LI>
811 !! <LI> days = 4 </LI>
812 !! <LI> months = 5 </LI>
813 !! <LI> years = 6 </LI>
814 !! <LI> unknown = -1 </LI>
815 !! </UL>
816 PURE INTEGER FUNCTION find_unit_ivalue(unit_string)
817 CHARACTER(len=*), INTENT(IN) :: unit_string !< Input string, containing the unit.
819 SELECT CASE (TRIM(unit_string))
820 CASE ('seconds')
821 find_unit_ivalue = 1
822 CASE ('minutes')
823 find_unit_ivalue = 2
824 CASE ('hours')
825 find_unit_ivalue = 3
826 CASE ('days')
827 find_unit_ivalue = 4
828 CASE ('months')
829 find_unit_ivalue = 5
830 CASE ('years')
831 find_unit_ivalue = 6
832 CASE DEFAULT
833 find_unit_ivalue = -1 ! Return statement if an incorrect / unknown unit used.
834 END SELECT
835 END FUNCTION find_unit_ivalue
837 !> @brief Allocate the file, in and out field arrays after reading the <TT>diag_table</TT> file. (CURRENTLY EMPTY)
838 SUBROUTINE initialize_output_arrays()
839 ! Place Holder
840 END SUBROUTINE initialize_output_arrays
842 END MODULE diag_table_mod
843 !> @}
844 ! close documentation grouping