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
64 integer,
parameter :: basedate_size = 6
65 integer,
parameter :: NUM_SUB_REGION_ARRAY = 8
66 integer,
parameter :: MAX_FREQ = 12
67 integer :: MAX_SUBAXES = 0
73 character(len=255),
allocatable :: var_name(:)
74 type(c_ptr),
allocatable :: var_pointer(:)
75 integer,
allocatable :: diag_field_indices(:)
80 character(len=FMS_FILE_LEN),
allocatable :: file_name(:)
81 type(c_ptr),
allocatable :: file_pointer(:)
82 integer,
allocatable :: diag_file_indices(:)
90 class(*),
allocatable :: corners(:,:)
99 character (len=:),
allocatable :: file_fname
100 integer :: file_frequnit(max_freq)
103 integer :: file_freq(max_freq)
104 integer :: file_timeunit
107 character (len=:),
allocatable :: file_unlimdim
109 integer :: file_new_file_freq(max_freq)
110 integer :: file_new_file_freq_units(max_freq)
114 character (len=:),
allocatable :: file_start_time
116 integer :: filename_time
119 integer :: file_duration(max_freq)
128 integer :: file_duration_units(max_freq)
131 integer :: current_new_file_freq_index
133 character (len=MAX_STR_LEN),
allocatable :: file_varlist(:)
135 character (len=MAX_STR_LEN),
allocatable :: file_outlist(:)
138 character (len=MAX_STR_LEN),
allocatable :: file_global_meta(:,:)
142 character (len=:),
allocatable :: default_var_precision
145 character (len=:),
allocatable :: default_var_reduction
148 character (len=:),
allocatable :: default_var_module
191 character (len=:),
private,
allocatable :: var_fname
192 character (len=:),
private,
allocatable :: var_varname
193 integer ,
private,
allocatable :: var_reduction
196 character (len=:),
private,
allocatable :: var_module
197 integer ,
private,
allocatable :: var_kind
198 character (len=:),
private,
allocatable :: var_outname
199 character (len=:),
private,
allocatable :: var_longname
200 character (len=:),
private,
allocatable :: var_units
201 real(kind=r4_kind),
private :: var_zbounds(2)
202 integer ,
private :: n_diurnal
204 integer ,
private :: pow_value
206 logical ,
private :: var_file_is_subregional
210 character (len=MAX_STR_LEN),
dimension (:, :),
private,
allocatable :: var_attributes
212 character(len=:),
allocatable :: var_axes_names
242 procedure :: add_axis_name
243 procedure :: is_file_subregional
250 character(len=:),
allocatable,
private :: diag_title
251 integer,
private,
dimension (basedate_size) :: diag_basedate
274 logical,
private :: diag_yaml_module_initialized = .false.
293 result(diag_basedate)
295 integer,
dimension (basedate_size) :: diag_basedate
297 diag_basedate = this%diag_basedate
304 if (this%has_diag_files())
then
316 character(len=:),
allocatable :: diag_title
318 diag_title = this%diag_title
328 diag_files = this%diag_files
336 integer,
intent(in) :: yaml_id
340 if (yaml_id .eq. diag_not_registered)
call mpp_error(fatal, &
341 "Diag_manager: The yaml id for this field is not is not set")
343 diag_field => this%diag_fields(variable_list%diag_field_indices(yaml_id))
354 diag_fields = this%diag_fields
360 integer,
intent(in) :: diag_subset_output
365 integer :: diag_yaml_id
367 integer,
allocatable :: diag_file_ids(:)
369 integer :: total_nvars
371 integer :: file_var_count
373 integer,
allocatable :: var_ids(:)
375 logical,
allocatable :: ignore(:)
376 integer :: actual_num_files
377 integer :: file_count
378 logical :: write_file
380 logical :: allow_averages
382 character(len=:),
allocatable :: filename
383 logical :: is_instantaneous
385 if (diag_yaml_module_initialized)
return
394 allocate(diag_file_ids(nfiles))
395 allocate(ignore(nfiles))
397 call get_block_ids(diag_yaml_id,
"diag_files", diag_file_ids)
402 if(diag_subset_output .ne. diag_all)
then
405 call get_value_from_key(diag_yaml_id, diag_file_ids(i),
"is_ocean", is_ocean, is_optional=.true.)
407 if (diag_subset_output .eq. diag_ocean .and. .not. is_ocean) ignore(i) = .true.
410 if(diag_subset_output .eq. diag_other .and. is_ocean) ignore(i) = .true.
418 call get_value_from_key(diag_yaml_id, diag_file_ids(i),
"write_file", write_file, is_optional=.true.)
419 if(.not. write_file) ignore(i) = .true.
422 if (.not. ignore(i))
then
424 total_nvars = total_nvars + nvars
425 if (nvars .ne. 0)
then
426 actual_num_files = actual_num_files + 1
429 call mpp_error(note,
"diag_manager_mod:: the file:"//trim(filename)//
" has no variables defined. Ignoring!")
430 if (
allocated(filename))
deallocate(filename)
436 allocate(diag_yaml%diag_files(actual_num_files))
437 allocate(diag_yaml%diag_fields(total_nvars))
438 allocate(variable_list%var_name(total_nvars))
439 allocate(variable_list%diag_field_indices(total_nvars))
440 allocate(file_list%file_name(actual_num_files))
441 allocate(file_list%diag_file_indices(actual_num_files))
446 nfiles_loop:
do i = 1, nfiles
448 file_count = file_count + 1
450 call fill_in_diag_files(diag_yaml_id, diag_file_ids(i), diag_yaml%diag_files(file_count))
453 file_list%file_name(file_count) = trim(diag_yaml%diag_files(file_count)%file_fname)//c_null_char
454 file_list%diag_file_indices(file_count) = file_count
457 nvars =
get_num_blocks(diag_yaml_id,
"varlist", parent_block_id=diag_file_ids(i))
458 allocate(var_ids(nvars))
459 call get_block_ids(diag_yaml_id,
"varlist", var_ids, parent_block_id=diag_file_ids(i))
461 allocate(diag_yaml%diag_files(file_count)%file_varlist(
get_total_num_vars(diag_yaml_id, diag_file_ids(i))))
462 allocate(diag_yaml%diag_files(file_count)%file_outlist(
get_total_num_vars(diag_yaml_id, diag_file_ids(i))))
463 allow_averages = .not. diag_yaml%diag_files(file_count)%file_freq(1) < 1
464 is_instantaneous = .false.
465 nvars_loop:
do j = 1, nvars
467 call get_value_from_key(diag_yaml_id, var_ids(j),
"write_var", write_var, is_optional=.true.)
468 if (.not. write_var) cycle
470 var_count = var_count + 1
471 file_var_count = file_var_count + 1
474 diag_yaml%diag_fields(var_count)%var_fname = diag_yaml%diag_files(file_count)%file_fname
477 diag_yaml%diag_fields(var_count)%var_axes_names =
""
478 diag_yaml%diag_fields(var_count)%var_file_is_subregional = diag_yaml%diag_files(file_count)%has_file_sub_region()
481 diag_yaml%diag_fields(var_count), allow_averages)
484 diag_yaml%diag_files(file_count)%file_varlist(file_var_count) = diag_yaml%diag_fields(var_count)%var_varname
485 if(diag_yaml%diag_fields(var_count)%has_var_outname())
then
486 diag_yaml%diag_files(file_count)%file_outlist(file_var_count) = diag_yaml%diag_fields(var_count)%var_outname
488 diag_yaml%diag_files(file_count)%file_outlist(file_var_count) =
""
492 variable_list%var_name(var_count) = trim(diag_yaml%diag_fields(var_count)%var_varname)//&
493 ":"//trim(diag_yaml%diag_fields(var_count)%var_module)//c_null_char
495 variable_list%var_name(var_count) = lowercase(variable_list%var_name(var_count))
496 variable_list%diag_field_indices(var_count) = var_count
503 call fms_sort_this(file_list%file_pointer, actual_num_files, file_list%diag_file_indices)
506 call fms_sort_this(variable_list%var_pointer, total_nvars, variable_list%diag_field_indices)
508 deallocate(diag_file_ids)
509 diag_yaml_module_initialized = .true.
516 do i = 1,
size(diag_yaml%diag_files, 1)
517 if(
allocated(diag_yaml%diag_files(i)%file_varlist))
deallocate(diag_yaml%diag_files(i)%file_varlist)
518 if(
allocated(diag_yaml%diag_files(i)%file_outlist))
deallocate(diag_yaml%diag_files(i)%file_outlist)
519 if(
allocated(diag_yaml%diag_files(i)%file_global_meta))
deallocate(diag_yaml%diag_files(i)%file_global_meta)
520 if(
allocated(diag_yaml%diag_files(i)%file_sub_region%corners)) &
521 deallocate(diag_yaml%diag_files(i)%file_sub_region%corners)
523 if(
allocated(diag_yaml%diag_files))
deallocate(diag_yaml%diag_files)
525 do i = 1,
size(diag_yaml%diag_fields, 1)
526 if(
allocated(diag_yaml%diag_fields(i)%var_attributes))
deallocate(diag_yaml%diag_fields(i)%var_attributes)
528 if(
allocated(diag_yaml%diag_fields))
deallocate(diag_yaml%diag_fields)
530 if(
allocated(file_list%file_pointer))
deallocate(file_list%file_pointer)
531 if(
allocated(file_list%file_name))
deallocate(file_list%file_name)
532 if(
allocated(file_list%diag_file_indices))
deallocate(file_list%diag_file_indices)
534 if(
allocated(variable_list%var_pointer))
deallocate(variable_list%var_pointer)
535 if(
allocated(variable_list%var_name))
deallocate(variable_list%var_name)
536 if(
allocated(variable_list%diag_field_indices))
deallocate(variable_list%diag_field_indices)
542 integer,
intent(in) :: diag_yaml_id
543 integer,
intent(in) :: diag_file_id
546 integer :: nsubregion
547 integer :: sub_region_id(1)
549 integer :: global_att_id(1)
553 integer,
allocatable :: key_ids(:)
554 character(len=:),
ALLOCATABLE :: grid_type
555 character(len=:),
ALLOCATABLE :: buffer
557 yaml_fileobj%file_frequnit = 0
561 call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_freq, yaml_fileobj%file_frequnit,
"freq")
570 call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_new_file_freq, &
571 yaml_fileobj%file_new_file_freq_units,
"new_file_freq")
579 yaml_fileobj%file_start_time, is_optional=.true.)
581 call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_duration, yaml_fileobj%file_duration_units, &
585 nsubregion =
get_num_blocks(diag_yaml_id,
"sub_region", parent_block_id=diag_file_id)
586 if (nsubregion .eq. 1)
then
587 max_subaxes = max_subaxes + 1
588 call get_block_ids(diag_yaml_id,
"sub_region", sub_region_id, parent_block_id=diag_file_id)
590 call get_sub_region(diag_yaml_id, sub_region_id(1), yaml_fileobj%file_sub_region, grid_type, &
591 yaml_fileobj%file_fname)
592 elseif (nsubregion .eq. 0)
then
593 yaml_fileobj%file_sub_region%grid_type = null_gridtype
595 call mpp_error(fatal,
"diag_yaml_object_init: file "//trim(yaml_fileobj%file_fname)//
" has multiple region blocks")
599 natt =
get_num_blocks(diag_yaml_id,
"global_meta", parent_block_id=diag_file_id)
600 if (natt .eq. 1)
then
601 call get_block_ids(diag_yaml_id,
"global_meta", global_att_id, parent_block_id=diag_file_id)
602 nkeys =
get_nkeys(diag_yaml_id, global_att_id(1))
603 allocate(key_ids(nkeys))
604 call get_key_ids(diag_yaml_id, global_att_id(1), key_ids)
606 allocate(yaml_fileobj%file_global_meta(nkeys, 2))
608 call get_key_name(diag_yaml_id, key_ids(j), yaml_fileobj%file_global_meta(j, 1))
609 call get_key_value(diag_yaml_id, key_ids(j), yaml_fileobj%file_global_meta(j, 2))
612 elseif (natt .ne. 0)
then
613 call mpp_error(fatal,
"diag_yaml_object_init: file "//trim(yaml_fileobj%file_fname)//&
614 &
" has multiple global_meta blocks")
628 integer,
intent(in) :: diag_file_id
630 integer,
intent(in) :: var_id
632 logical,
intent(in) :: allow_averages
635 integer :: var_att_id(1)
639 integer,
allocatable :: key_ids(:)
640 character(len=:),
ALLOCATABLE :: buffer
644 if (yaml_fileobj%default_var_reduction .eq.
"")
then
650 if (trim(buffer) .eq.
"") buffer = yaml_fileobj%default_var_reduction
655 if (.not. allow_averages)
then
656 if (field%var_reduction .ne.
time_none) &
657 call mpp_error(fatal,
"The file "//field%var_fname//
" can only have variables that have none as "//&
658 "the reduction method because the frequency is either -1 or 0. "//&
659 "Check your diag_table.yaml for the field:"//trim(field%var_varname))
662 if (yaml_fileobj%default_var_module .eq.
"")
then
667 if (trim(buffer) .eq.
"")
then
668 field%var_module = yaml_fileobj%default_var_module
670 field%var_module = trim(buffer)
675 if (yaml_fileobj%default_var_precision .eq.
"")
then
681 if (trim(buffer) .eq.
"") buffer = yaml_fileobj%default_var_precision
690 natt =
get_num_blocks(diag_file_id,
"attributes", parent_block_id=var_id)
691 if (natt .eq. 1)
then
692 call get_block_ids(diag_file_id,
"attributes", var_att_id, parent_block_id=var_id)
693 nkeys =
get_nkeys(diag_file_id, var_att_id(1))
694 allocate(key_ids(nkeys))
695 call get_key_ids(diag_file_id, var_att_id(1), key_ids)
697 allocate(field%var_attributes(nkeys, 2))
699 call get_key_name(diag_file_id, key_ids(j), field%var_attributes(j, 1))
700 call get_key_value(diag_file_id, key_ids(j), field%var_attributes(j, 2))
703 elseif (natt .ne. 0)
then
704 call mpp_error(fatal,
"diag_yaml_object_init: variable "//trim(field%var_varname)//&
705 " has multiple attribute blocks")
709 field%var_zbounds = diag_null
710 call get_value_from_key(diag_file_id, var_id,
"zbounds", field%var_zbounds, is_optional=.true.)
711 if (field%has_var_zbounds()) max_subaxes = max_subaxes + 1
717 integer,
intent(in) :: diag_file_id
718 integer,
intent(in) :: par_id
719 character(len=*),
intent(in) :: key_name
720 character(len=:),
allocatable :: value_name
721 logical,
intent(in),
optional :: is_optional
723 character(len=255) :: buffer
726 call get_value_from_key(diag_file_id, par_id, trim(key_name), buffer, is_optional= is_optional)
727 allocate(
character(len=len_trim(buffer)) :: value_name)
728 value_name = trim(buffer)
733 subroutine get_sub_region(diag_yaml_id, sub_region_id, sub_region, grid_type, fname)
734 integer,
intent(in) :: diag_yaml_id
735 integer,
intent(in) :: sub_region_id
737 character(len=*),
intent(in) :: grid_type
738 character(len=*),
intent(in) :: fname
740 select case (trim(grid_type))
742 sub_region%grid_type = latlon_gridtype
743 allocate(real(kind=r4_kind) :: sub_region%corners(4,2))
745 sub_region%grid_type = index_gridtype
746 allocate(
integer(kind=i4_kind) :: sub_region%corners(4,2))
748 call get_value_from_key(diag_yaml_id, sub_region_id,
"tile", sub_region%tile, is_optional=.true.)
749 if (sub_region%tile .eq. diag_null)
call mpp_error(fatal, &
750 "The tile number is required when defining a "//&
751 "subregion. Check your subregion entry for "//trim(fname))
753 call mpp_error(fatal, trim(grid_type)//
" is not a valid region type. &
754 &The acceptable values are latlon and index. &
755 &Check your entry for file:"//trim(fname))
758 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner1", sub_region%corners(1,:))
759 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner2", sub_region%corners(2,:))
760 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner3", sub_region%corners(3,:))
761 call get_value_from_key(diag_yaml_id, sub_region_id,
"corner4", sub_region%corners(4,:))
770 integer,
intent(in) :: diag_yaml_id
771 integer,
intent(in) :: diag_file_id
772 integer :: total_nvars
776 integer,
allocatable :: var_ids(:)
779 nvars =
get_num_blocks(diag_yaml_id,
"varlist", parent_block_id=diag_file_id)
780 allocate(var_ids(nvars))
781 call get_block_ids(diag_yaml_id,
"varlist", var_ids, parent_block_id=diag_file_id)
787 call get_value_from_key(diag_yaml_id, var_ids(i),
"write_var", var_write, is_optional=.true.)
788 if (var_write) total_nvars = total_nvars + 1
793 subroutine parse_key(filename, buffer, file_freq, file_frequnit, var)
794 character(len=*),
intent(in) :: filename
795 character(len=*),
intent(inout) :: buffer
796 integer,
intent(out) :: file_freq(:)
798 integer,
intent(out) :: file_frequnit(:)
800 character(len=*),
intent(in) :: var
806 character(len=255) :: str
807 character(len=10) :: units
810 if (buffer .eq.
"")
return
815 do while (.not. finished)
817 buffer = buffer(j+1:len_trim(buffer))
818 j = index(buffer,
",")
821 j = len_trim(buffer)+1
825 str = adjustl(buffer(1:j-1))
828 read(str(1:k-1), *, iostat=err_unit) file_freq(count)
829 units = str(k+1:len_trim(str))
831 if (err_unit .ne. 0) &
832 call mpp_error(fatal,
"Error parsing "//trim(var)//
". Check your entry for file"//&
835 if (file_freq(count) .lt. -1) &
836 call mpp_error(fatal, trim(var)//
" is not valid. &
837 &Check your entry for file:"//trim(filename))
839 if (file_freq(count) .eq. -1 .or. file_freq(count) .eq. 0)
then
841 file_frequnit(count) = diag_days
843 if (trim(units) .eq.
"") &
844 call mpp_error(fatal, trim(var)//
" units is required. &
845 &Check your entry for file:"//trim(filename))
848 trim(var)//
" for file:"//trim(filename))
856 character(len=*),
intent(in) :: file_timeunit
858 yaml_fileobj%file_timeunit =
set_valid_time_units(file_timeunit,
"timeunit for file:"//trim(yaml_fileobj%file_fname))
864 character(len=*),
intent(in) :: filename_time
866 select case (trim(filename_time))
874 yaml_fileobj%filename_time =
end_time
876 call mpp_error(fatal, trim(filename_time)//
" is an invalid filename_time &
877 &The acceptable values are begin, middle, and end. &
878 &Check your entry for file "//trim(yaml_fileobj%file_fname))
885 character(len=*),
intent(in) :: skind
887 select case (trim(skind))
897 call mpp_error(fatal, trim(skind)//
" is an invalid kind! &
898 &The acceptable values are r4, r8, i4, i8. &
899 &Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
908 character(len=*) ,
intent(in) :: reduction_method
917 if (index(reduction_method,
"diurnal") .ne. 0)
then
918 READ (reduction_method(8:len_trim(reduction_method)), fmt=*, iostat=ioerror) n_diurnal
919 if (ioerror .ne. 0) &
920 call mpp_error(fatal,
"Error getting the number of diurnal samples from "//trim(reduction_method))
921 if (n_diurnal .le. 0) &
922 call mpp_error(fatal,
"Diurnal samples should be greater than 0. &
923 & Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
925 elseif (index(reduction_method,
"pow") .ne. 0)
then
926 READ (reduction_method(4:len_trim(reduction_method)), fmt=*, iostat=ioerror) pow_value
927 if (ioerror .ne. 0) &
928 call mpp_error(fatal,
"Error getting the power value from "//trim(reduction_method))
929 if (pow_value .le. 0) &
930 call mpp_error(fatal,
"The power value should be greater than 0. &
931 & Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
934 select case (reduction_method)
948 call mpp_error(fatal, trim(reduction_method)//
" is an invalid reduction method! &
949 &The acceptable values are none, average, pow##, diurnal##, min, max, and rms. &
950 &Check your entry for file:"//trim(field%var_varname)//
" in file "//trim(field%var_fname))
954 field%n_diurnal = n_diurnal
955 field%pow_value = pow_value
961 result(time_units_int)
963 character(len=*),
intent(in) :: time_units
964 character(len=*),
intent(in) :: error_msg
966 integer :: time_units_int
968 select case (trim(time_units))
970 time_units_int = diag_seconds
972 time_units_int = diag_minutes
974 time_units_int = diag_hours
976 time_units_int = diag_days
978 time_units_int = diag_months
980 time_units_int = diag_years
982 time_units_int =diag_null
983 call mpp_error(fatal, trim(error_msg)//
" is not valid. Acceptable values are &
984 &seconds, minutes, hours, days, months, years")
1001 character (len=:),
allocatable :: res
1002 res = this%file_fname
1010 res = this%file_frequnit(this%current_new_file_freq_index)
1018 res = this%file_freq(this%current_new_file_freq_index)
1026 res = this%file_timeunit
1033 character (len=:),
allocatable :: res
1034 res = this%file_unlimdim
1042 res => this%file_sub_region
1050 res = this%file_new_file_freq(this%current_new_file_freq_index)
1058 res = this%file_new_file_freq_units(this%current_new_file_freq_index)
1065 character (len=:),
allocatable :: res
1066 res = this%file_start_time
1074 res = this%file_duration(this%current_new_file_freq_index)
1082 res = this%file_duration_units(this%current_new_file_freq_index)
1089 character (:),
allocatable :: res(:)
1090 res = this%file_varlist
1097 character (len=MAX_STR_LEN),
allocatable :: res(:,:)
1098 res = this%file_global_meta
1107 res = this%filename_time
1116 if (
allocated(this%file_global_meta)) &
1123 this%current_new_file_freq_index = this%current_new_file_freq_index + 1
1137 character (len=:),
allocatable :: res
1138 res = this%var_fname
1145 character (len=:),
allocatable :: res
1146 res = this%var_varname
1153 integer,
allocatable :: res
1154 res = this%var_reduction
1161 character (len=:),
allocatable :: res
1162 res = this%var_module
1169 integer,
allocatable :: res
1177 character (len=:),
allocatable :: res
1179 if (this%has_var_outname())
then
1180 res = this%var_outname
1182 res = this%var_varname
1190 character (len=:),
allocatable :: res
1191 res = this%var_longname
1198 character (len=:),
allocatable :: res
1199 res = this%var_units
1206 real(kind=r4_kind) :: res(2)
1207 res = this%var_zbounds
1214 character (len=MAX_STR_LEN),
allocatable :: res (:,:)
1215 res = this%var_attributes
1223 res = this%n_diurnal
1231 res = this%pow_value
1240 if (
allocated(this%var_attributes)) &
1249 obj%file_freq = diag_null
1250 obj%file_sub_region%tile = diag_null
1251 obj%file_new_file_freq = diag_null
1252 obj%file_duration = diag_null
1253 obj%file_new_file_freq_units = diag_null
1254 obj%file_duration_units = diag_null
1255 obj%current_new_file_freq_index = 1
1268 has_file_frequnit = this%file_frequnit(this%current_new_file_freq_index) .NE. diag_null
1298 if ( this%file_sub_region%grid_type .eq. latlon_gridtype .or. this%file_sub_region%grid_type .eq. index_gridtype)
then
1326 has_file_duration = this%file_duration(this%current_new_file_freq_index) .ne. diag_null
1387 if (
allocated(this%var_outname))
then
1388 if (trim(this%var_outname) .ne.
"")
then
1464 nfields = fms_find_unique(variable_list%var_pointer,
size(variable_list%var_pointer))
1473 character(len=*),
intent(in) :: diag_field_name
1474 character(len=*),
intent(in) :: module_name
1476 integer,
allocatable :: indices(:)
1478 indices = fms_find_my_string(variable_list%var_pointer,
size(variable_list%var_pointer), &
1479 & lowercase(trim(diag_field_name))//
":"//lowercase(trim(module_name)//c_null_char))
1487 integer,
intent(in) :: indices(:)
1493 allocate(diag_field(
size(indices)))
1495 do i = 1,
size(indices)
1496 field_id = variable_list%diag_field_indices(indices(i))
1497 diag_field(i) = diag_yaml%diag_fields(field_id)
1506 integer,
intent(in) :: indices(:)
1507 integer,
allocatable :: field_ids(:)
1510 allocate(field_ids(
size(indices)))
1512 do i = 1,
size(indices)
1513 field_ids(i) = variable_list%diag_field_indices(indices(i))
1523 integer,
intent(in) :: indices(:)
1524 integer,
allocatable :: file_id(:)
1528 character(len=FMS_FILE_LEN) :: filename
1529 integer,
allocatable :: file_indices(:)
1531 allocate(file_id(
size(indices)))
1533 do i = 1,
size(indices)
1534 field_id = variable_list%diag_field_indices(indices(i))
1536 filename = diag_yaml%diag_fields(field_id)%var_fname
1539 file_indices = fms_find_my_string(file_list%file_pointer,
size(file_list%file_pointer), &
1540 & trim(filename)//c_null_char)
1542 if (
size(file_indices) .ne. 1) &
1543 &
call mpp_error(fatal,
"get_diag_files_id: Error getting the correct number of file indices!"//&
1544 " The diag file "//trim(filename)//
" was defined "//string(
size(file_indices))&
1547 if (file_indices(1) .eq. diag_null) &
1548 &
call mpp_error(fatal,
"get_diag_files_id: Error finding the file "//trim(filename)//
" in the diag_files yaml")
1551 file_id(i) = file_list%diag_file_indices(file_indices(1))
1559 character(len=*),
optional,
intent(in) :: filename
1563 integer :: i, unit_num
1564 if(
present(filename))
then
1565 open(newunit=unit_num, file=trim(filename), action=
'WRITE')
1570 if(
mpp_pe() .eq. mpp_root_pe())
then
1571 write(unit_num, *)
'**********Dumping diag_yaml object**********'
1572 if( diag_yaml%has_diag_title())
write(unit_num, *)
'Title:', diag_yaml%diag_title
1573 if( diag_yaml%has_diag_basedate())
write(unit_num, *)
'basedate array:', diag_yaml%diag_basedate
1574 write(unit_num, *)
'FILES'
1575 allocate(fields(
SIZE(diag_yaml%get_diag_fields())))
1576 files => diag_yaml%diag_files
1577 fields = diag_yaml%get_diag_fields()
1579 write(unit_num, *)
'File: ', files(i)%get_file_fname()
1580 if(files(i)%has_file_frequnit())
write(unit_num, *)
'file_frequnit:', files(i)%get_file_frequnit()
1581 if(files(i)%has_file_freq())
write(unit_num, *)
'freq:', files(i)%get_file_freq()
1582 if(files(i)%has_file_timeunit())
write(unit_num, *)
'timeunit:', files(i)%get_file_timeunit()
1583 if(files(i)%has_file_unlimdim())
write(unit_num, *)
'unlimdim:', files(i)%get_file_unlimdim()
1585 if(files(i)%has_file_new_file_freq())
write(unit_num, *)
'new_file_freq:', files(i)%get_file_new_file_freq()
1586 if(files(i)%has_file_new_file_freq_units())
write(unit_num, *)
'new_file_freq_units:', &
1587 & files(i)%get_file_new_file_freq_units()
1588 if(files(i)%has_file_start_time())
write(unit_num, *)
'start_time:', files(i)%get_file_start_time()
1589 if(files(i)%has_file_duration())
write(unit_num, *)
'duration:', files(i)%get_file_duration()
1590 if(files(i)%has_file_duration_units())
write(unit_num, *)
'duration_units:', files(i)%get_file_duration_units()
1591 if(files(i)%has_file_varlist())
write(unit_num, *)
'varlist:', files(i)%get_file_varlist()
1592 if(files(i)%has_file_global_meta())
write(unit_num, *)
'global_meta:', files(i)%get_file_global_meta()
1593 if(files(i)%is_global_meta())
write(unit_num, *)
'global_meta:', files(i)%is_global_meta()
1594 write(unit_num, *)
''
1596 write(unit_num, *)
'FIELDS'
1597 do i=1,
SIZE(fields)
1598 write(unit_num, *)
'Field: ', fields(i)%get_var_fname()
1599 if(fields(i)%has_var_fname())
write(unit_num, *)
'fname:', fields(i)%get_var_fname()
1600 if(fields(i)%has_var_varname())
write(unit_num, *)
'varname:', fields(i)%get_var_varname()
1601 if(fields(i)%has_var_reduction())
write(unit_num, *)
'reduction:', fields(i)%get_var_reduction()
1602 if(fields(i)%has_var_module())
write(unit_num, *)
'module:', fields(i)%get_var_module()
1603 if(fields(i)%has_var_kind())
write(unit_num, *)
'kind:', fields(i)%get_var_kind()
1604 if(fields(i)%has_var_outname())
write(unit_num, *)
'outname:', fields(i)%get_var_outname()
1605 if(fields(i)%has_var_longname())
write(unit_num, *)
'longname:', fields(i)%get_var_longname()
1606 if(fields(i)%has_var_units())
write(unit_num, *)
'units:', fields(i)%get_var_units()
1607 if(fields(i)%has_var_zbounds())
write(unit_num, *)
'zbounds:', fields(i)%get_var_zbounds()
1608 if(fields(i)%has_var_attributes())
write(unit_num, *)
'attributes:', fields(i)%get_var_attributes()
1609 if(fields(i)%has_n_diurnal())
write(unit_num, *)
'n_diurnal:', fields(i)%get_n_diurnal()
1610 if(fields(i)%has_pow_value())
write(unit_num, *)
'pow_value:', fields(i)%get_pow_value()
1611 if(fields(i)%has_var_attributes())
write(unit_num, *)
'is_var_attributes:', fields(i)%is_var_attributes()
1615 if(
present(filename))
then
1627 type (fmsyamloutkeys_type),
allocatable :: keys(:), keys2(:), keys3(:)
1628 type (fmsyamloutvalues_type),
allocatable :: vals(:), vals2(:), vals3(:)
1630 character(len=128) :: tmpstr1, tmpstr2
1631 integer,
parameter :: tier1size = 3
1632 integer :: tier2size, tier3size
1633 integer,
allocatable :: tier3each(:)
1634 integer,
dimension(basedate_size) :: basedate_loc
1635 integer :: varnum_i, key3_i, gm
1636 character(len=32),
allocatable :: st_vals(:)
1638 if(
mpp_pe() .ne. mpp_root_pe())
return
1640 allocate(tier3each(
SIZE(diag_yaml%diag_files) * 3))
1641 tier3size = 0; tier3each = 0
1646 allocate(keys2(
SIZE(diag_yaml%diag_files)))
1647 allocate(vals2(
SIZE(diag_yaml%diag_files)))
1648 allocate(st_vals(
SIZE(diag_yaml%diag_files)))
1649 do i=1,
SIZE(diag_yaml%diag_files)
1650 call initialize_key_struct(keys2(i))
1651 call initialize_val_struct(vals2(i))
1652 if (
allocated(diag_yaml%diag_files(i)%file_varlist) )
then
1653 do j=1,
SIZE(diag_yaml%diag_files(i)%file_varlist)
1654 tier3size = tier3size + 1
1657 tier3size = tier3size + 2
1659 allocate(keys3(tier3size))
1660 allocate(vals3(tier3size))
1663 call initialize_key_struct(keys(1))
1664 call initialize_val_struct(vals(1))
1665 call fms_f2c_string( keys(1)%key1,
'title')
1666 call fms_f2c_string( vals(1)%val1, diag_yaml%diag_title)
1667 call fms_f2c_string( keys(1)%key2,
'base_date')
1668 basedate_loc = diag_yaml%get_basedate()
1669 tmpstr1 =
''; tmpstr2 =
''
1670 tmpstr1 = string(basedate_loc(1))
1671 tmpstr2 = trim(tmpstr1)
1672 do i=2, basedate_size
1673 tmpstr1 = string(basedate_loc(i))
1674 tmpstr2 = trim(tmpstr2) //
' ' // trim(tmpstr1)
1676 call fms_f2c_string(vals(1)%val2, trim(tmpstr2))
1677 call yaml_out_add_level2key(
'diag_files', keys(1))
1680 do i=1,
SIZE(diag_yaml%diag_files)
1681 fileptr => diag_yaml%diag_files(i)
1683 call fms_f2c_string(keys2(i)%key1,
'file_name')
1684 call fms_f2c_string(keys2(i)%key2,
'freq')
1685 call fms_f2c_string(keys2(i)%key3,
'freq_units')
1686 call fms_f2c_string(keys2(i)%key4,
'time_units')
1687 call fms_f2c_string(keys2(i)%key5,
'unlimdim')
1688 call fms_f2c_string(keys2(i)%key6,
'new_file_freq')
1689 call fms_f2c_string(keys2(i)%key7,
'new_file_freq_units')
1690 call fms_f2c_string(keys2(i)%key8,
'start_time')
1691 call fms_f2c_string(keys2(i)%key9,
'file_duration')
1692 call fms_f2c_string(keys2(i)%key10,
'file_duration_units')
1694 call fms_f2c_string(vals2(i)%val1, fileptr%file_fname)
1695 call fms_f2c_string(vals2(i)%val5, fileptr%file_unlimdim)
1698 do k=1,
SIZE(fileptr%file_freq)
1699 if(fileptr%file_freq(k) .eq. diag_null)
exit
1701 tmpstr2 = string(fileptr%file_freq(k))
1702 tmpstr1 = trim(tmpstr1)//
" "//trim(tmpstr2)
1704 call fms_f2c_string(vals2(i)%val2, adjustl(tmpstr1))
1707 do k=1,
SIZE(fileptr%file_new_file_freq)
1708 if(fileptr%file_new_file_freq(k) .eq. diag_null)
exit
1710 tmpstr2 = string(fileptr%file_new_file_freq(k))
1711 tmpstr1 = trim(tmpstr1)//
" "//trim(tmpstr2)
1713 call fms_f2c_string(vals2(i)%val6, adjustl(tmpstr1))
1715 call fms_f2c_string(vals2(i)%val8, trim(fileptr%get_file_start_time()))
1716 st_vals(i) = fileptr%get_file_start_time()
1718 do k=1,
SIZE(fileptr%file_duration)
1719 if(fileptr%file_duration(k) .eq. diag_null)
exit
1721 tmpstr2 = string(fileptr%file_duration(k))
1722 tmpstr1 = trim(tmpstr1)//
" "//trim(tmpstr2)
1724 call fms_f2c_string(vals2(i)%val9, adjustl(tmpstr1))
1728 call yaml_out_add_level2key(
'varlist', keys2(i))
1730 if(
SIZE(fileptr%file_varlist) .gt. 0)
then
1731 do j=1,
SIZE(fileptr%file_varlist)
1733 call initialize_key_struct(keys3(key3_i))
1734 call initialize_val_struct(vals3(key3_i))
1737 do varnum_i=1,
SIZE(diag_yaml%diag_fields)
1738 if( trim(diag_yaml%diag_fields(varnum_i)%var_varname ) .eq. trim(fileptr%file_varlist(j)) .and. &
1739 trim(diag_yaml%diag_fields(varnum_i)%var_fname) .eq. trim(fileptr%file_fname))
then
1741 if(diag_yaml%diag_fields(varnum_i)%has_var_outname())
then
1742 if(trim(diag_yaml%diag_fields(varnum_i)%var_outname) .eq. trim(fileptr%file_outlist(j)))
then
1743 varptr => diag_yaml%diag_fields(varnum_i)
1747 varptr => diag_yaml%diag_fields(varnum_i)
1752 if( .not.
associated(varptr))
call mpp_error(fatal,
"diag_yaml_output: could not find variable in list."//&
1753 " var: "// trim(fileptr%file_varlist(j)))
1754 call fms_f2c_string(keys3(key3_i)%key1,
'module')
1755 call fms_f2c_string(keys3(key3_i)%key2,
'var_name')
1756 call fms_f2c_string(keys3(key3_i)%key3,
'reduction')
1757 call fms_f2c_string(keys3(key3_i)%key4,
'kind')
1758 call fms_f2c_string(keys3(key3_i)%key5,
'output_name')
1759 call fms_f2c_string(keys3(key3_i)%key6,
'long_name')
1760 call fms_f2c_string(keys3(key3_i)%key7,
'units')
1761 call fms_f2c_string(keys3(key3_i)%key8,
'zbounds')
1762 call fms_f2c_string(keys3(key3_i)%key9,
'n_diurnal')
1763 call fms_f2c_string(keys3(key3_i)%key10,
'pow_value')
1764 call fms_f2c_string(keys3(key3_i)%key11,
'dimensions')
1765 if (varptr%has_var_module())
call fms_f2c_string(vals3(key3_i)%val1, varptr%var_module)
1766 if (varptr%has_var_varname())
call fms_f2c_string(vals3(key3_i)%val2, varptr%var_varname)
1767 if (varptr%has_var_reduction())
then
1768 call fms_f2c_string(vals3(key3_i)%val3, &
1771 if (varptr%has_var_outname())
call fms_f2c_string(vals3(key3_i)%val5, varptr%var_outname)
1772 if (varptr%has_var_longname())
call fms_f2c_string(vals3(key3_i)%val6, varptr%var_longname)
1773 if (varptr%has_var_units())
call fms_f2c_string(vals3(key3_i)%val7, varptr%var_units)
1774 if (varptr%has_var_kind())
then
1775 select case(varptr%var_kind)
1777 call fms_f2c_string(vals3(key3_i)%val4,
'i4')
1779 call fms_f2c_string(vals3(key3_i)%val4,
'i8')
1781 call fms_f2c_string(vals3(key3_i)%val4,
'r4')
1783 call fms_f2c_string(vals3(key3_i)%val4,
'r8')
1787 if( abs(varptr%var_zbounds(1) - real(diag_null, r4_kind)) .gt. 1.0e-5 )
then
1788 tmpstr2 = string(varptr%var_zbounds(1),
"F8.2") //
' ' // string(varptr%var_zbounds(2),
"F8.2")
1789 call fms_f2c_string(vals3(key3_i)%val8, trim(tmpstr2))
1792 if( varptr%n_diurnal .gt. 0)
then
1793 tmpstr1 =
''; tmpstr1 = string(varptr%n_diurnal)
1794 call fms_f2c_string(vals3(key3_i)%val9, tmpstr1)
1797 if( varptr%pow_value .gt. 0)
then
1798 tmpstr1 =
''; tmpstr1 = string(varptr%pow_value)
1799 call fms_f2c_string(vals3(key3_i)%val10, tmpstr1)
1802 tmpstr1 =
''; tmpstr1 = varptr%var_axes_names
1803 call fms_f2c_string(vals3(key3_i)%val11, trim(adjustl(tmpstr1)))
1808 tier3each(i*3-2) = j-1
1809 tier3each(i*3-1) = 1
1811 call initialize_key_struct(keys3(key3_i))
1812 call initialize_val_struct(vals3(key3_i))
1814 call yaml_out_add_level2key(
'sub_region', keys2(i))
1815 call fms_f2c_string(keys3(key3_i)%key1,
'grid_type')
1816 call fms_f2c_string(keys3(key3_i)%key2,
'tile')
1817 call fms_f2c_string(keys3(key3_i)%key3,
'corner1')
1818 call fms_f2c_string(keys3(key3_i)%key4,
'corner2')
1819 call fms_f2c_string(keys3(key3_i)%key5,
'corner3')
1820 call fms_f2c_string(keys3(key3_i)%key6,
'corner4')
1822 select case (fileptr%file_sub_region%grid_type)
1823 case(latlon_gridtype)
1824 call fms_f2c_string(vals3(key3_i)%val1,
'latlon')
1825 case(index_gridtype)
1826 call fms_f2c_string(vals3(key3_i)%val1,
'index')
1828 if(fileptr%file_sub_region%tile .ne. diag_null)
then
1829 tmpstr1 =
''; tmpstr1 = string(fileptr%file_sub_region%tile)
1830 call fms_f2c_string(vals3(key3_i)%val2, tmpstr1)
1832 if(fileptr%has_file_sub_region())
then
1833 if(
allocated(fileptr%file_sub_region%corners))
then
1834 select type (corners => fileptr%file_sub_region%corners)
1835 type is (real(r8_kind))
1836 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1837 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1838 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1839 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1840 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1841 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1842 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1843 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1844 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1845 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1846 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1847 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1848 type is (real(r4_kind))
1849 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1850 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1851 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1852 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1853 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1854 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1855 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1856 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1857 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1858 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1859 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1860 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1861 type is (
integer(i4_kind))
1862 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1863 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1864 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1865 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1866 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1867 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1868 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1869 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1870 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1871 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1872 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1873 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1874 type is (
integer(i8_kind))
1875 tmpstr1 =
''; tmpstr1 = string(corners(1,1))
1876 tmpstr2 =
''; tmpstr2 = string(corners(1,2))
1877 call fms_f2c_string(vals3(key3_i)%val3, trim(tmpstr1)//
' '//trim(tmpstr2))
1878 tmpstr1 =
''; tmpstr1 = string(corners(2,1))
1879 tmpstr2 =
''; tmpstr2 = string(corners(2,2))
1880 call fms_f2c_string(vals3(key3_i)%val4, trim(tmpstr1)//
' '//trim(tmpstr2))
1881 tmpstr1 =
''; tmpstr1 = string(corners(3,1))
1882 tmpstr2 =
''; tmpstr2 = string(corners(3,2))
1883 call fms_f2c_string(vals3(key3_i)%val5, trim(tmpstr1)//
' '//trim(tmpstr2))
1884 tmpstr1 =
''; tmpstr1 = string(corners(4,1))
1885 tmpstr2 =
''; tmpstr2 = string(corners(4,2))
1886 call fms_f2c_string(vals3(key3_i)%val6, trim(tmpstr1)//
' '//trim(tmpstr2))
1892 call initialize_key_struct(keys3(key3_i))
1893 call initialize_val_struct(vals3(key3_i))
1894 call yaml_out_add_level2key(
'global_meta', keys2(i))
1895 if ( fileptr%has_file_global_meta())
then
1896 do gm=1,
SIZE(fileptr%file_global_meta, 1)
1899 call fms_f2c_string(keys3(key3_i)%key1, fileptr%file_global_meta(1,1))
1900 call fms_f2c_string(vals3(key3_i)%val1, fileptr%file_global_meta(1,2))
1902 call fms_f2c_string(keys3(key3_i)%key2, fileptr%file_global_meta(2,1))
1903 call fms_f2c_string(vals3(key3_i)%val2, fileptr%file_global_meta(2,2))
1905 call fms_f2c_string(keys3(key3_i)%key3, fileptr%file_global_meta(3,1))
1906 call fms_f2c_string(vals3(key3_i)%val3, fileptr%file_global_meta(3,2))
1908 call fms_f2c_string(keys3(key3_i)%key4, fileptr%file_global_meta(4,1))
1909 call fms_f2c_string(vals3(key3_i)%val4, fileptr%file_global_meta(4,2))
1911 call fms_f2c_string(keys3(key3_i)%key5, fileptr%file_global_meta(5,1))
1912 call fms_f2c_string(vals3(key3_i)%val5, fileptr%file_global_meta(5,2))
1914 call fms_f2c_string(keys3(key3_i)%key6, fileptr%file_global_meta(6,1))
1915 call fms_f2c_string(vals3(key3_i)%val6, fileptr%file_global_meta(6,2))
1917 call fms_f2c_string(keys3(key3_i)%key7, fileptr%file_global_meta(7,1))
1918 call fms_f2c_string(vals3(key3_i)%val7, fileptr%file_global_meta(7,2))
1920 call fms_f2c_string(keys3(key3_i)%key8, fileptr%file_global_meta(8,1))
1921 call fms_f2c_string(vals3(key3_i)%val8, fileptr%file_global_meta(8,2))
1923 call fms_f2c_string(keys3(key3_i)%key9, fileptr%file_global_meta(9,1))
1924 call fms_f2c_string(vals3(key3_i)%val9, fileptr%file_global_meta(9,2))
1926 call fms_f2c_string(keys3(key3_i)%key10, fileptr%file_global_meta(10,1))
1927 call fms_f2c_string(vals3(key3_i)%val10, fileptr%file_global_meta(10,2))
1929 call fms_f2c_string(keys3(key3_i)%key11, fileptr%file_global_meta(11,1))
1930 call fms_f2c_string(vals3(key3_i)%val11, fileptr%file_global_meta(11,2))
1932 call fms_f2c_string(keys3(key3_i)%key12, fileptr%file_global_meta(12,1))
1933 call fms_f2c_string(vals3(key3_i)%val12, fileptr%file_global_meta(12,2))
1935 call fms_f2c_string(keys3(key3_i)%key13, fileptr%file_global_meta(13,1))
1936 call fms_f2c_string(vals3(key3_i)%val13, fileptr%file_global_meta(13,2))
1938 call fms_f2c_string(keys3(key3_i)%key14, fileptr%file_global_meta(14,1))
1939 call fms_f2c_string(vals3(key3_i)%val14, fileptr%file_global_meta(14,2))
1941 call fms_f2c_string(keys3(key3_i)%key15, fileptr%file_global_meta(15,1))
1942 call fms_f2c_string(vals3(key3_i)%val15, fileptr%file_global_meta(15,2))
1944 call fms_f2c_string(keys3(key3_i)%key16, fileptr%file_global_meta(16,1))
1945 call fms_f2c_string(vals3(key3_i)%val16, fileptr%file_global_meta(16,2))
1952 call write_yaml_from_struct_3(
'diag_out.yaml'//c_null_char, 1, keys, vals, &
1953 SIZE(diag_yaml%diag_files), keys2, vals2, &
1954 tier3size, tier3each, keys3, vals3, &
1955 (/
size(diag_yaml%diag_files), 0, 0, 0, 0, 0, 0, 0/))
1956 deallocate( keys, keys2, keys3, vals, vals2, vals3)
1962 integer,
intent(in) :: unit_param(:)
1965 character(len=7) :: tmp
1968 do i=1,
SIZE(unit_param)
1969 select case(unit_param(i))
1992 integer,
intent(in) :: reduction_val(:)
1995 character(len=7) :: tmp
1997 do i=1,
SIZE(reduction_val)
1998 select case (reduction_val(i))
2021 subroutine add_axis_name( this, axis_name )
2023 character(len=:),
allocatable,
intent(in) :: axis_name
2024 character(len=:),
allocatable :: tmp_str
2026 this%var_axes_names = trim(axis_name)//
" "//trim(this%var_axes_names)
2028 end subroutine add_axis_name
2030 pure function is_file_subregional( this ) &
2035 res = this%var_file_is_subregional
2036 end function is_file_subregional
2039 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.
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.
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
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 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_file_start_time(this)
Inquiry for diag_files_objfile_start_time.
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 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.
subroutine, public fms_diag_yaml_out()
Writes an output yaml with all available information on the written files. Will only write with root ...
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.
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