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=i4_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 function get_varname (this, filename, to_write) &
812 character(len=*),
optional,
intent(in) :: filename
813 logical,
optional,
intent(in) :: to_write
814 character(len=:),
allocatable :: rslt
821 if (
present(to_write))
then
823 if (.not.
present(filename))
then
824 call mpp_error(fatal,
"get_varname was called using the to_write optional argument, "//&
825 "but a filename was not provided!")
828 do i = 1,
size(this%diag_field)
829 if (trim(filename) .eq. trim(this%diag_field(i)%get_var_fname()))
then
830 rslt = this%diag_field(i)%get_var_outname()
837 end function get_varname
841 pure function get_longname (this) &
844 character(len=:),
allocatable :: rslt
845 if (
allocated(this%longname))
then
848 rslt = diag_null_string
850 end function get_longname
854 pure function get_standname (this) &
857 character(len=:),
allocatable :: rslt
858 if (
allocated(this%standname))
then
859 rslt = this%standname
861 rslt = diag_null_string
863 end function get_standname
867 pure function get_units (this) &
870 character(len=:),
allocatable :: rslt
871 if (
allocated(this%units))
then
874 rslt = diag_null_string
876 end function get_units
880 pure function get_modname (this) &
883 character(len=:),
allocatable :: rslt
884 if (
allocated(this%modname))
then
887 rslt = diag_null_string
889 end function get_modname
893 pure function get_realm (this) &
896 character(len=:),
allocatable :: rslt
897 if (
allocated(this%realm))
then
900 rslt = diag_null_string
902 end function get_realm
906 pure function get_interp_method (this) &
909 character(len=:),
allocatable :: rslt
910 if (
allocated(this%interp_method))
then
911 rslt = this%interp_method
913 rslt = diag_null_string
915 end function get_interp_method
919 pure function get_frequency (this) &
922 integer,
allocatable,
dimension (:) :: rslt
923 if (
allocated(this%frequency))
then
924 allocate (rslt(
size(this%frequency)))
925 rslt = this%frequency
930 end function get_frequency
934 pure function get_tile_count (this) &
938 if (
allocated(this%tile_count))
then
939 rslt = this%tile_count
943 end function get_tile_count
947 pure function get_area (this) &
951 if (
allocated(this%area))
then
956 end function get_area
960 pure function get_volume (this) &
964 if (
allocated(this%volume))
then
969 end function get_volume
976 function get_missing_value (this, var_type) &
979 integer,
intent(in) :: var_type
982 class(*),
allocatable :: rslt
984 if (.not.
allocated(this%missing_value))
then
986 "The missing value is not allocated", fatal)
991 select case (var_type)
993 allocate (real(kind=r4_kind) :: rslt)
994 select type (miss => this%missing_value)
995 type is (real(kind=r4_kind))
997 type is (real(kind=r4_kind))
998 rslt = real(miss, kind=r4_kind)
1000 type is (real(kind=r8_kind))
1002 type is (real(kind=r4_kind))
1003 rslt = real(miss, kind=r4_kind)
1007 allocate (real(kind=r8_kind) :: rslt)
1008 select type (miss => this%missing_value)
1009 type is (real(kind=r4_kind))
1011 type is (real(kind=r8_kind))
1012 rslt = real(miss, kind=r8_kind)
1014 type is (real(kind=r8_kind))
1016 type is (real(kind=r8_kind))
1017 rslt = real(miss, kind=r8_kind)
1022 end function get_missing_value
1029 function get_data_range (this, var_type) &
1032 integer,
intent(in) :: var_type
1034 class(*),
allocatable :: rslt(:)
1036 if ( .not.
allocated(this%data_RANGE))
call mpp_error (
"get_data_RANGE", &
1037 "The data_RANGE value is not allocated", fatal)
1041 select case (var_type)
1043 allocate (real(kind=r4_kind) :: rslt(2))
1044 select type (r => this%data_RANGE)
1045 type is (real(kind=r4_kind))
1047 type is (real(kind=r4_kind))
1048 rslt = real(r, kind=r4_kind)
1050 type is (real(kind=r8_kind))
1052 type is (real(kind=r4_kind))
1053 rslt = real(r, kind=r4_kind)
1057 allocate (real(kind=r8_kind) :: rslt(2))
1058 select type (r => this%data_RANGE)
1059 type is (real(kind=r4_kind))
1061 type is (real(kind=r8_kind))
1062 rslt = real(r, kind=r8_kind)
1064 type is (real(kind=r8_kind))
1066 type is (real(kind=r8_kind))
1067 rslt = real(r, kind=r8_kind)
1071 end function get_data_range
1075 function get_axis_id (this) &
1078 integer,
pointer,
dimension(:) :: rslt
1080 if(
allocated(this%axis_ids))
then
1081 rslt => this%axis_ids
1085 end function get_axis_id
1089 function get_domain (this) &
1094 if (
associated(this%domain))
then
1100 end function get_domain
1104 pure function get_type_of_domain (this) &
1109 rslt = this%type_of_domain
1110 end function get_type_of_domain
1113 subroutine set_file_ids(this, file_ids)
1115 integer,
intent(in) :: file_ids(:)
1117 allocate(this%file_ids(
size(file_ids)))
1118 this%file_ids = file_ids
1119 end subroutine set_file_ids
1123 pure function get_var_skind(this, field_yaml) &
1128 character(len=:),
allocatable :: rslt
1132 var_kind = field_yaml%get_var_kind()
1133 select case (var_kind)
1144 end function get_var_skind
1148 pure function get_multiple_send_data(this) &
1152 rslt = this%multiple_send_data
1153 end function get_multiple_send_data
1157 pure function get_longname_to_write(this, field_yaml) &
1162 character(len=:),
allocatable :: rslt
1164 rslt = field_yaml%get_var_longname()
1165 if (rslt .eq.
"")
then
1167 rslt = this%get_longname()
1171 if (rslt .eq.
"")
then
1173 rslt = field_yaml%get_var_varname()
1175 end function get_longname_to_write
1178 subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, &
1183 character(len=*),
intent(in) :: unlim_dimname
1184 character(len=120),
allocatable,
intent(out) :: dimnames(:)
1186 logical,
intent(in) :: is_regional
1187 integer,
intent(in) :: file_axis_ids(:)
1192 character(len=23) :: diurnal_axis_name
1194 if (this%is_static())
then
1195 naxis =
size(this%axis_ids)
1197 naxis =
size(this%axis_ids) + 1
1200 if (field_yaml%has_n_diurnal())
then
1204 allocate(dimnames(naxis))
1207 if (field_yaml%has_var_zbounds())
then
1208 do i = 1,
size(this%axis_ids)
1209 axis_ptr => diag_axis(this%axis_ids(i))
1210 if (axis_ptr%axis%is_z_axis())
then
1213 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)
1217 do i = 1,
size(this%axis_ids)
1218 axis_ptr => diag_axis(this%axis_ids(i))
1219 dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)
1224 if (field_yaml%has_n_diurnal())
then
1225 WRITE (diurnal_axis_name,
'(a,i2.2)')
'time_of_day_', field_yaml%get_n_diurnal()
1226 dimnames(naxis - 1) = trim(diurnal_axis_name)
1230 if (.not. this%is_static()) dimnames(naxis) = unlim_dimname
1232 end subroutine get_dimnames
1236 subroutine register_field_wrap(fms2io_fileobj, varname, vartype, dimensions, chunksizes)
1237 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1238 character(len=*),
INTENT(IN) :: varname
1239 character(len=*),
INTENT(IN) :: vartype
1240 character(len=*),
optional,
INTENT(IN) :: dimensions(:)
1241 integer,
optional,
INTENT(IN) :: chunksizes(:)
1244 select type(fms2io_fileobj)
1245 type is (fmsnetcdffile_t)
1246 call register_field(fms2io_fileobj, varname, vartype, dimensions)
1247 type is (fmsnetcdfdomainfile_t)
1248 call register_field(fms2io_fileobj, varname, vartype, dimensions, chunksizes=chunksizes)
1249 type is (fmsnetcdfunstructureddomainfile_t)
1250 call register_field(fms2io_fileobj, varname, vartype, dimensions)
1252 end subroutine register_field_wrap
1255 subroutine write_field_metadata(this, fms2io_fileobj, file_id, yaml_id, diag_axis, unlim_dimname, is_regional, &
1256 cell_measures, use_collective_writes, file_axis_ids)
1258 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1259 integer,
intent(in) :: file_id
1260 integer,
intent(in) :: yaml_id
1262 character(len=*),
intent(in) :: unlim_dimname
1263 logical,
intent(in) :: is_regional
1264 character(len=*),
intent(in) :: cell_measures
1265 logical,
intent(in) :: use_collective_writes
1267 integer,
intent(in) :: file_axis_ids(:)
1270 character(len=:),
allocatable :: var_name
1271 character(len=:),
allocatable :: long_name
1272 character(len=:),
allocatable :: units
1273 character(len=120),
allocatable :: dimnames(:)
1274 character(len=120) :: cell_methods
1276 character (len=MAX_STR_LEN),
allocatable :: yaml_field_attributes(:,:)
1277 character(len=:),
allocatable :: interp_method_tmp
1278 integer :: interp_method_len
1280 integer,
allocatable :: chunksizes(:)
1282 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
1283 var_name = field_yaml%get_var_outname()
1285 if (
allocated(this%axis_ids))
then
1286 call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, file_axis_ids)
1289 if ((use_collective_writes .and.
size(this%axis_ids) >= 2) .or. field_yaml%has_chunksizes())
then
1290 chunksizes = this%get_chunksizes(diag_axis, field_yaml)
1291 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), dimnames, &
1292 chunksizes = chunksizes)
1294 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), dimnames)
1297 if (this%is_static())
then
1298 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml))
1302 call register_field_wrap(fms2io_fileobj, var_name, this%get_var_skind(field_yaml), (/unlim_dimname/))
1306 long_name = this%get_longname_to_write(field_yaml)
1307 call register_variable_attribute(fms2io_fileobj, var_name,
"long_name", long_name, str_len=len_trim(long_name))
1309 units = this%get_units()
1310 if (units .ne. diag_null_string) &
1311 call register_variable_attribute(fms2io_fileobj, var_name,
"units", units, str_len=len_trim(units))
1313 if (this%has_missing_value())
then
1314 call register_variable_attribute(fms2io_fileobj, var_name,
"missing_value", &
1315 this%get_missing_value(field_yaml%get_var_kind()))
1316 call register_variable_attribute(fms2io_fileobj, var_name,
"_FillValue", &
1317 this%get_missing_value(field_yaml%get_var_kind()))
1319 call register_variable_attribute(fms2io_fileobj, var_name,
"missing_value", &
1320 get_default_missing_value(field_yaml%get_var_kind()))
1321 call register_variable_attribute(fms2io_fileobj, var_name,
"_FillValue", &
1322 get_default_missing_value(field_yaml%get_var_kind()))
1325 if (this%has_data_RANGE())
then
1326 call register_variable_attribute(fms2io_fileobj, var_name,
"valid_range", &
1327 this%get_data_range(field_yaml%get_var_kind()))
1330 if (this%has_interp_method())
then
1331 interp_method_tmp = this%interp_method
1332 interp_method_len = len_trim(interp_method_tmp)
1333 call register_variable_attribute(fms2io_fileobj, var_name,
"interp_method", interp_method_tmp, &
1334 str_len=interp_method_len)
1340 do i = 1, this%num_attributes
1341 call this%attributes(i)%write_metadata(fms2io_fileobj, var_name, &
1342 cell_methods=cell_methods)
1346 call this%append_time_cell_methods(cell_methods, field_yaml)
1347 if (trim(cell_methods) .ne.
"") &
1348 call register_variable_attribute(fms2io_fileobj, var_name,
"cell_methods", &
1349 trim(adjustl(cell_methods)), str_len=len_trim(adjustl(cell_methods)))
1354 if (trim(cell_measures) .ne.
"") &
1355 call register_variable_attribute(fms2io_fileobj, var_name,
"cell_measures", &
1356 trim(adjustl(cell_measures)), str_len=len_trim(adjustl(cell_measures)))
1359 if (this%has_standname()) &
1360 call register_variable_attribute(fms2io_fileobj, var_name,
"standard_name", &
1361 trim(this%get_standname()), str_len=len_trim(this%get_standname()))
1363 call this%write_coordinate_attribute(fms2io_fileobj, var_name, diag_axis)
1365 if (field_yaml%has_var_attributes())
then
1366 yaml_field_attributes = field_yaml%get_var_attributes()
1367 do i = 1,
size(yaml_field_attributes,1)
1368 call register_variable_attribute(fms2io_fileobj, var_name, trim(yaml_field_attributes(i,1)), &
1369 trim(yaml_field_attributes(i,2)), str_len=len_trim(yaml_field_attributes(i,2)))
1371 deallocate(yaml_field_attributes)
1373 end subroutine write_field_metadata
1381 function get_chunksizes(this, diag_axis, field_yaml) &
1388 integer,
allocatable :: chunksizes(:)
1396 ndim =
size(this%axis_ids)
1397 allocate(chunksizes(ndim + 1))
1399 if (field_yaml%has_chunksizes())
then
1400 specified_chunksizes = field_yaml%get_chunksizes()
1401 chunksizes = specified_chunksizes(1:ndim+1)
1407 select type (axis => diag_axis(this%axis_ids(i))%axis)
1409 if (axis%is_x_or_y_axis())
then
1410 call axis%get_dim_size_layout(dim_size, layout)
1411 if (mod(dim_size, layout) == 0)
then
1412 chunksizes(i) = dim_size / layout
1414 call mpp_error(fatal,
"The variable "//field_yaml%get_var_varname()//
" has a layout that is not"//&
1415 "evenly divisible by dimension size for axis "//axis%get_axis_name()//
"."&
1416 "This may lead to poor performance when using collective writes. "//&
1417 "Consider using a different layout, disabling collective writes, "//&
1418 "or specifying chunksizes manually via the diag table yaml")
1420 else if (axis%is_z_axis() .and. field_yaml%has_var_zbounds())
then
1423 chunksizes(i) = axis%axis_length()
1427 end function get_chunksizes
1431 subroutine write_coordinate_attribute (this, fms2io_fileobj, var_name, diag_axis)
1433 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
1434 character(len=*),
intent(in) :: var_name
1438 character(len = 252) :: aux_coord
1441 if (.not.
allocated(this%axis_ids))
return
1446 do i = 1,
size(this%axis_ids)
1447 select type (obj => diag_axis(this%axis_ids(i))%axis)
1449 if (obj%has_aux())
then
1450 aux_coord = trim(aux_coord)//
" "//obj%get_aux()
1455 if (trim(aux_coord) .eq.
"")
return
1457 call register_variable_attribute(fms2io_fileobj, var_name,
"coordinates", &
1458 trim(adjustl(aux_coord)), str_len=len_trim(adjustl(aux_coord)))
1460 end subroutine write_coordinate_attribute
1464 function get_data_buffer (this) &
1467 class(*),
dimension(:,:,:,:),
pointer :: rslt
1469 if (.not. this%data_buffer_is_allocated) &
1470 call mpp_error(fatal,
"The input data buffer for the field:"&
1471 //trim(this%varname)//
" was never allocated.")
1473 rslt => this%input_data_buffer%get_buffer()
1474 end function get_data_buffer
1479 function get_weight (this) &
1482 type(
real(kind=r8_kind)),
pointer :: rslt
1484 if (.not. this%data_buffer_is_allocated) &
1485 call mpp_error(fatal,
"The input data buffer for the field:"&
1486 //trim(this%varname)//
" was never allocated.")
1488 rslt => this%input_data_buffer%get_weight()
1489 end function get_weight
1493 pure logical function get_math_needs_to_be_done(this)
1495 get_math_needs_to_be_done = .false.
1496 if (
allocated(this%math_needs_to_be_done)) get_math_needs_to_be_done = this%math_needs_to_be_done
1497 end function get_math_needs_to_be_done
1509 pure logical function has_diag_id (this)
1511 has_diag_id =
allocated(this%diag_id)
1512 end function has_diag_id
1516 pure logical function has_attributes (this)
1518 has_attributes = this%num_attributes > 0
1519 end function has_attributes
1523 pure logical function has_static (this)
1525 has_static =
allocated(this%static)
1526 end function has_static
1530 pure logical function has_registered (this)
1532 has_registered =
allocated(this%registered)
1533 end function has_registered
1537 pure logical function has_mask_variant (this)
1539 has_mask_variant =
allocated(this%mask_variant)
1540 end function has_mask_variant
1544 pure logical function has_local (this)
1546 has_local =
allocated(this%local)
1547 end function has_local
1551 pure logical function has_vartype (this)
1553 has_vartype =
allocated(this%vartype)
1554 end function has_vartype
1558 pure logical function has_varname (this)
1560 has_varname =
allocated(this%varname)
1561 end function has_varname
1565 pure logical function has_longname (this)
1567 has_longname =
allocated(this%longname)
1568 end function has_longname
1572 pure logical function has_standname (this)
1574 has_standname =
allocated(this%standname)
1575 end function has_standname
1579 pure logical function has_units (this)
1581 has_units =
allocated(this%units)
1582 end function has_units
1586 pure logical function has_modname (this)
1588 has_modname =
allocated(this%modname)
1589 end function has_modname
1593 pure logical function has_realm (this)
1595 has_realm =
allocated(this%realm)
1596 end function has_realm
1600 pure logical function has_interp_method (this)
1602 has_interp_method =
allocated(this%interp_method)
1603 end function has_interp_method
1607 pure logical function has_frequency (this)
1609 has_frequency =
allocated(this%frequency)
1610 end function has_frequency
1614 pure logical function has_tile_count (this)
1616 has_tile_count =
allocated(this%tile_count)
1617 end function has_tile_count
1621 pure logical function has_axis_ids (this)
1623 has_axis_ids =
allocated(this%axis_ids)
1624 end function has_axis_ids
1628 pure logical function has_area (this)
1630 has_area =
allocated(this%area)
1631 end function has_area
1635 pure logical function has_volume (this)
1637 has_volume =
allocated(this%volume)
1638 end function has_volume
1642 pure logical function has_missing_value (this)
1644 has_missing_value =
allocated(this%missing_value)
1645 end function has_missing_value
1649 pure logical function has_data_range (this)
1651 has_data_range =
allocated(this%data_RANGE)
1652 end function has_data_range
1656 pure logical function has_input_data_buffer (this)
1658 has_input_data_buffer =
allocated(this%input_data_buffer)
1659 end function has_input_data_buffer
1662 subroutine diag_field_add_attribute(this, att_name, att_value)
1664 character(len=*),
intent(in) :: att_name
1665 class(*),
intent(in) :: att_value(:)
1667 this%num_attributes = this%num_attributes + 1
1668 if (this%num_attributes > max_field_attributes) &
1669 call mpp_error(fatal,
"diag_field_add_attribute: Number of attributes exceeds max_field_attributes for field:"&
1670 //trim(this%varname)//
". Increase diag_manager_nml:max_field_attributes.")
1672 call this%attributes(this%num_attributes)%add(att_name, att_value)
1673 end subroutine diag_field_add_attribute
1677 function get_default_missing_value(var_type) &
1680 integer,
intent(in) :: var_type
1681 class(*),
allocatable :: rslt
1683 select case(var_type)
1685 allocate(real(kind=r4_kind) :: rslt)
1686 rslt = real(cmor_missing_value, kind=r4_kind)
1688 allocate(real(kind=r8_kind) :: rslt)
1689 rslt = real(cmor_missing_value, kind=r8_kind)
1696 FUNCTION diag_field_id_from_name(this, module_name, field_name) &
1697 result(diag_field_id)
1699 CHARACTER(len=*),
INTENT(in) :: module_name
1700 CHARACTER(len=*),
INTENT(in) :: field_name
1702 integer :: diag_field_id
1705 if (this%get_varname() .eq. trim(field_name) .and. &
1706 this%get_modname() .eq. trim(module_name))
then
1707 diag_field_id = this%get_id()
1709 end function diag_field_id_from_name
1712 subroutine add_area_volume(this, area, volume)
1714 INTEGER,
optional,
INTENT(in) :: area
1715 INTEGER,
optional,
INTENT(in) :: volume
1717 if (
present(area))
then
1721 call mpp_error(fatal,
"diag_field_add_cell_measures: the area id is not valid. &
1722 &Verify that the area_id passed in to the field:"//this%varname// &
1723 " is valid and that the field is registered and in the diag_table.yaml")
1727 if (
present(volume))
then
1728 if (volume > 0)
then
1729 this%volume = volume
1731 call mpp_error(fatal,
"diag_field_add_cell_measures: the volume id is not valid. &
1732 &Verify that the volume_id passed in to the field:"//this%varname// &
1733 " is valid and that the field is registered and in the diag_table.yaml")
1737 end subroutine add_area_volume
1740 subroutine append_time_cell_methods(this, cell_methods, field_yaml)
1742 character(len=*),
intent(inout) :: cell_methods
1745 if (this%static)
then
1746 cell_methods = trim(cell_methods)//
" time: point "
1750 select case (field_yaml%get_var_reduction())
1752 cell_methods = trim(cell_methods)//
" time: point "
1754 cell_methods = trim(cell_methods)//
" time: mean"
1756 cell_methods = trim(cell_methods)//
" time: mean_pow"//int2str(field_yaml%get_pow_value())
1758 cell_methods = trim(cell_methods)//
" time: root_mean_square"
1760 cell_methods = trim(cell_methods)//
" time: max"
1762 cell_methods = trim(cell_methods)//
" time: min"
1764 cell_methods = trim(cell_methods)//
" time: mean"
1766 cell_methods = trim(cell_methods)//
" time: sum"
1768 end subroutine append_time_cell_methods
1771 subroutine dump_field_obj (this, unit_num)
1773 integer,
intent(in) :: unit_num
1776 if(
mpp_pe() .eq. mpp_root_pe())
then
1777 if(
allocated(this%file_ids))
write(unit_num, *)
'file_ids:' ,this%file_ids
1778 if(
allocated(this%diag_id))
write(unit_num, *)
'diag_id:' ,this%diag_id
1779 if(
allocated(this%static))
write(unit_num, *)
'static:' ,this%static
1780 if(
allocated(this%registered))
write(unit_num, *)
'registered:' ,this%registered
1781 if(
allocated(this%mask_variant))
write(unit_num, *)
'mask_variant:' ,this%mask_variant
1782 if(
allocated(this%do_not_log))
write(unit_num, *)
'do_not_log:' ,this%do_not_log
1783 if(
allocated(this%local))
write(unit_num, *)
'local:' ,this%local
1784 if(
allocated(this%vartype))
write(unit_num, *)
'vartype:' ,this%vartype
1785 if(
allocated(this%varname))
write(unit_num, *)
'varname:' ,this%varname
1786 if(
allocated(this%longname))
write(unit_num, *)
'longname:' ,this%longname
1787 if(
allocated(this%standname))
write(unit_num, *)
'standname:' ,this%standname
1788 if(
allocated(this%units))
write(unit_num, *)
'units:' ,this%units
1789 if(
allocated(this%modname))
write(unit_num, *)
'modname:' ,this%modname
1790 if(
allocated(this%realm))
write(unit_num, *)
'realm:' ,this%realm
1791 if(
allocated(this%interp_method))
write(unit_num, *)
'interp_method:' ,this%interp_method
1792 if(
allocated(this%tile_count))
write(unit_num, *)
'tile_count:' ,this%tile_count
1793 if(
allocated(this%axis_ids))
write(unit_num, *)
'axis_ids:' ,this%axis_ids
1794 write(unit_num, *)
'type_of_domain:' ,this%type_of_domain
1795 if(
allocated(this%area))
write(unit_num, *)
'area:' ,this%area
1796 if(
allocated(this%missing_value))
then
1797 select type(missing_val => this%missing_value)
1798 type is (real(r4_kind))
1799 write(unit_num, *)
'missing_value:', missing_val
1800 type is (real(r8_kind))
1801 write(unit_num, *)
'missing_value:' ,missing_val
1802 type is(
integer(i4_kind))
1803 write(unit_num, *)
'missing_value:' ,missing_val
1804 type is(
integer(i8_kind))
1805 write(unit_num, *)
'missing_value:' ,missing_val
1808 if(
allocated( this%data_RANGE))
then
1809 select type(drange => this%data_RANGE)
1810 type is (real(r4_kind))
1811 write(unit_num, *)
'data_RANGE:' ,drange
1812 type is (real(r8_kind))
1813 write(unit_num, *)
'data_RANGE:' ,drange
1814 type is(
integer(i4_kind))
1815 write(unit_num, *)
'data_RANGE:' ,drange
1816 type is(
integer(i8_kind))
1817 write(unit_num, *)
'data_RANGE:' ,drange
1820 write(unit_num, *)
'num_attributes:' ,this%num_attributes
1821 if(
allocated(this%attributes))
then
1822 do i=1, this%num_attributes
1823 if(
allocated(this%attributes(i)%att_value))
then
1824 select type( val => this%attributes(i)%att_value)
1825 type is (real(r8_kind))
1826 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1827 type is (real(r4_kind))
1828 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1829 type is (
integer(i4_kind))
1830 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1831 type is (
integer(i8_kind))
1832 write(unit_num, *)
'attribute name', this%attributes(i)%att_name,
'val:', val
1844 function get_starting_compute_domain(axis_ids, diag_axis) &
1845 result(compute_domain)
1846 integer,
intent(in) :: axis_ids(:)
1849 integer :: compute_domain(4)
1851 integer :: compute_idx(2)
1855 axis_loop:
do a = 1,
size(axis_ids)
1856 select type (axis => diag_axis(axis_ids(a))%axis)
1858 call axis%get_compute_domain(compute_idx, dummy)
1859 if ( compute_idx(1) .ne. diag_null) compute_domain(a) = compute_idx(1)
1862 end function get_starting_compute_domain
1865 pure function get_file_ids(this)
1867 integer,
allocatable :: get_file_ids(:)
1868 get_file_ids = this%file_ids
1873 function get_mask(this)
1875 logical,
pointer :: get_mask(:,:,:,:)
1876 get_mask => this%mask
1877 end function get_mask
1881 subroutine allocate_mask(this, mask_in, omp_axis)
1883 logical,
intent(in) :: mask_in(:,:,:,:)
1885 integer :: axis_num, length(4)
1886 integer,
pointer :: id_num
1888 if(.not.
present(omp_axis))
then
1889 allocate(this%mask(
size(mask_in,1),
size(mask_in,2),
size(mask_in,3), &
1894 do axis_num=1,
size(this%axis_ids)
1895 id_num => this%axis_ids(axis_num)
1896 select type(axis => omp_axis(id_num)%axis)
1898 length(axis_num) = axis%axis_length()
1901 allocate(this%mask(length(1), length(2), length(3), length(4)))
1903 end subroutine allocate_mask
1906 subroutine set_mask(this, mask_in, field_info, is, js, ks, ie, je, ke)
1908 logical,
intent(in) :: mask_in(:,:,:,:)
1909 character(len=*),
intent(in) :: field_info
1910 integer,
optional,
intent(in) :: is, js, ks, ie, je, ke
1911 if(
present(is))
then
1912 if(is .lt. lbound(this%mask,1) .or. ie .gt. ubound(this%mask,1) .or. &
1913 js .lt. lbound(this%mask,2) .or. je .gt. ubound(this%mask,2) .or. &
1914 ks .lt. lbound(this%mask,3) .or. ke .gt. ubound(this%mask,3))
then
1915 print *,
"PE:", int2str(
mpp_pe()),
"The size of the mask is", &
1917 "But the indices passed in are is=", int2str(is),
" ie=", int2str(ie),&
1918 " js=", int2str(js),
" je=", int2str(je), &
1919 " ks=", int2str(ks),
" ke=", int2str(ke), &
1920 " ", trim(field_info)
1921 call mpp_error(fatal,
"set_mask:: given indices out of bounds for allocated mask")
1923 this%mask(is:ie, js:je, ks:ke, :) = mask_in
1927 end subroutine set_mask
1930 subroutine set_halo_present(this)
1932 this%halo_present = .true.
1933 end subroutine set_halo_present
1936 pure function is_halo_present(this)
1938 logical :: is_halo_present
1939 is_halo_present = this%halo_present
1940 end function is_halo_present
1945 function find_missing_value(this, missing_val) &
1948 class(*),
allocatable,
intent(out) :: missing_val
1949 real(r8_kind),
allocatable :: res
1952 if(this%has_missing_value())
then
1953 missing_val = this%get_missing_value(this%get_vartype())
1955 vtype = this%get_vartype()
1956 if(vtype .eq. r8)
then
1957 missing_val = cmor_missing_value
1959 missing_val = real(cmor_missing_value, r4_kind)
1963 select type(missing_val)
1964 type is (real(r8_kind))
1966 type is (real(r4_kind))
1967 res = real(missing_val, r8_kind)
1969 end function find_missing_value
1974 pure logical function has_mask_allocated(this)
1976 has_mask_allocated =
allocated(this%mask)
1977 end function has_mask_allocated
1981 pure function is_variable_in_file(this, file_id) &
1984 integer,
intent(in) :: file_id
1990 if (any(this%file_ids .eq. file_id)) res = .true.
1991 end function is_variable_in_file
1995 function get_field_file_name(this) &
1998 character(len=:),
allocatable :: res
2000 res = this%diag_field(1)%get_var_fname()
2001 end function get_field_file_name
2004 subroutine generate_associated_files_att(this, att, start_time)
2006 character(len=*),
intent(inout) :: att
2007 type(
time_type),
intent(in) :: start_time
2009 character(len=:),
allocatable :: field_name
2010 character(len=FMS_FILE_LEN) :: file_name
2011 character(len=128) :: start_date
2013 integer :: year, month, day, hour, minute, second
2015 file_name = this%get_field_file_name()
2016 field_name = this%get_varname(to_write = .true., filename=file_name)
2020 if (index(att, field_name) .ne. 0)
return
2022 if (prepend_date)
then
2023 call get_date(start_time, year, month, day, hour, minute, second)
2024 write (start_date,
'(1I20.4, 2I2.2)') year, month, day
2025 file_name = trim(adjustl(start_date))//
'.'//trim(file_name)
2028 att = trim(att)//
" "//trim(field_name)//
": "//trim(file_name)//
".nc"
2029 end subroutine generate_associated_files_att
2033 function check_for_slices(field, diag_axis, var_size) &
2037 integer,
intent(in) :: var_size(:)
2044 if (.not. field%has_axis_ids())
then
2048 do i = 1,
size(field%axis_ids)
2049 select type (axis_obj => diag_axis(field%axis_ids(i))%axis)
2051 if (axis_obj%axis_length() .ne. var_size(i))
then
2059 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.
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