FMS  2024.01.00
Flexible Modeling System
diag_table.F90
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>
249 
250 MODULE diag_table_mod
251 
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
258 
259  IMPLICIT NONE
260 
261  PRIVATE
262  PUBLIC :: parse_diag_table
263 
264  !> Private type to hold field information for the diag table
265  !> @ingroup diag_table_mod
267  CHARACTER(len=128) :: module_name, field_name, output_name, file_name
268  CHARACTER(len=50) :: time_sampling
269  CHARACTER(len=50) :: time_method
270  CHARACTER(len=50) :: spatial_ops
271  TYPE(coord_type) :: regional_coords
272  INTEGER :: pack
273  END TYPE field_description_type
274 
275  !> Private type to hold file information for the diag table
276  !> @ingroup diag_table_mod
278  INTEGER :: output_freq
279  INTEGER :: file_format
280  INTEGER :: new_file_freq
281  INTEGER :: file_duration
282  INTEGER :: iTime_units
283  INTEGER :: iOutput_freq_units
284  INTEGER :: iNew_file_freq_units
285  INTEGER :: iFile_duration_units
286  CHARACTER(len=128) :: file_name
287  CHARACTER(len=10) :: output_freq_units
288  CHARACTER(len=10) :: time_units
289  CHARACTER(len=128) :: long_name
290  CHARACTER(len=10) :: new_file_freq_units
291  CHARACTER(len=25) :: start_time_s
292  CHARACTER(len=10) :: file_duration_units
293  CHARACTER(len=10) :: filename_time_bounds
294  TYPE(time_type) :: start_time
295  END TYPE file_description_type
296 
297 !> @addtogroup diag_table_mod
298 !> @{
299 
300  CHARACTER(len=*), PARAMETER :: UNALLOWED_QTE = "'"//'"'
301  CHARACTER(len=*), PARAMETER :: UNALLOWED_ALL = unallowed_qte//","
302 
303 CONTAINS
304 
305  !> @brief Parse the <TT>diag_table</TT> in preparation for diagnostic output.
306  !! @details <TT>parse_diag_table</TT> is the public interface to parse the diag_table, and
307  !! setup the arrays needed to store the
308  !! requested diagnostics from the <TT>diag_table</TT>. <TT>parse_diag_table</TT> will
309  !! return a non-zero <TT>istat</TT> if
310  !! a problem parsing the <TT>diag_table</TT>.
311  !!
312  !! NOT YET IMPLEMENTED: <TT>parse_diag_table</TT> will parse through the <TT>diag_table</TT>
313  !! twice. The first pass, will be
314  !! to get a good "guess" of array sizes. These arrays, that will hold the requested
315  !! diagnostic fields and files, will then be
316  !! allocated to the size of the "guess" plus a slight increase.
317  SUBROUTINE parse_diag_table(diag_subset, istat, err_msg)
318  INTEGER, INTENT(in), OPTIONAL :: diag_subset !< Diagnostic sampling subset.
319  INTEGER, INTENT(out), OPTIONAL, TARGET :: istat !< Status of parsing the <TT>diag_table</TT>.
320  !! A non-zero status indicates a problem parsing the table.
321  CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< Error message corresponding to the
322  !! <TT>istat</TT> return value.
323 
324  INTEGER, PARAMETER :: dt_line_length = 256
325 
326  INTEGER :: record_len !< String length of the diag_table line read in.
327  INTEGER :: num_lines !< Number of lines in diag_table
328  INTEGER :: line_num !< Integer representation of the line number.
329  INTEGER :: commentstart !< Index location of first '#' on line
330  INTEGER :: diag_subset_output !< local value of diag_subset
331  INTEGER :: nfields, nfiles !< Number of fields and files. Not used yet.
332  INTEGER :: npass !< number of passes done while parsing the diag_table (1 for files, 2 for fields)
333  INTEGER, TARGET :: mystat !< variable to hold return status of function/subroutine calls.
334  INTEGER, POINTER :: pstat !< pointer that points to istat if preset, otherwise, points to mystat.
335 
336  CHARACTER(len=5) :: line_number !< String representation of the line number.
337  CHARACTER(len=256) :: record_line !< Current line from the diag_table.
338  CHARACTER(len=256) :: local_err_msg !< Sting to hold local error messages.
339  CHARACTER(len=:), DIMENSION(:), ALLOCATABLE :: diag_table
340  integer :: base_time_int(6) !< The base time as read in from the table [year month day hour min sec]
341 
342  TYPE(file_description_type) :: temp_file
343  TYPE(field_description_type) :: temp_field
344 
345  ! set up the pstat pointer
346  IF ( PRESENT(istat) ) THEN
347  pstat => istat
348  ELSE
349  pstat => mystat
350  END IF
351  ! Default return value (success)
352  pstat = 0
353 
354  IF ( PRESENT(diag_subset) ) THEN
355  diag_subset_output = diag_subset
356  ELSE
357  diag_subset_output = diag_all
358  END IF
359 
360  call ascii_read('diag_table', diag_table, num_lines=num_lines)
361 
362  ! Read in the global file labeling string
363  READ (unit=diag_table(1), fmt=*, iostat=mystat) global_descriptor
364  IF ( mystat /= 0 ) THEN
365  pstat = mystat
366  IF ( fms_error_handler('diag_table_mod::parse_diag_table', &
367  'Error reading the global descriptor from the diagnostic table.', err_msg) ) RETURN
368  END IF
369 
370  ! Read in the base date
371  READ (unit=diag_table(2), fmt=*, iostat=mystat) base_time_int
372  IF ( mystat /= 0 ) THEN
373  pstat = mystat
374  IF ( fms_error_handler('diag_manager_init', 'Error reading the base date from the diagnostic table.', &
375  & err_msg) ) RETURN
376  END IF
377 
378  call set_base_time(base_time_int)
379 
380  nfiles=0
381  nfields=0
382  pass: DO npass = 1, 2
383  parser: DO line_num=3, num_lines
384  ! Read in the entire line from the file.
385  ! If there is a read error, give a warning, and
386  ! cycle the parser loop.
387  READ (diag_table(line_num), fmt='(A)', iostat=mystat) record_line
388  ! Increase line counter, and put in string for use in warning/error messages.
389  WRITE (line_number, '(I5)') line_num
390 
391  IF ( mystat > 0 ) THEN
392  IF ( mpp_pe() == mpp_root_pe() ) &
393  & CALL error_mesg("diag_table_mod::parse_diag_table",&
394  & "Problem reading the diag_table (line:" //line_number//").", fatal)
395  cycle parser
396  ELSE IF ( mystat < 0 ) THEN
397  EXIT parser
398  END IF
399 
400  ! How long is the read in string?
401  record_len = len_trim(record_line)
402 
403  ! ignore blank lines and lines with comments only (comment marker '#')
404  commentstart = index(record_line,'#')
405  IF ( commentstart .NE. 0 ) record_line = record_line(1:commentstart-1)
406  IF ( len_trim(record_line) == 0 .OR. record_len == 0 ) cycle parser
407 
408  init: IF ( npass == 1 ) THEN ! Checking for files only
409  IF ( is_a_file(trim(record_line)) ) THEN
410  temp_file = parse_file_line(line=record_line, istat=mystat, err_msg=local_err_msg)
411 
412  IF ( mystat > 0 ) THEN
413  CALL error_mesg("diag_table_mod::parse_diag_table",&
414  & trim(local_err_msg)//" (line:" //trim(line_number)//").", fatal)
415  ELSE IF ( mystat < 0 ) THEN
416  IF ( mpp_pe() == mpp_root_pe() )&
417  & CALL error_mesg("diag_table_mod::parse_diag_table",&
418  & trim(local_err_msg)//" (line: "//trim(line_number)//").", warning)
419  cycle parser
420  ELSE IF ( (diag_subset_output == diag_other .AND. index(lowercase(temp_file%file_name), "ocean").NE.0)&
421  & .OR. (diag_subset_output == diag_ocean .AND. index(lowercase(temp_file%file_name), "ocean").EQ.0)&
422  & ) THEN
423  cycle parser
424  ELSE IF ( temp_file%new_file_freq > 0 ) THEN ! Call the init_file subroutine. The '1'
425  !! is for the tile_count
426  CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, &
427  & temp_file%file_format, temp_file%iTime_units, temp_file%long_name, 1, &
428  & temp_file%new_file_freq, temp_file%iNew_file_freq_units,&
429  & temp_file%start_time, temp_file%file_duration, temp_file%iFile_duration_units, &
430  & temp_file%filename_time_bounds)
431  ELSE
432  CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, &
433  & temp_file%file_format, temp_file%iTime_units, temp_file%long_name, 1)
434  END IF
435 
436  ! Increment number of files
437  nfiles = nfiles + 1
438  END IF
439  ELSE ! Looking for fields
440  IF ( .NOT.is_a_file(trim(record_line)) ) THEN
441  temp_field = parse_field_line(line=record_line, istat=mystat, err_msg=local_err_msg)
442 
443  ! Check for errors, then initialize the input and output field
444  IF ( mystat > 0 ) THEN
445  CALL error_mesg("diag_table_mod::parse_diag_table",&
446  & trim(local_err_msg)//" (line: "//trim(line_number)//").",fatal)
447  ELSE IF ( mystat < 0 ) THEN
448  IF ( mpp_pe() == mpp_root_pe() )&
449  & CALL error_mesg("diag_table_mod::Parse_diag_table",&
450  & trim(local_err_msg)//" (line: "//trim(line_number)//").",warning)
451  cycle parser
452  ELSE IF ((diag_subset_output == diag_other .AND. index(lowercase(temp_field%file_name), "ocean").NE.0)&
453  &.OR. (diag_subset_output == diag_ocean .AND. index(lowercase(temp_field%file_name), "ocean").EQ.0)&
454  & ) THEN
455  cycle parser
456  ELSE IF ( lowercase(trim(temp_field%spatial_ops)) == 'none' ) THEN
457  CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)
458  CALL init_output_field(temp_field%module_name, temp_field%field_name, temp_field%output_name, &
459  & temp_field%file_name, temp_field%time_method, temp_field%pack, 1)
460  ELSE
461  CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)
462  CALL init_output_field(temp_field%module_name, temp_field%field_name, temp_field%output_name, &
463  & temp_field%file_name, temp_field%time_method, temp_field%pack, 1, temp_field%regional_coords)
464  END IF
465 
466  ! Increment number of fields
467  nfields = nfields + 1
468  END IF
469  END IF init
470  END DO parser
471  END DO pass
472 
473  ! Close the diag_table file.
474  DEALLOCATE(diag_table)
475 
476  ! check duplicate output_fields in the diag_table
477  CALL check_duplicate_output_fields(err_msg=local_err_msg)
478  IF ( local_err_msg /= '' ) THEN
479  pstat = 1
480  IF ( fms_error_handler('diag_table_mod::parse_diag_table', trim(local_err_msg), err_msg) ) RETURN
481  END IF
482 
483  END SUBROUTINE parse_diag_table
484 
485  !> @brief <TT>parse_file_line</TT> parses a file description line from the <TT>diag_table</TT> file, and returns a
486  !! <TT>TYPE(file_description_type)</TT>. The calling function, would then need to call
487  !! the <TT>init_file</TT> to initialize
488  !! the diagnostic output file.
489  !! @return file_description_type parse_file_line
490  TYPE(file_description_type) function parse_file_line(line, istat, err_msg)
491  CHARACTER(len=*), INTENT(in) :: line !< Line to parse from the <TT>diag_table</TT> file.
492  INTEGER, INTENT(out), OPTIONAL, TARGET :: istat !< Return state of the function. A value of 0 indicates success.
493  !! A positive value indicates a <TT>FATAL</TT> error occurred,
494  !! and a negative value indicates a <TT>WARNING</TT>
495  !! should be issued.
496  CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< Error string to include in the <TT>FATAL</TT>
497  !! or <TT>WARNING</TT> message.
498 
499  INTEGER, TARGET :: mystat
500  INTEGER, POINTER :: pstat
501  INTEGER :: year, month, day, hour, minute, second
502  CHARACTER(len=256) :: local_err_msg !< Hold the return error message from routine calls.
503 
504  IF ( PRESENT(istat) ) THEN
505  pstat => istat
506  ELSE
507  pstat => mystat
508  END IF
509  pstat = 0 ! default success return value
510 
511  ! Initialize the optional file description fields.
512  parse_file_line%new_file_freq = 0
513  parse_file_line%new_file_freq_units = ''
514  parse_file_line%start_time_s = ''
515  parse_file_line%file_duration = 0
516  parse_file_line%file_duration_units = ''
517  parse_file_line%filename_time_bounds = ''
518 
519  ! Read in the file description line..
520  READ (line, fmt=*, iostat=mystat) parse_file_line%file_name, parse_file_line%output_freq, &
521  & parse_file_line%output_freq_units,&
522  & parse_file_line%file_format, parse_file_line%time_units, parse_file_line%long_name,&
523  & parse_file_line%new_file_freq, parse_file_line%new_file_freq_units, parse_file_line%start_time_s,&
524  & parse_file_line%file_duration, parse_file_line%file_duration_units, parse_file_line%filename_time_bounds
525  IF ( mystat > 0 ) THEN
526  pstat = mystat
527  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Incorrect file description format in diag_table.', &
528  & err_msg) ) RETURN
529  END IF
530 
531  ! Check for unallowed characters in strings
532  IF ( scan(parse_file_line%file_name, unallowed_all) > 0 ) THEN
533  pstat = 1
534  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
535  & 'Unallowed character in file_name in the diag_table.', err_msg) ) RETURN
536  END IF
537  IF ( scan(parse_file_line%output_freq_units, unallowed_all) > 0 ) THEN
538  pstat = 1
539  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
540  & 'Unallowed character in output_freq_units in the diag_table.', err_msg) ) RETURN
541  END IF
542  IF ( scan(parse_file_line%time_units, unallowed_all) > 0 ) THEN
543  pstat = 1
544  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
545  & 'Unallowed character in time_units in the diag_table.', err_msg) ) RETURN
546  END IF
547  IF ( scan(parse_file_line%long_name, unallowed_all) > 0 ) THEN
548  pstat = 1
549  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
550  & 'Unallowed character in long_name in the diag_table.', err_msg) ) RETURN
551  END IF
552  IF ( scan(parse_file_line%new_file_freq_units, unallowed_all) > 0 ) THEN
553  pstat = 1
554  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
555  & 'Unallowed character in new_file_freq_units in the diag_table.', err_msg) ) RETURN
556  END IF
557  IF ( scan(parse_file_line%start_time_s, unallowed_all) > 0 ) THEN
558  pstat = 1
559  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
560  & 'Unallowed character in start_time_s in the diag_table.', err_msg) ) RETURN
561  END IF
562  IF ( scan(parse_file_line%file_duration_units, unallowed_all) > 0 ) THEN
563  pstat = 1
564  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
565  & 'Unallowed character in file_duration_units in the diag_table.', err_msg) ) RETURN
566  END IF
567 
568 
569  ! Fix the file name
570  parse_file_line%file_name = fix_file_name(trim(parse_file_line%file_name))
571 
572  ! Verify values / formats are correct
573  IF ( parse_file_line%file_format > 2 .OR. parse_file_line%file_format < 1 ) THEN
574  pstat = 1
575  IF ( fms_error_handler('diag_table_mod::parse_file_line', &
576  & 'Invalid file format for file description in the diag_table.',&
577  & err_msg) ) RETURN
578  END IF
579 
580  ! check for known units
581  parse_file_line%iTime_units = find_unit_ivalue(parse_file_line%time_units)
582  parse_file_line%iOutput_freq_units = find_unit_ivalue(parse_file_line%output_freq_units)
583  parse_file_line%iNew_file_freq_units = find_unit_ivalue(parse_file_line%new_file_freq_units)
584  parse_file_line%iFile_duration_units = find_unit_ivalue(parse_file_line%file_duration_units)
585  ! Verify the units are valid
586  IF ( parse_file_line%iTime_units < 0 ) THEN
587  pstat = 1
588  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid time axis units in diag_table.', err_msg) )&
589  & RETURN
590  END IF
591  IF ( parse_file_line%iOutput_freq_units < 0 ) THEN
592  pstat = 1
593  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid output frequency units in diag_table.', &
594  & err_msg) ) RETURN
595  END IF
596  IF ( parse_file_line%iNew_file_freq_units < 0 .AND. parse_file_line%new_file_freq > 0 ) THEN
597  pstat = 1
598  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid new file frequency units in diag_table.', &
599  & err_msg) ) RETURN
600  END IF
601  IF ( parse_file_line%iFile_duration_units < 0 .AND. parse_file_line%file_duration > 0 ) THEN
602  pstat = 1
603  IF (fms_error_handler('diag_table_mod::parse_file_line', 'Invalid file duration units in diag_table.',err_msg))&
604  & RETURN
605  END IF
606 
607  !::sdu::
608  !::sdu:: Here is where we would want to parse the regional/global string
609  !::sdu::
610 
611  ! Check for file frequency, start time and duration presence.
612  ! This will determine how the init subroutine is called.
613  new_file_freq_present: IF ( parse_file_line%new_file_freq > 0 ) THEN ! New file frequency present.
614  IF ( len_trim(parse_file_line%start_time_s) > 0 ) THEN ! start time present
615  READ (parse_file_line%start_time_s, fmt=*, iostat=mystat) year, month, day, hour, minute, second
616  IF ( mystat /= 0 ) THEN
617  pstat = 1
618  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
619  & 'Invalid start time in the file description in diag_table.', err_msg) ) RETURN
620  END IF
621  parse_file_line%start_time = set_date(year, month, day, hour, minute, second, err_msg=local_err_msg)
622  IF ( local_err_msg /= '' ) THEN
623  pstat = 1
624  IF ( fms_error_handler('diag_table_mod::parse_file_line', local_err_msg, err_msg) ) RETURN
625  END IF
626  IF ( parse_file_line%file_duration <= 0 ) THEN ! file_duration not present
627  parse_file_line%file_duration = parse_file_line%new_file_freq
628  parse_file_line%iFile_duration_units = parse_file_line%iNew_file_freq_units
629  END IF
630  ELSE
631  parse_file_line%start_time = get_base_time()
632  parse_file_line%file_duration = parse_file_line%new_file_freq
633  parse_file_line%iFile_duration_units = parse_file_line%iNew_file_freq_units
634  END IF
635  END IF new_file_freq_present
636 
637  !< If filename_time_bounds is empty using defaults
638  IF (trim(parse_file_line%filename_time_bounds) == "") THEN
639  parse_file_line%filename_time_bounds = "middle"
640  ELSE
641  !< Check if the filename_time_bounds is one of the accepted values
642  IF (trim(parse_file_line%filename_time_bounds) /= "begin" .or. &
643  & trim(parse_file_line%filename_time_bounds) /= "middle" .or. &
644  & trim(parse_file_line%filename_time_bounds) /= "end") THEN
645  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
646  & 'filename_time_bounds must be "begin", "middle", "end".', err_msg) ) RETURN
647  ENDIF
648  ENDIF
649 
650  END FUNCTION parse_file_line
651 
652  !> @brief Parse a field description line from the <TT>diag_table</TT> file.
653  !! @return field_description_type parse_field_line
654  !! @details <TT>parse_field_line</TT> parses a field description line from the <TT>diag_table</TT>
655  !! file, and returns a
656  !! <TT>TYPE(field_description_type)</TT>. The calling function, would then need to call
657  !! the <TT>init_input_field</TT> and
658  !! <TT>init_output_field</TT> to initialize the diagnostic output field.
659  TYPE(field_description_type) function parse_field_line(line, istat, err_msg)
660  CHARACTER(len=*), INTENT(in) :: line !< Line to parse from the <TT>diag_table</TT> file.
661  INTEGER, INTENT(out), OPTIONAL, TARGET :: istat !< Return state of the function. A value of 0 indicates success.
662  !! A positive value indicates a <TT>FATAL</TT> error occurred,
663  !! and a negative value indicates a <TT>WARNING</TT>
664  !! should be issued.
665  CHARACTER(len=*), OPTIONAL, INTENT(out) :: err_msg !< Error string to include in the <TT>FATAL</TT>
666  !! or <TT>WARNING</TT> message.
667 
668  INTEGER, TARGET :: mystat
669  INTEGER, POINTER :: pstat
670 
671  IF ( PRESENT(istat) ) THEN
672  pstat => istat
673  ELSE
674  pstat => mystat
675  END IF
676  pstat = 0 ! default success return value
677 
678  READ (line, fmt=*, iostat=mystat) parse_field_line%module_name, parse_field_line%field_name, &
679  & parse_field_line%output_name, parse_field_line%file_name, parse_field_line%time_sampling, &
680  & parse_field_line%time_method, parse_field_line%spatial_ops, parse_field_line%pack
681  IF ( mystat /= 0 ) THEN
682  pstat = 1
683  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
684  & 'Field description format is incorrect in diag_table.', err_msg) ) RETURN
685  END IF
686 
687  ! Check for unallowed characters in the string
688  IF ( scan(parse_field_line%module_name, unallowed_all) > 0 ) THEN
689  pstat = 1
690  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
691  & 'Unallowed character in module_name in the diag_table.', err_msg) ) RETURN
692  END IF
693  IF ( scan(parse_field_line%field_name, unallowed_all) > 0 ) THEN
694  pstat = 1
695  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
696  & 'Unallowed character in field_name in the diag_table.', err_msg) ) RETURN
697  END IF
698  IF ( scan(parse_field_line%output_name, unallowed_all) > 0 ) THEN
699  pstat = 1
700  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
701  & 'Unallowed character in output_name in the diag_table.', err_msg) ) RETURN
702  END IF
703  IF ( scan(parse_field_line%file_name, unallowed_all) > 0 ) THEN
704  pstat = 1
705  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
706  & 'Unallowed character in file_name in the diag_table.', err_msg) ) RETURN
707  END IF
708  IF ( scan(parse_field_line%time_sampling, unallowed_all) > 0 ) THEN
709  pstat = 1
710  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
711  & 'Unallowed character in time_sampling in the diag_table.', err_msg) ) RETURN
712  END IF
713  IF ( scan(parse_field_line%time_method, unallowed_all) > 0 ) THEN
714  pstat = 1
715  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
716  & 'Unallowed character in time_method in the diag_table.', err_msg) ) RETURN
717  END IF
718  IF ( scan(parse_field_line%spatial_ops, unallowed_qte) > 0 ) THEN
719  pstat = 1
720  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
721  & 'Unallowed character in spatial_ops in the diag_table.', err_msg) ) RETURN
722  END IF
723 
724  ! Fix the file name
725  ! Removes any added '.nc' and appends additional information.
726  parse_field_line%file_name = fix_file_name(trim(parse_field_line%file_name))
727 
728  IF ( parse_field_line%pack > 8 .OR. parse_field_line%pack < 1 ) THEN
729  pstat = 1
730  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
731  & 'Packing is out of range for the field description in diag_table.', err_msg) ) RETURN
732  END IF
733 
734  IF ( lowercase(trim(parse_field_line%spatial_ops)) /= 'none' ) THEN
735  READ (parse_field_line%spatial_ops, fmt=*, iostat=mystat) parse_field_line%regional_coords
736  IF ( mystat /= 0 ) THEN
737  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
738  & 'Error in regional output description for field description in diag_table.', err_msg) ) RETURN
739  END IF
740  END IF
741  END FUNCTION parse_field_line
742 
743  !> @brief Determines if a line from the diag_table file is a file
744  !! @return Logical is_a_file
745  !! @details <TT>is_a_file</TT> checks a diag_table line to determine if the line describes
746  !! a file. If the line describes a file, the
747  !! <TT>is_a_file</TT> will return <TT>.TRUE.</TT>. Otherwise, it will return <TT>.FALSE.</TT>
748  PURE LOGICAL FUNCTION is_a_file(line)
749  CHARACTER(len=*), INTENT(in) :: line !< String containing the <TT>diag_table</TT> line.
750 
751  CHARACTER(len=5) :: first
752  INTEGER :: second
753  INTEGER :: mystat !< IO status from read
754 
755 #if defined __PATHSCALE__ || defined _CRAYFTN
756  ! This portion is to 'fix' pathscale's and Cray's Fortran compilers inability to handle
757  ! the FMT=* correctly in the read
758  ! statement.
759  CHARACTER(len=10) :: secondstring
760  INTEGER :: comma1, comma2, linelen
761 
762  linelen = len(line)
763  comma1 = index(line,',') + 1 ! +1 to go past the comma
764  comma2 = index(line(comma1:linelen),',') + comma1 - 2 ! -2 to get rid of +1 in comma1 and to get
765  !! 1 character before the comma
766 
767  secondstring = adjustl(line(comma1:comma2))
768  READ (unit=secondstring, fmt='(I)', iostat=mystat) second
769 #else
770  READ (unit=line, fmt=*, iostat=mystat) first, second
771 #endif
772 
773  ! The line is a file if my status is zero after the read.
774  is_a_file = mystat == 0
775  END FUNCTION is_a_file
776 
777  !> @brief Fixes the file name for use with diagnostic file and field initializations.
778  !! @return Character(len=128) fix_file_name
779  PURE CHARACTER(len=128) FUNCTION fix_file_name(file_name_string)
780  CHARACTER(len=*), INTENT(IN) :: file_name_string !< String containing the file name from the <TT>diag_table</TT>.
781 
782  INTEGER :: file_name_len
783 
784  fix_file_name = file_name_string ! Default return value
785 
786  file_name_len = len_trim(file_name_string)
787 
788  ! Remove trailing '.nc' from the file_name, and append suffixes
789  IF ( file_name_len > 2 ) THEN
790  IF ( file_name_string(file_name_len-2:file_name_len) == '.nc' ) THEN
791  fix_file_name = file_name_string(1:file_name_len-3)
792  file_name_len = file_name_len - 3
793  END IF
794  END IF
795 
796  ! Add the optional suffix based on the pe list name if the
797  ! append_pelist_name == .TRUE.
798  IF ( append_pelist_name ) THEN
799  fix_file_name(file_name_len+1:) = trim(pelist_name)
800  END IF
801  END FUNCTION fix_file_name
802 
803  !> @brief Return the integer value for the given time unit.
804  !! @return Integer find_unit_ivalue
805  !! @details Returns the corresponding integer value for the given time unit.
806  !! <UL>
807  !! <LI> seconds = 1 </LI>
808  !! <LI> minutes = 2 </LI>
809  !! <LI> hours = 3 </LI>
810  !! <LI> days = 4 </LI>
811  !! <LI> months = 5 </LI>
812  !! <LI> years = 6 </LI>
813  !! <LI> unknown = -1 </LI>
814  !! </UL>
815  PURE INTEGER FUNCTION find_unit_ivalue(unit_string)
816  CHARACTER(len=*), INTENT(IN) :: unit_string !< Input string, containing the unit.
817 
818  SELECT CASE (trim(unit_string))
819  CASE ('seconds')
820  find_unit_ivalue = 1
821  CASE ('minutes')
822  find_unit_ivalue = 2
823  CASE ('hours')
824  find_unit_ivalue = 3
825  CASE ('days')
826  find_unit_ivalue = 4
827  CASE ('months')
828  find_unit_ivalue = 5
829  CASE ('years')
830  find_unit_ivalue = 6
831  CASE DEFAULT
832  find_unit_ivalue = -1 ! Return statement if an incorrect / unknown unit used.
833  END SELECT
834  END FUNCTION find_unit_ivalue
835 
836  !> @brief Allocate the file, in and out field arrays after reading the <TT>diag_table</TT> file. (CURRENTLY EMPTY)
838  ! Place Holder
839  END SUBROUTINE initialize_output_arrays
840 
841 END MODULE diag_table_mod
842 !> @}
843 ! close documentation grouping
type(time_type) function get_base_time()
gets the module variable base_time
Definition: diag_data.F90:511
subroutine set_base_time(base_time_int)
Set the module variable base_time.
Definition: diag_data.F90:463
Define the region for field output.
Definition: diag_data.F90:171
pure character(len=128) function fix_file_name(file_name_string)
Fixes the file name for use with diagnostic file and field initializations.
Definition: diag_table.F90:780
subroutine initialize_output_arrays()
Allocate the file, in and out field arrays after reading the diag_table file. (CURRENTLY EMPTY)
Definition: diag_table.F90:838
type(field_description_type) function parse_field_line(line, istat, err_msg)
Parse a field description line from the diag_table file.
Definition: diag_table.F90:660
type(file_description_type) function parse_file_line(line, istat, err_msg)
parse_file_line parses a file description line from the diag_table file, and returns a TYPE(file_desc...
Definition: diag_table.F90:491
pure logical function is_a_file(line)
Determines if a line from the diag_table file is a file.
Definition: diag_table.F90:749
subroutine, public parse_diag_table(diag_subset, istat, err_msg)
Parse the diag_table in preparation for diagnostic output.
Definition: diag_table.F90:318
pure integer function find_unit_ivalue(unit_string)
Return the integer value for the given time unit.
Definition: diag_table.F90:816
Private type to hold field information for the diag table.
Definition: diag_table.F90:266
Private type to hold file information for the diag table.
Definition: diag_table.F90:277
subroutine, public init_input_field(module_name, field_name, tile_count)
Initialize the input field.
Definition: diag_util.F90:1311
subroutine, public init_file(name, output_freq, output_units, format, time_units, long_name, tile_count, new_file_freq, new_file_freq_units, start_time, file_duration, file_duration_units, filename_time_bounds)
Initialize the output file.
Definition: diag_util.F90:1065
subroutine, public init_output_field(module_name, field_name, output_name, output_file, time_method, pack, tile_count, local_coord)
Initialize the output field.
Definition: diag_util.F90:1344
subroutine, public check_duplicate_output_fields(err_msg)
Checks to see if output_name and output_file are unique in output_fields.
Definition: diag_util.F90:2238
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
Definition: fms.F90:525
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
Definition: fms.F90:498
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:378
Given an input date in year, month, days, etc., creates a time_type that represents this time interva...
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.