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
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
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
355 INTEGER,
INTENT(in),
OPTIONAL :: diag_subset
356 INTEGER,
INTENT(out),
OPTIONAL,
TARGET :: istat
357 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
359 INTEGER,
PARAMETER :: dt_line_length = 256
361 INTEGER :: stdlog_unit
362 INTEGER :: record_len
365 INTEGER :: commentstart
366 INTEGER :: diag_subset_output
367 INTEGER :: nfields, nfiles
369 INTEGER,
TARGET :: mystat
370 INTEGER,
POINTER :: pstat
372 CHARACTER(len=5) :: line_number
373 CHARACTER(len=9) :: amonth
374 CHARACTER(len=256) :: record_line
375 CHARACTER(len=256) :: local_err_msg
376 CHARACTER(len=DT_LINE_LENGTH),
DIMENSION(:),
ALLOCATABLE :: diag_table
382 IF (
PRESENT(istat) )
THEN 390 IF (
PRESENT(diag_subset) )
THEN 391 diag_subset_output = diag_subset
397 stdlog_unit = stdlog()
398 num_lines = get_ascii_file_num_lines(
'diag_table', dt_line_length)
399 allocate(diag_table(num_lines))
401 call read_ascii_file(
'diag_table', dt_line_length, diag_table)
405 IF ( mystat /= 0 )
THEN 407 IF (
fms_error_handler(
'diag_table_mod::parse_diag_table',
'Error reading the global descriptor from the diagnostic table.',&
413 IF ( mystat /= 0 )
THEN 415 IF (
fms_error_handler(
'diag_manager_init',
'Error reading the base date from the diagnostic table.', err_msg) )
RETURN 422 IF (
fms_error_handler(
'diag_table_mod::parse_diag_table',
'The base_year/month/day can not equal zero', err_msg) )
RETURN 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, &
441 pass:
DO npass = 1, 2
442 parser:
DO line_num=3, num_lines
446 READ (diag_table(line_num), fmt=
'(A)', iostat=mystat) record_line
448 WRITE (line_number,
'(I5)') line_num
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)
455 ELSE IF ( mystat < 0 )
THEN 460 record_len = len_trim(record_line)
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
467 init:
IF ( npass == 1 )
THEN 469 temp_file =
parse_file_line(line=record_line, istat=mystat, err_msg=local_err_msg)
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)
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 482 ELSE IF ( temp_file%new_file_freq > 0 )
THEN 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)
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)
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)
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)
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 510 ELSE IF ( lowercase(trim(temp_field%spatial_ops)) ==
'none' )
THEN 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)
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)
521 nfields = nfields + 1
528 DEALLOCATE(diag_table)
532 IF ( local_err_msg /=
'' )
THEN 534 IF (
fms_error_handler(
'diag_table_mod::parse_diag_table', trim(local_err_msg), err_msg) )
RETURN 559 INTEGER,
INTENT(out) :: iunit
560 INTEGER,
INTENT(out),
OPTIONAL,
TARGET :: iostat
561 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
563 INTEGER,
TARGET :: mystat
564 INTEGER,
POINTER :: pstat
566 IF (
PRESENT(iostat) )
THEN 572 IF ( .NOT.file_exist(
'diag_table') )
THEN 575 &
'diag_table file does not exist.', err_msg) )
RETURN 580 CALL mpp_open(iunit,
'diag_table', action=mpp_rdonly)
598 INTEGER,
INTENT(in) :: iunit
600 CALL close_file(iunit)
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
631 INTEGER,
TARGET :: mystat
632 INTEGER,
POINTER :: pstat
633 INTEGER :: year, month, day, hour, minute, second
634 CHARACTER(len=256) :: local_err_msg
636 IF (
PRESENT(istat) )
THEN 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 =
'' 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 657 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Incorrect file description format in diag_table.', err_msg) )&
662 IF ( scan(parse_file_line%file_name,
unallowed_all) > 0 )
THEN 665 &
'Unallowed character in file_name in the diag_table.', err_msg) )
RETURN 667 IF ( scan(parse_file_line%output_freq_units,
unallowed_all) > 0 )
THEN 670 &
'Unallowed character in output_freq_units in the diag_table.', err_msg) )
RETURN 672 IF ( scan(parse_file_line%time_units,
unallowed_all) > 0 )
THEN 675 &
'Unallowed character in time_units in the diag_table.', err_msg) )
RETURN 677 IF ( scan(parse_file_line%long_name,
unallowed_all) > 0 )
THEN 680 &
'Unallowed character in long_name in the diag_table.', err_msg) )
RETURN 682 IF ( scan(parse_file_line%new_file_freq_units,
unallowed_all) > 0 )
THEN 685 &
'Unallowed character in new_file_freq_units in the diag_table.', err_msg) )
RETURN 687 IF ( scan(parse_file_line%start_time_s,
unallowed_all) > 0 )
THEN 690 &
'Unallowed character in start_time_s in the diag_table.', err_msg) )
RETURN 692 IF ( scan(parse_file_line%file_duration_units,
unallowed_all) > 0 )
THEN 695 &
'Unallowed character in file_duration_units in the diag_table.', err_msg) )
RETURN 700 parse_file_line%file_name =
fix_file_name(trim(parse_file_line%file_name))
703 IF ( parse_file_line%file_format > 2 .OR. parse_file_line%file_format < 1 )
THEN 705 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid file format for file description in the diag_table.',&
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)
715 IF ( parse_file_line%iTime_units < 0 )
THEN 717 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid time axis units in diag_table.', err_msg) )&
720 IF ( parse_file_line%iOutput_freq_units < 0 )
THEN 722 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid output frequency units in diag_table.', err_msg) )&
725 IF ( parse_file_line%iNew_file_freq_units < 0 .AND. parse_file_line%new_file_freq > 0 )
THEN 727 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid new file frequency units in diag_table.', err_msg) )&
730 IF ( parse_file_line%iFile_duration_units < 0 .AND. parse_file_line%file_duration > 0 )
THEN 732 IF (
fms_error_handler(
'diag_table_mod::parse_file_line',
'Invalid file duration units in diag_table.', err_msg) )&
742 new_file_freq_present:
IF ( parse_file_line%new_file_freq > 0 )
THEN 743 IF ( len_trim(parse_file_line%start_time_s) > 0 )
THEN 744 READ (parse_file_line%start_time_s, fmt=*, iostat=mystat) year, month, day, hour, minute, second
745 IF ( mystat /= 0 )
THEN 748 &
'Invalid start time in the file description in diag_table.', err_msg) )
RETURN 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 753 IF (
fms_error_handler(
'diag_table_mod::parse_file_line', local_err_msg, err_msg) )
RETURN 755 IF ( parse_file_line%file_duration <= 0 )
THEN 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
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
764 END IF new_file_freq_present
792 CHARACTER(len=*),
INTENT(in) :: line
793 INTEGER,
INTENT(out),
OPTIONAL,
TARGET :: istat
794 CHARACTER(len=*),
OPTIONAL,
INTENT(out) :: err_msg
796 INTEGER,
TARGET :: mystat
797 INTEGER,
POINTER :: pstat
799 IF (
PRESENT(istat) )
THEN 809 IF ( mystat /= 0 )
THEN 811 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
812 &
'Field description format is incorrect in diag_table.', err_msg) )
RETURN 818 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
819 &
'Unallowed character in module_name in the diag_table.', err_msg) )
RETURN 823 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
824 &
'Unallowed character in field_name in the diag_table.', err_msg) )
RETURN 828 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
829 &
'Unallowed character in output_name in the diag_table.', err_msg) )
RETURN 833 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
834 &
'Unallowed character in file_name in the diag_table.', err_msg) )
RETURN 838 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
839 &
'Unallowed character in time_sampling in the diag_table.', err_msg) )
RETURN 843 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
844 &
'Unallowed character in time_method in the diag_table.', err_msg) )
RETURN 848 IF ( fms_error_handler(
'diag_table_mod::parse_field_line',&
849 &
'Unallowed character in spatial_ops in the diag_table.', err_msg) )
RETURN 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 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 887 CHARACTER(len=*),
INTENT(in) :: line
889 CHARACTER(len=5) :: first
893 #if defined __PATHSCALE__ || defined _CRAYFTN 896 CHARACTER(len=10) :: secondstring
897 INTEGER :: comma1, comma2, linelen
900 comma1 = index(line,
',') + 1
901 comma2 = index(line(comma1:linelen),
',') + comma1 - 2
903 secondstring = adjustl(line(comma1:comma2))
904 READ (unit=secondstring, fmt=
'(I)', iostat=mystat) second
906 READ (unit=line, fmt=*, iostat=mystat) first, second
929 PURE CHARACTER(len=128) FUNCTION fix_file_name(file_name_string)
930 CHARACTER(len=*),
INTENT(IN) :: file_name_string
932 INTEGER :: file_name_len
936 file_name_len = len_trim(file_name_string)
939 IF ( file_name_len > 2 )
THEN 940 IF ( file_name_string(file_name_len-2:file_name_len) ==
'.nc' )
THEN 942 file_name_len = file_name_len - 3
948 IF ( append_pelist_name )
THEN 977 CHARACTER(len=*),
INTENT(IN) :: unit_string
979 SELECT CASE (trim(unit_string))
type(file_description_type) function parse_file_line(line, istat, err_msg)
character(len=256) global_descriptor
character(len=9) function, public month_name(n)
pure character(len=128) function fix_file_name(file_name_string)
subroutine open_diag_table(iunit, iostat, err_msg)
type(time_type) base_time
character(len=32) pelist_name
subroutine, public check_duplicate_output_fields(err_msg)
real, parameter, public seconds_per_minute
Seconds in a minute [s].
subroutine initialize_output_arrays()
logical function, public fms_error_handler(routine, message, err_msg)
type(field_description_type) function parse_field_line(line, istat, err_msg)
integer, parameter diag_ocean
subroutine, public init_output_field(module_name, field_name, output_name, output_file, time_method, pack, tile_count, local_coord)
logical append_pelist_name
character(len= *), parameter unallowed_all
real, parameter, public seconds_per_hour
Seconds in an hour [s].
integer function, public get_calendar_type()
pure logical function is_a_file(line)
pure integer function find_unit_ivalue(unit_string)
integer, parameter, public no_calendar
character(len= *), parameter unallowed_qte
integer, parameter diag_other
subroutine, public init_input_field(module_name, field_name, tile_count)
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)
integer, parameter diag_all
subroutine, public parse_diag_table(diag_subset, istat, err_msg)
subroutine, public error_mesg(routine, message, level)
subroutine close_diag_table(iunit)