FV3 Bundle
diag_table.F90
Go to the documentation of this file.
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 
21  ! <CONTACT EMAIL="seth.underwood@noaa.gov">
22  ! Seth Underwood
23  ! </CONTACT>
24  ! <HISTORY SRC="http://www.gfdl.noaa.gov/fms-cgi-bin/cvsweb.cgi/FMS/" />
25  ! <OVERVIEW>
26  ! <TT>diag_table_mod</TT> is a set of subroutines use to parse out the data from a <TT>diag_table</TT>. This module
27  ! will also setup the arrays required to store the information by counting the number of input fields, output files, and
28  ! files.
29  ! </OVERVIEW>
30  ! <DESCRIPTION>
31  ! <TT>diag_table_mod</TT> parses the <TT>diag_table</TT> file, and sets up the required arrays to hold the information
32  ! needed for the <TT>diag_manager_mod</TT> to correctly write out the model history files.
33  !
34  ! The <I>diagnostics table</I> allows users to specify sampling rates and the choice of fields at run time. The
35  ! <TT>diag_table</TT> file consists of comma-separated ASCII values. The <TT>diag_table</TT> essentially has three sections:
36  ! <B>Global</B>, <B>File</B>, and <B>Field</B> sections. The <B>Global</B> section must be the first two lines of the file,
37  ! whereas the <B>File</B> and <B>Field</B> sections can be inter mixed to allow the file to be organized as desired.
38  ! Comments can be added to the <TT>diag_table</TT> file by using the hash symbol (#) as 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 <TT>diag_table_chk</TT>has been
41  ! added to the FRE tools suite to check a <TT>diag_table</TT> for errors. A brief usage statement can be obtained by running
42  ! <TT>diag_table_chk --help</TT>, and a man page like description can views by running <TT>perldoc diag_table_chk</TT>.
43  !
44  ! Below is a description of the three sections.
45  ! <OL>
46  ! <LI>
47  ! <B>Global Section:</B> The first two lines of the <TT>diag_table</TT> must contain the <I>title</I> and the <I>base
48  ! date</I> of the experiment respectively. The <I>title</I> must be a Fortran CHARACTER string. The <I>base date</I>
49  ! is the reference time used for the time units, and must be greater than or equal to the model start time.
50  ! The <I>base date</I> consists of six space-separated integer in the following format.<BR />
51  ! <TT><NOBR>year month day hour minute second</NOBR></TT><BR />
52  ! </LI>
53  ! <LI>
54  ! <B>File Section:</B> File lines contain 6 required and 5 optional fields (optional fields are surrounded with
55  ! square brackets ([]). File lines can be intermixed with the field lines, but the file must be defined before any
56  ! fields that are to be written to the file. File lines have the following format:<BR />
57  ! <PRELN>
58  ! "file_name", output_freq, "output_freq_units", file_format, "time_axis_units", "time_axis_name"
59  ! [, new_file_freq, "new_file_freq_units"[, "start_time"[, file_duration, "file_duration_units"]]]
60  ! </PRELN>
61  ! <BR />
62  ! with the following descriptions.
63  ! <DL>
64  ! <DT><TT>CHARACTER(len=128) :: file_name</TT></DT>
65  ! <DD>
66  ! Output file name without the trailing "<TT>.nc</TT>".
67  !
68  ! A single file description can produce multiple files using special time string suffix keywords. This time string
69  ! will append the time strings to the base file name each time a new file is opened. They syntax for the time string
70  ! suffix keywords are <TT>%#tt</TT> Where <TT>#</TT> is a mandatory single digit number specifying the width of the
71  ! field, and <TT>tt</TT> can be as follows:
72  ! <NL>
73  ! <LI><TT>yr</TT> <EN /> Years</LI>
74  ! <LI><TT>mo</TT> <EN /> Months</LI>
75  ! <LI><TT>dy</TT> <EN /> Days</LI>
76  ! <LI><TT>hr</TT> <EN /> Hours</LI>
77  ! <LI><TT>mi</TT> <EN /> Minutes</LI>
78  ! <LI><TT>sc</TT> <EN /> Seconds</LI>
79  ! </NL>
80  ! Thus, a file name of <TT>file2_yr_dy%1yr%3dy</TT> will have a base file name of <TT>file2_yr_dy_1_001</TT> if the
81  ! file is created on year 1 day 1 of the model run. <B><I>NOTE:</I></B> The time suffix keywords must be used if the
82  ! optional fields <TT>new_file_freq</TT> and <TT>new_file_freq_units</TT> are used, otherwise a <TT>FATAL</TT> error
83  ! will occur.
84  ! </DD>
85  !
86  ! <DT><TT>INTEGER :: output_freq</TT></DT>
87  ! <DD>How often to write fields to file.
88  ! <NL>
89  ! <LI><TT>> 0</TT> <EN /> Output frequency in <TT>output_freq_units</TT>.</LI>
90  ! <LI><TT>= 0</TT> <EN /> Output frequency every time set. (<TT>output_freq_units</TT> is ignored.)</LI>
91  ! <LI><TT>=-1</TT> <EN /> Output at end of run only. (<TT>output_freq_units</TT> is ignored.)</LI>
92  ! </NL>
93  ! </DD>
94  ! <DT><TT>CHARACTER(len=10) :: output_freq_units</TT></DT>
95  ! <DD>
96  ! Time units for output. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>, <TT>minutes</TT>,
97  ! <TT>hours</TT>, or <TT>seconds</TT>.
98  ! </DD>
99  ! <DT><TT>INTEGER :: file_format</TT></DT>
100  ! <DD>
101  ! Output file format. Currently only the <I>netCDF</I> file format is supported.
102  ! <NL>
103  ! <LI><TT>= 1</TT> <EN /> netCDF</LI>
104  ! </NL>
105  ! </DD>
106  ! <DT><TT>CHARACTER(len=10) :: time_axis_units</TT></DT>
107  ! <DD>
108  ! Time units for the output file time axis. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>,
109  ! <TT>minutes</TT>, <TT>hours</TT>, or <TT>seconds</TT>.
110  ! </DD>
111  ! <DT><TT>CHARACTER(len=128) :: time_axis_name</TT></DT>
112  ! <DD>
113  ! Axis name for the output file time axis. The character sting must contain the string 'time'. (mixed upper and
114  ! lowercase allowed.)
115  ! </DD>
116  ! <DT><TT>INTEGER, OPTIONAL :: new_file_freq</TT></DT>
117  ! <DD>
118  ! Frequency for closing the existing file, and creating a new file in <TT>new_file_freq_units</TT>.
119  ! </DD>
120  ! <DT><TT>CHARACTER(len=10), OPTIONAL :: new_file_freq_units</TT></DT>
121  ! <DD>
122  ! Time units for creating a new file. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>,
123  ! <TT>minutes</TT>, <TT>hours</TT>, or <TT>seconds</TT>. <B><I>NOTE:</I></B> If the <TT>new_file_freq</TT> field is
124  ! present, then this field must also be present.
125  ! </DD>
126  ! <DT><TT>CHARACTER(len=25), OPTIONAL :: start_time</TT></DT>
127  ! <DD>
128  ! Time to start the file for the first time. The format of this string is the same as the <I>global date</I>. <B><I>
129  ! NOTE:</I></B> The <TT>new_file_freq</TT> and the <TT>new_file_freq_units</TT> fields must be present to use this field.
130  ! </DD>
131  ! <DT><TT>INTEGER, OPTIONAL :: file_duration</TT></DT>
132  ! <DD>
133  ! How long file should receive data after start time in <TT>file_duration_units</TT>. This optional field can only
134  ! be used if the <TT>start_time</TT> field is present. If this field is absent, then the file duration will be equal
135  ! to the frequency for creating new files. <B><I>NOTE:</I></B> The <TT>file_duration_units</TT> field must also be
136  ! present if this field is present.
137  ! </DD>
138  ! <DT><TT>CHARACTER(len=10), OPTIONAL :: file_duration_units</TT></DT>
139  ! <DD>
140  ! File duration units. Can be either <TT>years</TT>, <TT>months</TT>, <TT>days</TT>,
141  ! <TT>minutes</TT>, <TT>hours</TT>, or <TT>seconds</TT>. <B><I>NOTE:</I></B> If the <TT>file_duration</TT> field is
142  ! present, then this field must also be present.
143  ! </DD>
144  ! </DL>
145  ! </LI>
146  ! <LI>
147  ! <B>Field Section:</B> Field lines contain 8 fields. Field lines can be intermixed with file lines. Fields line can contain
148  ! fields that are not written to any files. The file name for these fields is <TT>null</TT>.
149  !
150  ! Field lines have the following format:<BR />
151  ! <PRE>
152  ! "module_name", "field_name", "output_name", "file_name", "time_sampling", "reduction_method", "regional_section", packing
153  ! </PRE>
154  ! with the following descriptions.
155  ! <DL>
156  ! <DT><TT>CHARACTER(len=128) :: module_name</TT></DT>
157  ! <DD>Module that contains the <TT>field_name</TT> variable. (e.g. <TT>atmos_mod</TT>, <TT>land_mod</TT>)</DD>
158  ! <DT><TT>CHARACTER(len=128) :: field_name</TT></DT>
159  ! <DD>Module variable name that has data to be written to file.</DD>
160  ! <DT><TT>CHARACTER(len=128) :: output_name</TT></DT>
161  ! <DD>Name of the field as written in <TT>file_name</TT>.</DD>
162  ! <DT><TT>CHARACTER(len=128) :: file_name</TT></DT>
163  ! <DD>
164  ! Name of the file where the field is to be written. <B><I>NOTE:</I></B> The file <TT>file_name</TT> must be
165  ! defined first.
166  ! </DD>
167  ! <DT><TT>CHARACTER(len=50) :: time_sampling</TT></DT>
168  ! <DD>Currently not used. Please use the string "all".</DD>
169  ! <DT><TT>CHARACTER(len=50) :: reduction_method</TT></DT>
170  ! <DD>
171  ! The data reduction method to perform prior to writing data to disk. Valid options are (redundant names are
172  ! separated with commas):
173  ! <DL>
174  ! <DT><TT>.TRUE.</TT>, average, avg, mean</DT>
175  ! <DD>Average from the last time written to the current time.</DD>
176  ! <DT><TT>.FALSE.</TT>, none</DT>
177  ! <DD>No reduction performed. Write current time step value only.</DD>
178  ! <DT>rms</DT> <DD>Calculate the root mean square from the last time written to the current time.</DD>
179  ! <DT>pow##</DT> <DD>Calculate the mean of the power ## from the last time written to the current time.</DD>
180  ! <DT>min</DT> <DD>Minimum value from last write to current time.</DD>
181  ! <DT>max</DT> <DD>Maximum value from last write to current time.</DD>
182  ! <DT>diurnal##</DT> <DD>## diurnal averages</DD>
183  ! </DL>
184  ! </DD>
185  ! <DT><TT>CHARACTER(len=50) :: regional_section</TT></DT>
186  ! <DD>
187  ! Bounds of the regional section to capture. A value of <TT>none</TT> indicates a global region. The regional
188  ! section has the following format:<BR />
189  ! <TT>lat_min, lat_max, lon_min, lon_max, vert_min, vert_max</TT><BR />
190  ! Use <TT>vert_min = -1</TT> and <TT>vert_max = -1</TT> to get the entire vertical axis. <B><I>NOTE:</I></B>
191  ! Currently, the defined region <I>MUST</I> be confined to a single tile.
192  ! </DD>
193  ! <DT><TT>INTEGER :: packing</TT></DT>
194  ! <DD>
195  ! Fortran number <TT>KIND</TT> of the data written. Valid values:
196  ! <NL>
197  ! <LI><TT>= 1</TT> <EN /> double precision</LI>
198  ! <LI><TT>= 2</TT> <EN /> float</LI>
199  ! <LI><TT>= 4</TT> <EN /> packed 16-bit integers</LI>
200  ! <LI><TT>= 8</TT> <EN /> packed 1-byte (not tested).</LI>
201  ! </NL>
202  ! </DD>
203  ! </DL>
204  ! </LI>
205  ! </OL>
206  !
207  ! <H4><B>Sample <TT>diag_table</TT></B></H4>
208  ! <NL>
209  ! <LI>
210  ! <PRE>
211  ! "diag manager test"
212  ! 1999 1 1 0 0 0
213  !
214  ! #output files
215  ! 10_days, 10, "days", 1, "hours", "Time"
216  ! "file1_hr%hr3", 5, "days", 1, "hours", "Time", 15, "days"
217  ! "file2_yr_dy%yr1%dy3", 5, "days", 1, "hours", "Time", 10, "days", "1 1 7 0 0 0"
218  ! "file3_yr_dy%yr1%dy3", 5, "days", 1, "hours", "Time", 20, "days", "1 1 7 0 0 0", 5, "years"
219  !
220  ! #output variables
221  ! "ice_mod", "ice", "ice", "10_days", "all", .false., "none", 2
222  !
223  ! # temp_local file and fields.
224  ! temp_local, 1, "days", 1, "hours", "Time"
225  ! "ocean_mod", "temp", "temp", "temp_local", "all", .FALSE., "5 259.5 -59.5 59.5 1 1", 2
226  ! </PRE>
227  ! </LI>
228  ! </NL>
229  !
230  ! <H4>Useful Additional Utility</H4>
231  ! A simple utility has been created to help discover
232  ! </DESCRIPTION>
233  USE mpp_io_mod, ONLY: mpp_open, mpp_rdonly
234  USE mpp_mod, ONLY: read_ascii_file, get_ascii_file_num_lines
235  USE fms_mod, ONLY: fms_error_handler, error_mesg, file_exist, stdlog, mpp_pe, mpp_root_pe, fatal, warning, lowercase, close_file
238 
242 
243  IMPLICIT NONE
244 
245  PRIVATE
246  PUBLIC :: parse_diag_table
247 
249  CHARACTER(len=128) :: module_name, field_name, output_name, file_name
250  CHARACTER(len=50) :: time_sampling
251  CHARACTER(len=50) :: time_method
252  CHARACTER(len=50) :: spatial_ops
253  TYPE(coord_type) :: regional_coords
254  INTEGER :: pack
255  END TYPE field_description_type
256 
258  INTEGER :: output_freq
259  INTEGER :: file_format
260  INTEGER :: new_file_freq
261  INTEGER :: file_duration
262  INTEGER :: itime_units
263  INTEGER :: ioutput_freq_units
264  INTEGER :: inew_file_freq_units
265  INTEGER :: ifile_duration_units
266  CHARACTER(len=128) :: file_name
267  CHARACTER(len=10) :: output_freq_units
268  CHARACTER(len=10) :: time_units
269  CHARACTER(len=128) :: long_name
270  CHARACTER(len=10) :: new_file_freq_units
271  CHARACTER(len=25) :: start_time_s
272  CHARACTER(len=10) :: file_duration_units
273  TYPE(time_type) :: start_time
274  END TYPE file_description_type
275 
276  CHARACTER(len=*), PARAMETER :: unallowed_qte = "'"//'"'
277  CHARACTER(len=*), PARAMETER :: unallowed_all = unallowed_qte//","
278 
279 CONTAINS
280 
281  ! <SUBROUTINE NAME="parse_diag_table">
282  ! <OVERVIEW>
283  ! Parse the <TT>diag_table</TT> in preparation for diagnostic output.
284  ! </OVERVIEW>
285  ! <TEMPLATE>
286  ! SUBROUTINE parse_diag_table(diag_subset, istat, err_msg)
287  ! </TEMPLATE>
288  ! <DESCRIPTION>
289  ! <TT>parse_diag_table</TT> is the public interface to parse the diag_table, and setup the arrays needed to store the
290  ! requested diagnostics from the <TT>diag_table</TT>. <TT>parse_diag_table</TT> will return a non-zero <TT>istat</TT> if
291  ! a problem parsing the <TT>diag_table</TT>.
292  !
293  ! NOT YET IMPLEMENTED: <TT>parse_diag_table</TT> will parse through the <TT>diag_table</TT> twice. The first pass, will be
294  ! to get a good "guess" of array sizes. These arrays, that will hold the requested diagnostic fields and files, will then be
295  ! allocated to the size of the "guess" plus a slight increase.
296  ! </DESCRIPTION>
297  ! <IN NAME="diag_subset" TYPE="INTEGER, OPTIONAL">
298  ! Diagnostic sampling subset.
299  ! </IN>
300  ! <OUT NAME="iunit" TYPE="INTEGER, OPTIONAL">
301  ! Status of parsing the <TT>diag_table</TT>. A non-zero status indicates a problem parsing the table.
302  ! </OUT>
303  ! <OUT NAME="err_msg" TYPE="CHARACTER(len=*), OPTIONAL">
304  ! Error message corresponding to the <TT>istat</TT> return value.
305  ! </OUT>
306  ! <ERROR STATUS="FATAL">
307  ! diag_table file does not exist.
308  ! </ERROR>
309  ! <ERROR STATUS="FATAL">
310  ! Error reading the global descriptor from the diagnostic table.
311  ! </ERROR>
312  ! <ERROR STATUS="FATAL">
313  ! Error reading the base date from the diagnostic table.
314  ! </ERROR>
315  ! <ERROR STATUS="FATAL">
316  ! The base_year/month/day can not equal zero
317  ! </ERROR>
318  ! <ERROR STATUS="WARNING">
319  ! Problem reading diag_table, line numbers in errors may be incorrect.
320  ! </ERROR>
321  ! <ERROR STATUS="FATAL">
322  ! Problem reading the diag_table (line: <line_number>)
323  ! </ERROR>
324  ! <ERROR STATUS="FATAL">
325  ! Incorrect file description FORMAT in diag_table. (line: <line_number>)
326  ! </ERROR>
327  ! <ERROR STATUS="FATAL">
328  ! Invalid file FORMAT for file description in the diag_table. (line: <line_number>)
329  ! </ERROR>
330  ! <ERROR STATUS="FATAL">
331  ! Invalid time axis units in diag_table. (line: <line_number>)
332  ! </ERROR>
333  ! <ERROR STATUS="FATAL">
334  ! Invalid output frequency units in diag_table. (line: <line_number>)
335  ! </ERROR>
336  ! <ERROR STATUS="FATAL">
337  ! Invalid NEW file frequency units in diag_table. (line: <line_number>)
338  ! </ERROR>
339  ! <ERROR STATUS="FATAL">
340  ! Invalid file duration units in diag_table. (line: <line_number>)
341  ! </ERROR>
342  ! <ERROR STATUS="FATAL">
343  ! Invalid start time in the file description in diag_table. (line: <line_number>)
344  ! </ERROR>
345  ! <ERROR STATUS="FATAL">
346  ! Field description FORMAT is incorrect in diag_table. (line: <line_number>)
347  ! </ERROR>
348  ! <ERROR STATUS="FATAL">
349  ! Packing is out of range for the field description in diag_table. (line: <line_number>)
350  ! </ERROR>
351  ! <ERROR STATUS="FATAL">
352  ! Error in regional output description for field description in diag_table. (line: <line_number>)
353  ! </ERROR>
354  SUBROUTINE parse_diag_table(diag_subset, istat, err_msg)
355  INTEGER, INTENT(in), OPTIONAL :: diag_subset
356  INTEGER, INTENT(out), OPTIONAL, TARGET :: istat
357  CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
358 
359  INTEGER, PARAMETER :: dt_line_length = 256
360 
361  INTEGER :: stdlog_unit !< Fortran file unit number for the stdlog file.
362  INTEGER :: record_len !< String length of the diag_table line read in.
363  INTEGER :: num_lines !< Number of lines in diag_table
364  INTEGER :: line_num !< Integer representation of the line number.
365  INTEGER :: commentstart !< Index location of first '#' on line
366  INTEGER :: diag_subset_output !< local value of diag_subset
367  INTEGER :: nfields, nfiles !< Number of fields and files. Not used yet.
368  INTEGER :: npass !< number of passes done while parsing the diag_table (1 for files, 2 for fields)
369  INTEGER, TARGET :: mystat !< variable to hold return status of function/subroutine calls.
370  INTEGER, POINTER :: pstat !< pointer that points to istat if preset, otherwise, points to mystat.
371 
372  CHARACTER(len=5) :: line_number !< String representation of the line number.
373  CHARACTER(len=9) :: amonth !< Month name
374  CHARACTER(len=256) :: record_line !< Current line from the diag_table.
375  CHARACTER(len=256) :: local_err_msg !< Sting to hold local error messages.
376  CHARACTER(len=DT_LINE_LENGTH), DIMENSION(:), ALLOCATABLE :: diag_table
377 
378  TYPE(file_description_type) :: temp_file
379  TYPE(field_description_type) :: temp_field
380 
381  ! set up the pstat pointer
382  IF ( PRESENT(istat) ) THEN
383  pstat => istat
384  ELSE
385  pstat => mystat
386  END IF
387  ! Default return value (success)
388  pstat = 0
389 
390  IF ( PRESENT(diag_subset) ) THEN
391  diag_subset_output = diag_subset
392  ELSE
393  diag_subset_output = diag_all
394  END IF
395 
396  ! get the stdlog unit number
397  stdlog_unit = stdlog()
398  num_lines = get_ascii_file_num_lines('diag_table', dt_line_length)
399  allocate(diag_table(num_lines))
400 
401  call read_ascii_file('diag_table', dt_line_length, diag_table)
402 
403  ! Read in the global file labeling string
404  READ (unit=diag_table(1), fmt=*, iostat=mystat) global_descriptor
405  IF ( mystat /= 0 ) THEN
406  pstat = mystat
407  IF ( fms_error_handler('diag_table_mod::parse_diag_table', 'Error reading the global descriptor from the diagnostic table.',&
408  & err_msg) ) RETURN
409  END IF
410 
411  ! Read in the base date
412  READ (unit=diag_table(2), fmt=*, iostat=mystat) base_year, base_month, base_day, base_hour, base_minute, base_second
413  IF ( mystat /= 0 ) THEN
414  pstat = mystat
415  IF ( fms_error_handler('diag_manager_init', 'Error reading the base date from the diagnostic table.', err_msg) ) RETURN
416  END IF
417 
418  ! Set up the time type for base time
419  IF ( get_calendar_type() /= no_calendar ) THEN
420  IF ( base_year==0 .OR. base_month==0 .OR. base_day==0 ) THEN
421  pstat = 101
422  IF ( fms_error_handler('diag_table_mod::parse_diag_table', 'The base_year/month/day can not equal zero', err_msg) ) RETURN
423  END IF
425  amonth = month_name(base_month)
426  ELSE
427  ! No calendar - ignore year and month
429  base_year = 0
430  base_month = 0
431  amonth = 'day'
432  END IF
433 
434  IF ( mpp_pe() == mpp_root_pe() ) THEN
435  WRITE (stdlog_unit,'("base date used = ",I4,1X,A,2I3,2(":",I2.2)," gmt")') base_year, trim(amonth), base_day, &
437  END IF
438 
439  nfiles=0
440  nfields=0
441  pass: DO npass = 1, 2
442  parser: DO line_num=3, num_lines
443  ! Read in the entire line from the file.
444  ! If there is a read error, give a warning, and
445  ! cycle the parser loop.
446  READ (diag_table(line_num), fmt='(A)', iostat=mystat) record_line
447  ! Increase line counter, and put in string for use in warning/error messages.
448  WRITE (line_number, '(I5)') line_num
449 
450  IF ( mystat > 0 ) THEN
451  IF ( mpp_pe() == mpp_root_pe() ) &
452  & CALL error_mesg("diag_table_mod::parse_diag_table",&
453  & "Problem reading the diag_table (line:" //line_number//").", fatal)
454  cycle parser
455  ELSE IF ( mystat < 0 ) THEN
456  EXIT parser
457  END IF
458 
459  ! How long is the read in string?
460  record_len = len_trim(record_line)
461 
462  ! ignore blank lines and lines with comments only (comment marker '#')
463  commentstart = index(record_line,'#')
464  IF ( commentstart .NE. 0 ) record_line = record_line(1:commentstart-1)
465  IF ( len_trim(record_line) == 0 .OR. record_len == 0 ) cycle parser
466 
467  init: IF ( npass == 1 ) THEN ! Checking for files only
468  IF ( is_a_file(trim(record_line)) ) THEN
469  temp_file = parse_file_line(line=record_line, istat=mystat, err_msg=local_err_msg)
470 
471  IF ( mystat > 0 ) THEN
472  CALL error_mesg("diag_table_mod::parse_diag_table",&
473  & trim(local_err_msg)//" (line:" //trim(line_number)//").", fatal)
474  ELSE IF ( mystat < 0 ) THEN
475  IF ( mpp_pe() == mpp_root_pe() )&
476  & CALL error_mesg("diag_table_mod::parse_diag_table",&
477  & trim(local_err_msg)//" (line: "//trim(line_number)//").", warning)
478  cycle parser
479  ELSE IF ( (diag_subset_output == diag_other .AND. index(lowercase(temp_file%file_name), "ocean") .NE. 0).OR.&
480  & (diag_subset_output == diag_ocean .AND. index(lowercase(temp_file%file_name), "ocean") .EQ. 0) ) THEN
481  cycle parser
482  ELSE IF ( temp_file%new_file_freq > 0 ) THEN ! Call the init_file subroutine. The '1' is for the tile_count
483  CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, temp_file%file_format,&
484  & temp_file%iTime_units, temp_file%long_name, 1, temp_file%new_file_freq, temp_file%iNew_file_freq_units,&
485  & temp_file%start_time, temp_file%file_duration, temp_file%iFile_duration_units)
486  ELSE
487  CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, temp_file%file_format,&
488  & temp_file%iTime_units, temp_file%long_name, 1)
489  END IF
490 
491  ! Increment number of files
492  nfiles = nfiles + 1
493  END IF
494  ELSE ! Looking for fields
495  IF ( .NOT.is_a_file(trim(record_line)) ) THEN
496  temp_field = parse_field_line(line=record_line, istat=mystat, err_msg=local_err_msg)
497 
498  ! Check for errors, then initialize the input and output field
499  IF ( mystat > 0 ) THEN
500  CALL error_mesg("diag_table_mod::parse_diag_table",&
501  & trim(local_err_msg)//" (line: "//trim(line_number)//").",fatal)
502  ELSE IF ( mystat < 0 ) THEN
503  IF ( mpp_pe() == mpp_root_pe() )&
504  & CALL error_mesg("diag_table_mod::Parse_diag_table",&
505  & trim(local_err_msg)//" (line: "//trim(line_number)//").",warning)
506  cycle parser
507  ELSE IF ( (diag_subset_output == diag_other .AND. index(lowercase(temp_field%file_name), "ocean") .NE. 0).OR.&
508  & (diag_subset_output == diag_ocean .AND. index(lowercase(temp_field%file_name), "ocean") .EQ. 0) ) THEN
509  cycle parser
510  ELSE IF ( lowercase(trim(temp_field%spatial_ops)) == 'none' ) THEN
511  CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)
512  CALL init_output_field(temp_field%module_name, temp_field%field_name, temp_field%output_name, temp_field%file_name,&
513  & temp_field%time_method, temp_field%pack, 1)
514  ELSE
515  CALL init_input_field(temp_field%module_name, temp_field%field_name, 1)
516  CALL init_output_field(temp_field%module_name, temp_field%field_name, temp_field%output_name, temp_field%file_name,&
517  & temp_field%time_method, temp_field%pack, 1, temp_field%regional_coords)
518  END IF
519 
520  ! Increment number of fields
521  nfields = nfields + 1
522  END IF
523  END IF init
524  END DO parser
525  END DO pass
526 
527  ! Close the diag_table file.
528  DEALLOCATE(diag_table)
529 
530  ! check duplicate output_fields in the diag_table
531  CALL check_duplicate_output_fields(err_msg=local_err_msg)
532  IF ( local_err_msg /= '' ) THEN
533  pstat = 1
534  IF ( fms_error_handler('diag_table_mod::parse_diag_table', trim(local_err_msg), err_msg) ) RETURN
535  END IF
536 
537  END SUBROUTINE parse_diag_table
538  ! </SUBROUTINE>
539 
540  ! <PRIVATE>
541  ! <SUBROUTINE NAME="open_diag_table">
542  ! <OVERVIEW>
543  ! Open the diag_table file.
544  ! </OVERVIEW>
545  ! <TEMPLATE>
546  ! SUBROUTINE open_diag_table(iunit, iostat)
547  ! </TEMPLATE>
548  ! <DESCRIPTION>
549  ! Open the <TT>diag_table</TT> file, and return the Fortran file unit number.
550  ! </DESCRIPTION>
551  ! <OUT NAME="iunit" TYPE="INTEGER">Fortran file unit number of the <TT>diag_table</TT>.</OUT>
552  ! <IN NAME="iostat" TYPE="INTEGER, OPTIONAL">
553  ! Status of opening file. If iostat == 0, file exists. If iostat > 0, the diag_table file does not exist.
554  ! </IN>
555  ! <OUT NAME="err_msg" TYPE="CHARACTER(len=*), OPTIONAL">
556  ! String to hold the return error message.
557  ! </OUT>
558  SUBROUTINE open_diag_table(iunit, iostat, err_msg)
559  INTEGER, INTENT(out) :: iunit
560  INTEGER, INTENT(out), OPTIONAL, TARGET :: iostat
561  CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
562 
563  INTEGER, TARGET :: mystat
564  INTEGER, POINTER :: pstat
565 
566  IF ( PRESENT(iostat) ) THEN
567  pstat => iostat
568  ELSE
569  pstat => mystat
570  END IF
571 
572  IF ( .NOT.file_exist('diag_table') ) THEN
573  pstat = 1
574  IF ( fms_error_handler('diag_table_mod::open_diag_table',&
575  & 'diag_table file does not exist.', err_msg) ) RETURN
576  ELSE
577  pstat = 0
578  END IF
579 
580  CALL mpp_open(iunit, 'diag_table', action=mpp_rdonly)
581  END SUBROUTINE open_diag_table
582  ! </SUBROUTINE>
583  ! </PRIVATE>
584 
585  ! <PRIVATE>
586  ! <SUBROUTINE NAME="close_diag_table">
587  ! <OVERVIEW>
588  ! Close the diag_table file.
589  ! </OVERVIEW>
590  ! <TEMPLATE>
591  ! SUBROUTINE close_diag_table(iunit)
592  ! </TEMPLATE>
593  ! <DESCRIPTION>
594  ! Closes the diag_table file.
595  ! </DESCRIPTION>
596  ! <IN NAME="iunit" TYPE="INTEGER">Fortran file unit number of the <TT>diag_table</TT>.</IN>
597  SUBROUTINE close_diag_table(iunit)
598  INTEGER, INTENT(in) :: iunit
599 
600  CALL close_file(iunit)
601  END SUBROUTINE close_diag_table
602  ! </SUBROUTINE>
603  ! </PRIVATE>
604 
605  ! <PRIVATE>
606  ! <FUNCTION NAME="parse_file_line">
607  ! <OVERVIEW>
608  ! Parse a file description line from the <TT>diag_table</TT> file.
609  ! </OVERVIEW>
610  ! <TEMPLATE>
611  ! TYPE(file_description_type) FUNCTION parse_file_line(line, istat, err_msg)
612  ! </TEMPLATE>
613  ! <DESCRIPTION>
614  ! <TT>parse_file_line</TT> parses a file description line from the <TT>diag_table</TT> file, and returns a
615  ! <TT>TYPE(file_description_type)</TT>. The calling function, would then need to call the <TT>init_file</TT> to initialize
616  ! the diagnostic output file.
617  ! </DESCRIPTION>
618  ! <IN NAME="line" TYPE="CHARACTER(len=*)">Line to parse from the <TT>diag_table</TT> file.</IN>
619  ! <OUT NAME="istat" TYPE="INTEGER, OPTIONAL">
620  ! Return state of the function. A value of 0 indicates success. A positive value indicates a <TT>FATAL</TT> error occurred,
621  ! and a negative value indicates a <TT>WARNING</TT> should be issued.
622  ! </OUT>
623  ! <OUT NAME="err_msg" TYPE="CHARACTER(len=*), OPTIONAL">
624  ! Error string to include in the <TT>FATAL</TT> or <TT>WARNING</TT> message.
625  ! </OUT>
626  TYPE(file_description_type) FUNCTION parse_file_line(line, istat, err_msg)
627  CHARACTER(len=*), INTENT(in) :: line
628  INTEGER, INTENT(out), OPTIONAL, TARGET :: istat
629  CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg
630 
631  INTEGER, TARGET :: mystat
632  INTEGER, POINTER :: pstat
633  INTEGER :: year, month, day, hour, minute, second
634  CHARACTER(len=256) :: local_err_msg !< Hold the return error message from routine calls.
635 
636  IF ( PRESENT(istat) ) THEN
637  pstat => istat
638  ELSE
639  pstat => mystat
640  END IF
641  pstat = 0 ! default success return value
642 
643  ! Initialize the optional file description fields.
644  parse_file_line%new_file_freq = 0
645  parse_file_line%new_file_freq_units = ''
646  parse_file_line%start_time_s = ''
647  parse_file_line%file_duration = 0
648  parse_file_line%file_duration_units = ''
649 
650  ! Read in the file description line..
651  READ (line, fmt=*, iostat=mystat) parse_file_line%file_name, parse_file_line%output_freq, parse_file_line%output_freq_units,&
652  & parse_file_line%file_format, parse_file_line%time_units, parse_file_line%long_name,&
653  & parse_file_line%new_file_freq, parse_file_line%new_file_freq_units, parse_file_line%start_time_s,&
654  & parse_file_line%file_duration, parse_file_line%file_duration_units
655  IF ( mystat > 0 ) THEN
656  pstat = mystat
657  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Incorrect file description format in diag_table.', err_msg) )&
658  & RETURN
659  END IF
660 
661  ! Check for unallowed characters in strings
662  IF ( scan(parse_file_line%file_name, unallowed_all) > 0 ) THEN
663  pstat = 1
664  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
665  & 'Unallowed character in file_name in the diag_table.', err_msg) ) RETURN
666  END IF
667  IF ( scan(parse_file_line%output_freq_units, unallowed_all) > 0 ) THEN
668  pstat = 1
669  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
670  & 'Unallowed character in output_freq_units in the diag_table.', err_msg) ) RETURN
671  END IF
672  IF ( scan(parse_file_line%time_units, unallowed_all) > 0 ) THEN
673  pstat = 1
674  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
675  & 'Unallowed character in time_units in the diag_table.', err_msg) ) RETURN
676  END IF
677  IF ( scan(parse_file_line%long_name, unallowed_all) > 0 ) THEN
678  pstat = 1
679  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
680  & 'Unallowed character in long_name in the diag_table.', err_msg) ) RETURN
681  END IF
682  IF ( scan(parse_file_line%new_file_freq_units, unallowed_all) > 0 ) THEN
683  pstat = 1
684  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
685  & 'Unallowed character in new_file_freq_units in the diag_table.', err_msg) ) RETURN
686  END IF
687  IF ( scan(parse_file_line%start_time_s, unallowed_all) > 0 ) THEN
688  pstat = 1
689  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
690  & 'Unallowed character in start_time_s in the diag_table.', err_msg) ) RETURN
691  END IF
692  IF ( scan(parse_file_line%file_duration_units, unallowed_all) > 0 ) THEN
693  pstat = 1
694  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
695  & 'Unallowed character in file_duration_units in the diag_table.', err_msg) ) RETURN
696  END IF
697 
698 
699  ! Fix the file name
700  parse_file_line%file_name = fix_file_name(trim(parse_file_line%file_name))
701 
702  ! Verify values / formats are correct
703  IF ( parse_file_line%file_format > 2 .OR. parse_file_line%file_format < 1 ) THEN
704  pstat = 1
705  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid file format for file description in the diag_table.',&
706  & err_msg) ) RETURN
707  END IF
708 
709  ! check for known units
710  parse_file_line%iTime_units = find_unit_ivalue(parse_file_line%time_units)
711  parse_file_line%iOutput_freq_units = find_unit_ivalue(parse_file_line%output_freq_units)
712  parse_file_line%iNew_file_freq_units = find_unit_ivalue(parse_file_line%new_file_freq_units)
713  parse_file_line%iFile_duration_units = find_unit_ivalue(parse_file_line%file_duration_units)
714  ! Verify the units are valid
715  IF ( parse_file_line%iTime_units < 0 ) THEN
716  pstat = 1
717  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid time axis units in diag_table.', err_msg) )&
718  & RETURN
719  END IF
720  IF ( parse_file_line%iOutput_freq_units < 0 ) THEN
721  pstat = 1
722  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid output frequency units in diag_table.', err_msg) )&
723  & RETURN
724  END IF
725  IF ( parse_file_line%iNew_file_freq_units < 0 .AND. parse_file_line%new_file_freq > 0 ) THEN
726  pstat = 1
727  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid new file frequency units in diag_table.', err_msg) )&
728  & RETURN
729  END IF
730  IF ( parse_file_line%iFile_duration_units < 0 .AND. parse_file_line%file_duration > 0 ) THEN
731  pstat = 1
732  IF ( fms_error_handler('diag_table_mod::parse_file_line', 'Invalid file duration units in diag_table.', err_msg) )&
733  & RETURN
734  END IF
735 
736  !::sdu::
737  !::sdu:: Here is where we would want to parse the regional/global string
738  !::sdu::
739 
740  ! Check for file frequency, start time and duration presence.
741  ! This will determine how the init subroutine is called.
742  new_file_freq_present: IF ( parse_file_line%new_file_freq > 0 ) THEN ! New file frequency present.
743  IF ( len_trim(parse_file_line%start_time_s) > 0 ) THEN ! start time present
744  READ (parse_file_line%start_time_s, fmt=*, iostat=mystat) year, month, day, hour, minute, second
745  IF ( mystat /= 0 ) THEN
746  pstat = 1
747  IF ( fms_error_handler('diag_table_mod::parse_file_line',&
748  & 'Invalid start time in the file description in diag_table.', err_msg) ) RETURN
749  END IF
750  parse_file_line%start_time = set_date(year, month, day, hour, minute, second, err_msg=local_err_msg)
751  IF ( local_err_msg /= '' ) THEN
752  pstat = 1
753  IF ( fms_error_handler('diag_table_mod::parse_file_line', local_err_msg, err_msg) ) RETURN
754  END IF
755  IF ( parse_file_line%file_duration <= 0 ) THEN ! file_duration not present
756  parse_file_line%file_duration = parse_file_line%new_file_freq
757  parse_file_line%iFile_duration_units = parse_file_line%iNew_file_freq_units
758  END IF
759  ELSE
760  parse_file_line%start_time = base_time
761  parse_file_line%file_duration = parse_file_line%new_file_freq
762  parse_file_line%iFile_duration_units = parse_file_line%iNew_file_freq_units
763  END IF
764  END IF new_file_freq_present
765 
766  END FUNCTION parse_file_line
767  ! </FUNCTION>
768  ! </PRIVATE>
769 
770  ! <PRIVATE>
771  ! <FUNCTION NAME="parse_field_line">
772  ! <OVERVIEW>
773  ! Parse a field description line from the <TT>diag_table</TT> file.
774  ! </OVERVIEW>
775  ! <TEMPLATE>
776  ! TYPE(field_description_type) FUNCTION parse_field_line(line, istat, err_msg)
777  ! </TEMPLATE>
778  ! <DESCRIPTION>
779  ! <TT>parse_field_line</TT> parses a field description line from the <TT>diag_table</TT> file, and returns a
780  ! <TT>TYPE(field_description_type)</TT>. The calling function, would then need to call the <TT>init_input_field</TT> and
781  ! <TT>init_output_field</TT> to initialize the diagnostic output field.
782  ! </DESCRIPTION>
783  ! <IN NAME="line" TYPE="CHARACTER(len=*)">Line to parse from the <TT>diag_table</TT> file.</IN>
784  ! <OUT NAME="istat" TYPE="INTEGER, OPTIONAL">
785  ! Return state of the function. A value of 0 indicates success. A positive value indicates a <TT>FATAL</TT> error occurred,
786  ! and a negative value indicates a <TT>WARNING</TT> should be issued.
787  ! </OUT>
788  ! <OUT NAME="err_msg" TYPE="CHARACTER(len=*), OPTIONAL">
789  ! Error string to include in the <TT>FATAL</TT> or <TT>WARNING</TT> message.
790  ! </OUT>
791  TYPE(field_description_type) function parse_field_line(line, istat, err_msg)
792  CHARACTER(len=*), INTENT(in) :: line
793  INTEGER, INTENT(out), OPTIONAL, TARGET :: istat
794  CHARACTER(len=*), OPTIONAL, INTENT(out) :: err_msg
795 
796  INTEGER, TARGET :: mystat
797  INTEGER, POINTER :: pstat
798 
799  IF ( PRESENT(istat) ) THEN
800  pstat => istat
801  ELSE
802  pstat => mystat
803  END IF
804  pstat = 0 ! default success return value
805 
806  READ (line, fmt=*, iostat=mystat) parse_field_line%module_name, parse_field_line%field_name, parse_field_line%output_name,&
807  & parse_field_line%file_name, parse_field_line%time_sampling, parse_field_line%time_method, parse_field_line%spatial_ops,&
808  & parse_field_line%pack
809  IF ( mystat /= 0 ) THEN
810  pstat = 1
811  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
812  & 'Field description format is incorrect in diag_table.', err_msg) ) RETURN
813  END IF
814 
815  ! Check for unallowed characters in the string
816  IF ( scan(parse_field_line%module_name, unallowed_all) > 0 ) THEN
817  pstat = 1
818  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
819  & 'Unallowed character in module_name in the diag_table.', err_msg) ) RETURN
820  END IF
821  IF ( scan(parse_field_line%field_name, unallowed_all) > 0 ) THEN
822  pstat = 1
823  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
824  & 'Unallowed character in field_name in the diag_table.', err_msg) ) RETURN
825  END IF
826  IF ( scan(parse_field_line%output_name, unallowed_all) > 0 ) THEN
827  pstat = 1
828  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
829  & 'Unallowed character in output_name in the diag_table.', err_msg) ) RETURN
830  END IF
831  IF ( scan(parse_field_line%file_name, unallowed_all) > 0 ) THEN
832  pstat = 1
833  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
834  & 'Unallowed character in file_name in the diag_table.', err_msg) ) RETURN
835  END IF
836  IF ( scan(parse_field_line%time_sampling, unallowed_all) > 0 ) THEN
837  pstat = 1
838  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
839  & 'Unallowed character in time_sampling in the diag_table.', err_msg) ) RETURN
840  END IF
841  IF ( scan(parse_field_line%time_method, unallowed_all) > 0 ) THEN
842  pstat = 1
843  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
844  & 'Unallowed character in time_method in the diag_table.', err_msg) ) RETURN
845  END IF
846  IF ( scan(parse_field_line%spatial_ops, unallowed_qte) > 0 ) THEN
847  pstat = 1
848  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
849  & 'Unallowed character in spatial_ops in the diag_table.', err_msg) ) RETURN
850  END IF
851 
852  ! Fix the file name
853  ! Removes any added '.nc' and appends additional information.
854  parse_field_line%file_name = fix_file_name(trim(parse_field_line%file_name))
855 
856  IF ( parse_field_line%pack > 8 .OR. parse_field_line%pack < 1 ) THEN
857  pstat = 1
858  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
859  & 'Packing is out of range for the field description in diag_table.', err_msg) ) RETURN
860  END IF
861 
862  IF ( lowercase(trim(parse_field_line%spatial_ops)) /= 'none' ) THEN
863  READ (parse_field_line%spatial_ops, fmt=*, iostat=mystat) parse_field_line%regional_coords
864  IF ( mystat /= 0 ) THEN
865  IF ( fms_error_handler('diag_table_mod::parse_field_line',&
866  & 'Error in regional output description for field description in diag_table.', err_msg) ) RETURN
867  END IF
868  END IF
869  END FUNCTION parse_field_line
870  ! </FUNCTION>
871  ! </PRIVATE>
872 
873  ! <PRIVATE>
874  ! <FUNCTION NAME="is_a_file">
875  ! <OVERVIEW>
876  ! Determines if a line from the diag_table file is a file.
877  ! </OVERVIEW>
878  ! <TEMPLATE>
879  ! PURE LOGICAL FUNCTION is_a_file(line)
880  ! </TEMPLATE>
881  ! <DESCRIPTION>
882  ! <TT>is_a_file</TT> checks a diag_table line to determine if the line describes a file. If the line describes a file, the
883  ! <TT>is_a_file</TT> will return <TT>.TRUE.</TT>. Otherwise, it will return <TT>.FALSE.</TT>
884  ! </DESCRIPTION>
885  ! <IN NAME="line" TYPE="CARACTER(len=*)">String containing the <TT>diag_table</TT> line.</IN>
886  PURE LOGICAL FUNCTION is_a_file(line)
887  CHARACTER(len=*), INTENT(in) :: line
888 
889  CHARACTER(len=5) :: first
890  INTEGER :: second
891  INTEGER :: mystat !< IO status from read
892 
893 #if defined __PATHSCALE__ || defined _CRAYFTN
894  ! This portion is to 'fix' pathscale's and Cray's Fortran compilers inability to handle the FMT=* correctly in the read
895  ! statement.
896  CHARACTER(len=10) :: secondstring
897  INTEGER :: comma1, comma2, linelen
898 
899  linelen = len(line)
900  comma1 = index(line,',') + 1 ! +1 to go past the comma
901  comma2 = index(line(comma1:linelen),',') + comma1 - 2 ! -2 to get rid of +1 in comma1 and to get 1 character before the comma
902 
903  secondstring = adjustl(line(comma1:comma2))
904  READ (unit=secondstring, fmt='(I)', iostat=mystat) second
905 #else
906  READ (unit=line, fmt=*, iostat=mystat) first, second
907 #endif
908 
909  ! The line is a file if my status is zero after the read.
910  is_a_file = mystat == 0
911  END FUNCTION is_a_file
912  ! </FUNCTION>
913  ! </PRIVATE>
914 
915  ! <PRIVATE>
916  ! <FUNCTION NAME="fix_file_name(file_name_string)">
917  ! <OVERVIEW>
918  ! Fixes the file name for use with diagnostic file and field initializations.
919  ! </OVERVIEW>
920  ! <TEMPLATE>
921  ! PURE CHARACTER(len=128) FUNCTION fix_file_name(file_name_string)
922  ! </TEMPLATE>
923  ! <DESCRIPTION>
924  ! Removes any trailing '.nc' and appends (if requested) append_pelist_name.
925  !
926  ! Presently, the ensemble appendix will override the append_pelist_name variable.
927  ! </DESCRIPTION>
928  ! <IN NAME="file_name_string" TYPE="CHARACTER(len=*)">String containing the file name from the <TT>diag_table</TT>.</IN>
929  PURE CHARACTER(len=128) FUNCTION fix_file_name(file_name_string)
930  CHARACTER(len=*), INTENT(IN) :: file_name_string
931 
932  INTEGER :: file_name_len
933 
934  fix_file_name = file_name_string ! Default return value
935 
936  file_name_len = len_trim(file_name_string)
937 
938  ! Remove trailing '.nc' from the file_name, and append suffixes
939  IF ( file_name_len > 2 ) THEN
940  IF ( file_name_string(file_name_len-2:file_name_len) == '.nc' ) THEN
941  fix_file_name = file_name_string(1:file_name_len-3)
942  file_name_len = file_name_len - 3
943  END IF
944  END IF
945 
946  ! Add the optional suffix based on the pe list name if the
947  ! append_pelist_name == .TRUE.
948  IF ( append_pelist_name ) THEN
949  fix_file_name(file_name_len+1:) = trim(pelist_name)
950  END IF
951  END FUNCTION fix_file_name
952  ! </FUNCTION>
953  ! </PRIVATE>
954 
955  ! <PRIVATE>
956  ! <FUNCTION NAME="find_unit_ivalue">
957  ! <OVERVIEW>
958  ! Return the integer value for the given time unit.
959  ! </OVERVIEW>
960  ! <TEMPLATE>
961  ! PURE INTEGER FUNCTION find_unit_ivalue(unit_string)
962  ! </TEMPLATE>
963  ! <DESCRIPTION>
964  ! Returns the corresponding integer value for the given time unit.
965  ! <UL>
966  ! <LI> seconds = 1 </LI>
967  ! <LI> minutes = 2 </LI>
968  ! <LI> hours = 3 </LI>
969  ! <LI> days = 4 </LI>
970  ! <LI> months = 5 </LI>
971  ! <LI> years = 6 </LI>
972  ! <LI> unknown = -1 </LI>
973  ! </UL>
974  ! </DESCRIPTION>
975  ! <IN NAME="unit_string" TYPE="CHARACTER(len=*)">String containing the unit.</IN>
976  PURE INTEGER FUNCTION find_unit_ivalue(unit_string)
977  CHARACTER(len=*), INTENT(IN) :: unit_string !< Input string, containing the unit.
978 
979  SELECT CASE (trim(unit_string))
980  CASE ('seconds')
981  find_unit_ivalue = 1
982  CASE ('minutes')
983  find_unit_ivalue = 2
984  CASE ('hours')
985  find_unit_ivalue = 3
986  CASE ('days')
987  find_unit_ivalue = 4
988  CASE ('months')
989  find_unit_ivalue = 5
990  CASE ('years')
991  find_unit_ivalue = 6
992  CASE DEFAULT
993  find_unit_ivalue = -1 ! Return statement if an incorrect / unknown unit used.
994  END SELECT
995  END FUNCTION find_unit_ivalue
996  ! </FUNCTION>
997  ! </PRIVATE>
998 
999  ! <PRIVATE>
1000  ! <SUBROUTINE NAME="initialize_output_arrays">
1001  ! <OVERVIEW>
1002  ! Allocate the file, in and out field arrays after reading the <TT>diag_table</TT> file.
1003  ! </OVERVIEW>
1004  ! <TEMPLATE>
1005  ! SUBROUTINE initialize_output_arrays()
1006  ! </TEMPLATE>
1007  ! <DESCRIPTION>
1008  ! After reading in the <TT>diag_table</TT> file, the arrays that will hold the file, in, and out field data need to be
1009  ! allocated. This routine will determine the size of the arrays, and then allocate the arrays.
1010  ! </DESCRIPTION>
1011  SUBROUTINE initialize_output_arrays()
1012  ! Place Holder
1013  END SUBROUTINE initialize_output_arrays
1014  ! </SUBROUTINE>
1015  ! </PRIVATE>
1016 END MODULE diag_table_mod
Definition: fms.F90:20
type(file_description_type) function parse_file_line(line, istat, err_msg)
Definition: diag_table.F90:627
character(len=256) global_descriptor
Definition: diag_data.F90:774
integer base_year
Definition: diag_data.F90:773
integer base_month
Definition: diag_data.F90:773
character(len=9) function, public month_name(n)
pure character(len=128) function fix_file_name(file_name_string)
Definition: diag_table.F90:930
subroutine open_diag_table(iunit, iostat, err_msg)
Definition: diag_table.F90:559
type(time_type) base_time
Definition: diag_data.F90:772
character(len=32) pelist_name
Definition: diag_data.F90:800
subroutine, public check_duplicate_output_fields(err_msg)
Definition: diag_util.F90:2593
real, parameter, public seconds_per_minute
Seconds in a minute [s].
Definition: constants.F90:118
integer base_day
Definition: diag_data.F90:773
subroutine initialize_output_arrays()
logical function, public fms_error_handler(routine, message, err_msg)
Definition: fms.F90:573
integer base_second
Definition: diag_data.F90:773
Definition: mpp.F90:39
type(field_description_type) function parse_field_line(line, istat, err_msg)
Definition: diag_table.F90:792
integer, parameter diag_ocean
Definition: diag_data.F90:99
subroutine, public init_output_field(module_name, field_name, output_name, output_file, time_method, pack, tile_count, local_coord)
Definition: diag_util.F90:1478
logical append_pelist_name
Definition: diag_data.F90:709
character(len= *), parameter unallowed_all
Definition: diag_table.F90:277
real, parameter, public seconds_per_hour
Seconds in an hour [s].
Definition: constants.F90:117
integer function, public get_calendar_type()
pure logical function is_a_file(line)
Definition: diag_table.F90:887
pure integer function find_unit_ivalue(unit_string)
Definition: diag_table.F90:977
integer, parameter, public no_calendar
character(len= *), parameter unallowed_qte
Definition: diag_table.F90:276
integer, parameter diag_other
Definition: diag_data.F90:98
integer base_hour
Definition: diag_data.F90:773
subroutine, public init_input_field(module_name, field_name, tile_count)
Definition: diag_util.F90:1426
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)
Definition: diag_util.F90:1059
integer, parameter diag_all
Definition: diag_data.F90:100
subroutine, public parse_diag_table(diag_subset, istat, err_msg)
Definition: diag_table.F90:355
subroutine, public error_mesg(routine, message, level)
Definition: fms.F90:529
subroutine close_diag_table(iunit)
Definition: diag_table.F90:598
integer base_minute
Definition: diag_data.F90:773