250 MODULE diag_table_mod
252 USE fms2_io_mod,
ONLY: ascii_read
256 & diag_other, diag_ocean, diag_all,
coord_type, append_pelist_name, pelist_name
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
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
300 CHARACTER(len=*),
PARAMETER :: UNALLOWED_QTE =
"'"//
'"'
301 CHARACTER(len=*),
PARAMETER :: UNALLOWED_ALL = unallowed_qte//
","
318 INTEGER,
INTENT(in),
OPTIONAL :: diag_subset
319 INTEGER,
INTENT(out),
OPTIONAL,
TARGET :: istat
321 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
324 INTEGER,
PARAMETER :: dt_line_length = 256
326 INTEGER :: record_len
329 INTEGER :: commentstart
330 INTEGER :: diag_subset_output
331 INTEGER :: nfields, nfiles
333 INTEGER,
TARGET :: mystat
334 INTEGER,
POINTER :: pstat
336 CHARACTER(len=5) :: line_number
337 CHARACTER(len=256) :: record_line
338 CHARACTER(len=256) :: local_err_msg
339 CHARACTER(len=:),
DIMENSION(:),
ALLOCATABLE :: diag_table
340 integer :: base_time_int(6)
346 IF (
PRESENT(istat) )
THEN
354 IF (
PRESENT(diag_subset) )
THEN
355 diag_subset_output = diag_subset
357 diag_subset_output = diag_all
360 call ascii_read(
'diag_table', diag_table, num_lines=num_lines)
363 READ (unit=diag_table(1), fmt=*, iostat=mystat) global_descriptor
364 IF ( mystat /= 0 )
THEN
367 'Error reading the global descriptor from the diagnostic table.', err_msg) )
RETURN
371 READ (unit=diag_table(2), fmt=*, iostat=mystat) base_time_int
372 IF ( mystat /= 0 )
THEN
374 IF (
fms_error_handler(
'diag_manager_init',
'Error reading the base date from the diagnostic table.', &
382 pass:
DO npass = 1, 2
383 parser:
DO line_num=3, num_lines
387 READ (diag_table(line_num), fmt=
'(A)', iostat=mystat) record_line
389 WRITE (line_number,
'(I5)') line_num
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)
396 ELSE IF ( mystat < 0 )
THEN
401 record_len = len_trim(record_line)
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
408 init:
IF ( npass == 1 )
THEN
410 temp_file =
parse_file_line(line=record_line, istat=mystat, err_msg=local_err_msg)
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)
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)&
424 ELSE IF ( temp_file%new_file_freq > 0 )
THEN
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)
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)
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)
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)
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)&
456 ELSE IF ( lowercase(trim(temp_field%spatial_ops)) ==
'none' )
THEN
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)
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)
467 nfields = nfields + 1
474 DEALLOCATE(diag_table)
478 IF ( local_err_msg /=
'' )
THEN
480 IF (
fms_error_handler(
'diag_table_mod::parse_diag_table', trim(local_err_msg), err_msg) )
RETURN
491 CHARACTER(len=*),
INTENT(in) :: line
492 INTEGER,
INTENT(out),
OPTIONAL,
TARGET :: istat
496 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
499 INTEGER,
TARGET :: mystat
500 INTEGER,
POINTER :: pstat
501 INTEGER :: year, month, day, hour, minute, second
502 CHARACTER(len=256) :: local_err_msg
504 IF (
PRESENT(istat) )
THEN
525 IF ( mystat > 0 )
THEN
527 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Incorrect file description format in diag_table.', &
535 &
'Unallowed character in file_name in the diag_table.', err_msg) )
RETURN
540 &
'Unallowed character in output_freq_units in the diag_table.', err_msg) )
RETURN
545 &
'Unallowed character in time_units in the diag_table.', err_msg) )
RETURN
550 &
'Unallowed character in long_name in the diag_table.', err_msg) )
RETURN
552 IF ( scan(
parse_file_line%new_file_freq_units, unallowed_all) > 0 )
THEN
555 &
'Unallowed character in new_file_freq_units in the diag_table.', err_msg) )
RETURN
560 &
'Unallowed character in start_time_s in the diag_table.', err_msg) )
RETURN
562 IF ( scan(
parse_file_line%file_duration_units, unallowed_all) > 0 )
THEN
565 &
'Unallowed character in file_duration_units in the diag_table.', err_msg) )
RETURN
576 &
'Invalid file format for file description in the diag_table.',&
588 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid time axis units in diag_table.', err_msg) )&
593 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid output frequency units in diag_table.', &
598 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid new file frequency units in diag_table.', &
603 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid file duration units in diag_table.',err_msg))&
615 READ (
parse_file_line%start_time_s, fmt=*, iostat=mystat) year, month, day, hour, minute, second
616 IF ( mystat /= 0 )
THEN
619 &
'Invalid start time in the file description in diag_table.', err_msg) )
RETURN
622 IF ( local_err_msg /=
'' )
THEN
624 IF (
fms_error_handler(
'diag_table_mod::parse_file_line', local_err_msg, err_msg) )
RETURN
635 END IF new_file_freq_present
646 &
'filename_time_bounds must be "begin", "middle", "end".', err_msg) )
RETURN
660 CHARACTER(len=*),
INTENT(in) :: line
661 INTEGER,
INTENT(out),
OPTIONAL,
TARGET :: istat
665 CHARACTER(len=*),
OPTIONAL,
INTENT(out) :: err_msg
668 INTEGER,
TARGET :: mystat
669 INTEGER,
POINTER :: pstat
671 IF (
PRESENT(istat) )
THEN
681 IF ( mystat /= 0 )
THEN
683 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
684 &
'Field description format is incorrect in diag_table.', err_msg) )
RETURN
690 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
691 &
'Unallowed character in module_name in the diag_table.', err_msg) )
RETURN
695 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
696 &
'Unallowed character in field_name in the diag_table.', err_msg) )
RETURN
700 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
701 &
'Unallowed character in output_name in the diag_table.', err_msg) )
RETURN
705 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
706 &
'Unallowed character in file_name in the diag_table.', err_msg) )
RETURN
710 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
711 &
'Unallowed character in time_sampling in the diag_table.', err_msg) )
RETURN
715 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
716 &
'Unallowed character in time_method in the diag_table.', err_msg) )
RETURN
720 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
721 &
'Unallowed character in spatial_ops in the diag_table.', err_msg) )
RETURN
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
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
749 CHARACTER(len=*),
INTENT(in) :: line
751 CHARACTER(len=5) :: first
755 #if defined __PATHSCALE__ || defined _CRAYFTN
759 CHARACTER(len=10) :: secondstring
760 INTEGER :: comma1, comma2, linelen
763 comma1 = index(line,
',') + 1
764 comma2 = index(line(comma1:linelen),
',') + comma1 - 2
767 secondstring = adjustl(line(comma1:comma2))
768 READ (unit=secondstring, fmt=
'(I)', iostat=mystat) second
770 READ (unit=line, fmt=*, iostat=mystat) first, second
780 CHARACTER(len=*),
INTENT(IN) :: file_name_string
782 INTEGER :: file_name_len
786 file_name_len = len_trim(file_name_string)
789 IF ( file_name_len > 2 )
THEN
790 IF ( file_name_string(file_name_len-2:file_name_len) ==
'.nc' )
THEN
792 file_name_len = file_name_len - 3
798 IF ( append_pelist_name )
THEN
816 CHARACTER(len=*),
INTENT(IN) :: unit_string
818 SELECT CASE (trim(unit_string))
841 END MODULE diag_table_mod
type(time_type) function get_base_time()
gets the module variable base_time
subroutine set_base_time(base_time_int)
Set the module variable base_time.
Define the region for field output.
pure character(len=128) function fix_file_name(file_name_string)
Fixes the file name for use with diagnostic file and field initializations.
subroutine initialize_output_arrays()
Allocate the file, in and out field arrays after reading the diag_table file. (CURRENTLY EMPTY)
type(field_description_type) function parse_field_line(line, istat, err_msg)
Parse a field description line from the diag_table file.
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...
pure logical function is_a_file(line)
Determines if a line from the diag_table file is a file.
subroutine, public parse_diag_table(diag_subset, istat, err_msg)
Parse the diag_table in preparation for diagnostic output.
pure integer function find_unit_ivalue(unit_string)
Return the integer value for the given time unit.
Private type to hold field information for the diag table.
Private type to hold file information for the diag table.
subroutine, public init_input_field(module_name, field_name, tile_count)
Initialize the input field.
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.
subroutine, public init_output_field(module_name, field_name, output_name, output_file, time_method, pack, tile_count, local_coord)
Initialize the output field.
subroutine, public check_duplicate_output_fields(err_msg)
Checks to see if output_name and output_file are unique in output_fields.
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
integer function mpp_pe()
Returns processor ID.
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.