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(2)
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
388 select type (varrange)
389 type is (
integer(kind=i4_kind))
390 allocate(
integer(kind=i4_kind) :: this%data_range(2))
391 this%data_RANGE = varrange
392 type is (
integer(kind=i8_kind))
393 allocate(
integer(kind=i8_kind) :: this%data_range(2))
394 this%data_RANGE = varrange
395 type is (real(kind=r4_kind))
396 allocate(
integer(kind=r4_kind) :: this%data_range(2))
397 this%data_RANGE = varrange
398 type is (real(kind=r8_kind))
399 allocate(
integer(kind=r8_kind) :: this%data_range(2))
400 this%data_RANGE = varrange
402 call mpp_error(
"fms_register_diag_field_obj", &
403 "The varRange passed to register a diagnostic is not a r8, r4, i8, or i4",&
408 if (
present(area))
then
409 if (area < 0)
call mpp_error(
"fms_register_diag_field_obj", &
410 "The area id passed with field_name"//trim(varname)//
" has not been registered. &
411 &Check that there is a register_diag_field call for the AREA measure and that is in the &
412 &diag_table.yaml", fatal)
417 if (
present(volume))
then
418 if (volume < 0)
call mpp_error(
"fms_register_diag_field_obj", &
419 "The volume id passed with field_name"//trim(varname)//
" has not been registered. &
420 &Check that there is a register_diag_field call for the VOLUME measure and that is in the &
421 &diag_table.yaml", fatal)
422 allocate(this%volume)
426 this%mask_variant = .false.
427 if (
present(mask_variant))
then
428 this%mask_variant = mask_variant
431 if (
present(do_not_log))
then
432 allocate(this%do_not_log)
433 this%do_not_log = do_not_log
436 if (
present(multiple_send_data))
then
437 this%multiple_send_data = multiple_send_data
439 this%multiple_send_data = .false.
444 allocate(this%attributes(max_field_attributes))
445 this%num_attributes = 0
446 this%registered = .true.
447 end subroutine fms_register_diag_field_obj
451 subroutine set_diag_id(this , id)
454 if (
allocated(this%registered))
then
455 if (this%registered)
then
456 call mpp_error(
"set_diag_id",
"The variable"//this%varname//
" is already registered", fatal)
463 end subroutine set_diag_id
466 subroutine set_vartype(objin , var)
470 type is (real(kind=8))
472 type is (real(kind=4))
474 type is (
integer(kind=8))
476 type is (
integer(kind=4))
478 type is (
character(*))
481 objin%vartype = null_type_int
482 call mpp_error(
"set_vartype",
"The variable"//objin%varname//
" is not a supported type "// &
483 " r8, r4, i8, i4, or string.", warning)
485 end subroutine set_vartype
488 subroutine set_send_data_time (this, time)
492 call this%input_data_buffer%set_send_data_time(time)
493 end subroutine set_send_data_time
497 function get_send_data_time(this) &
502 rslt = this%input_data_buffer%get_send_data_time()
503 end function get_send_data_time
506 subroutine prepare_data_buffer(this)
509 if (.not. this%multiple_send_data)
return
510 if (this%mask_variant)
return
511 call this%input_data_buffer%prepare_input_buffer_object(this%modname//
":"//this%varname)
512 end subroutine prepare_data_buffer
515 subroutine init_data_buffer(this)
518 if (.not. this%multiple_send_data)
return
519 if (this%mask_variant)
return
520 call this%input_data_buffer%init_input_buffer_object()
521 end subroutine init_data_buffer
524 subroutine set_data_buffer (this, input_data, mask, weight, is, js, ks, ie, je, ke)
526 class(*),
intent(in) :: input_data(:,:,:,:)
527 logical,
intent(in) :: mask(:,:,:,:)
529 real(kind=r8_kind),
intent(in) :: weight
530 integer,
intent(in) :: is, js, ks
532 integer,
intent(in) :: ie, je, ke
535 character(len=128) :: err_msg
536 if (.not.this%data_buffer_is_allocated) &
537 call mpp_error (
"set_data_buffer",
"The data buffer for the field "//trim(this%varname)//
" was unable to be "//&
539 if (this%multiple_send_data)
then
540 err_msg = this%input_data_buffer%update_input_buffer_object(input_data, is, js, ks, ie, je, ke, &
541 mask, this%mask, this%mask_variant, this%var_is_masked)
543 this%mask(is:ie, js:je, ks:ke, :) = mask
544 err_msg = this%input_data_buffer%set_input_buffer_object(input_data, weight, is, js, ks, ie, je, ke)
546 if (trim(err_msg) .ne.
"")
call mpp_error(fatal,
"Field:"//trim(this%varname)//
" -"//trim(err_msg))
548 end subroutine set_data_buffer
551 logical function allocate_data_buffer(this, input_data, diag_axis)
553 class(*),
dimension(:,:,:,:),
intent(in) :: input_data
556 character(len=128) :: err_msg
559 allocate(this%input_data_buffer)
560 err_msg = this%input_data_buffer%allocate_input_buffer_object(input_data, this%axis_ids, diag_axis)
561 if (trim(err_msg) .ne.
"")
then
562 call mpp_error(fatal,
"Field:"//trim(this%varname)//
" -"//trim(err_msg))
566 allocate_data_buffer = .true.
567 end function allocate_data_buffer
569 subroutine set_math_needs_to_be_done (this, math_needs_to_be_done)
571 logical,
intent (in) :: math_needs_to_be_done
572 this%math_needs_to_be_done = math_needs_to_be_done
573 end subroutine set_math_needs_to_be_done
576 subroutine set_var_is_masked(this, is_masked)
578 logical,
intent (in) :: is_masked
580 this%var_is_masked = is_masked
581 end subroutine set_var_is_masked
585 function get_var_is_masked(this) &
590 rslt = this%var_is_masked
591 end function get_var_is_masked
594 subroutine set_data_buffer_is_allocated (this, data_buffer_is_allocated)
596 logical,
intent (in) :: data_buffer_is_allocated
598 this%data_buffer_is_allocated = data_buffer_is_allocated
599 end subroutine set_data_buffer_is_allocated
603 pure logical function is_data_buffer_allocated (this)
606 is_data_buffer_allocated = .false.
607 if (
allocated(this%data_buffer_is_allocated)) is_data_buffer_allocated = this%data_buffer_is_allocated
611 subroutine what_is_vartype(this)
613 if (.not.
allocated(this%vartype))
then
614 call mpp_error(
"what_is_vartype",
"The variable type has not been set prior to this call", warning)
617 select case (this%vartype)
619 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
620 " is REAL(kind=8)", note)
622 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
623 " is REAL(kind=4)", note)
625 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
626 " is INTEGER(kind=8)", note)
628 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
629 " is INTEGER(kind=4)", note)
631 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
632 " is CHARACTER(*)", note)
634 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
635 " was not set", warning)
637 call mpp_error(
"what_is_vartype",
"The variable type of "//trim(this%varname)//&
638 " is not supported by diag_manager", fatal)
640 end subroutine what_is_vartype
644 subroutine copy_diag_obj(this , objout)
650 if (
allocated(this%registered))
then
651 objout%registered = this%registered
653 call mpp_error(
"copy_diag_obj",
"You can only copy objects that have been registered",warning)
655 objout%diag_id = this%diag_id
657 if (
allocated(this%attributes)) objout%attributes = this%attributes
658 objout%static = this%static
659 if (
allocated(this%frequency)) objout%frequency = this%frequency
660 if (
allocated(this%varname)) objout%varname = this%varname
662 end subroutine copy_diag_obj
667 pure integer function fms_diag_get_id (this)
result(diag_id)
670 if (
allocated(this%registered))
then
672 diag_id = this%diag_id
675 diag_id = diag_not_registered
677 end function fms_diag_get_id
684 function fms_diag_obj_as_string_basic(this)
result(rslt)
686 character(:),
allocatable :: rslt
687 character (len=:),
allocatable :: registered, vartype, varname, diag_id
688 if ( .not.
allocated (this))
then
693 rslt =
"[Obj:" // varname //
"," // vartype //
"," // registered //
"," // diag_id //
"]"
715 if(
allocated (this%varname))
then
716 varname = this%varname
721 rslt =
"[Obj:" // varname //
"," // vartype //
"," // registered //
"," // diag_id //
"]"
723 end function fms_diag_obj_as_string_basic
726 function diag_obj_is_registered (this)
result (rslt)
729 rslt = this%registered
730 end function diag_obj_is_registered
732 function diag_obj_is_static (this)
result (rslt)
736 if (
allocated(this%static)) rslt = this%static
737 end function diag_obj_is_static
741 function is_scalar (this)
result (rslt)
745 end function is_scalar
752 function get_attributes (this) &
758 if (this%num_attributes > 0 ) rslt => this%attributes
759 end function get_attributes
763 pure function get_static (this) &
768 end function get_static
772 pure function get_registered (this) &
776 rslt = this%registered
777 end function get_registered
781 pure function get_mask_variant (this) &
786 if (
allocated(this%mask_variant)) rslt = this%mask_variant
787 end function get_mask_variant
791 pure function get_local (this) &
796 end function get_local
800 pure function get_vartype (this) &
805 end function get_vartype
809 pure function get_varname (this, to_write) &
812 logical,
optional,
intent(in) :: to_write
813 character(len=:),
allocatable :: rslt
817 if (
present(to_write))
then
820 rslt = this%diag_field(1)%get_var_outname()
824 end function get_varname
828 pure function get_longname (this) &
831 character(len=:),
allocatable :: rslt
832 if (
allocated(this%longname))
then
835 rslt = diag_null_string
837 end function get_longname
841 pure function get_standname (this) &
844 character(len=:),
allocatable :: rslt
845 if (
allocated(this%standname))
then
846 rslt = this%standname
848 rslt = diag_null_string
850 end function get_standname
854 pure function get_units (this) &
857 character(len=:),
allocatable :: rslt
858 if (
allocated(this%units))
then
861 rslt = diag_null_string
863 end function get_units
867 pure function get_modname (this) &
870 character(len=:),
allocatable :: rslt
871 if (
allocated(this%modname))
then
874 rslt = diag_null_string
876 end function get_modname
880 pure function get_realm (this) &
883 character(len=:),
allocatable :: rslt
884 if (
allocated(this%realm))
then
887 rslt = diag_null_string
889 end function get_realm
893 pure function get_interp_method (this) &
896 character(len=:),
allocatable :: rslt
897 if (
allocated(this%interp_method))
then
898 rslt = this%interp_method
900 rslt = diag_null_string
902 end function get_interp_method
906 pure function get_frequency (this) &
909 integer,
allocatable,
dimension (:) :: rslt
910 if (
allocated(this%frequency))
then
911 allocate (rslt(
size(this%frequency)))
912 rslt = this%frequency
917 end function get_frequency
921 pure function get_tile_count (this) &
925 if (
allocated(this%tile_count))
then
926 rslt = this%tile_count
930 end function get_tile_count
934 pure function get_area (this) &
938 if (
allocated(this%area))
then
943 end function get_area
947 pure function get_volume (this) &
951 if (
allocated(this%volume))
then
956 end function get_volume
963 function get_missing_value (this, var_type) &
966 integer,
intent(in) :: var_type
969 class(*),
allocatable :: rslt
971 if (.not.
allocated(this%missing_value))
then
973 "The missing value is not allocated", fatal)
978 select case (var_type)
980 allocate (real(kind=r4_kind) :: rslt)
981 select type (miss => this%missing_value)
982 type is (real(kind=r4_kind))
984 type is (real(kind=r4_kind))
985 rslt = real(miss, kind=r4_kind)
987 type is (real(kind=r8_kind))
989 type is (real(kind=r4_kind))
990 rslt = real(miss, kind=r4_kind)
994 allocate (real(kind=r8_kind) :: rslt)
995 select type (miss => this%missing_value)
996 type is (real(kind=r4_kind))
998 type is (real(kind=r8_kind))
999 rslt = real(miss, kind=r8_kind)
1001 type is (real(kind=r8_kind))
1003 type is (real(kind=r8_kind))
1004 rslt = real(miss, kind=r8_kind)
1009 end function get_missing_value
1016 function get_data_range (this, var_type) &
1019 integer,
intent(in) :: var_type
1021 class(*),
allocatable :: rslt(:)
1023 if ( .not.
allocated(this%data_RANGE))
call mpp_error (
"get_data_RANGE", &
1024 "The data_RANGE value is not allocated", fatal)
1028 select case (var_type)
1030 allocate (real(kind=r4_kind) :: rslt(2))
1031 select type (r => this%data_RANGE)
1032 type is (real(kind=r4_kind))
1034 type is (real(kind=r4_kind))
1035 rslt = real(r, kind=r4_kind)
1037 type is (real(kind=r8_kind))
1039 type is (real(kind=r4_kind))
1040 rslt = real(r, kind=r4_kind)
1044 allocate (real(kind=r8_kind) :: rslt(2))
1045 select type (r => this%data_RANGE)
1046 type is (real(kind=r4_kind))
1048 type is (real(kind=r8_kind))
1049 rslt = real(r, kind=r8_kind)
1051 type is (real(kind=r8_kind))
1053 type is (real(kind=r8_kind))
1054 rslt = real(r, kind=r8_kind)
1058 end function get_data_range
1062 function get_axis_id (this) &
1065 integer,
pointer,
dimension(:) :: rslt
1067 if(
allocated(this%axis_ids))
then
1068 rslt => this%axis_ids
1072 end function get_axis_id
1076 function get_domain (this) &
1081 if (
associated(this%domain))
then
1087 end function get_domain
1091 pure function get_type_of_domain (this) &
1096 rslt = this%type_of_domain
1097 end function get_type_of_domain
1100 subroutine set_file_ids(this, file_ids)
1102 integer,
intent(in) :: file_ids(:)
1104 allocate(this%file_ids(
size(file_ids)))
1105 this%file_ids = file_ids
1106 end subroutine set_file_ids
1110 pure function get_var_skind(this, field_yaml) &
1115 character(len=:),
allocatable :: rslt
1119 var_kind = field_yaml%get_var_kind()
1120 select case (var_kind)
1131 end function get_var_skind
1135 pure function get_multiple_send_data(this) &
1139 rslt = this%multiple_send_data
1140 end function get_multiple_send_data
1144 pure function get_longname_to_write(this, field_yaml) &
1149 character(len=:),
allocatable :: rslt
1151 rslt = field_yaml%get_var_longname()
1152 if (rslt .eq.
"")
then
1154 rslt = this%get_longname()
1158 if (rslt .eq.
"")
then
1160 rslt = field_yaml%get_var_varname()
1162 end function get_longname_to_write
1165 subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional)
1169 character(len=*),
intent(in) :: unlim_dimname
1170 character(len=120),
allocatable,
intent(out) :: dimnames(:)
1172 logical,
intent(in) :: is_regional
1177 character(len=23) :: diurnal_axis_name
1179 if (this%is_static())
then
1180 naxis =
size(this%axis_ids)
1182 naxis =
size(this%axis_ids) + 1
1185 if (field_yaml%has_n_diurnal())
then
1189 allocate(dimnames(naxis))
1192 if (field_yaml%has_var_zbounds())
then
1193 do i = 1,
size(this%axis_ids)
1194 axis_ptr => diag_axis(this%axis_ids(i))
1195 if (axis_ptr%axis%is_z_axis())
then
1196 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)//
"_sub01"
1198 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)
1202 do i = 1,
size(this%axis_ids)
1203 axis_ptr => diag_axis(this%axis_ids(i))
1204 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)
1209 if (field_yaml%has_n_diurnal())
then
1210 WRITE (diurnal_axis_name,
'(a,i2.2)')
'time_of_day_', field_yaml%get_n_diurnal()
1211 dimnames(naxis - 1) = trim(diurnal_axis_name)
1215 if (.not. this%is_static()) dimnames(naxis) = unlim_dimname
1217 end subroutine get_dimnames
1221 subroutine register_field_wrap(fms2io_fileobj, varname, vartype, dimensions, chunksizes)
1222 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1223 character(len=*),
INTENT(IN) :: varname
1224 character(len=*),
INTENT(IN) :: vartype
1225 character(len=*),
optional,
INTENT(IN) :: dimensions(:)
1226 integer,
optional,
INTENT(IN) :: chunksizes(:)
1229 select type(fms2io_fileobj)
1230 type is (fmsnetcdffile_t)
1231 call register_field(fms2io_fileobj, varname, vartype, dimensions)
1232 type is (fmsnetcdfdomainfile_t)
1233 call register_field(fms2io_fileobj, varname, vartype, dimensions, chunksizes=chunksizes)
1234 type is (fmsnetcdfunstructureddomainfile_t)
1235 call register_field(fms2io_fileobj, varname, vartype, dimensions)
1237 end subroutine register_field_wrap
1240 subroutine write_field_metadata(this, fms2io_fileobj, file_id, yaml_id, diag_axis, unlim_dimname, is_regional, &
1241 cell_measures, use_collective_writes)
1243 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1244 integer,
intent(in) :: file_id
1245 integer,
intent(in) :: yaml_id
1247 character(len=*),
intent(in) :: unlim_dimname
1248 logical,
intent(in) :: is_regional
1249 character(len=*),
intent(in) :: cell_measures
1250 logical,
intent(in) :: use_collective_writes
1254 character(len=:),
allocatable :: var_name
1255 character(len=:),
allocatable :: long_name
1256 character(len=:),
allocatable :: units
1257 character(len=120),
allocatable :: dimnames(:)
1258 character(len=120) :: cell_methods
1260 character (len=MAX_STR_LEN),
allocatable :: yaml_field_attributes(:,:)
1261 character(len=:),
allocatable :: interp_method_tmp
1262 integer :: interp_method_len
1264 integer,
allocatable :: chunksizes(:)
1266 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
1267 var_name = field_yaml%get_var_outname()
1269 if (
allocated(this%axis_ids))
then
1270 call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional)
1273 if ((use_collective_writes .and.
size(this%axis_ids) >= 2) .or. field_yaml%has_chunksizes())
then
1274 chunksizes = this%get_chunksizes(diag_axis, field_yaml)
1275 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), dimnames, &
1276 chunksizes = chunksizes)
1278 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), dimnames)
1281 if (this%is_static())
then
1282 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml))
1286 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), (/unlim_dimname/))
1290 long_name = this%get_longname_to_write(field_yaml)
1291 call register_variable_attribute(fms2io_fileobj, var_name,
"long_name", long_name, str_len=len_trim(long_name))
1293 units = this%get_units()
1294 if (units .ne. diag_null_string) &
1295 call register_variable_attribute(fms2io_fileobj, var_name,
"units", units, str_len=len_trim(units))
1297 if (this%has_missing_value())
then
1298 call register_variable_attribute(fms2io_fileobj, var_name,
"missing_value", &
1299 this%get_missing_value(field_yaml%get_var_kind()))
1300 call register_variable_attribute(fms2io_fileobj, var_name,
"_FillValue", &
1301 this%get_missing_value(field_yaml%get_var_kind()))
1303 call register_variable_attribute(fms2io_fileobj, var_name,
"missing_value", &
1304 get_default_missing_value(field_yaml%get_var_kind()))
1305 call register_variable_attribute(fms2io_fileobj, var_name,
"_FillValue", &
1306 get_default_missing_value(field_yaml%get_var_kind()))
1309 if (this%has_data_RANGE())
then
1310 call register_variable_attribute(fms2io_fileobj, var_name,
"valid_range", &
1311 this%get_data_range(field_yaml%get_var_kind()))
1314 if (this%has_interp_method())
then
1315 interp_method_tmp = this%interp_method
1316 interp_method_len = len_trim(interp_method_tmp)
1317 call register_variable_attribute(fms2io_fileobj, var_name,
"interp_method", interp_method_tmp, &
1318 str_len=interp_method_len)
1324 do i = 1, this%num_attributes
1325 call this%attributes(i)%write_metadata(fms2io_fileobj, var_name, &
1326 cell_methods=cell_methods)
1330 call this%append_time_cell_methods(cell_methods, field_yaml)
1331 if (trim(cell_methods) .ne.
"") &
1332 call register_variable_attribute(fms2io_fileobj, var_name,
"cell_methods", &
1333 trim(adjustl(cell_methods)), str_len=len_trim(adjustl(cell_methods)))
1338 if (trim(cell_measures) .ne.
"") &
1339 call register_variable_attribute(fms2io_fileobj, var_name,
"cell_measures", &
1340 trim(adjustl(cell_measures)), str_len=len_trim(adjustl(cell_measures)))
1343 if (this%has_standname()) &
1344 call register_variable_attribute(fms2io_fileobj, var_name,
"standard_name", &
1345 trim(this%get_standname()), str_len=len_trim(this%get_standname()))
1347 call this%write_coordinate_attribute(fms2io_fileobj, var_name, diag_axis)
1349 if (field_yaml%has_var_attributes())
then
1350 yaml_field_attributes = field_yaml%get_var_attributes()
1351 do i = 1,
size(yaml_field_attributes,1)
1352 call register_variable_attribute(fms2io_fileobj, var_name, trim(yaml_field_attributes(i,1)), &
1353 trim(yaml_field_attributes(i,2)), str_len=len_trim(yaml_field_attributes(i,2)))
1355 deallocate(yaml_field_attributes)
1357 end subroutine write_field_metadata
1365 function get_chunksizes(this, diag_axis, field_yaml) &
1372 integer,
allocatable :: chunksizes(:)
1380 ndim =
size(this%axis_ids)
1381 allocate(chunksizes(ndim + 1))
1383 if (field_yaml%has_chunksizes())
then
1384 specified_chunksizes = field_yaml%get_chunksizes()
1385 chunksizes = specified_chunksizes(1:ndim+1)
1391 select type (axis => diag_axis(this%axis_ids(i))%axis)
1393 if (axis%is_x_or_y_axis())
then
1394 call axis%get_dim_size_layout(dim_size, layout)
1395 if (mod(dim_size, layout) == 0)
then
1396 chunksizes(i) = dim_size / layout
1398 call mpp_error(fatal,
"The variable "//field_yaml%get_var_varname()//
" has a layout that is not"//&
1399 "evenly divisible by dimension size for axis "//axis%get_axis_name()//
"."&
1400 "This may lead to poor performance when using collective writes. "//&
1401 "Consider using a different layout, disabling collective writes, "//&
1402 "or specifying chunksizes manually via the diag table yaml")
1404 else if (axis%is_z_axis() .and. field_yaml%has_var_zbounds())
then
1407 chunksizes(i) = axis%axis_length()
1411 end function get_chunksizes
1415 subroutine write_coordinate_attribute (this, fms2io_fileobj, var_name, diag_axis)
1417 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1418 character(len=*),
intent(in) :: var_name
1422 character(len = 252) :: aux_coord
1425 if (.not.
allocated(this%axis_ids))
return
1430 do i = 1,
size(this%axis_ids)
1431 select type (obj => diag_axis(this%axis_ids(i))%axis)
1433 if (obj%has_aux())
then
1434 aux_coord = trim(aux_coord)//
" "//obj%get_aux()
1439 if (trim(aux_coord) .eq.
"")
return
1441 call register_variable_attribute(fms2io_fileobj, var_name,
"coordinates", &
1442 trim(adjustl(aux_coord)), str_len=len_trim(adjustl(aux_coord)))
1444 end subroutine write_coordinate_attribute
1448 function get_data_buffer (this) &
1451 class(*),
dimension(:,:,:,:),
pointer :: rslt
1453 if (.not. this%data_buffer_is_allocated) &
1454 call mpp_error(fatal,
"The input data buffer for the field:"&
1455 //trim(this%varname)//
" was never allocated.")
1457 rslt => this%input_data_buffer%get_buffer()
1458 end function get_data_buffer
1463 function get_weight (this) &
1466 type(
real(kind=r8_kind)),
pointer :: rslt
1468 if (.not. this%data_buffer_is_allocated) &
1469 call mpp_error(fatal,
"The input data buffer for the field:"&
1470 //trim(this%varname)//
" was never allocated.")
1472 rslt => this%input_data_buffer%get_weight()
1473 end function get_weight
1477 pure logical function get_math_needs_to_be_done(this)
1479 get_math_needs_to_be_done = .false.
1480 if (
allocated(this%math_needs_to_be_done)) get_math_needs_to_be_done = this%math_needs_to_be_done
1481 end function get_math_needs_to_be_done
1493 pure logical function has_diag_id (this)
1495 has_diag_id =
allocated(this%diag_id)
1496 end function has_diag_id
1500 pure logical function has_attributes (this)
1502 has_attributes = this%num_attributes > 0
1503 end function has_attributes
1507 pure logical function has_static (this)
1509 has_static =
allocated(this%static)
1510 end function has_static
1514 pure logical function has_registered (this)
1516 has_registered =
allocated(this%registered)
1517 end function has_registered
1521 pure logical function has_mask_variant (this)
1523 has_mask_variant =
allocated(this%mask_variant)
1524 end function has_mask_variant
1528 pure logical function has_local (this)
1530 has_local =
allocated(this%local)
1531 end function has_local
1535 pure logical function has_vartype (this)
1537 has_vartype =
allocated(this%vartype)
1538 end function has_vartype
1542 pure logical function has_varname (this)
1544 has_varname =
allocated(this%varname)
1545 end function has_varname
1549 pure logical function has_longname (this)
1551 has_longname =
allocated(this%longname)
1552 end function has_longname
1556 pure logical function has_standname (this)
1558 has_standname =
allocated(this%standname)
1559 end function has_standname
1563 pure logical function has_units (this)
1565 has_units =
allocated(this%units)
1566 end function has_units
1570 pure logical function has_modname (this)
1572 has_modname =
allocated(this%modname)
1573 end function has_modname
1577 pure logical function has_realm (this)
1579 has_realm =
allocated(this%realm)
1580 end function has_realm
1584 pure logical function has_interp_method (this)
1586 has_interp_method =
allocated(this%interp_method)
1587 end function has_interp_method
1591 pure logical function has_frequency (this)
1593 has_frequency =
allocated(this%frequency)
1594 end function has_frequency
1598 pure logical function has_tile_count (this)
1600 has_tile_count =
allocated(this%tile_count)
1601 end function has_tile_count
1605 pure logical function has_axis_ids (this)
1607 has_axis_ids =
allocated(this%axis_ids)
1608 end function has_axis_ids
1612 pure logical function has_area (this)
1614 has_area =
allocated(this%area)
1615 end function has_area
1619 pure logical function has_volume (this)
1621 has_volume =
allocated(this%volume)
1622 end function has_volume
1626 pure logical function has_missing_value (this)
1628 has_missing_value =
allocated(this%missing_value)
1629 end function has_missing_value
1633 pure logical function has_data_range (this)
1635 has_data_range =
allocated(this%data_RANGE)
1636 end function has_data_range
1640 pure logical function has_input_data_buffer (this)
1642 has_input_data_buffer =
allocated(this%input_data_buffer)
1643 end function has_input_data_buffer
1646 subroutine diag_field_add_attribute(this, att_name, att_value)
1648 character(len=*),
intent(in) :: att_name
1649 class(*),
intent(in) :: att_value(:)
1651 this%num_attributes = this%num_attributes + 1
1652 if (this%num_attributes > max_field_attributes) &
1653 call mpp_error(fatal,
"diag_field_add_attribute: Number of attributes exceeds max_field_attributes for field:"&
1654 //trim(this%varname)//
". Increase diag_manager_nml:max_field_attributes.")
1656 call this%attributes(this%num_attributes)%add(att_name, att_value)
1657 end subroutine diag_field_add_attribute
1661 function get_default_missing_value(var_type) &
1664 integer,
intent(in) :: var_type
1665 class(*),
allocatable :: rslt
1667 select case(var_type)
1669 allocate(real(kind=r4_kind) :: rslt)
1670 rslt = real(cmor_missing_value, kind=r4_kind)
1672 allocate(real(kind=r8_kind) :: rslt)
1673 rslt = real(cmor_missing_value, kind=r8_kind)
1680 PURE FUNCTION diag_field_id_from_name(this, module_name, field_name) &
1681 result(diag_field_id)
1683 CHARACTER(len=*),
INTENT(in) :: module_name
1684 CHARACTER(len=*),
INTENT(in) :: field_name
1686 integer :: diag_field_id
1689 if (this%get_varname() .eq. trim(field_name) .and. &
1690 this%get_modname() .eq. trim(module_name))
then
1691 diag_field_id = this%get_id()
1693 end function diag_field_id_from_name
1696 subroutine add_area_volume(this, area, volume)
1698 INTEGER,
optional,
INTENT(in) :: area
1699 INTEGER,
optional,
INTENT(in) :: volume
1701 if (
present(area))
then
1705 call mpp_error(fatal,
"diag_field_add_cell_measures: the area id is not valid. &
1706 &Verify that the area_id passed in to the field:"//this%varname// &
1707 " is valid and that the field is registered and in the diag_table.yaml")
1711 if (
present(volume))
then
1712 if (volume > 0)
then
1713 this%volume = volume
1715 call mpp_error(fatal,
"diag_field_add_cell_measures: the volume id is not valid. &
1716 &Verify that the volume_id passed in to the field:"//this%varname// &
1717 " is valid and that the field is registered and in the diag_table.yaml")
1721 end subroutine add_area_volume
1724 subroutine append_time_cell_methods(this, cell_methods, field_yaml)
1726 character(len=*),
intent(inout) :: cell_methods
1729 if (this%static)
then
1730 cell_methods = trim(cell_methods)//
" time: point "
1734 select case (field_yaml%get_var_reduction())
1736 cell_methods = trim(cell_methods)//
" time: point "
1738 cell_methods = trim(cell_methods)//
" time: mean"
1740 cell_methods = trim(cell_methods)//
" time: mean_pow"//int2str(field_yaml%get_pow_value())
1742 cell_methods = trim(cell_methods)//
" time: root_mean_square"
1744 cell_methods = trim(cell_methods)//
" time: max"
1746 cell_methods = trim(cell_methods)//
" time: min"
1748 cell_methods = trim(cell_methods)//
" time: mean"
1750 cell_methods = trim(cell_methods)//
" time: sum"
1752 end subroutine append_time_cell_methods
1755 subroutine dump_field_obj (this, unit_num)
1757 integer,
intent(in) :: unit_num
1760 if(
mpp_pe() .eq. mpp_root_pe())
then
1761 if(
allocated(this%file_ids))
write(unit_num, *)
'file_ids:' ,this%file_ids
1762 if(
allocated(this%diag_id))
write(unit_num, *)
'diag_id:' ,this%diag_id
1763 if(
allocated(this%static))
write(unit_num, *)
'static:' ,this%static
1764 if(
allocated(this%registered))
write(unit_num, *)
'registered:' ,this%registered
1765 if(
allocated(this%mask_variant))
write(unit_num, *)
'mask_variant:' ,this%mask_variant
1766 if(
allocated(this%do_not_log))
write(unit_num, *)
'do_not_log:' ,this%do_not_log
1767 if(
allocated(this%local))
write(unit_num, *)
'local:' ,this%local
1768 if(
allocated(this%vartype))
write(unit_num, *)
'vartype:' ,this%vartype
1769 if(
allocated(this%varname))
write(unit_num, *)
'varname:' ,this%varname
1770 if(
allocated(this%longname))
write(unit_num, *)
'longname:' ,this%longname
1771 if(
allocated(this%standname))
write(unit_num, *)
'standname:' ,this%standname
1772 if(
allocated(this%units))
write(unit_num, *)
'units:' ,this%units
1773 if(
allocated(this%modname))
write(unit_num, *)
'modname:' ,this%modname
1774 if(
allocated(this%realm))
write(unit_num, *)
'realm:' ,this%realm
1775 if(
allocated(this%interp_method))
write(unit_num, *)
'interp_method:' ,this%interp_method
1776 if(
allocated(this%tile_count))
write(unit_num, *)
'tile_count:' ,this%tile_count
1777 if(
allocated(this%axis_ids))
write(unit_num, *)
'axis_ids:' ,this%axis_ids
1778 write(unit_num, *)
'type_of_domain:' ,this%type_of_domain
1779 if(
allocated(this%area))
write(unit_num, *)
'area:' ,this%area
1780 if(
allocated(this%missing_value))
then
1781 select type(missing_val => this%missing_value)
1782 type is (real(r4_kind))
1783 write(unit_num, *)
'missing_value:', missing_val
1784 type is (real(r8_kind))
1785 write(unit_num, *)
'missing_value:' ,missing_val
1786 type is(
integer(i4_kind))
1787 write(unit_num, *)
'missing_value:' ,missing_val
1788 type is(
integer(i8_kind))
1789 write(unit_num, *)
'missing_value:' ,missing_val
1792 if(
allocated( this%data_RANGE))
then
1793 select type(drange => this%data_RANGE)
1794 type is (real(r4_kind))
1795 write(unit_num, *)
'data_RANGE:' ,drange
1796 type is (real(r8_kind))
1797 write(unit_num, *)
'data_RANGE:' ,drange
1798 type is(
integer(i4_kind))
1799 write(unit_num, *)
'data_RANGE:' ,drange
1800 type is(
integer(i8_kind))
1801 write(unit_num, *)
'data_RANGE:' ,drange
1804 write(unit_num, *)
'num_attributes:' ,this%num_attributes
1805 if(
allocated(this%attributes))
then
1806 do i=1, this%num_attributes
1807 if(
allocated(this%attributes(i)%att_value))
then
1808 select type( val => this%attributes(i)%att_value)
1809 type is (real(r8_kind))
1810 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1811 type is (real(r4_kind))
1812 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1813 type is (
integer(i4_kind))
1814 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1815 type is (
integer(i8_kind))
1816 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1828 function get_starting_compute_domain(axis_ids, diag_axis) &
1829 result(compute_domain)
1830 integer,
intent(in) :: axis_ids(:)
1833 integer :: compute_domain(4)
1835 integer :: compute_idx(2)
1839 axis_loop:
do a = 1,
size(axis_ids)
1840 select type (axis => diag_axis(axis_ids(a))%axis)
1842 call axis%get_compute_domain(compute_idx, dummy)
1843 if ( compute_idx(1) .ne. diag_null) compute_domain(a) = compute_idx(1)
1846 end function get_starting_compute_domain
1849 pure function get_file_ids(this)
1851 integer,
allocatable :: get_file_ids(:)
1852 get_file_ids = this%file_ids
1857 function get_mask(this)
1859 logical,
pointer :: get_mask(:,:,:,:)
1860 get_mask => this%mask
1861 end function get_mask
1865 subroutine allocate_mask(this, mask_in, omp_axis)
1867 logical,
intent(in) :: mask_in(:,:,:,:)
1869 integer :: axis_num, length(4)
1870 integer,
pointer :: id_num
1872 if(.not.
present(omp_axis))
then
1873 allocate(this%mask(
size(mask_in,1),
size(mask_in,2),
size(mask_in,3), &
1878 do axis_num=1,
size(this%axis_ids)
1879 id_num => this%axis_ids(axis_num)
1880 select type(axis => omp_axis(id_num)%axis)
1882 length(axis_num) = axis%axis_length()
1885 allocate(this%mask(length(1), length(2), length(3), length(4)))
1887 end subroutine allocate_mask
1890 subroutine set_mask(this, mask_in, field_info, is, js, ks, ie, je, ke)
1892 logical,
intent(in) :: mask_in(:,:,:,:)
1893 character(len=*),
intent(in) :: field_info
1894 integer,
optional,
intent(in) :: is, js, ks, ie, je, ke
1895 if(
present(is))
then
1896 if(is .lt. lbound(this%mask,1) .or. ie .gt. ubound(this%mask,1) .or. &
1897 js .lt. lbound(this%mask,2) .or. je .gt. ubound(this%mask,2) .or. &
1898 ks .lt. lbound(this%mask,3) .or. ke .gt. ubound(this%mask,3))
then
1899 print *,
"PE:", int2str(
mpp_pe()),
"The size of the mask is", &
1901 "But the indices passed in are is=", int2str(is),
" ie=", int2str(ie),&
1902 " js=", int2str(js),
" je=", int2str(je), &
1903 " ks=", int2str(ks),
" ke=", int2str(ke), &
1904 " ", trim(field_info)
1905 call mpp_error(fatal,
"set_mask:: given indices out of bounds for allocated mask")
1907 this%mask(is:ie, js:je, ks:ke, :) = mask_in
1911 end subroutine set_mask
1914 subroutine set_halo_present(this)
1916 this%halo_present = .true.
1917 end subroutine set_halo_present
1920 pure function is_halo_present(this)
1922 logical :: is_halo_present
1923 is_halo_present = this%halo_present
1924 end function is_halo_present
1929 function find_missing_value(this, missing_val) &
1932 class(*),
allocatable,
intent(out) :: missing_val
1933 real(r8_kind),
allocatable :: res
1936 if(this%has_missing_value())
then
1937 missing_val = this%get_missing_value(this%get_vartype())
1939 vtype = this%get_vartype()
1940 if(vtype .eq. r8)
then
1941 missing_val = cmor_missing_value
1943 missing_val = real(cmor_missing_value, r4_kind)
1947 select type(missing_val)
1948 type is (real(r8_kind))
1950 type is (real(r4_kind))
1951 res = real(missing_val, r8_kind)
1953 end function find_missing_value
1958 pure logical function has_mask_allocated(this)
1960 has_mask_allocated =
allocated(this%mask)
1961 end function has_mask_allocated
1965 pure function is_variable_in_file(this, file_id) &
1968 integer,
intent(in) :: file_id
1974 if (any(this%file_ids .eq. file_id)) res = .true.
1975 end function is_variable_in_file
1979 function get_field_file_name(this) &
1982 character(len=:),
allocatable :: res
1984 res = this%diag_field(1)%get_var_fname()
1985 end function get_field_file_name
1988 subroutine generate_associated_files_att(this, att, start_time)
1990 character(len=*),
intent(inout) :: att
1991 type(
time_type),
intent(in) :: start_time
1993 character(len=:),
allocatable :: field_name
1994 character(len=FMS_FILE_LEN) :: file_name
1995 character(len=128) :: start_date
1997 integer :: year, month, day, hour, minute, second
1998 field_name = this%get_varname(to_write = .true.)
2002 if (index(att, field_name) .ne. 0)
return
2004 file_name = this%get_field_file_name()
2006 if (prepend_date)
then
2007 call get_date(start_time, year, month, day, hour, minute, second)
2008 write (start_date,
'(1I20.4, 2I2.2)') year, month, day
2009 file_name = trim(adjustl(start_date))//
'.'//trim(file_name)
2012 att = trim(att)//
" "//trim(field_name)//
": "//trim(file_name)//
".nc"
2013 end subroutine generate_associated_files_att
2017 function check_for_slices(field, diag_axis, var_size) &
2021 integer,
intent(in) :: var_size(:)
2028 if (.not. field%has_axis_ids())
then
2032 do i = 1,
size(field%axis_ids)
2033 select type (axis_obj => diag_axis(field%axis_ids(i))%axis)
2035 if (axis_obj%axis_length() .ne. var_size(i))
then
2043 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 within the given file Example usage:
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.
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