31 module fms_diag_yaml_mod
33 use diag_data_mod,
only: diag_null, diag_ocean, diag_all, diag_other,
set_base_time, latlon_gridtype, &
34 index_gridtype, null_gridtype, diag_seconds, diag_minutes, diag_hours, diag_days, &
43 use,
intrinsic :: iso_c_binding, only : c_ptr, c_null_char
46 use platform_mod,
only: r4_kind, i4_kind, r8_kind, i8_kind, fms_file_len
47 use fms_mod,
only: lowercase
50 use fms2_io_mod,
only: file_exists, get_instance_filename
67 integer,
parameter :: basedate_size = 6
68 integer,
parameter :: NUM_SUB_REGION_ARRAY = 8
69 integer,
parameter :: MAX_FREQ = 12
70 integer :: MAX_SUBAXES = 0
76 character(len=255),
allocatable :: var_name(:)
77 type(c_ptr),
allocatable :: var_pointer(:)
78 integer,
allocatable :: diag_field_indices(:)
83 character(len=FMS_FILE_LEN),
allocatable :: file_name(:)
84 type(c_ptr),
allocatable :: file_pointer(:)
85 integer,
allocatable :: diag_file_indices(:)
93 class(*),
allocatable :: corners(:,:)
102 character (len=:),
allocatable :: file_fname
103 integer :: file_frequnit(max_freq)
106 integer :: file_freq(max_freq)
107 integer :: file_timeunit
110 character (len=:),
allocatable :: file_unlimdim
112 integer :: file_new_file_freq(max_freq)
113 integer :: file_new_file_freq_units(max_freq)
119 logical :: file_start_time_set
120 integer :: filename_time
123 integer :: file_duration(max_freq)
132 integer :: file_duration_units(max_freq)
135 integer :: current_new_file_freq_index
137 character (len=MAX_STR_LEN),
allocatable :: file_varlist(:)
139 character (len=MAX_STR_LEN),
allocatable :: file_outlist(:)
142 character (len=MAX_STR_LEN),
allocatable :: file_global_meta(:,:)
146 character (len=:),
allocatable :: default_var_precision
149 character (len=:),
allocatable :: default_var_reduction
152 character (len=:),
allocatable :: default_var_module
195 character (len=:),
private,
allocatable :: var_fname
196 character (len=:),
private,
allocatable :: var_varname
197 integer ,
private,
allocatable :: var_reduction
200 character (len=:),
private,
allocatable :: var_module
201 integer ,
private,
allocatable :: var_kind
202 character (len=:),
private,
allocatable :: var_outname
203 character (len=:),
private,
allocatable :: var_longname
204 character (len=:),
private,
allocatable :: var_units
205 character (len=:),
private,
allocatable :: standard_name
206 real(kind=r4_kind),
private :: var_zbounds(2)
207 integer ,
private :: n_diurnal
209 integer ,
private :: pow_value
211 logical ,
private :: var_file_is_subregional
215 character (len=MAX_STR_LEN),
dimension (:, :),
private,
allocatable :: var_attributes
217 character(len=:),
allocatable :: var_axes_names
248 procedure :: add_axis_name
249 procedure :: is_file_subregional
257 character(len=:),
allocatable,
private :: diag_title
258 integer,
private,
dimension (basedate_size) :: diag_basedate
281 logical,
private :: diag_yaml_module_initialized = .false.
300 result(diag_basedate)
302 integer,
dimension (basedate_size) :: diag_basedate
304 diag_basedate = this%diag_basedate
311 if (this%has_diag_files())
then
323 character(len=:),
allocatable :: diag_title
325 diag_title = this%diag_title
335 diag_files = this%diag_files
343 integer,
intent(in) :: yaml_id
347 if (yaml_id .eq. diag_not_registered)
call mpp_error(fatal, &
348 "Diag_manager: The yaml id for this field is not is not set")
350 diag_field => this%diag_fields(variable_list%diag_field_indices(yaml_id))
361 diag_fields = this%diag_fields
367 integer,
intent(in) :: diag_subset_output
372 integer :: diag_yaml_id
374 integer,
allocatable :: diag_file_ids(:)
376 integer :: total_nvars
378 integer :: file_var_count
380 integer,
allocatable :: var_ids(:)
382 logical,
allocatable :: ignore(:)
383 integer :: actual_num_files
384 integer :: file_count
385 logical :: write_file
387 logical :: allow_averages
389 character(len=:),
allocatable :: filename
390 logical :: is_instantaneous
391 character(len=FMS_FILE_LEN) :: yamlfilename
393 if (diag_yaml_module_initialized)
return
396 call get_instance_filename(
"diag_table.yaml", yamlfilename)
397 if (index(trim(yamlfilename),
"ens_") .ne. 0)
then
398 if (file_exists(yamlfilename) .and. file_exists(
"diag_table.yaml")) &
399 call mpp_error(fatal,
"Both diag_table.yaml and "//trim(yamlfilename)//
" exists, pick one!")
402 if (.not. file_exists(yamlfilename)) yamlfilename =
"diag_table.yaml"
405 if (diag_yaml_id .eq. missing_file_error_code) &
406 call mpp_error(fatal,
"The "//trim(yamlfilename)//
" is not present and it is required!")
413 allocate(diag_file_ids(nfiles))
414 allocate(ignore(nfiles))
416 call get_block_ids(diag_yaml_id,
"diag_files", diag_file_ids)
421 if(diag_subset_output .ne. diag_all)
then
424 call get_value_from_key(diag_yaml_id, diag_file_ids(i),
"is_ocean", is_ocean, is_optional=.true.)
426 if (diag_subset_output .eq. diag_ocean .and. .not. is_ocean) ignore(i) = .true.
429 if(diag_subset_output .eq. diag_other .and. is_ocean) ignore(i) = .true.
437 call get_value_from_key(diag_yaml_id, diag_file_ids(i),
"write_file", write_file, is_optional=.true.)
438 if(.not. write_file) ignore(i) = .true.
441 if (.not. ignore(i))
then
443 total_nvars = total_nvars + nvars
444 if (nvars .ne. 0)
then
445 actual_num_files = actual_num_files + 1
448 call mpp_error(note,
"diag_manager_mod:: the file:"//trim(filename)//
" has no variables defined. Ignoring!")
449 if (
allocated(filename))
deallocate(filename)
455 allocate(diag_yaml%diag_files(actual_num_files))
456 allocate(diag_yaml%diag_fields(total_nvars))
457 allocate(variable_list%var_name(total_nvars))
458 allocate(variable_list%diag_field_indices(total_nvars))
459 allocate(file_list%file_name(actual_num_files))
460 allocate(file_list%diag_file_indices(actual_num_files))
465 nfiles_loop:
do i = 1, nfiles
467 file_count = file_count + 1
469 call fill_in_diag_files(diag_yaml_id, diag_file_ids(i), diag_yaml%diag_files(file_count))
472 file_list%file_name(file_count) = trim(diag_yaml%diag_files(file_count)%file_fname)//c_null_char
473 file_list%diag_file_indices(file_count) = file_count
476 nvars =
get_num_blocks(diag_yaml_id,
"varlist", parent_block_id=diag_file_ids(i))
477 allocate(var_ids(nvars))
478 call get_block_ids(diag_yaml_id,
"varlist", var_ids, parent_block_id=diag_file_ids(i))
480 allocate(diag_yaml%diag_files(file_count)%file_varlist(
get_total_num_vars(diag_yaml_id, diag_file_ids(i))))
481 allocate(diag_yaml%diag_files(file_count)%file_outlist(
get_total_num_vars(diag_yaml_id, diag_file_ids(i))))
482 allow_averages = .not. diag_yaml%diag_files(file_count)%file_freq(1) < 1
483 is_instantaneous = .false.
484 nvars_loop:
do j = 1, nvars
486 call get_value_from_key(diag_yaml_id, var_ids(j),
"write_var", write_var, is_optional=.true.)
487 if (.not. write_var) cycle
489 var_count = var_count + 1
490 file_var_count = file_var_count + 1
493 diag_yaml%diag_fields(var_count)%var_fname = diag_yaml%diag_files(file_count)%file_fname
496 diag_yaml%diag_fields(var_count)%var_axes_names =
""
497 diag_yaml%diag_fields(var_count)%var_file_is_subregional = diag_yaml%diag_files(file_count)%has_file_sub_region()
500 diag_yaml%diag_fields(var_count), allow_averages)
503 diag_yaml%diag_files(file_count)%file_varlist(file_var_count) = diag_yaml%diag_fields(var_count)%var_varname
504 if(diag_yaml%diag_fields(var_count)%has_var_outname())
then
505 diag_yaml%diag_files(file_count)%file_outlist(file_var_count) = diag_yaml%diag_fields(var_count)%var_outname
507 diag_yaml%diag_files(file_count)%file_outlist(file_var_count) =
""
511 variable_list%var_name(var_count) = trim(diag_yaml%diag_fields(var_count)%var_varname)//&
512 ":"//trim(diag_yaml%diag_fields(var_count)%var_module)//c_null_char
514 variable_list%var_name(var_count) = lowercase(variable_list%var_name(var_count))
515 variable_list%diag_field_indices(var_count) = var_count
522 call fms_sort_this(file_list%file_pointer, actual_num_files, file_list%diag_file_indices)
525 call fms_sort_this(variable_list%var_pointer, total_nvars, variable_list%diag_field_indices)
527 deallocate(diag_file_ids)
528 diag_yaml_module_initialized = .true.
535 do i = 1,
size(diag_yaml%diag_files, 1)
536 if(
allocated(diag_yaml%diag_files(i)%file_varlist))
deallocate(diag_yaml%diag_files(i)%file_varlist)
537 if(
allocated(diag_yaml%diag_files(i)%file_outlist))
deallocate(diag_yaml%diag_files(i)%file_outlist)
538 if(
allocated(diag_yaml%diag_files(i)%file_global_meta))
deallocate(diag_yaml%diag_files(i)%file_global_meta)
539 if(
allocated(diag_yaml%diag_files(i)%file_sub_region%corners)) &
540 deallocate(diag_yaml%diag_files(i)%file_sub_region%corners)
542 if(
allocated(diag_yaml%diag_files))
deallocate(diag_yaml%diag_files)
544 do i = 1,
size(diag_yaml%diag_fields, 1)
545 if(
allocated(diag_yaml%diag_fields(i)%var_attributes))
deallocate(diag_yaml%diag_fields(i)%var_attributes)
547 if(
allocated(diag_yaml%diag_fields))
deallocate(diag_yaml%diag_fields)
549 if(
allocated(file_list%file_pointer))
deallocate(file_list%file_pointer)
550 if(
allocated(file_list%file_name))
deallocate(file_list%file_name)
551 if(
allocated(file_list%diag_file_indices))
deallocate(file_list%diag_file_indices)
553 if(
allocated(variable_list%var_pointer))
deallocate(variable_list%var_pointer)
554 if(
allocated(variable_list%var_name))
deallocate(variable_list%var_name)
555 if(
allocated(variable_list%diag_field_indices))
deallocate(variable_list%diag_field_indices)
561 integer,
intent(in) :: diag_yaml_id
562 integer,
intent(in) :: diag_file_id
565 integer :: nsubregion
566 integer :: sub_region_id(1)
568 integer :: global_att_id(1)
572 integer,
allocatable :: key_ids(:)
573 character(len=:),
ALLOCATABLE :: grid_type
574 character(len=:),
ALLOCATABLE :: buffer
575 integer :: start_time_int(6)
577 yaml_fileobj%file_frequnit = 0
581 call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_freq, yaml_fileobj%file_frequnit,
"freq")
590 call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_new_file_freq, &
591 yaml_fileobj%file_new_file_freq_units,
"new_file_freq")
598 start_time_int = diag_null
599 yaml_fileobj%file_start_time_set = .false.
601 start_time_int, is_optional=.true.)
602 if (any(start_time_int .ne. diag_null))
then
603 yaml_fileobj%file_start_time_set = .true.
604 call set_time_type(start_time_int, yaml_fileobj%file_start_time)
607 call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_duration, yaml_fileobj%file_duration_units, &
611 nsubregion =
get_num_blocks(diag_yaml_id,
"sub_region", parent_block_id=diag_file_id)
612 if (nsubregion .eq. 1)
then
613 max_subaxes = max_subaxes + 1
614 call get_block_ids(diag_yaml_id,
"sub_region", sub_region_id, parent_block_id=diag_file_id)
616 call get_sub_region(diag_yaml_id, sub_region_id(1), yaml_fileobj%file_sub_region, grid_type, &
617 yaml_fileobj%file_fname)
618 elseif (nsubregion .eq. 0)
then
619 yaml_fileobj%file_sub_region%grid_type = null_gridtype
621 call mpp_error(fatal,
"diag_yaml_object_init: file "//trim(yaml_fileobj%file_fname)//
" has multiple region blocks")
625 natt =
get_num_blocks(diag_yaml_id,
"global_meta", parent_block_id=diag_file_id)
626 if (natt .eq. 1)
then
627 call get_block_ids(diag_yaml_id,
"global_meta", global_att_id, parent_block_id=diag_file_id)
628 nkeys =
get_nkeys(diag_yaml_id, global_att_id(1))
629 allocate(key_ids(nkeys))
630 call get_key_ids(diag_yaml_id, global_att_id(1), key_ids)
632 allocate(yaml_fileobj%file_global_meta(nkeys, 2))
634 call get_key_name(diag_yaml_id, key_ids(j), yaml_fileobj%file_global_meta(j, 1))
635 call get_key_value(diag_yaml_id, key_ids(j), yaml_fileobj%file_global_meta(j, 2))
638 elseif (natt .ne. 0)
then
639 call mpp_error(fatal,
"diag_yaml_object_init: file "//trim(yaml_fileobj%file_fname)//&
640 &
" has multiple global_meta blocks")
654 integer,
intent(in) :: diag_file_id
656 integer,
intent(in) :: var_id
658 logical,
intent(in) :: allow_averages
661 integer :: var_att_id(1)
665 integer,
allocatable :: key_ids(:)
666 character(len=:),
ALLOCATABLE :: buffer
670 if (yaml_fileobj%default_var_reduction .eq.
"")
then
676 if (trim(buffer) .eq.
"") buffer = yaml_fileobj%default_var_reduction
681 if (.not. allow_averages)
then
682 if (field%var_reduction .ne.
time_none) &
683 call mpp_error(fatal,
"The file "//field%var_fname//
" can only have variables that have none as "//&
684 "the reduction method because the frequency is either -1 or 0. "//&
685 "Check your diag_table.yaml for the field:"//trim(field%var_varname))
688 if (yaml_fileobj%default_var_module .eq.
"")
then
693 if (trim(buffer) .eq.
"")
then
694 field%var_module = yaml_fileobj%default_var_module
696 field%var_module = trim(buffer)
701 if (yaml_fileobj%default_var_precision .eq.
"")
then
707 if (trim(buffer) .eq.
"") buffer = yaml_fileobj%default_var_precision
716 natt =
get_num_blocks(diag_file_id,
"attributes", parent_block_id=var_id)
717 if (natt .eq. 1)
then
718 call get_block_ids(diag_file_id,
"attributes", var_att_id, parent_block_id=var_id)
719 nkeys =
get_nkeys(diag_file_id, var_att_id(1))
720 allocate(key_ids(nkeys))
721 call get_key_ids(diag_file_id, var_att_id(1), key_ids)
723 allocate(field%var_attributes(nkeys, 2))
725 call get_key_name(diag_file_id, key_ids(j), field%var_attributes(j, 1))
726 call get_key_value(diag_file_id, key_ids(j), field%var_attributes(j, 2))
729 elseif (natt .ne. 0)
then
730 call mpp_error(fatal,
"diag_yaml_object_init: variable "//trim(field%var_varname)//&
731 " has multiple attribute blocks")
735 field%var_zbounds = diag_null
736 call get_value_from_key(diag_file_id, var_id,
"zbounds", field%var_zbounds, is_optional=.true.)
737 if (field%has_var_zbounds()) max_subaxes = max_subaxes + 1
743 integer,
intent(in) :: diag_file_id
744 integer,
intent(in) :: par_id
745 character(len=*),
intent(in) :: key_name
746 character(len=:),
allocatable :: value_name
747 logical,
intent(in),
optional :: is_optional
749 character(len=255) :: buffer
752 call get_value_from_key(diag_file_id, par_id, trim(key_name), buffer, is_optional= is_optional)
753 allocate(
character(len=len_trim(buffer)) :: value_name)
754 value_name = trim(buffer)
759 subroutine get_sub_region(diag_yaml_id, sub_region_id, sub_region, grid_type, fname)
760 integer,
intent(in) :: diag_yaml_id
761 integer,
intent(in) :: sub_region_id
763 character(len=*),
intent(in) :: grid_type
764 character(len=*),
intent(in) :: fname
766 select case (trim(grid_type))
768 sub_region%grid_type = latlon_gridtype
769 allocate(real(kind=r4_kind) :: sub_region%corners(4,2))
771 sub_region%grid_type = index_gridtype
772 allocate(
integer(kind=i4_kind) :: sub_region%corners(4,2))
774 call get_value_from_key(diag_yaml_id, sub_region_id,
"tile", sub_region%tile, is_optional=.true.)
775 if (sub_region%tile .eq. diag_null)
call mpp_error(fatal, &
776 "The tile number is required when defining a "//&
777 "subregion. Check your subregion entry for "//trim(fname))
779 call mpp_error(fatal, trim(grid_type)//
" is not a valid region type. &
780 &The acceptable values are latlon and index. &
781 &Check your entry for file:"//trim(fname))
784 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner1", sub_region%corners(1,:))
785 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner2", sub_region%corners(2,:))
786 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner3", sub_region%corners(3,:))
787 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner4", sub_region%corners(4,:))
796 integer,
intent(in) :: diag_yaml_id
797 integer,
intent(in) :: diag_file_id
798 integer :: total_nvars
802 integer,
allocatable :: var_ids(:)
805 nvars =
get_num_blocks(diag_yaml_id,
"varlist", parent_block_id=diag_file_id)
806 allocate(var_ids(nvars))
807 call get_block_ids(diag_yaml_id,
"varlist", var_ids, parent_block_id=diag_file_id)
813 call get_value_from_key(diag_yaml_id, var_ids(i),
"write_var", var_write, is_optional=.true.)
814 if (var_write) total_nvars = total_nvars + 1
819 subroutine parse_key(filename, buffer, file_freq, file_frequnit, var)
820 character(len=*),
intent(in) :: filename
821 character(len=*),
intent(inout) :: buffer
822 integer,
intent(out) :: file_freq(:)
824 integer,
intent(out) :: file_frequnit(:)
826 character(len=*),
intent(in) :: var
832 character(len=255) :: str
833 character(len=10) :: units
836 if (buffer .eq.
"")
return
841 do while (.not. finished)
843 buffer = buffer(j+1:len_trim(buffer))
844 j = index(buffer,
",")
847 j = len_trim(buffer)+1
851 str = adjustl(buffer(1:j-1))
854 read(str(1:k-1), *, iostat=err_unit) file_freq(count)
855 units = str(k+1:len_trim(str))
857 if (err_unit .ne. 0) &
858 call mpp_error(fatal,
"Error parsing "//trim(var)//
". Check your entry for file"//&
861 if (file_freq(count) .lt. -1) &
862 call mpp_error(fatal, trim(var)//
" is not valid. &
863 &Check your entry for file:"//trim(filename))
865 if (file_freq(count) .eq. -1 .or. file_freq(count) .eq. 0)
then
867 file_frequnit(count) = diag_days
869 if (trim(units) .eq.
"") &
870 call mpp_error(fatal, trim(var)//
" units is required. &
871 &Check your entry for file:"//trim(filename))
874 trim(var)//
" for file:"//trim(filename))
882 character(len=*),
intent(in) :: file_timeunit
884 yaml_fileobj%file_timeunit =
set_valid_time_units(file_timeunit,
"timeunit for file:"//trim(yaml_fileobj%file_fname))
890 character(len=*),
intent(in) :: filename_time
892 select case (trim(filename_time))
900 yaml_fileobj%filename_time =
end_time
902 call mpp_error(fatal, trim(filename_time)//
" is an invalid filename_time &
903 &The acceptable values are begin, middle, and end. &
904 &Check your entry for file "//trim(yaml_fileobj%file_fname))
911 character(len=*),
intent(in) :: skind
913 select case (trim(skind))
923 call mpp_error(fatal, trim(skind)//
" is an invalid kind! &
924 &The acceptable values are r4, r8, i4, i8. &
925 &Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
934 character(len=*) ,
intent(in) :: reduction_method
943 if (index(reduction_method,
"diurnal") .ne. 0)
then
944 READ (reduction_method(8:len_trim(reduction_method)), fmt=*, iostat=ioerror) n_diurnal
945 if (ioerror .ne. 0) &
946 call mpp_error(fatal,
"Error getting the number of diurnal samples from "//trim(reduction_method))
947 if (n_diurnal .le. 0) &
948 call mpp_error(fatal,
"Diurnal samples should be greater than 0. &
949 & Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
951 elseif (index(reduction_method,
"pow") .ne. 0)
then
952 READ (reduction_method(4:len_trim(reduction_method)), fmt=*, iostat=ioerror) pow_value
953 if (ioerror .ne. 0) &
954 call mpp_error(fatal,
"Error getting the power value from "//trim(reduction_method))
955 if (pow_value .le. 0) &
956 call mpp_error(fatal,
"The power value should be greater than 0. &
957 & Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
960 select case (reduction_method)
974 call mpp_error(fatal, trim(reduction_method)//
" is an invalid reduction method! &
975 &The acceptable values are none, average, pow##, diurnal##, min, max, and rms. &
976 &Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
980 field%n_diurnal = n_diurnal
981 field%pow_value = pow_value
987 result(time_units_int)
989 character(len=*),
intent(in) :: time_units
990 character(len=*),
intent(in) :: error_msg
992 integer :: time_units_int
994 select case (trim(time_units))
996 time_units_int = diag_seconds
998 time_units_int = diag_minutes
1000 time_units_int = diag_hours
1002 time_units_int = diag_days
1004 time_units_int = diag_months
1006 time_units_int = diag_years
1008 time_units_int =diag_null
1009 call mpp_error(fatal, trim(error_msg)//
" is not valid. Acceptable values are &
1010 &seconds, minutes, hours, days, months, years")
1027 character (len=:),
allocatable :: res
1028 res = this%file_fname
1036 res = this%file_frequnit(this%current_new_file_freq_index)
1044 res = this%file_freq(this%current_new_file_freq_index)
1052 res = this%file_timeunit
1059 character (len=:),
allocatable :: res
1060 res = this%file_unlimdim
1068 res => this%file_sub_region
1076 res = this%file_new_file_freq(this%current_new_file_freq_index)
1084 res = this%file_new_file_freq_units(this%current_new_file_freq_index)
1091 type(time_type) :: res
1092 res = this%file_start_time
1100 res = this%file_duration(this%current_new_file_freq_index)
1108 res = this%file_duration_units(this%current_new_file_freq_index)
1115 character (:),
allocatable :: res(:)
1116 res = this%file_varlist
1123 character (len=MAX_STR_LEN),
allocatable :: res(:,:)
1124 res = this%file_global_meta
1133 res = this%filename_time
1142 if (
allocated(this%file_global_meta)) &
1149 this%current_new_file_freq_index = this%current_new_file_freq_index + 1
1163 character (len=:),
allocatable :: res
1164 res = this%var_fname
1171 character (len=:),
allocatable :: res
1172 res = this%var_varname
1179 integer,
allocatable :: res
1180 res = this%var_reduction
1187 character (len=:),
allocatable :: res
1188 res = this%var_module
1195 integer,
allocatable :: res
1203 character (len=:),
allocatable :: res
1205 if (this%has_var_outname())
then
1206 res = this%var_outname
1208 res = this%var_varname
1216 character (len=:),
allocatable :: res
1217 res = this%var_longname
1224 character (len=:),
allocatable :: res
1225 res = this%var_units
1232 real(kind=r4_kind) :: res(2)
1233 res = this%var_zbounds
1240 character (len=MAX_STR_LEN),
allocatable :: res (:,:)
1241 res = this%var_attributes
1249 res = this%n_diurnal
1257 res = this%pow_value
1266 if (
allocated(this%var_attributes)) &
1275 obj%file_freq = diag_null
1276 obj%file_sub_region%tile = diag_null
1277 obj%file_new_file_freq = diag_null
1278 obj%file_duration = diag_null
1279 obj%file_new_file_freq_units = diag_null
1280 obj%file_duration_units = diag_null
1281 obj%current_new_file_freq_index = 1
1294 has_file_frequnit = this%file_frequnit(this%current_new_file_freq_index) .NE. diag_null
1324 if ( this%file_sub_region%grid_type .eq. latlon_gridtype .or. this%file_sub_region%grid_type .eq. index_gridtype)
then
1352 has_file_duration = this%file_duration(this%current_new_file_freq_index) .ne. diag_null
1413 if (
allocated(this%var_outname))
then
1414 if (trim(this%var_outname) .ne.
"")
then
1496 nfields = fms_find_unique(variable_list%var_pointer,
size(variable_list%var_pointer))
1505 character(len=*),
intent(in) :: diag_field_name
1506 character(len=*),
intent(in) :: module_name
1508 integer,
allocatable :: indices(:)
1510 indices = fms_find_my_string(variable_list%var_pointer,
size(variable_list%var_pointer), &
1511 & lowercase(trim(diag_field_name))//
":"//lowercase(trim(module_name)//c_null_char))
1519 integer,
intent(in) :: indices(:)
1525 allocate(diag_field(
size(indices)))
1527 do i = 1,
size(indices)
1528 field_id = variable_list%diag_field_indices(indices(i))
1529 diag_field(i) = diag_yaml%diag_fields(field_id)
1538 integer,
intent(in) :: indices(:)
1539 integer,
allocatable :: field_ids(:)
1542 allocate(field_ids(
size(indices)))
1544 do i = 1,
size(indices)
1545 field_ids(i) = variable_list%diag_field_indices(indices(i))
1555 integer,
intent(in) :: indices(:)
1556 integer,
allocatable :: file_id(:)
1560 character(len=FMS_FILE_LEN) :: filename
1561 integer,
allocatable :: file_indices(:)
1563 allocate(file_id(
size(indices)))
1565 do i = 1,
size(indices)
1566 field_id = variable_list%diag_field_indices(indices(i))
1568 filename = diag_yaml%diag_fields(field_id)%var_fname
1571 file_indices = fms_find_my_string(file_list%file_pointer,
size(file_list%file_pointer), &
1572 & trim(filename)//c_null_char)
1574 if (
size(file_indices) .ne. 1) &
1575 &
call mpp_error(fatal,
"get_diag_files_id: Error getting the correct number of file indices!"//&
1576 " The diag file "//trim(filename)//
" was defined "//string(
size(file_indices))&
1579 if (file_indices(1) .eq. diag_null) &
1580 &
call mpp_error(fatal,
"get_diag_files_id: Error finding the file "//trim(filename)//
" in the diag_files yaml")
1583 file_id(i) = file_list%diag_file_indices(file_indices(1))
1591 character(len=*),
optional,
intent(in) :: filename
1595 integer :: i, unit_num
1596 if(
present(filename))
then
1597 open(newunit=unit_num, file=trim(filename), action=
'WRITE')
1602 if(
mpp_pe() .eq. mpp_root_pe())
then
1603 write(unit_num, *)
'**********Dumping diag_yaml object**********'
1604 if( diag_yaml%has_diag_title())
write(unit_num, *)
'Title:', diag_yaml%diag_title
1605 if( diag_yaml%has_diag_basedate())
write(unit_num, *)
'basedate array:', diag_yaml%diag_basedate
1606 write(unit_num, *)
'FILES'
1607 allocate(fields(
SIZE(diag_yaml%get_diag_fields())))
1608 files => diag_yaml%diag_files
1609 fields = diag_yaml%get_diag_fields()
1611 write(unit_num, *)
'File: ', files(i)%get_file_fname()
1612 if(files(i)%has_file_frequnit())
write(unit_num, *)
'file_frequnit:', files(i)%get_file_frequnit()
1613 if(files(i)%has_file_freq())
write(unit_num, *)
'freq:', files(i)%get_file_freq()
1614 if(files(i)%has_file_timeunit())
write(unit_num, *)
'timeunit:', files(i)%get_file_timeunit()
1615 if(files(i)%has_file_unlimdim())
write(unit_num, *)
'unlimdim:', files(i)%get_file_unlimdim()
1617 if(files(i)%has_file_new_file_freq())
write(unit_num, *)
'new_file_freq:', files(i)%get_file_new_file_freq()
1618 if(files(i)%has_file_new_file_freq_units())
write(unit_num, *)
'new_file_freq_units:', &
1619 & files(i)%get_file_new_file_freq_units()
1620 if(files(i)%has_file_start_time())
write(unit_num, *)
'start_time:', &
1621 & date_to_string(files(i)%get_file_start_time())
1622 if(files(i)%has_file_duration())
write(unit_num, *)
'duration:', files(i)%get_file_duration()
1623 if(files(i)%has_file_duration_units())
write(unit_num, *)
'duration_units:', files(i)%get_file_duration_units()
1624 if(files(i)%has_file_varlist())
write(unit_num, *)
'varlist:', files(i)%get_file_varlist()
1625 if(files(i)%has_file_global_meta())
write(unit_num, *)
'global_meta:', files(i)%get_file_global_meta()
1626 if(files(i)%is_global_meta())
write(unit_num, *)
'global_meta:', files(i)%is_global_meta()
1627 write(unit_num, *)
''
1629 write(unit_num, *)
'FIELDS'
1630 do i=1,
SIZE(fields)
1631 write(unit_num, *)
'Field: ', fields(i)%get_var_fname()
1632 if(fields(i)%has_var_fname())
write(unit_num, *)
'fname:', fields(i)%get_var_fname()
1633 if(fields(i)%has_var_varname())
write(unit_num, *)
'varname:', fields(i)%get_var_varname()
1634 if(fields(i)%has_var_reduction())
write(unit_num, *)
'reduction:', fields(i)%get_var_reduction()
1635 if(fields(i)%has_var_module())
write(unit_num, *)
'module:', fields(i)%get_var_module()
1636 if(fields(i)%has_var_kind())
write(unit_num, *)
'kind:', fields(i)%get_var_kind()
1637 if(fields(i)%has_var_outname())
write(unit_num, *)
'outname:', fields(i)%get_var_outname()
1638 if(fields(i)%has_var_longname())
write(unit_num, *)
'longname:', fields(i)%get_var_longname()
1639 if(fields(i)%has_var_units())
write(unit_num, *)
'units:', fields(i)%get_var_units()
1640 if(fields(i)%has_var_zbounds())
write(unit_num, *)
'zbounds:', fields(i)%get_var_zbounds()
1641 if(fields(i)%has_var_attributes())
write(unit_num, *)
'attributes:', fields(i)%get_var_attributes()
1642 if(fields(i)%has_n_diurnal())
write(unit_num, *)
'n_diurnal:', fields(i)%get_n_diurnal()
1643 if(fields(i)%has_pow_value())
write(unit_num, *)
'pow_value:', fields(i)%get_pow_value()
1644 if(fields(i)%has_var_attributes())
write(unit_num, *)
'is_var_attributes:', fields(i)%is_var_attributes()
1648 if(
present(filename))
then
1658 integer,
intent(in) :: ntimes(:)
1659 integer,
intent(in) :: ntiles(:)
1660 integer,
intent(in) :: ndistributedfiles(:)
1664 type (fmsyamloutkeys_type),
allocatable :: keys(:), keys2(:), keys3(:)
1665 type (fmsyamloutvalues_type),
allocatable :: vals(:), vals2(:), vals3(:)
1667 character(len=128) :: tmpstr1, tmpstr2
1668 integer,
parameter :: tier1size = 3
1669 integer :: tier2size, tier3size
1670 integer,
allocatable :: tier3each(:)
1671 integer,
dimension(basedate_size) :: basedate_loc
1672 integer :: varnum_i, key3_i, gm
1673 character(len=32),
allocatable :: st_vals(:)
1674 character(len=FMS_FILE_LEN) :: filename
1679 if(
mpp_pe() .ne. mpp_root_pe())
return
1681 allocate(tier3each(
SIZE(diag_yaml%diag_files) * 3))
1682 tier3size = 0; tier3each = 0
1687 allocate(keys2(
SIZE(diag_yaml%diag_files)))
1688 allocate(vals2(
SIZE(diag_yaml%diag_files)))
1689 allocate(st_vals(
SIZE(diag_yaml%diag_files)))
1690 do i=1,
SIZE(diag_yaml%diag_files)
1691 call initialize_key_struct(keys2(i))
1692 call initialize_val_struct(vals2(i))
1693 if (
allocated(diag_yaml%diag_files(i)%file_varlist) )
then
1694 do j=1,
SIZE(diag_yaml%diag_files(i)%file_varlist)
1695 tier3size = tier3size + 1
1698 tier3size = tier3size + 2
1700 allocate(keys3(tier3size))
1701 allocate(vals3(tier3size))
1704 call initialize_key_struct(keys(1))
1705 call initialize_val_struct(vals(1))
1706 call fms_f2c_string( keys(1)%key1,
'title')
1707 call fms_f2c_string( vals(1)%val1, diag_yaml%diag_title)
1708 call fms_f2c_string( keys(1)%key2,
'base_date')
1709 basedate_loc = diag_yaml%get_basedate()
1710 tmpstr1 =
''; tmpstr2 =
''
1711 tmpstr1 = string(basedate_loc(1))
1712 tmpstr2 = trim(tmpstr1)
1713 do i=2, basedate_size
1714 tmpstr1 = string(basedate_loc(i))
1715 tmpstr2 = trim(tmpstr2) //
' ' // trim(tmpstr1)
1717 call fms_f2c_string(vals(1)%val2, trim(tmpstr2))
1718 call yaml_out_add_level2key(
'diag_files', keys(1))
1721 do i=1,
SIZE(diag_yaml%diag_files)
1722 fileptr => diag_yaml%diag_files(i)
1724 call fms_f2c_string(keys2(i)%key1,
'file_name')
1725 call fms_f2c_string(keys2(i)%key2,
'freq')
1726 call fms_f2c_string(keys2(i)%key3,
'freq_units')
1727 call fms_f2c_string(keys2(i)%key4,
'time_units')
1728 call fms_f2c_string(keys2(i)%key5,
'unlimdim')
1729 call fms_f2c_string(keys2(i)%key6,
'new_file_freq')
1730 call fms_f2c_string(keys2(i)%key7,
'new_file_freq_units')
1731 call fms_f2c_string(keys2(i)%key8,
'start_time')
1732 call fms_f2c_string(keys2(i)%key9,
'file_duration')
1733 call fms_f2c_string(keys2(i)%key10,
'file_duration_units')
1736 call fms_f2c_string(keys2(i)%key11,
'number_of_timelevels')
1741 call fms_f2c_string(keys2(i)%key12,
'number_of_tiles')
1747 call fms_f2c_string(keys2(i)%key13,
'number_of_distributed_files')
1749 call fms_f2c_string(vals2(i)%val1, fileptr%file_fname)
1750 call fms_f2c_string(vals2(i)%val5, fileptr%file_unlimdim)
1753 do k=1,
SIZE(fileptr%file_freq)
1754 if(fileptr%file_freq(k) .eq. diag_null)
exit
1756 tmpstr2 = string(fileptr%file_freq(k))
1757 tmpstr1 = trim(tmpstr1)//
" "//trim(tmpstr2)
1759 call fms_f2c_string(vals2(i)%val2, adjustl(tmpstr1))
1762 do k=1,
SIZE(fileptr%file_new_file_freq)
1763 if(fileptr%file_new_file_freq(k) .eq. diag_null)
exit
1765 tmpstr2 = string(fileptr%file_new_file_freq(k))
1766 tmpstr1 = trim(tmpstr1)//
" "//trim(tmpstr2)
1768 call fms_f2c_string(vals2(i)%val6, adjustl(tmpstr1))
1770 if (fileptr%has_file_start_time())
then
1771 call fms_f2c_string(vals2(i)%val8, trim(date_to_string(fileptr%get_file_start_time())))
1773 call fms_f2c_string(vals2(i)%val8,
"")
1776 do k=1,
SIZE(fileptr%file_duration)
1777 if(fileptr%file_duration(k) .eq. diag_null)
exit
1779 tmpstr2 = string(fileptr%file_duration(k))
1780 tmpstr1 = trim(tmpstr1)//
" "//trim(tmpstr2)
1782 call fms_f2c_string(vals2(i)%val9, adjustl(tmpstr1))
1784 call fms_f2c_string(vals2(i)%val11, string(ntimes(i)))
1785 call fms_f2c_string(vals2(i)%val12, string(ntiles(i)))
1786 call fms_f2c_string(vals2(i)%val13, string(ndistributedfiles(i)))
1789 call yaml_out_add_level2key(
'varlist', keys2(i))
1791 if(
SIZE(fileptr%file_varlist) .gt. 0)
then
1792 do j=1,
SIZE(fileptr%file_varlist)
1794 call initialize_key_struct(keys3(key3_i))
1795 call initialize_val_struct(vals3(key3_i))
1798 do varnum_i=1,
SIZE(diag_yaml%diag_fields)
1799 if( trim(diag_yaml%diag_fields(varnum_i)%var_varname ) .eq. trim(fileptr%file_varlist(j)) .and. &
1800 trim(diag_yaml%diag_fields(varnum_i)%var_fname) .eq. trim(fileptr%file_fname))
then
1802 if(diag_yaml%diag_fields(varnum_i)%has_var_outname())
then
1803 if(trim(diag_yaml%diag_fields(varnum_i)%var_outname) .eq. trim(fileptr%file_outlist(j)))
then
1804 varptr => diag_yaml%diag_fields(varnum_i)
1808 varptr => diag_yaml%diag_fields(varnum_i)
1813 if( .not.
associated(varptr))
call mpp_error(fatal,
"diag_yaml_output: could not find variable in list."//&
1814 " var: "// trim(fileptr%file_varlist(j)))
1815 call fms_f2c_string(keys3(key3_i)%key1,
'module')
1816 call fms_f2c_string(keys3(key3_i)%key2,
'var_name')
1817 call fms_f2c_string(keys3(key3_i)%key3,
'reduction')
1818 call fms_f2c_string(keys3(key3_i)%key4,
'kind')
1819 call fms_f2c_string(keys3(key3_i)%key5,
'output_name')
1820 call fms_f2c_string(keys3(key3_i)%key6,
'long_name')
1821 call fms_f2c_string(keys3(key3_i)%key7,
'units')
1822 call fms_f2c_string(keys3(key3_i)%key8,
'zbounds')
1823 call fms_f2c_string(keys3(key3_i)%key9,
'n_diurnal')
1824 call fms_f2c_string(keys3(key3_i)%key10,
'pow_value')
1825 call fms_f2c_string(keys3(key3_i)%key11,
'dimensions')
1826 call fms_f2c_string(keys3(key3_i)%key12,
'standard_name')
1827 if (varptr%has_var_module())
call fms_f2c_string(vals3(key3_i)%val1, varptr%var_module)
1828 if (varptr%has_var_varname())
call fms_f2c_string(vals3(key3_i)%val2, varptr%var_varname)
1829 if (varptr%has_var_reduction())
then
1830 call fms_f2c_string(vals3(key3_i)%val3, &
1833 if (varptr%has_var_outname())
call fms_f2c_string(vals3(key3_i)%val5, varptr%var_outname)
1834 if (varptr%has_var_longname())
call fms_f2c_string(vals3(key3_i)%val6, varptr%var_longname)
1835 if (varptr%has_var_units())
call fms_f2c_string(vals3(key3_i)%val7, varptr%var_units)
1836 if (varptr%has_var_kind())
then
1837 select case(varptr%var_kind)
1839 call fms_f2c_string(vals3(key3_i)%val4,
'i4')
1841 call fms_f2c_string(vals3(key3_i)%val4,
'i8')
1843 call fms_f2c_string(vals3(key3_i)%val4,
'r4')
1845 call fms_f2c_string(vals3(key3_i)%val4,
'r8')
1849 if( abs(varptr%var_zbounds(1) - real(diag_null, r4_kind)) .gt. 1.0e-5 )
then
1850 tmpstr2 = string(varptr%var_zbounds(1),
"F8.2") //
' ' // string(varptr%var_zbounds(2),
"F8.2")
1851 call fms_f2c_string(vals3(key3_i)%val8, trim(tmpstr2))
1854 if( varptr%n_diurnal .gt. 0)
then
1855 tmpstr1 =
''; tmpstr1 = string(varptr%n_diurnal)
1856 call fms_f2c_string(vals3(key3_i)%val9, tmpstr1)
1859 if( varptr%pow_value .gt. 0)
then
1860 tmpstr1 =
''; tmpstr1 = string(varptr%pow_value)
1861 call fms_f2c_string(vals3(key3_i)%val10, tmpstr1)
1864 tmpstr1 =
''; tmpstr1 = varptr%var_axes_names
1865 call fms_f2c_string(vals3(key3_i)%val11, trim(adjustl(tmpstr1)))
1867 if(diag_yaml%diag_fields(varnum_i)%has_standname())&
1868 call fms_f2c_string(vals3(key3_i)%val12, diag_yaml%diag_fields(varnum_i)%standard_name)
1873 tier3each(i*3-2) = j-1
1874 tier3each(i*3-1) = 1
1876 call initialize_key_struct(keys3(key3_i))
1877 call initialize_val_struct(vals3(key3_i))
1879 call yaml_out_add_level2key(
'sub_region', keys2(i))
1880 call fms_f2c_string(keys3(key3_i)%key1,
'grid_type')
1881 call fms_f2c_string(keys3(key3_i)%key2,
'tile')
1882 call fms_f2c_string(keys3(key3_i)%key3,
'corner1')
1883 call fms_f2c_string(keys3(key3_i)%key4,
'corner2')
1884 call fms_f2c_string(keys3(key3_i)%key5,
'corner3')
1885 call fms_f2c_string(keys3(key3_i)%key6,
'corner4')
1887 select case (fileptr%file_sub_region%grid_type)
1888 case(latlon_gridtype)
1889 call fms_f2c_string(vals3(key3_i)%val1,
'latlon')
1890 case(index_gridtype)
1891 call fms_f2c_string(vals3(key3_i)%val1,
'index')
1893 if(fileptr%file_sub_region%tile .ne. diag_null)
then
1894 tmpstr1 =
''; tmpstr1 = string(fileptr%file_sub_region%tile)
1895 call fms_f2c_string(vals3(key3_i)%val2, tmpstr1)
1897 if(fileptr%has_file_sub_region())
then
1898 if(
allocated(fileptr%file_sub_region%corners))
then
1899 select type (corners => fileptr%file_sub_region%corners)
1900 type is (real(r8_kind))
1901 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1902 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1903 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1904 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1905 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1906 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1907 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1908 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1909 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1910 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1911 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1912 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1913 type is (real(r4_kind))
1914 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1915 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1916 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1917 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1918 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1919 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1920 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1921 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1922 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1923 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1924 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1925 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1926 type is (
integer(i4_kind))
1927 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1928 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1929 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1930 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1931 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1932 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1933 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1934 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1935 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1936 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1937 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1938 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1939 type is (
integer(i8_kind))
1940 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1941 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1942 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1943 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1944 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1945 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1946 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1947 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1948 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1949 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1950 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1951 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1957 call initialize_key_struct(keys3(key3_i))
1958 call initialize_val_struct(vals3(key3_i))
1959 call yaml_out_add_level2key(
'global_meta', keys2(i))
1960 if ( fileptr%has_file_global_meta())
then
1961 do gm=1,
SIZE(fileptr%file_global_meta, 1)
1964 call fms_f2c_string(keys3(key3_i)%key1, fileptr%file_global_meta(1,1))
1965 call fms_f2c_string(vals3(key3_i)%val1, fileptr%file_global_meta(1,2))
1967 call fms_f2c_string(keys3(key3_i)%key2, fileptr%file_global_meta(2,1))
1968 call fms_f2c_string(vals3(key3_i)%val2, fileptr%file_global_meta(2,2))
1970 call fms_f2c_string(keys3(key3_i)%key3, fileptr%file_global_meta(3,1))
1971 call fms_f2c_string(vals3(key3_i)%val3, fileptr%file_global_meta(3,2))
1973 call fms_f2c_string(keys3(key3_i)%key4, fileptr%file_global_meta(4,1))
1974 call fms_f2c_string(vals3(key3_i)%val4, fileptr%file_global_meta(4,2))
1976 call fms_f2c_string(keys3(key3_i)%key5, fileptr%file_global_meta(5,1))
1977 call fms_f2c_string(vals3(key3_i)%val5, fileptr%file_global_meta(5,2))
1979 call fms_f2c_string(keys3(key3_i)%key6, fileptr%file_global_meta(6,1))
1980 call fms_f2c_string(vals3(key3_i)%val6, fileptr%file_global_meta(6,2))
1982 call fms_f2c_string(keys3(key3_i)%key7, fileptr%file_global_meta(7,1))
1983 call fms_f2c_string(vals3(key3_i)%val7, fileptr%file_global_meta(7,2))
1985 call fms_f2c_string(keys3(key3_i)%key8, fileptr%file_global_meta(8,1))
1986 call fms_f2c_string(vals3(key3_i)%val8, fileptr%file_global_meta(8,2))
1988 call fms_f2c_string(keys3(key3_i)%key9, fileptr%file_global_meta(9,1))
1989 call fms_f2c_string(vals3(key3_i)%val9, fileptr%file_global_meta(9,2))
1991 call fms_f2c_string(keys3(key3_i)%key10, fileptr%file_global_meta(10,1))
1992 call fms_f2c_string(vals3(key3_i)%val10, fileptr%file_global_meta(10,2))
1994 call fms_f2c_string(keys3(key3_i)%key11, fileptr%file_global_meta(11,1))
1995 call fms_f2c_string(vals3(key3_i)%val11, fileptr%file_global_meta(11,2))
1997 call fms_f2c_string(keys3(key3_i)%key12, fileptr%file_global_meta(12,1))
1998 call fms_f2c_string(vals3(key3_i)%val12, fileptr%file_global_meta(12,2))
2000 call fms_f2c_string(keys3(key3_i)%key13, fileptr%file_global_meta(13,1))
2001 call fms_f2c_string(vals3(key3_i)%val13, fileptr%file_global_meta(13,2))
2003 call fms_f2c_string(keys3(key3_i)%key14, fileptr%file_global_meta(14,1))
2004 call fms_f2c_string(vals3(key3_i)%val14, fileptr%file_global_meta(14,2))
2006 call fms_f2c_string(keys3(key3_i)%key15, fileptr%file_global_meta(15,1))
2007 call fms_f2c_string(vals3(key3_i)%val15, fileptr%file_global_meta(15,2))
2009 call fms_f2c_string(keys3(key3_i)%key16, fileptr%file_global_meta(16,1))
2010 call fms_f2c_string(vals3(key3_i)%val16, fileptr%file_global_meta(16,2))
2017 call get_instance_filename(
'diag_manifest.yaml.'//string(
mpp_pe()), filename)
2018 call write_yaml_from_struct_3( trim(filename)//c_null_char, 1, keys, vals, &
2019 SIZE(diag_yaml%diag_files), keys2, vals2, &
2020 tier3size, tier3each, keys3, vals3, &
2021 (/
size(diag_yaml%diag_files), 0, 0, 0, 0, 0, 0, 0/))
2022 deallocate( keys, keys2, keys3, vals, vals2, vals3)
2028 integer,
intent(in) :: unit_param(:)
2031 character(len=7) :: tmp
2034 do i=1,
SIZE(unit_param)
2035 select case(unit_param(i))
2058 integer,
intent(in) :: reduction_val(:)
2061 character(len=7) :: tmp
2063 do i=1,
SIZE(reduction_val)
2064 select case (reduction_val(i))
2087 subroutine add_axis_name( this, axis_name )
2089 character(len=:),
allocatable,
intent(in) :: axis_name
2090 character(len=:),
allocatable :: tmp_str
2092 this%var_axes_names = trim(axis_name)//
" "//trim(this%var_axes_names)
2094 end subroutine add_axis_name
2099 character(len=*),
optional,
intent(in) :: standard_name
2101 if (
present(standard_name))
then
2102 this%standard_name = standard_name(1:len_trim(standard_name))
2104 this%standard_name =
""
2108 pure function is_file_subregional( this ) &
2113 res = this%var_file_is_subregional
2114 end function is_file_subregional
2117 end module fms_diag_yaml_mod
integer, parameter max_str_len
Max length for a string.
integer, parameter end_time
Use the end of the time average bounds.
integer, parameter time_min
The reduction method is min value.
subroutine set_base_time(base_time_int)
Set the module variable base_time.
integer, parameter time_diurnal
The reduction method is diurnal.
integer, parameter time_power
The reduction method is average with exponents.
integer, parameter begin_time
Use the begining of the time average bounds.
integer, parameter time_average
The reduction method is average of values.
integer, parameter time_sum
The reduction method is sum of values.
integer, parameter time_rms
The reudction method is root mean square of values.
integer, parameter middle_time
Use the middle of the time average bounds.
integer, parameter time_none
There is no reduction method.
integer, parameter time_max
The reduction method is max value.
integer, parameter r8
Supported type/kind of the variable.
subroutine, public set_time_type(time_int, time)
Sets up a time_type based on 6 member array of integers defining the [year month day hour min sec].
integer pure function size_file_varlist(this)
Finds the number of variables in the file_varlist.
pure logical function has_diag_basedate(this)
diag_file_objdiag_basedate is on the stack, so this is always true
type(diagyamlobject_type) function, pointer, public get_diag_yaml_obj()
gets the diag_yaml module variable
type(diagyamlfilesvar_type) function, dimension(:), allocatable, public get_diag_fields_entries(indices)
Gets the diag_field entries corresponding to the indices of the sorted variable_list.
pure integer function get_filename_time(this)
Get the integer equivalent of the time to use to determine the filename, if using a wildcard file nam...
pure logical function has_file_duration_units(this)
diag_file_objfile_duration_units is on the stack, so this will retrun true
pure logical function has_var_reduction(this)
Checks if diag_file_objvar_reduction is allocated.
pure logical function has_var_attributes(this)
Checks if diag_file_objvar_attributes is allocated.
subroutine set_filename_time(yaml_fileobj, filename_time)
This checks if the filename_time in a diag file is correct and sets the integer equivalent.
subroutine fill_in_diag_fields(diag_file_id, yaml_fileobj, var_id, field, allow_averages)
Fills in a diagYamlFilesVar_type with the contents of a variable block in diag_table....
pure logical function has_n_diurnal(this)
Checks if diag_file_objn_diurnal is set.
subroutine, public diag_yaml_object_end()
Destroys the diag_yaml object.
pure integer function get_pow_value(this)
Inquiry for diag_yaml_files_var_objpow_value.
pure integer function get_file_new_file_freq_units(this)
Inquiry for diag_files_objfile_new_file_freq_units.
subroutine add_standname(this, standard_name)
Adds the standname for the DiagYamlFilesVar_type.
pure logical function has_var_varname(this)
Checks if diag_file_objvar_varname is allocated.
subroutine set_file_time_units(yaml_fileobj, file_timeunit)
This checks if the time unit in a diag file is valid and sets the integer equivalent.
pure logical function has_file_timeunit(this)
Checks if diag_file_objfile_timeunit is allocated.
pure integer function size_diag_files(this)
Find the number of files listed in the diag yaml.
pure logical function has_file_start_time(this)
Checks if diag_file_objfile_start_time is allocated.
pure logical function has_file_sub_region(this)
Checks if diag_file_objfile_sub_region is being used and has the sub region variables allocated.
pure integer function, allocatable get_var_reduction(this)
Inquiry for diag_yaml_files_var_objvar_reduction.
pure integer function get_file_duration_units(this)
Inquiry for diag_files_objfile_duration_units.
type(diagyamlfiles_type) function, dimension(:), allocatable get_diag_files(this)
get the diag_files of a diag_yaml type
pure logical function has_file_global_meta(this)
Checks if diag_file_objfile_global_meta is allocated.
pure logical function has_var_longname(this)
Checks if diag_file_objvar_longname is allocated.
pure character(len=:) function, allocatable get_var_module(this)
Inquiry for diag_yaml_files_var_objvar_module.
pure logical function has_file_frequnit(this)
Checks if diag_file_objfile_frequnit is allocated.
logical function is_global_meta(this)
Inquiry for whether file_global_meta is allocated.
pure real(kind=r4_kind) function, dimension(2) get_var_zbounds(this)
Inquiry for diag_yaml_files_var_objvar_zbounds.
pure integer function, dimension(basedate_size) get_basedate(this)
get the basedate of a diag_yaml type
subroutine, public fms_diag_yaml_out(ntimes, ntiles, ndistributedfiles)
Writes an output yaml with all available information on the written files. Will only write with root ...
integer function set_valid_time_units(time_units, error_msg)
This checks if a time unit is valid and if it is, it assigns the integer equivalent.
pure logical function has_diag_title(this)
Checks if diag_file_objdiag_title is allocated.
subroutine get_sub_region(diag_yaml_id, sub_region_id, sub_region, grid_type, fname)
gets the lat/lon of the sub region to use in a diag_table yaml
pure character(len=:) function, allocatable get_var_fname(this)
Inquiry for diag_yaml_files_var_objvar_fname.
pure logical function has_standname(this)
Checks if diag_file_objstandname is set.
pure integer function get_file_timeunit(this)
Inquiry for diag_files_objfile_timeunit.
subroutine increase_new_file_freq_index(this)
Increate the current_new_file_freq_index by 1.
subroutine diag_yaml_files_obj_init(obj)
Initializes the non string values of a diagYamlFiles_type to its default values.
integer function, dimension(:), allocatable, public get_diag_field_ids(indices)
Gets field indices corresponding to the indices (input argument) in the sorted variable_list.
pure character(len=8 *size(unit_param)) function get_diag_unit_string(unit_param)
private function for getting unit string from diag_data parameter values
subroutine, public diag_yaml_object_init(diag_subset_output)
Uses the yaml_parser_mod to read in the diag_table and fill in the diag_yaml object.
pure logical function has_var_write(this)
diag_file_objvar_write is on the stack, so this returns true
logical function is_var_attributes(this)
Inquiry for whether var_attributes is allocated.
pure character(len=:) function, allocatable get_var_units(this)
Inquiry for diag_yaml_files_var_objvar_units.
subroutine, public dump_diag_yaml_obj(filename)
Prints out values from diag_yaml object for debugging. Only writes on root.
pure integer function, allocatable get_var_kind(this)
Inquiry for diag_yaml_files_var_objvar_kind.
integer function, public get_num_unique_fields()
Determine the number of unique diag_fields in the diag_yaml_object.
pure character(:) function, dimension(:), allocatable get_file_varlist(this)
Inquiry for diag_files_objfile_varlist.
integer function get_total_num_vars(diag_yaml_id, diag_file_id)
gets the total number of variables in the diag_table yaml file
pure integer function get_file_frequnit(this)
Inquiry for diag_files_objfile_frequnit.
type(diagyamlfilesvar_type) function, pointer get_diag_field_from_id(this, yaml_id)
Get the diag_field yaml corresponding to a yaml_id.
pure character(len=:) function, allocatable get_file_fname(this)
Inquiry for diag_files_objfile_fname.
pure logical function has_var_outname(this)
Checks if diag_file_objvar_outname is allocated.
pure logical function has_file_new_file_freq_units(this)
Checks if diag_file_objfile_new_file_freq_units is allocated.
pure character(len=max_str_len) function, dimension(:,:), allocatable get_file_global_meta(this)
Inquiry for diag_files_objfile_global_meta.
pure character(len=:) function, allocatable get_var_varname(this)
Inquiry for diag_yaml_files_var_objvar_varname.
pure integer function get_file_new_file_freq(this)
Inquiry for diag_files_objfile_new_file_freq.
subroutine set_field_reduction(field, reduction_method)
This checks if the reduction of a diag field is valid and sets it If the reduction method is diurnalX...
pure logical function has_diag_fields(this)
Checks if diag_file_objdiag_fields is allocated.
pure integer function get_n_diurnal(this)
Inquiry for diag_yaml_files_var_objn_diurnal.
pure logical function has_file_freq(this)
diag_file_objfile_freq is on the stack, so the object always has it
subroutine set_field_kind(field, skind)
This checks if the kind of a diag field is valid and sets it.
pure type(time_type) function get_file_start_time(this)
Inquiry for diag_files_objfile_start_time.
pure logical function has_file_new_file_freq(this)
diag_file_objfile_new_file_freq is defined on the stack, so this will return true
pure type(diagyamlfilesvar_type) function, dimension(:), allocatable get_diag_fields(this)
get the diag_fields of a diag_yaml type
pure logical function has_var_module(this)
Checks if diag_file_objvar_module is allocated.
pure character(len=:) function, allocatable get_file_unlimdim(this)
Inquiry for diag_files_objfile_unlimdim.
pure logical function has_file_varlist(this)
Checks if diag_file_objfile_varlist is allocated.
pure character(len=:) function, allocatable get_var_outname(this)
Inquiry for diag_yaml_files_var_objvar_outname.
pure character(len=:) function, allocatable get_var_longname(this)
Inquiry for diag_yaml_files_var_objvar_longname.
pure character(len=8 *max_freq) function get_diag_reduction_string(reduction_val)
private function for getting reduction type string from parameter values
pure logical function has_diag_files(this)
Checks if diag_file_objdiag_files is allocated.
pure character(len=max_str_len) function, dimension(:,:), allocatable get_var_attributes(this)
Inquiry for diag_yaml_files_var_objvar_attributes.
pure logical function has_var_kind(this)
Checks if diag_file_objvar_kind is allocated.
pure integer function get_file_duration(this)
Inquiry for diag_files_objfile_duration.
subroutine fill_in_diag_files(diag_yaml_id, diag_file_id, yaml_fileobj)
Fills in a diagYamlFiles_type with the contents of a file block in diag_table.yaml.
integer function, dimension(:), allocatable, public find_diag_field(diag_field_name, module_name)
Determines if a diag_field is in the diag_yaml_object.
pure logical function has_var_zbounds(this)
Checks if diag_file_objvar_zbounds is allocated.
pure character(len=:) function, allocatable get_title(this)
get the title of a diag_yaml type
type(subregion_type) function, pointer get_file_sub_region(this)
Inquiry for diag_files_objfile_subregion.
pure integer function get_file_freq(this)
Inquiry for diag_files_objfile_freq.
integer function, dimension(:), allocatable, public get_diag_files_id(indices)
Finds the indices of the diag_yamldiag_files(:) corresponding to fields in variable_list(indices)
subroutine parse_key(filename, buffer, file_freq, file_frequnit, var)
This parses the freq, new_file_freq, or file_duration keys which are read in as a comma list.
pure logical function has_file_write(this)
Checks if diag_file_objfile_write is on the stack, so this will always be true.
pure logical function has_pow_value(this)
Checks if diag_file_objpow_value is set.
pure logical function has_var_units(this)
Checks if diag_file_objvar_units is allocated.
pure logical function has_var_fname(this)
Checks if diag_file_objvar_fname is allocated.
pure logical function has_file_unlimdim(this)
Checks if diag_file_objfile_unlimdim is allocated.
subroutine diag_get_value_from_key(diag_file_id, par_id, key_name, value_name, is_optional)
diag_manager wrapper to get_value_from_key to use for allocatable string variables
pure logical function has_file_fname(this)
Checks if diag_file_objfile_fname is allocated.
pure logical function has_file_duration(this)
diag_file_objfile_duration is allocated on th stack, so this is always true
Object that holds the information of the diag_yaml.
character(:) function, allocatable, public string(v, fmt)
Converts a number or a Boolean value to a string.
type(c_ptr) function, dimension(:), allocatable, public fms_array_to_pointer(my_array)
Converts a character array to an array of c pointers!
integer function, dimension(:), allocatable, public fms_find_my_string(my_pointer, narray, string_to_find)
Searches through a SORTED array of pointers for a string.
subroutine, public fms_f2c_string(dest, str_in)
Copies a Fortran string into a C string and puts c_null_char in any trailing spaces.
subroutine, public initialize_val_struct(yv)
subroutine, public initialize_key_struct(yk)
Keys for the output yaml on a given level corresponding to the struct in yaml_output_functions....
Values for the output yaml on a given level corresponding to the struct in yaml_output_functions....
integer function stdout()
This function returns the current standard fortran unit numbers for output.
integer function mpp_pe()
Returns processor ID.
character(len=15) function, public date_to_string(time, err_msg)
Get the a character string that represents the time. The format will be yyyymmdd.hhmmss.
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.
integer function, public get_nkeys(file_id, block_id)
Gets the number of key-value pairs in a block.
subroutine, public get_key_name(file_id, key_id, key_name)
Gets the key from a file id.
integer function, public open_and_parse_file(filename)
Opens and parses a yaml file.
subroutine, public get_key_ids(file_id, block_id, key_ids)
Gets the ids of the key-value pairs in a block.
subroutine, public get_block_ids(file_id, block_name, block_ids, parent_block_id)
Gets the the ids of the blocks with block_name in the yaml file If parent_block_id is present,...
integer function, public get_num_blocks(file_id, block_name, parent_block_id)
Determines the number of blocks with block_name in the yaml file If parent_block_id is present,...
subroutine, public get_key_value(file_id, key_id, key_value)
Gets the value from a file id.
Dermine the value of a key from a keyname.
c function that finds the number of unique strings in an array of c pointers
Sorts an array of pointers (my pointer) of size (p_size) in alphabetical order.
type to hold the diag_file information
type to hold the info a diag_field
type to hold an array of sorted diag_files
type to hold the sub region information about a file
type to hold an array of sorted diag_fiels