18 module fms_diag_field_object_mod
31 use diag_data_mod,
only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, &
34 use fms_string_utils_mod,
only: int2str=>
string
41 use fms2_io_mod,
only: fmsnetcdffile_t, fmsnetcdfdomainfile_t, fmsnetcdfunstructureddomainfile_t,
register_field, &
42 register_variable_attribute
58 integer,
allocatable,
dimension(:) :: file_ids
60 integer,
allocatable,
private :: diag_id
61 integer,
allocatable,
dimension(:) :: buffer_ids
63 integer,
private :: num_attributes
64 logical,
allocatable,
private :: static
65 logical,
allocatable,
private :: scalar
66 logical,
allocatable,
private :: registered
67 logical,
allocatable,
private :: mask_variant
68 logical,
allocatable,
private :: var_is_masked
69 logical,
allocatable,
private :: do_not_log
70 logical,
allocatable,
private :: local
71 integer,
allocatable,
private :: vartype
72 character(len=:),
allocatable,
private :: varname
73 character(len=:),
allocatable,
private :: longname
74 character(len=:),
allocatable,
private :: standname
75 character(len=:),
allocatable,
private :: units
76 character(len=:),
allocatable,
private :: modname
77 character(len=:),
allocatable,
private :: realm
79 character(len=:),
allocatable,
private :: interp_method
83 integer,
allocatable,
dimension(:),
private :: frequency
84 integer,
allocatable,
private :: tile_count
85 integer,
allocatable,
dimension(:),
private :: axis_ids
87 INTEGER ,
private :: type_of_domain
89 integer,
allocatable,
private :: area, volume
90 class(*),
allocatable,
private :: missing_value
91 class(*),
allocatable,
private :: data_range(:)
94 logical,
allocatable,
private :: multiple_send_data
96 logical,
allocatable,
private :: data_buffer_is_allocated
98 logical,
allocatable,
private :: math_needs_to_be_done
100 logical,
allocatable :: buffer_allocated
103 logical,
allocatable :: mask(:,:,:,:)
104 logical :: halo_present = .false.
108 procedure :: get_id => fms_diag_get_id
109 procedure :: id_from_name => diag_field_id_from_name
110 procedure :: copy => copy_diag_obj
111 procedure :: register => fms_register_diag_field_obj
112 procedure :: setid => set_diag_id
113 procedure :: set_type => set_vartype
114 procedure :: set_data_buffer => set_data_buffer
115 procedure :: prepare_data_buffer
116 procedure :: init_data_buffer
117 procedure :: set_data_buffer_is_allocated
118 procedure :: set_send_data_time
119 procedure :: get_send_data_time
120 procedure :: is_data_buffer_allocated
121 procedure :: allocate_data_buffer
122 procedure :: set_math_needs_to_be_done => set_math_needs_to_be_done
123 procedure :: add_attribute => diag_field_add_attribute
124 procedure :: vartype_inq => what_is_vartype
125 procedure :: set_var_is_masked
126 procedure :: get_var_is_masked
128 procedure :: is_static => diag_obj_is_static
129 procedure :: is_scalar
130 procedure :: is_registered => get_registered
131 procedure :: is_registeredb => diag_obj_is_registered
132 procedure :: is_mask_variant => get_mask_variant
133 procedure :: is_local => get_local
136 procedure :: has_diag_id
137 procedure :: has_attributes
138 procedure :: has_static
139 procedure :: has_registered
140 procedure :: has_mask_variant
141 procedure :: has_local
142 procedure :: has_vartype
143 procedure :: has_varname
144 procedure :: has_longname
145 procedure :: has_standname
146 procedure :: has_units
147 procedure :: has_modname
148 procedure :: has_realm
149 procedure :: has_interp_method
150 procedure :: has_frequency
151 procedure :: has_tile_count
152 procedure :: has_axis_ids
153 procedure :: has_area
154 procedure :: has_volume
155 procedure :: has_missing_value
156 procedure :: has_data_range
157 procedure :: has_input_data_buffer
159 procedure :: get_attributes
160 procedure :: get_static
161 procedure :: get_registered
162 procedure :: get_mask_variant
163 procedure :: get_local
164 procedure :: get_vartype
165 procedure :: get_varname
166 procedure :: get_longname
167 procedure :: get_standname
168 procedure :: get_units
169 procedure :: get_modname
170 procedure :: get_realm
171 procedure :: get_interp_method
172 procedure :: get_frequency
173 procedure :: get_tile_count
174 procedure :: get_area
175 procedure :: get_volume
176 procedure :: get_missing_value
177 procedure :: get_data_range
178 procedure :: get_axis_id
179 procedure :: get_data_buffer
180 procedure :: get_mask
181 procedure :: get_weight
182 procedure :: dump_field_obj
183 procedure :: get_domain
184 procedure :: get_type_of_domain
185 procedure :: set_file_ids
186 procedure :: get_dimnames
187 procedure :: get_var_skind
188 procedure :: get_longname_to_write
189 procedure :: get_multiple_send_data
190 procedure :: write_field_metadata
191 procedure :: get_chunksizes
192 procedure :: write_coordinate_attribute
193 procedure :: get_math_needs_to_be_done
194 procedure :: add_area_volume
195 procedure :: append_time_cell_methods
196 procedure :: get_file_ids
197 procedure :: set_mask
198 procedure :: allocate_mask
199 procedure :: set_halo_present
200 procedure :: is_halo_present
201 procedure :: find_missing_value
202 procedure :: has_mask_allocated
203 procedure :: is_variable_in_file
204 procedure :: get_field_file_name
205 procedure :: generate_associated_files_att
210 logical,
private :: module_is_initialized = .false.
215 public :: fms_diag_fields_object_init
217 public :: fms_diag_field_object_end
218 public :: get_default_missing_value
219 public :: check_for_slices
227 subroutine fms_diag_field_object_end (ob)
229 if (
allocated(ob))
deallocate(ob)
230 module_is_initialized = .false.
231 end subroutine fms_diag_field_object_end
236 logical function fms_diag_fields_object_init(ob)
241 ob(i)%diag_id = diag_not_registered
242 ob(i)%registered = .false.
244 module_is_initialized = .true.
245 fms_diag_fields_object_init = .true.
246 end function fms_diag_fields_object_init
249 subroutine fms_register_diag_field_obj &
250 (this, modname, varname, diag_field_indices, diag_axis, axes, &
251 longname, units, missing_value, varrange, mask_variant, standname, &
252 do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static, &
256 CHARACTER(len=*),
INTENT(in) :: modname
257 CHARACTER(len=*),
INTENT(in) :: varname
258 integer,
INTENT(in) :: diag_field_indices(:)
261 INTEGER,
TARGET,
OPTIONAL,
INTENT(in) :: axes(:)
262 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: longname
263 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
264 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standname
265 class(*),
OPTIONAL,
INTENT(in) :: missing_value
266 class(*),
OPTIONAL,
INTENT(in) :: varrange(:)
267 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
268 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
269 CHARACTER(len=*),
OPTIONAL,
INTENT(out) :: err_msg
270 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
274 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
275 INTEGER,
OPTIONAL,
INTENT(in) :: area
276 INTEGER,
OPTIONAL,
INTENT(in) :: volume
277 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
279 LOGICAL,
OPTIONAL,
INTENT(in) :: static
280 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
283 character(len=:),
allocatable,
target :: a_name_tmp
287 this%varname = trim(varname)
288 this%modname = trim(modname)
293 if (
present(static))
then
296 this%static = .false.
300 if (
present(axes))
then
302 this%scalar = .false.
308 do i=1,
SIZE(diag_field_indices)
309 yaml_var_ptr => diag_yaml%get_diag_field_from_id(diag_field_indices(i))
312 a_name_tmp = diag_axis(axes(j))%axis%get_axis_name( yaml_var_ptr%is_file_subregional())
313 if(yaml_var_ptr%has_var_zbounds() .and. a_name_tmp .eq.
'z') &
314 a_name_tmp = trim(a_name_tmp)//
"_sub01"
315 call yaml_var_ptr%add_axis_name(a_name_tmp)
318 if(yaml_var_ptr%has_n_diurnal())
then
319 a_name_tmp =
"time_of_day_"// int2str(yaml_var_ptr%get_n_diurnal())
320 call yaml_var_ptr%add_axis_name(a_name_tmp)
323 if(.not. this%static)
then
325 call yaml_var_ptr%add_axis_name(a_name_tmp)
331 this%type_of_domain = no_domain
332 this%domain => null()
334 if(.not. this%static)
then
335 do i=1,
SIZE(diag_field_indices)
337 yaml_var_ptr => diag_yaml%get_diag_field_from_id(diag_field_indices(i))
338 call yaml_var_ptr%add_axis_name(a_name_tmp)
342 nullify(yaml_var_ptr)
345 if (
present(longname)) this%longname = trim(longname)
346 if (
present(standname)) this%standname = trim(standname)
347 do i=1,
SIZE(diag_field_indices)
348 yaml_var_ptr => diag_yaml%get_diag_field_from_id(diag_field_indices(i))
351 call yaml_var_ptr%add_standname(standname)
355 if (
present(units))
then
356 if (trim(units) .ne.
"none") this%units = trim(units)
358 if (
present(realm)) this%realm = trim(realm)
359 if (
present(interp_method)) this%interp_method = trim(interp_method)
361 if (
present(tile_count))
then
362 allocate(this%tile_count)
363 this%tile_count = tile_count
366 if (
present(missing_value))
then
367 select type (missing_value)
368 type is (
integer(kind=i4_kind))
369 allocate(
integer(kind=i4_kind) :: this%missing_value)
370 this%missing_value = missing_value
371 type is (
integer(kind=i8_kind))
372 allocate(
integer(kind=i8_kind) :: this%missing_value)
373 this%missing_value = missing_value
374 type is (real(kind=r4_kind))
375 allocate(real(kind=r4_kind) :: this%missing_value)
376 this%missing_value = missing_value
377 type is (real(kind=r8_kind))
378 allocate(real(kind=r8_kind) :: this%missing_value)
379 this%missing_value = missing_value
381 call mpp_error(
"fms_register_diag_field_obj", &
382 "The missing value passed to register a diagnostic is not a r8, r4, i8, or i4",&
387 if (
present(varrange))
then
389 if (
size(varrange) /= 2)
call mpp_error(
"fms_register_diag_field_obj", &
390 "The varRange passed to register a diagnostic must have exactly 2 elements (/min, max/)", fatal)
391 select type (varrange)
392 type is (
integer(kind=i4_kind))
393 allocate(
integer(kind=i4_kind) :: this%data_range(2))
394 this%data_RANGE = varrange
395 type is (
integer(kind=i8_kind))
396 allocate(
integer(kind=i8_kind) :: this%data_range(2))
397 this%data_RANGE = varrange
398 type is (real(kind=r4_kind))
399 allocate(
integer(kind=i4_kind) :: this%data_range(2))
400 this%data_RANGE = varrange
401 type is (real(kind=r8_kind))
402 allocate(
integer(kind=r8_kind) :: this%data_range(2))
403 this%data_RANGE = varrange
405 call mpp_error(
"fms_register_diag_field_obj", &
406 "The varRange passed to register a diagnostic is not a r8, r4, i8, or i4",&
411 if (
present(area))
then
412 if (area < 0)
call mpp_error(
"fms_register_diag_field_obj", &
413 "The area id passed with field_name"//trim(varname)//
" has not been registered. &
414 &Check that there is a register_diag_field call for the AREA measure and that is in the &
415 &diag_table.yaml", fatal)
420 if (
present(volume))
then
421 if (volume < 0)
call mpp_error(
"fms_register_diag_field_obj", &
422 "The volume id passed with field_name"//trim(varname)//
" has not been registered. &
423 &Check that there is a register_diag_field call for the VOLUME measure and that is in the &
424 &diag_table.yaml", fatal)
425 allocate(this%volume)
429 this%mask_variant = .false.
430 if (
present(mask_variant))
then
431 this%mask_variant = mask_variant
434 if (
present(do_not_log))
then
435 allocate(this%do_not_log)
436 this%do_not_log = do_not_log
439 if (
present(multiple_send_data))
then
440 this%multiple_send_data = multiple_send_data
442 this%multiple_send_data = .false.
447 allocate(this%attributes(max_field_attributes))
448 this%num_attributes = 0
449 this%registered = .true.
450 end subroutine fms_register_diag_field_obj
454 subroutine set_diag_id(this , id)
457 if (
allocated(this%registered))
then
458 if (this%registered)
then
459 call mpp_error(
"set_diag_id",
"The variable"//this%varname//
" is already registered", fatal)
466 end subroutine set_diag_id
469 subroutine set_vartype(objin , var)
473 type is (real(kind=8))
475 type is (real(kind=4))
477 type is (
integer(kind=8))
479 type is (
integer(kind=4))
481 type is (
character(*))
484 objin%vartype = null_type_int
485 call mpp_error(
"set_vartype",
"The variable"//objin%varname//
" is not a supported type "// &
486 " r8, r4, i8, i4, or string.", warning)
488 end subroutine set_vartype
491 subroutine set_send_data_time (this, time)
495 call this%input_data_buffer%set_send_data_time(time)
496 end subroutine set_send_data_time
500 function get_send_data_time(this) &
505 rslt = this%input_data_buffer%get_send_data_time()
506 end function get_send_data_time
509 subroutine prepare_data_buffer(this)
512 if (.not. this%multiple_send_data)
return
513 if (this%mask_variant)
return
514 call this%input_data_buffer%prepare_input_buffer_object(this%modname//
":"//this%varname)
515 end subroutine prepare_data_buffer
518 subroutine init_data_buffer(this)
521 if (.not. this%multiple_send_data)
return
522 if (this%mask_variant)
return
523 call this%input_data_buffer%init_input_buffer_object()
524 end subroutine init_data_buffer
527 subroutine set_data_buffer (this, input_data, mask, weight, is, js, ks, ie, je, ke)
529 class(*),
intent(in) :: input_data(:,:,:,:)
530 logical,
intent(in) :: mask(:,:,:,:)
532 real(kind=r8_kind),
intent(in) :: weight
533 integer,
intent(in) :: is, js, ks
535 integer,
intent(in) :: ie, je, ke
538 character(len=128) :: err_msg
539 if (.not.this%data_buffer_is_allocated) &
540 call mpp_error (
"set_data_buffer",
"The data buffer for the field "//trim(this%varname)//
" was unable to be "//&
542 if (this%multiple_send_data)
then
543 err_msg = this%input_data_buffer%update_input_buffer_object(input_data, is, js, ks, ie, je, ke, &
544 mask, this%mask, this%mask_variant, this%var_is_masked)
546 this%mask(is:ie, js:je, ks:ke, :) = mask
547 err_msg = this%input_data_buffer%set_input_buffer_object(input_data, weight, is, js, ks, ie, je, ke)
549 if (trim(err_msg) .ne.
"")
call mpp_error(fatal,
"Field:"//trim(this%varname)//
" -"//trim(err_msg))
551 end subroutine set_data_buffer
554 logical function allocate_data_buffer(this, input_data, diag_axis)
556 class(*),
dimension(:,:,:,:),
intent(in) :: input_data
559 character(len=128) :: err_msg
562 allocate(this%input_data_buffer)
563 err_msg = this%input_data_buffer%allocate_input_buffer_object(input_data, this%axis_ids, diag_axis)
564 if (trim(err_msg) .ne.
"")
then
565 call mpp_error(fatal,
"Field:"//trim(this%varname)//
" -"//trim(err_msg))
569 allocate_data_buffer = .true.
570 end function allocate_data_buffer
572 subroutine set_math_needs_to_be_done (this, math_needs_to_be_done)
574 logical,
intent (in) :: math_needs_to_be_done
575 this%math_needs_to_be_done = math_needs_to_be_done
576 end subroutine set_math_needs_to_be_done
579 subroutine set_var_is_masked(this, is_masked)
581 logical,
intent (in) :: is_masked
583 this%var_is_masked = is_masked
584 end subroutine set_var_is_masked
588 function get_var_is_masked(this) &
593 rslt = this%var_is_masked
594 end function get_var_is_masked
597 subroutine set_data_buffer_is_allocated (this, data_buffer_is_allocated)
599 logical,
intent (in) :: data_buffer_is_allocated
601 this%data_buffer_is_allocated = data_buffer_is_allocated
602 end subroutine set_data_buffer_is_allocated
606 pure logical function is_data_buffer_allocated (this)
609 is_data_buffer_allocated = .false.
610 if (
allocated(this%data_buffer_is_allocated)) is_data_buffer_allocated = this%data_buffer_is_allocated
614 subroutine what_is_vartype(this)
616 if (.not.
allocated(this%vartype))
then
617 call mpp_error(
"what_is_vartype",
"The variable type has not been set prior to this call", warning)
620 select case (this%vartype)
622 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
623 " is REAL(kind=8)", note)
625 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
626 " is REAL(kind=4)", note)
628 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
629 " is INTEGER(kind=8)", note)
631 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
632 " is INTEGER(kind=4)", note)
634 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
635 " is CHARACTER(*)", note)
637 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
638 " was not set", warning)
640 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
641 " is not supported by diag_manager", fatal)
643 end subroutine what_is_vartype
647 subroutine copy_diag_obj(this , objout)
653 if (
allocated(this%registered))
then
654 objout%registered = this%registered
656 call mpp_error(
"copy_diag_obj",
"You can only copy objects that have been registered",warning)
658 objout%diag_id = this%diag_id
660 if (
allocated(this%attributes)) objout%attributes = this%attributes
661 objout%static = this%static
662 if (
allocated(this%frequency)) objout%frequency = this%frequency
663 if (
allocated(this%varname)) objout%varname = this%varname
665 end subroutine copy_diag_obj
670 pure integer function fms_diag_get_id (this)
result(diag_id)
673 if (
allocated(this%registered))
then
675 diag_id = this%diag_id
678 diag_id = diag_not_registered
680 end function fms_diag_get_id
687 function fms_diag_obj_as_string_basic(this)
result(rslt)
689 character(:),
allocatable :: rslt
690 character (len=:),
allocatable :: registered, vartype, varname, diag_id
691 if ( .not.
allocated (this))
then
696 rslt =
"[Obj:" // varname //
"," // vartype //
"," // registered //
"," // diag_id //
"]"
718 if(
allocated (this%varname))
then
719 varname = this%varname
724 rslt =
"[Obj:" // varname //
"," // vartype //
"," // registered //
"," // diag_id //
"]"
726 end function fms_diag_obj_as_string_basic
729 function diag_obj_is_registered (this)
result (rslt)
732 rslt = this%registered
733 end function diag_obj_is_registered
735 function diag_obj_is_static (this)
result (rslt)
739 if (
allocated(this%static)) rslt = this%static
740 end function diag_obj_is_static
744 function is_scalar (this)
result (rslt)
748 end function is_scalar
755 function get_attributes (this) &
761 if (this%num_attributes > 0 ) rslt => this%attributes
762 end function get_attributes
766 pure function get_static (this) &
771 end function get_static
775 pure function get_registered (this) &
779 rslt = this%registered
780 end function get_registered
784 pure function get_mask_variant (this) &
789 if (
allocated(this%mask_variant)) rslt = this%mask_variant
790 end function get_mask_variant
794 pure function get_local (this) &
799 end function get_local
803 pure function get_vartype (this) &
808 end function get_vartype
812 function get_varname (this, filename, to_write) &
815 character(len=*),
optional,
intent(in) :: filename
816 logical,
optional,
intent(in) :: to_write
817 character(len=:),
allocatable :: rslt
824 if (
present(to_write))
then
826 if (.not.
present(filename))
then
827 call mpp_error(fatal,
"get_varname was called using the to_write optional argument, "//&
828 "but a filename was not provided!")
831 do i = 1,
size(this%diag_field)
832 if (trim(filename) .eq. trim(this%diag_field(i)%get_var_fname()))
then
833 rslt = this%diag_field(i)%get_var_outname()
840 end function get_varname
844 pure function get_longname (this) &
847 character(len=:),
allocatable :: rslt
848 if (
allocated(this%longname))
then
851 rslt = diag_null_string
853 end function get_longname
857 pure function get_standname (this) &
860 character(len=:),
allocatable :: rslt
861 if (
allocated(this%standname))
then
862 rslt = this%standname
864 rslt = diag_null_string
866 end function get_standname
870 pure function get_units (this) &
873 character(len=:),
allocatable :: rslt
874 if (
allocated(this%units))
then
877 rslt = diag_null_string
879 end function get_units
883 pure function get_modname (this) &
886 character(len=:),
allocatable :: rslt
887 if (
allocated(this%modname))
then
890 rslt = diag_null_string
892 end function get_modname
896 pure function get_realm (this) &
899 character(len=:),
allocatable :: rslt
900 if (
allocated(this%realm))
then
903 rslt = diag_null_string
905 end function get_realm
909 pure function get_interp_method (this) &
912 character(len=:),
allocatable :: rslt
913 if (
allocated(this%interp_method))
then
914 rslt = this%interp_method
916 rslt = diag_null_string
918 end function get_interp_method
922 pure function get_frequency (this) &
925 integer,
allocatable,
dimension (:) :: rslt
926 if (
allocated(this%frequency))
then
927 allocate (rslt(
size(this%frequency)))
928 rslt = this%frequency
933 end function get_frequency
937 pure function get_tile_count (this) &
941 if (
allocated(this%tile_count))
then
942 rslt = this%tile_count
946 end function get_tile_count
950 pure function get_area (this) &
954 if (
allocated(this%area))
then
959 end function get_area
963 pure function get_volume (this) &
967 if (
allocated(this%volume))
then
972 end function get_volume
979 function get_missing_value (this, var_type) &
982 integer,
intent(in) :: var_type
985 class(*),
allocatable :: rslt
987 if (.not.
allocated(this%missing_value))
then
989 "The missing value is not allocated", fatal)
994 select case (var_type)
996 allocate (real(kind=r4_kind) :: rslt)
997 select type (miss => this%missing_value)
998 type is (real(kind=r4_kind))
1000 type is (real(kind=r4_kind))
1001 rslt = real(miss, kind=r4_kind)
1003 type is (real(kind=r8_kind))
1005 type is (real(kind=r4_kind))
1006 rslt = real(miss, kind=r4_kind)
1010 allocate (real(kind=r8_kind) :: rslt)
1011 select type (miss => this%missing_value)
1012 type is (real(kind=r4_kind))
1014 type is (real(kind=r8_kind))
1015 rslt = real(miss, kind=r8_kind)
1017 type is (real(kind=r8_kind))
1019 type is (real(kind=r8_kind))
1020 rslt = real(miss, kind=r8_kind)
1025 end function get_missing_value
1032 function get_data_range (this, var_type) &
1035 integer,
intent(in) :: var_type
1037 class(*),
allocatable :: rslt(:)
1039 if ( .not.
allocated(this%data_RANGE))
call mpp_error (
"get_data_RANGE", &
1040 "The data_RANGE value is not allocated", fatal)
1044 select case (var_type)
1046 allocate (real(kind=r4_kind) :: rslt(2))
1047 select type (r => this%data_RANGE)
1048 type is (real(kind=r4_kind))
1050 type is (real(kind=r4_kind))
1051 rslt = real(r, kind=r4_kind)
1053 type is (real(kind=r8_kind))
1055 type is (real(kind=r4_kind))
1056 rslt = real(r, kind=r4_kind)
1060 allocate (real(kind=r8_kind) :: rslt(2))
1061 select type (r => this%data_RANGE)
1062 type is (real(kind=r4_kind))
1064 type is (real(kind=r8_kind))
1065 rslt = real(r, kind=r8_kind)
1067 type is (real(kind=r8_kind))
1069 type is (real(kind=r8_kind))
1070 rslt = real(r, kind=r8_kind)
1074 end function get_data_range
1078 function get_axis_id (this) &
1081 integer,
pointer,
dimension(:) :: rslt
1083 if(
allocated(this%axis_ids))
then
1084 rslt => this%axis_ids
1088 end function get_axis_id
1092 function get_domain (this) &
1097 if (
associated(this%domain))
then
1103 end function get_domain
1107 pure function get_type_of_domain (this) &
1112 rslt = this%type_of_domain
1113 end function get_type_of_domain
1116 subroutine set_file_ids(this, file_ids)
1118 integer,
intent(in) :: file_ids(:)
1120 allocate(this%file_ids(
size(file_ids)))
1121 this%file_ids = file_ids
1122 end subroutine set_file_ids
1126 pure function get_var_skind(this, field_yaml) &
1131 character(len=:),
allocatable :: rslt
1135 var_kind = field_yaml%get_var_kind()
1136 select case (var_kind)
1147 end function get_var_skind
1151 pure function get_multiple_send_data(this) &
1155 rslt = this%multiple_send_data
1156 end function get_multiple_send_data
1160 pure function get_longname_to_write(this, field_yaml) &
1165 character(len=:),
allocatable :: rslt
1167 rslt = field_yaml%get_var_longname()
1168 if (rslt .eq.
"")
then
1170 rslt = this%get_longname()
1174 if (rslt .eq.
"")
then
1176 rslt = field_yaml%get_var_varname()
1178 end function get_longname_to_write
1181 subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, &
1186 character(len=*),
intent(in) :: unlim_dimname
1187 character(len=120),
allocatable,
intent(out) :: dimnames(:)
1189 logical,
intent(in) :: is_regional
1190 integer,
intent(in) :: file_axis_ids(:)
1195 character(len=23) :: diurnal_axis_name
1197 if (this%is_static())
then
1198 naxis =
size(this%axis_ids)
1200 naxis =
size(this%axis_ids) + 1
1203 if (field_yaml%has_n_diurnal())
then
1207 allocate(dimnames(naxis))
1210 if (field_yaml%has_var_zbounds())
then
1211 do i = 1,
size(this%axis_ids)
1212 axis_ptr => diag_axis(this%axis_ids(i))
1213 if (axis_ptr%axis%is_z_axis())
then
1216 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)
1220 do i = 1,
size(this%axis_ids)
1221 axis_ptr => diag_axis(this%axis_ids(i))
1222 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)
1227 if (field_yaml%has_n_diurnal())
then
1228 WRITE (diurnal_axis_name,
'(a,i2.2)')
'time_of_day_', field_yaml%get_n_diurnal()
1229 dimnames(naxis - 1) = trim(diurnal_axis_name)
1233 if (.not. this%is_static()) dimnames(naxis) = unlim_dimname
1235 end subroutine get_dimnames
1239 subroutine register_field_wrap(fms2io_fileobj, varname, vartype, dimensions, chunksizes)
1240 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1241 character(len=*),
INTENT(IN) :: varname
1242 character(len=*),
INTENT(IN) :: vartype
1243 character(len=*),
optional,
INTENT(IN) :: dimensions(:)
1244 integer,
optional,
INTENT(IN) :: chunksizes(:)
1247 select type(fms2io_fileobj)
1248 type is (fmsnetcdffile_t)
1249 call register_field(fms2io_fileobj, varname, vartype, dimensions)
1250 type is (fmsnetcdfdomainfile_t)
1251 call register_field(fms2io_fileobj, varname, vartype, dimensions, chunksizes=chunksizes)
1252 type is (fmsnetcdfunstructureddomainfile_t)
1253 call register_field(fms2io_fileobj, varname, vartype, dimensions)
1255 end subroutine register_field_wrap
1258 subroutine write_field_metadata(this, fms2io_fileobj, file_id, yaml_id, diag_axis, unlim_dimname, is_regional, &
1259 cell_measures, use_collective_writes, file_axis_ids)
1261 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1262 integer,
intent(in) :: file_id
1263 integer,
intent(in) :: yaml_id
1265 character(len=*),
intent(in) :: unlim_dimname
1266 logical,
intent(in) :: is_regional
1267 character(len=*),
intent(in) :: cell_measures
1268 logical,
intent(in) :: use_collective_writes
1270 integer,
intent(in) :: file_axis_ids(:)
1273 character(len=:),
allocatable :: var_name
1274 character(len=:),
allocatable :: long_name
1275 character(len=:),
allocatable :: units
1276 character(len=120),
allocatable :: dimnames(:)
1277 character(len=120) :: cell_methods
1279 character (len=MAX_STR_LEN),
allocatable :: yaml_field_attributes(:,:)
1280 character(len=:),
allocatable :: interp_method_tmp
1281 integer :: interp_method_len
1283 integer,
allocatable :: chunksizes(:)
1285 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
1286 var_name = field_yaml%get_var_outname()
1288 if (
allocated(this%axis_ids))
then
1289 call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, file_axis_ids)
1292 if ((use_collective_writes .and.
size(this%axis_ids) >= 2) .or. field_yaml%has_chunksizes())
then
1293 chunksizes = this%get_chunksizes(diag_axis, field_yaml)
1294 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), dimnames, &
1295 chunksizes = chunksizes)
1297 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), dimnames)
1300 if (this%is_static())
then
1301 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml))
1305 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), (/unlim_dimname/))
1309 long_name = this%get_longname_to_write(field_yaml)
1310 call register_variable_attribute(fms2io_fileobj, var_name,
"long_name", long_name, str_len=len_trim(long_name))
1312 units = this%get_units()
1313 if (units .ne. diag_null_string) &
1314 call register_variable_attribute(fms2io_fileobj, var_name,
"units", units, str_len=len_trim(units))
1316 if (this%has_missing_value())
then
1317 call register_variable_attribute(fms2io_fileobj, var_name,
"missing_value", &
1318 this%get_missing_value(field_yaml%get_var_kind()))
1319 call register_variable_attribute(fms2io_fileobj, var_name,
"_FillValue", &
1320 this%get_missing_value(field_yaml%get_var_kind()))
1322 call register_variable_attribute(fms2io_fileobj, var_name,
"missing_value", &
1323 get_default_missing_value(field_yaml%get_var_kind()))
1324 call register_variable_attribute(fms2io_fileobj, var_name,
"_FillValue", &
1325 get_default_missing_value(field_yaml%get_var_kind()))
1328 if (this%has_data_RANGE())
then
1329 call register_variable_attribute(fms2io_fileobj, var_name,
"valid_range", &
1330 this%get_data_range(field_yaml%get_var_kind()))
1333 if (this%has_interp_method())
then
1334 interp_method_tmp = this%interp_method
1335 interp_method_len = len_trim(interp_method_tmp)
1336 call register_variable_attribute(fms2io_fileobj, var_name,
"interp_method", interp_method_tmp, &
1337 str_len=interp_method_len)
1343 do i = 1, this%num_attributes
1344 call this%attributes(i)%write_metadata(fms2io_fileobj, var_name, &
1345 cell_methods=cell_methods)
1349 call this%append_time_cell_methods(cell_methods, field_yaml)
1350 if (trim(cell_methods) .ne.
"") &
1351 call register_variable_attribute(fms2io_fileobj, var_name,
"cell_methods", &
1352 trim(adjustl(cell_methods)), str_len=len_trim(adjustl(cell_methods)))
1357 if (trim(cell_measures) .ne.
"") &
1358 call register_variable_attribute(fms2io_fileobj, var_name,
"cell_measures", &
1359 trim(adjustl(cell_measures)), str_len=len_trim(adjustl(cell_measures)))
1362 if (this%has_standname()) &
1363 call register_variable_attribute(fms2io_fileobj, var_name,
"standard_name", &
1364 trim(this%get_standname()), str_len=len_trim(this%get_standname()))
1366 call this%write_coordinate_attribute(fms2io_fileobj, var_name, diag_axis)
1368 if (field_yaml%has_var_attributes())
then
1369 yaml_field_attributes = field_yaml%get_var_attributes()
1370 do i = 1,
size(yaml_field_attributes,1)
1371 call register_variable_attribute(fms2io_fileobj, var_name, trim(yaml_field_attributes(i,1)), &
1372 trim(yaml_field_attributes(i,2)), str_len=len_trim(yaml_field_attributes(i,2)))
1374 deallocate(yaml_field_attributes)
1376 end subroutine write_field_metadata
1384 function get_chunksizes(this, diag_axis, field_yaml) &
1391 integer,
allocatable :: chunksizes(:)
1399 ndim =
size(this%axis_ids)
1400 allocate(chunksizes(ndim + 1))
1402 if (field_yaml%has_chunksizes())
then
1403 specified_chunksizes = field_yaml%get_chunksizes()
1404 chunksizes = specified_chunksizes(1:ndim+1)
1410 select type (axis => diag_axis(this%axis_ids(i))%axis)
1412 if (axis%is_x_or_y_axis())
then
1413 call axis%get_dim_size_layout(dim_size, layout)
1414 if (mod(dim_size, layout) == 0)
then
1415 chunksizes(i) = dim_size / layout
1417 call mpp_error(fatal,
"The variable "//field_yaml%get_var_varname()//
" has a layout that is not"//&
1418 "evenly divisible by dimension size for axis "//axis%get_axis_name()//
"."&
1419 "This may lead to poor performance when using collective writes. "//&
1420 "Consider using a different layout, disabling collective writes, "//&
1421 "or specifying chunksizes manually via the diag table yaml")
1423 else if (axis%is_z_axis() .and. field_yaml%has_var_zbounds())
then
1426 chunksizes(i) = axis%axis_length()
1430 end function get_chunksizes
1434 subroutine write_coordinate_attribute (this, fms2io_fileobj, var_name, diag_axis)
1436 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1437 character(len=*),
intent(in) :: var_name
1441 character(len = 252) :: aux_coord
1444 if (.not.
allocated(this%axis_ids))
return
1449 do i = 1,
size(this%axis_ids)
1450 select type (obj => diag_axis(this%axis_ids(i))%axis)
1452 if (obj%has_aux())
then
1453 aux_coord = trim(aux_coord)//
" "//obj%get_aux()
1458 if (trim(aux_coord) .eq.
"")
return
1460 call register_variable_attribute(fms2io_fileobj, var_name,
"coordinates", &
1461 trim(adjustl(aux_coord)), str_len=len_trim(adjustl(aux_coord)))
1463 end subroutine write_coordinate_attribute
1467 function get_data_buffer (this) &
1470 class(*),
dimension(:,:,:,:),
pointer :: rslt
1472 if (.not. this%data_buffer_is_allocated) &
1473 call mpp_error(fatal,
"The input data buffer for the field:"&
1474 //trim(this%varname)//
" was never allocated.")
1476 rslt => this%input_data_buffer%get_buffer()
1477 end function get_data_buffer
1482 function get_weight (this) &
1485 type(
real(kind=r8_kind)),
pointer :: rslt
1487 if (.not. this%data_buffer_is_allocated) &
1488 call mpp_error(fatal,
"The input data buffer for the field:"&
1489 //trim(this%varname)//
" was never allocated.")
1491 rslt => this%input_data_buffer%get_weight()
1492 end function get_weight
1496 pure logical function get_math_needs_to_be_done(this)
1498 get_math_needs_to_be_done = .false.
1499 if (
allocated(this%math_needs_to_be_done)) get_math_needs_to_be_done = this%math_needs_to_be_done
1500 end function get_math_needs_to_be_done
1512 pure logical function has_diag_id (this)
1514 has_diag_id =
allocated(this%diag_id)
1515 end function has_diag_id
1519 pure logical function has_attributes (this)
1521 has_attributes = this%num_attributes > 0
1522 end function has_attributes
1526 pure logical function has_static (this)
1528 has_static =
allocated(this%static)
1529 end function has_static
1533 pure logical function has_registered (this)
1535 has_registered =
allocated(this%registered)
1536 end function has_registered
1540 pure logical function has_mask_variant (this)
1542 has_mask_variant =
allocated(this%mask_variant)
1543 end function has_mask_variant
1547 pure logical function has_local (this)
1549 has_local =
allocated(this%local)
1550 end function has_local
1554 pure logical function has_vartype (this)
1556 has_vartype =
allocated(this%vartype)
1557 end function has_vartype
1561 pure logical function has_varname (this)
1563 has_varname =
allocated(this%varname)
1564 end function has_varname
1568 pure logical function has_longname (this)
1570 has_longname =
allocated(this%longname)
1571 end function has_longname
1575 pure logical function has_standname (this)
1577 has_standname =
allocated(this%standname)
1578 end function has_standname
1582 pure logical function has_units (this)
1584 has_units =
allocated(this%units)
1585 end function has_units
1589 pure logical function has_modname (this)
1591 has_modname =
allocated(this%modname)
1592 end function has_modname
1596 pure logical function has_realm (this)
1598 has_realm =
allocated(this%realm)
1599 end function has_realm
1603 pure logical function has_interp_method (this)
1605 has_interp_method =
allocated(this%interp_method)
1606 end function has_interp_method
1610 pure logical function has_frequency (this)
1612 has_frequency =
allocated(this%frequency)
1613 end function has_frequency
1617 pure logical function has_tile_count (this)
1619 has_tile_count =
allocated(this%tile_count)
1620 end function has_tile_count
1624 pure logical function has_axis_ids (this)
1626 has_axis_ids =
allocated(this%axis_ids)
1627 end function has_axis_ids
1631 pure logical function has_area (this)
1633 has_area =
allocated(this%area)
1634 end function has_area
1638 pure logical function has_volume (this)
1640 has_volume =
allocated(this%volume)
1641 end function has_volume
1645 pure logical function has_missing_value (this)
1647 has_missing_value =
allocated(this%missing_value)
1648 end function has_missing_value
1652 pure logical function has_data_range (this)
1654 has_data_range =
allocated(this%data_RANGE)
1655 end function has_data_range
1659 pure logical function has_input_data_buffer (this)
1661 has_input_data_buffer =
allocated(this%input_data_buffer)
1662 end function has_input_data_buffer
1665 subroutine diag_field_add_attribute(this, att_name, att_value)
1667 character(len=*),
intent(in) :: att_name
1668 class(*),
intent(in) :: att_value(:)
1670 this%num_attributes = this%num_attributes + 1
1671 if (this%num_attributes > max_field_attributes) &
1672 call mpp_error(fatal,
"diag_field_add_attribute: Number of attributes exceeds max_field_attributes for field:"&
1673 //trim(this%varname)//
". Increase diag_manager_nml:max_field_attributes.")
1675 call this%attributes(this%num_attributes)%add(att_name, att_value)
1676 end subroutine diag_field_add_attribute
1680 function get_default_missing_value(var_type) &
1683 integer,
intent(in) :: var_type
1684 class(*),
allocatable :: rslt
1686 select case(var_type)
1688 allocate(real(kind=r4_kind) :: rslt)
1689 rslt = real(cmor_missing_value, kind=r4_kind)
1691 allocate(real(kind=r8_kind) :: rslt)
1692 rslt = real(cmor_missing_value, kind=r8_kind)
1699 FUNCTION diag_field_id_from_name(this, module_name, field_name) &
1700 result(diag_field_id)
1702 CHARACTER(len=*),
INTENT(in) :: module_name
1703 CHARACTER(len=*),
INTENT(in) :: field_name
1705 integer :: diag_field_id
1708 if (this%get_varname() .eq. trim(field_name) .and. &
1709 this%get_modname() .eq. trim(module_name))
then
1710 diag_field_id = this%get_id()
1712 end function diag_field_id_from_name
1715 subroutine add_area_volume(this, area, volume)
1717 INTEGER,
optional,
INTENT(in) :: area
1718 INTEGER,
optional,
INTENT(in) :: volume
1720 if (
present(area))
then
1724 call mpp_error(fatal,
"diag_field_add_cell_measures: the area id is not valid. &
1725 &Verify that the area_id passed in to the field:"//this%varname// &
1726 " is valid and that the field is registered and in the diag_table.yaml")
1730 if (
present(volume))
then
1731 if (volume > 0)
then
1732 this%volume = volume
1734 call mpp_error(fatal,
"diag_field_add_cell_measures: the volume id is not valid. &
1735 &Verify that the volume_id passed in to the field:"//this%varname// &
1736 " is valid and that the field is registered and in the diag_table.yaml")
1740 end subroutine add_area_volume
1743 subroutine append_time_cell_methods(this, cell_methods, field_yaml)
1745 character(len=*),
intent(inout) :: cell_methods
1748 if (this%static)
then
1749 cell_methods = trim(cell_methods)//
" time: point "
1753 select case (field_yaml%get_var_reduction())
1755 cell_methods = trim(cell_methods)//
" time: point "
1757 cell_methods = trim(cell_methods)//
" time: mean"
1759 cell_methods = trim(cell_methods)//
" time: mean_pow"//int2str(field_yaml%get_pow_value())
1761 cell_methods = trim(cell_methods)//
" time: root_mean_square"
1763 cell_methods = trim(cell_methods)//
" time: max"
1765 cell_methods = trim(cell_methods)//
" time: min"
1767 cell_methods = trim(cell_methods)//
" time: mean"
1769 cell_methods = trim(cell_methods)//
" time: sum"
1771 end subroutine append_time_cell_methods
1774 subroutine dump_field_obj (this, unit_num)
1776 integer,
intent(in) :: unit_num
1779 if(
mpp_pe() .eq. mpp_root_pe())
then
1780 if(
allocated(this%file_ids))
write(unit_num, *)
'file_ids:' ,this%file_ids
1781 if(
allocated(this%diag_id))
write(unit_num, *)
'diag_id:' ,this%diag_id
1782 if(
allocated(this%static))
write(unit_num, *)
'static:' ,this%static
1783 if(
allocated(this%registered))
write(unit_num, *)
'registered:' ,this%registered
1784 if(
allocated(this%mask_variant))
write(unit_num, *)
'mask_variant:' ,this%mask_variant
1785 if(
allocated(this%do_not_log))
write(unit_num, *)
'do_not_log:' ,this%do_not_log
1786 if(
allocated(this%local))
write(unit_num, *)
'local:' ,this%local
1787 if(
allocated(this%vartype))
write(unit_num, *)
'vartype:' ,this%vartype
1788 if(
allocated(this%varname))
write(unit_num, *)
'varname:' ,this%varname
1789 if(
allocated(this%longname))
write(unit_num, *)
'longname:' ,this%longname
1790 if(
allocated(this%standname))
write(unit_num, *)
'standname:' ,this%standname
1791 if(
allocated(this%units))
write(unit_num, *)
'units:' ,this%units
1792 if(
allocated(this%modname))
write(unit_num, *)
'modname:' ,this%modname
1793 if(
allocated(this%realm))
write(unit_num, *)
'realm:' ,this%realm
1794 if(
allocated(this%interp_method))
write(unit_num, *)
'interp_method:' ,this%interp_method
1795 if(
allocated(this%tile_count))
write(unit_num, *)
'tile_count:' ,this%tile_count
1796 if(
allocated(this%axis_ids))
write(unit_num, *)
'axis_ids:' ,this%axis_ids
1797 write(unit_num, *)
'type_of_domain:' ,this%type_of_domain
1798 if(
allocated(this%area))
write(unit_num, *)
'area:' ,this%area
1799 if(
allocated(this%missing_value))
then
1800 select type(missing_val => this%missing_value)
1801 type is (real(r4_kind))
1802 write(unit_num, *)
'missing_value:', missing_val
1803 type is (real(r8_kind))
1804 write(unit_num, *)
'missing_value:' ,missing_val
1805 type is(
integer(i4_kind))
1806 write(unit_num, *)
'missing_value:' ,missing_val
1807 type is(
integer(i8_kind))
1808 write(unit_num, *)
'missing_value:' ,missing_val
1811 if(
allocated( this%data_RANGE))
then
1812 select type(drange => this%data_RANGE)
1813 type is (real(r4_kind))
1814 write(unit_num, *)
'data_RANGE:' ,drange
1815 type is (real(r8_kind))
1816 write(unit_num, *)
'data_RANGE:' ,drange
1817 type is(
integer(i4_kind))
1818 write(unit_num, *)
'data_RANGE:' ,drange
1819 type is(
integer(i8_kind))
1820 write(unit_num, *)
'data_RANGE:' ,drange
1823 write(unit_num, *)
'num_attributes:' ,this%num_attributes
1824 if(
allocated(this%attributes))
then
1825 do i=1, this%num_attributes
1826 if(
allocated(this%attributes(i)%att_value))
then
1827 select type( val => this%attributes(i)%att_value)
1828 type is (real(r8_kind))
1829 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1830 type is (real(r4_kind))
1831 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1832 type is (
integer(i4_kind))
1833 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1834 type is (
integer(i8_kind))
1835 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1847 function get_starting_compute_domain(axis_ids, diag_axis) &
1848 result(compute_domain)
1849 integer,
intent(in) :: axis_ids(:)
1852 integer :: compute_domain(4)
1854 integer :: compute_idx(2)
1858 axis_loop:
do a = 1,
size(axis_ids)
1859 select type (axis => diag_axis(axis_ids(a))%axis)
1861 call axis%get_compute_domain(compute_idx, dummy)
1862 if ( compute_idx(1) .ne. diag_null) compute_domain(a) = compute_idx(1)
1865 end function get_starting_compute_domain
1868 pure function get_file_ids(this)
1870 integer,
allocatable :: get_file_ids(:)
1871 get_file_ids = this%file_ids
1876 function get_mask(this)
1878 logical,
pointer :: get_mask(:,:,:,:)
1879 get_mask => this%mask
1880 end function get_mask
1884 subroutine allocate_mask(this, mask_in, omp_axis)
1886 logical,
intent(in) :: mask_in(:,:,:,:)
1888 integer :: axis_num, length(4)
1889 integer,
pointer :: id_num
1891 if(.not.
present(omp_axis))
then
1892 allocate(this%mask(
size(mask_in,1),
size(mask_in,2),
size(mask_in,3), &
1897 do axis_num=1,
size(this%axis_ids)
1898 id_num => this%axis_ids(axis_num)
1899 select type(axis => omp_axis(id_num)%axis)
1901 length(axis_num) = axis%axis_length()
1904 allocate(this%mask(length(1), length(2), length(3), length(4)))
1906 end subroutine allocate_mask
1909 subroutine set_mask(this, mask_in, field_info, is, js, ks, ie, je, ke)
1911 logical,
intent(in) :: mask_in(:,:,:,:)
1912 character(len=*),
intent(in) :: field_info
1913 integer,
optional,
intent(in) :: is, js, ks, ie, je, ke
1914 if(
present(is))
then
1915 if(is .lt. lbound(this%mask,1) .or. ie .gt. ubound(this%mask,1) .or. &
1916 js .lt. lbound(this%mask,2) .or. je .gt. ubound(this%mask,2) .or. &
1917 ks .lt. lbound(this%mask,3) .or. ke .gt. ubound(this%mask,3))
then
1918 print *,
"PE:", int2str(
mpp_pe()),
"The size of the mask is", &
1920 "But the indices passed in are is=", int2str(is),
" ie=", int2str(ie),&
1921 " js=", int2str(js),
" je=", int2str(je), &
1922 " ks=", int2str(ks),
" ke=", int2str(ke), &
1923 " ", trim(field_info)
1924 call mpp_error(fatal,
"set_mask:: given indices out of bounds for allocated mask")
1926 this%mask(is:ie, js:je, ks:ke, :) = mask_in
1930 end subroutine set_mask
1933 subroutine set_halo_present(this)
1935 this%halo_present = .true.
1936 end subroutine set_halo_present
1939 pure function is_halo_present(this)
1941 logical :: is_halo_present
1942 is_halo_present = this%halo_present
1943 end function is_halo_present
1948 function find_missing_value(this, missing_val) &
1951 class(*),
allocatable,
intent(out) :: missing_val
1952 real(r8_kind),
allocatable :: res
1955 if(this%has_missing_value())
then
1956 missing_val = this%get_missing_value(this%get_vartype())
1958 vtype = this%get_vartype()
1959 if(vtype .eq. r8)
then
1960 missing_val = cmor_missing_value
1962 missing_val = real(cmor_missing_value, r4_kind)
1966 select type(missing_val)
1967 type is (real(r8_kind))
1969 type is (real(r4_kind))
1970 res = real(missing_val, r8_kind)
1972 end function find_missing_value
1977 pure logical function has_mask_allocated(this)
1979 has_mask_allocated =
allocated(this%mask)
1980 end function has_mask_allocated
1984 pure function is_variable_in_file(this, file_id) &
1987 integer,
intent(in) :: file_id
1993 if (any(this%file_ids .eq. file_id)) res = .true.
1994 end function is_variable_in_file
1998 function get_field_file_name(this) &
2001 character(len=:),
allocatable :: res
2003 res = this%diag_field(1)%get_var_fname()
2004 end function get_field_file_name
2007 subroutine generate_associated_files_att(this, att, start_time, var_output_name)
2010 character(len=*),
intent(inout) :: att
2011 type(
time_type),
intent(in) :: start_time
2012 character(len=*),
intent(out) :: var_output_name
2015 character(len=:),
allocatable :: field_name
2016 character(len=FMS_FILE_LEN) :: file_name
2017 character(len=128) :: start_date
2019 integer :: year, month, day, hour, minute, second
2021 file_name = this%get_field_file_name()
2022 field_name = this%get_varname(to_write = .true., filename=file_name)
2025 var_output_name = field_name
2029 if (index(att, field_name) .ne. 0)
return
2031 if (prepend_date)
then
2032 call get_date(start_time, year, month, day, hour, minute, second)
2033 write (start_date,
'(1I20.4, 2I2.2)') year, month, day
2034 file_name = trim(adjustl(start_date))//
'.'//trim(file_name)
2037 att = trim(att)//
" "//trim(field_name)//
": "//trim(file_name)//
".nc"
2038 end subroutine generate_associated_files_att
2042 function check_for_slices(field, diag_axis, var_size) &
2046 integer,
intent(in) :: var_size(:)
2053 if (.not. field%has_axis_ids())
then
2057 do i = 1,
size(field%axis_ids)
2058 select type (axis_obj => diag_axis(field%axis_ids(i))%axis)
2060 if (axis_obj%axis_length() .ne. var_size(i))
then
2068 end module fms_diag_field_object_mod
integer, parameter max_str_len
Max length for a string.
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
character(len=7) avg_name
Name of the average fields.
integer, parameter diag_field_not_found
Return value for a diag_field that isn't found in the diag_table.
integer, parameter string
s is the 19th letter of the alphabet
integer, parameter time_min
The reduction method is min value.
integer, parameter time_diurnal
The reduction method is diurnal.
integer, parameter time_power
The reduction method is average with exponents.
real(r8_kind), parameter cmor_missing_value
CMOR standard missing value.
logical prepend_date
Should the history file have the start date prepended to the file name. .TRUE. is only supported if t...
integer, parameter max_dimensions
Max number of dimensions allowed (including unlimited dimension)
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 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 max_field_attributes
Maximum number of user definable attributes per field. Liptak: Changed from 2 to 4 20170718.
Type to hold the attributes of the field/axis/file.
Defines a new field/variable within the given file. After a variable is registered,...
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.
subroutine, public find_z_sub_axis_name(dim_name, parent_axis_id, file_axis_id, field_yaml, diag_axis)
Determine the name of the z subaxis by matching the parent axis id and the zbounds in the diag table ...
integer function, public get_num_unique_fields()
Determine the number of unique diag_fields in the diag_yaml_object.
integer function, dimension(:), allocatable, public find_diag_field(diag_field_name, module_name)
Determines if a diag_field is in the diag_yaml_object.
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, public get_domain_and_domain_type(diag_axis, axis_id, domain_type, domain, var_name)
Loop through a variable's axis_id to determine and return the domain type and domain to use.
character(:) function, allocatable, public string(v, fmt)
Converts a number or a Boolean value to a string.
integer function mpp_pe()
Returns processor ID.
subroutine, public get_date(time, year, month, day, hour, minute, second, tick, err_msg)
Gets the date for different calendar types. Given a time_interval, returns the corresponding date und...
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.
Type to hold the domain info for an axis This type was created to avoid having to send in "Domain",...
Type to hold the diagnostic axis description.
Type to hold the diag_axis (either subaxis or a full axis)
Type to hold the diagnostic axis description.
Object that holds all variable information.
type to hold the info a diag_field