19module fms_diag_object_mod
20use mpp_mod,
only: fatal, note, warning,
mpp_error, mpp_pe, mpp_root_pe, stdout
21use diag_data_mod,
only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, &
28 &
OPERATOR(<),
OPERATOR(==),
OPERATOR(/=),
OPERATOR(/),
OPERATOR(+),
ASSIGNMENT(=),
get_date, &
32use fms_diag_field_object_mod,
only:
fmsdiagfield_type, fms_diag_fields_object_init, get_default_missing_value, &
41use fms_mod,
only: fms_error_handler
43use constants_mod,
only: seconds_per_day
50use fms_string_utils_mod,
only:
string
64 logical,
private :: data_was_send
66 integer,
private :: registered_buffers = 0
68 integer,
private :: registered_variables
69 integer,
private :: registered_axis
70 logical,
private :: initialized=.false.
71 logical,
private :: files_initialized=.false.
72 logical,
private :: fields_initialized=.false.
73 logical,
private :: buffers_initialized=.false.
74 logical,
private :: axes_initialized=.false.
79 procedure :: init => fms_diag_object_init
80 procedure :: diag_end => fms_diag_object_end
81 procedure :: fms_register_diag_field_scalar
82 procedure :: fms_register_diag_field_array
83 procedure :: fms_register_static_field
84 procedure :: fms_diag_axis_init
85 procedure :: register => fms_register_diag_field_obj
86 procedure :: fms_diag_field_add_attribute
87 procedure :: fms_diag_axis_add_attribute
88 procedure :: fms_get_domain2d
89 procedure :: fms_get_axis_length
90 procedure :: fms_get_diag_field_id_from_name
91 procedure :: fms_get_field_name_from_id
92 procedure :: fms_get_axis_name_from_id
93 procedure :: fms_diag_accept_data
94 procedure :: fms_diag_send_complete
95 procedure :: do_buffer_math
96 procedure :: fms_diag_do_io
97 procedure :: fms_diag_do_reduction
98 procedure :: fms_diag_field_add_cell_measures
99 procedure :: allocate_diag_field_output_buffers
100 procedure :: fms_diag_compare_window
101 procedure :: set_time_end
102 procedure :: write_diag_manifest
104 procedure :: get_diag_buffer
110public :: fms_register_diag_field_obj
111public :: fms_register_diag_field_scalar
112public :: fms_register_diag_field_array
113public :: fms_register_static_field
114public :: fms_diag_field_add_attribute
115public :: fms_get_diag_field_id_from_name
116public :: fms_diag_object
118integer,
private :: registered_variables
119public :: dump_diag_obj
127subroutine fms_diag_object_init (this,diag_subset_output, time_init)
129 integer :: diag_subset_output
130 INTEGER,
DIMENSION(6),
OPTIONAL,
INTENT(IN) :: time_init
133 if (this%initialized)
return
140 if (.not.
present(time_init))
then
145 this%files_initialized = fms_diag_files_object_init(this%FMS_diag_files)
146 this%fields_initialized = fms_diag_fields_object_init(this%FMS_diag_fields)
147 this%buffers_initialized =fms_diag_output_buffer_init(this%FMS_diag_output_buffers,
SIZE(diag_yaml%get_diag_fields()))
148 this%registered_variables = 0
149 this%registered_axis = 0
150 this%data_was_send = .false.
151 this%initialized = .true.
154 "You must compile with -Duse_yaml to use the option use_modern_diag", fatal)
156end subroutine fms_diag_object_init
159subroutine write_diag_manifest(this)
162 integer,
allocatable :: ntimes(:)
163 integer,
allocatable :: ntiles(:)
164 integer,
allocatable :: ndistributedfiles(:)
170 nfiles =
size(this%FMS_diag_files)
171 allocate(ntimes(nfiles))
172 allocate(ntiles(nfiles))
173 allocate(ndistributedfiles(nfiles))
175 do i = 1,
size(this%FMS_diag_files)
176 ntimes(i) = this%FMS_diag_files(i)%get_num_time_levels()
177 ntiles(i) = this%FMS_diag_files(i)%get_num_tiles()
178 ndistributedfiles(i) = this%FMS_diag_files(i)%get_ndistributedfiles()
183 call mpp_error(fatal,
"You must compile with -Duse_yaml to call fms_diag_object%write_diag_manifest!")
186end subroutine write_diag_manifest
192subroutine fms_diag_object_end (this, time)
199 if (.not. this%initialized)
return
201 call this%do_buffer_math()
202 call this%fms_diag_do_io(
end_time=time)
204 call this%write_diag_manifest()
207 do i=1,
size(this%FMS_diag_output_buffers)
208 call this%FMS_diag_output_buffers(i)%flush_buffer()
210 deallocate(this%FMS_diag_output_buffers)
212 this%initialized = .false.
215 call mpp_error(fatal,
"You can not call fms_diag_object%end without yaml")
217end subroutine fms_diag_object_end
223integer function fms_register_diag_field_obj &
224 (this, modname, varname, axes, init_time, &
225 longname, units, missing_value, varrange, mask_variant, standname, &
226 do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static, &
230 CHARACTER(len=*),
INTENT(in) :: modname
231 CHARACTER(len=*),
INTENT(in) :: varname
232 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
233 INTEGER,
TARGET,
OPTIONAL,
INTENT(in) :: axes(:)
234 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: longname
235 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
236 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standname
237 class(*),
OPTIONAL,
INTENT(in) :: missing_value
238 class(*),
OPTIONAL,
INTENT(in) :: varrange(2)
239 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
240 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
241 CHARACTER(len=*),
OPTIONAL,
INTENT(out) :: err_msg
242 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
246 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
247 INTEGER,
OPTIONAL,
INTENT(in) :: area
248 INTEGER,
OPTIONAL,
INTENT(in) :: volume
249 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
251 LOGICAL,
OPTIONAL,
INTENT(in) :: static
252 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
261 integer,
allocatable :: file_ids(:)
263 integer,
allocatable :: diag_field_indices(:)
264 class(
diagdomain_t),
pointer :: null_diag_domain => null()
268CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
271 if (diag_field_indices(1) .eq. diag_null)
then
274 deallocate(diag_field_indices)
278 this%registered_variables = this%registered_variables + 1
279 fms_register_diag_field_obj = this%registered_variables
281 call this%FMS_diag_fields(this%registered_variables)%&
282 &setid(this%registered_variables)
285 fieldptr => this%FMS_diag_fields(this%registered_variables)
288 call fieldptr%set_file_ids(file_ids)
291 fieldptr%buffer_allocated = .false.
295 call fieldptr%register(modname, varname, diag_field_indices, this%diag_axis, &
296 axes=axes, longname=longname, units=units, missing_value=missing_value, varrange= varrange, &
297 mask_variant= mask_variant, standname=standname, do_not_log=do_not_log, err_msg=err_msg, &
298 interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
299 static=static, multiple_send_data=multiple_send_data)
302 if (
present(axes) .and.
present(init_time))
then
303 do i = 1,
size(file_ids)
304 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
305 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
306 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
307 if(fieldptr%get_type_of_domain() .eq.
no_domain)
then
308 call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
310 call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
312 call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
313 call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
314 fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
315 call fileptr%add_start_time(init_time)
316 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
318 elseif (
present(axes))
then
319 do i = 1,
size(file_ids)
320 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
321 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
322 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
323 call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
324 if(fieldptr%get_type_of_domain() .eq.
no_domain)
then
325 call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
327 call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
329 call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
330 fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
331 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
333 elseif (
present(init_time))
then
334 do i = 1,
size(file_ids)
335 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
336 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
337 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
338 call fileptr%add_start_time(init_time)
339 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
342 do i = 1,
size(file_ids)
343 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
344 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
345 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
346 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
352 do i = 1,
size(fieldptr%buffer_ids)
353 bufferptr => this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))
354 call bufferptr%set_field_id(this%registered_variables)
355 call bufferptr%set_yaml_id(fieldptr%buffer_ids(i))
357 yamlfptr => diag_yaml%diag_fields(fieldptr%buffer_ids(i))
358 if( yamlfptr%get_var_reduction() .eq.
time_diurnal)
then
359 call bufferptr%set_diurnal_sample_size(yamlfptr%get_n_diurnal())
361 call bufferptr%init_buffer_time(init_time)
362 call bufferptr%set_next_output(this%FMS_diag_files(file_ids(i))%get_next_output(), &
363 this%FMS_diag_files(file_ids(i))%get_next_next_output(), is_static=fieldptr%is_static())
368 deallocate(diag_field_indices)
370end function fms_register_diag_field_obj
375INTEGER FUNCTION fms_register_diag_field_scalar(this,module_name, field_name, init_time, &
376 & long_name, units, missing_value, var_range, standard_name, do_not_log, err_msg,&
377 & area, volume, realm, multiple_send_data)
379 CHARACTER(len=*),
INTENT(in) :: module_name
380 CHARACTER(len=*),
INTENT(in) :: field_name
381 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
382 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
383 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
384 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
385 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
386 CLASS(*),
OPTIONAL,
INTENT(in) :: var_range(:)
387 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
388 CHARACTER(len=*),
OPTIONAL,
INTENT(out):: err_msg
389 INTEGER,
OPTIONAL,
INTENT(in) :: area
390 INTEGER,
OPTIONAL,
INTENT(in) :: volume
391 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
392 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
397CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
399 fms_register_diag_field_scalar = this%register(&
400 & module_name, field_name, init_time=init_time, &
401 & longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
402 & standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
403 & area=area, volume=volume, realm=realm, multiple_send_data=multiple_send_data)
405end function fms_register_diag_field_scalar
410INTEGER FUNCTION fms_register_diag_field_array(this, module_name, field_name, axes, init_time, &
411 & long_name, units, missing_value, var_range, mask_variant, standard_name, verbose,&
412 & do_not_log, err_msg, interp_method, tile_count, area, volume, realm, &
413 & multiple_send_data)
415 CHARACTER(len=*),
INTENT(in) :: module_name
416 CHARACTER(len=*),
INTENT(in) :: field_name
417 INTEGER,
INTENT(in) :: axes(:)
418 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
419 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
420 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
421 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
422 CLASS(*),
OPTIONAL,
INTENT(in) :: var_range(:)
423 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
424 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
425 LOGICAL,
OPTIONAL,
INTENT(in) :: verbose
426 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
427 CHARACTER(len=*),
OPTIONAL,
INTENT(out):: err_msg
428 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
432 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
433 INTEGER,
OPTIONAL,
INTENT(in) :: area
434 INTEGER,
OPTIONAL,
INTENT(in) :: volume
435 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
436 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
442CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
444 fms_register_diag_field_array = this%register( &
445 & module_name, field_name, init_time=init_time, &
446 & axes=axes, longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
447 & mask_variant=mask_variant, standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
448 & interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
449 & multiple_send_data=multiple_send_data)
451end function fms_register_diag_field_array
456INTEGER FUNCTION fms_register_static_field(this, module_name, field_name, axes, long_name, units,&
457 & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,&
458 & tile_count, area, volume, realm)
460 CHARACTER(len=*),
INTENT(in) :: module_name
461 CHARACTER(len=*),
INTENT(in) :: field_name
462 INTEGER,
DIMENSION(:),
INTENT(in) :: axes
463 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
464 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
465 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
466 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
467 CLASS(*),
OPTIONAL,
INTENT(in) :: range(:)
468 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
469 LOGICAL,
OPTIONAL,
INTENT(in) :: dynamic
470 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
471 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
475 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
476 INTEGER,
OPTIONAL,
INTENT(in) :: area
478 INTEGER,
OPTIONAL,
INTENT(in) :: volume
480 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
485CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
489 if (
size(axes) .eq. 1 .and. axes(1) .eq. null_axis_id)
then
491 fms_register_static_field = this%register( &
492 & module_name, field_name, &
493 & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
494 & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
495 & standname=standard_name, area=area, volume=volume, realm=realm, &
498 fms_register_static_field = this%register( &
499 & module_name, field_name, axes=axes, &
500 & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
501 & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
502 & standname=standard_name, area=area, volume=volume, realm=realm, &
506end function fms_register_static_field
511FUNCTION fms_diag_axis_init(this, axis_name, axis_data, units, cart_name, axis_length, long_name, direction,&
512 & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position ) &
516 CHARACTER(len=*),
INTENT(in) :: axis_name
517 CLASS(*),
INTENT(in) :: axis_data(:)
518 CHARACTER(len=*),
INTENT(in) :: units
519 CHARACTER(len=1),
INTENT(in) :: cart_name
521 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: long_name
522 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: set_name
523 INTEGER,
INTENT(in),
OPTIONAL :: direction
524 INTEGER,
INTENT(in),
OPTIONAL :: edges
525 TYPE(
domain1d),
INTENT(in),
OPTIONAL :: domain
526 TYPE(
domain2d),
INTENT(in),
OPTIONAL :: domain2
527 TYPE(
domainug),
INTENT(in),
OPTIONAL :: domainu
528 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: aux
530 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: req
531 INTEGER,
INTENT(in),
OPTIONAL :: tile_count
532 INTEGER,
INTENT(in),
OPTIONAL :: domain_position
537CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
539 CHARACTER(len=:),
ALLOCATABLE :: edges_name
541 this%registered_axis = this%registered_axis + 1
544 &
"diag_axis_init: max_axes exceeded, increase via diag_manager_nml")
548 select type (axis => this%diag_axis(this%registered_axis)%axis )
550 if(
present(edges))
then
551 if (edges < 0 .or. edges > this%registered_axis) &
552 call mpp_error(fatal,
"diag_axit_init: The edge axis has not been defined. &
553 &Call diag_axis_init for the edge axis first")
554 select type (edges_axis => this%diag_axis(edges)%axis)
556 edges_name = edges_axis%get_axis_name()
557 call axis%set_edges(edges_name, edges)
560 call axis%register(axis_name, axis_data, units, cart_name, long_name=long_name, &
561 & direction=direction, set_name=set_name, domain=domain, domain2=domain2, domainu=domainu, aux=aux, &
564 id = this%registered_axis
565 call axis%set_axis_id(id)
568end function fms_diag_axis_init
577subroutine fms_diag_accept_data (this, diag_field_id, field_data, mask, rmask, &
578 time, is_in, js_in, ks_in, &
579 ie_in, je_in, ke_in, weight, err_msg)
581 INTEGER,
INTENT(in) :: diag_field_id
582 CLASS(*),
DIMENSION(:,:,:,:),
INTENT(in) :: field_data
583 LOGICAL,
allocatable,
INTENT(in) :: mask(:,:,:,:)
585 CLASS(*),
allocatable,
INTENT(in) :: rmask(:,:,:,:)
587 CLASS(*),
INTENT(in),
OPTIONAL :: weight
588 TYPE (
time_type),
INTENT(in),
OPTIONAL :: time
589 INTEGER,
INTENT(in),
OPTIONAL :: is_in, js_in, ks_in
590 INTEGER,
INTENT(in),
OPTIONAL :: ie_in, je_in, ke_in
591 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
593 integer :: is, js, ks
594 integer :: ie, je, ke
595 integer :: omp_num_threads
597 logical :: buffer_the_data
599 character(len=128) :: error_string
600 logical :: data_buffer_is_allocated
601 character(len=256) :: field_info
603 logical,
allocatable,
dimension(:,:,:,:) :: oor_mask
604 real(kind=r8_kind) :: field_weight
608 logical :: using_blocking
610CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
614 field_info =
" Check send data call for field:"//trim(this%FMS_diag_fields(diag_field_id)%get_varname())//&
615 " and module:"//trim(this%FMS_diag_fields(diag_field_id)%get_modname())
618 if (.not.this%FMS_diag_fields(diag_field_id)%is_static() .and. .not.
present(time)) &
619 call mpp_error(fatal,
"Time must be present if the field is not static. "//trim(field_info))
626 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
628 using_blocking = .false.
629 if ((
present(is_in) .and. .not.
present(ie_in)) .or. (
present(js_in) .and. .not.
present(je_in))) &
630 using_blocking = .true.
633 if ((
present(is_in) .and.
present(ie_in)) .or. (
present(js_in) .and.
present(je_in))) &
637 if (this%FMS_diag_fields(diag_field_id)%is_mask_variant())
then
638 if (.not.
allocated(mask) .and. .not.
allocated(rmask))
call mpp_error(fatal, &
639 "The field was registered with mask_variant, but mask or rmask are not present in the send_data call. "//&
644 if (
allocated(mask) .and.
allocated(rmask))
call mpp_error(fatal, &
645 "mask and rmask are both present in the send_data call. "//&
649 oor_mask =
init_mask(rmask, mask, field_data)
652 buffer_the_data = .false.
658 omp_num_threads = omp_get_num_threads()
659 omp_level = omp_get_level()
660 buffer_the_data = (omp_num_threads > 1 .AND. omp_level > 0)
668 IF (
PRESENT(is_in) ) is = is_in
669 IF (
PRESENT(js_in) ) js = js_in
670 IF (
PRESENT(ks_in) ) ks = ks_in
671 ie = is+
SIZE(field_data, 1)-1
672 je = js+
SIZE(field_data, 2)-1
673 ke = ks+
SIZE(field_data, 3)-1
674 IF (
PRESENT(ie_in) ) ie = ie_in
675 IF (
PRESENT(je_in) ) je = je_in
676 IF (
PRESENT(ke_in) ) ke = ke_in
678 if (.not. buffer_the_data .and. using_blocking)
then
681 buffer_the_data = check_for_slices(this%FMS_diag_fields(diag_field_id), this%diag_axis, &
687 if (this%FMS_diag_fields(diag_field_id)%get_multiple_send_data()) &
688 buffer_the_data = .true.
691 main_if:
if (buffer_the_data)
then
695 if (.not. this%data_was_send) this%data_was_send = .true.
699 if(has_halos)
call this%FMS_diag_fields(diag_field_id)%set_halo_present()
702 if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
703 call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
705 if (
allocated(mask) .or.
allocated(rmask))
then
706 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
708 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
711 if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated())
then
712 data_buffer_is_allocated = &
713 this%FMS_diag_fields(diag_field_id)%allocate_data_buffer(field_data, this%diag_axis)
714 if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
715 call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
717 call this%FMS_diag_fields(diag_field_id)%set_send_data_time(time)
718 call this%FMS_diag_fields(diag_field_id)%set_data_buffer_is_allocated(.true.)
719 call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.true.)
721 call this%FMS_diag_fields(diag_field_id)%set_data_buffer(field_data, oor_mask, field_weight, &
722 is, js, ks, ie, je, ke)
726 if (.not. this%data_was_send) this%data_was_send = .true.
730 if(has_halos)
call this%FMS_diag_fields(diag_field_id)%set_halo_present()
733 if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
734 call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
736 if (
allocated(mask) .or.
allocated(rmask))
then
737 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
739 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
742 error_string = bounds%set_bounds(field_data, is, ie, js, je, ks, ke, has_halos)
743 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
745 call this%allocate_diag_field_output_buffers(field_data, diag_field_id)
746 error_string = this%fms_diag_do_reduction(field_data, diag_field_id, oor_mask, field_weight, &
747 bounds, using_blocking, time=time)
748 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
749 call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.false.)
750 if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
751 call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
752 call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask, field_info)
756end subroutine fms_diag_accept_data
759subroutine do_buffer_math(this)
771 integer,
dimension(:),
allocatable :: file_field_ids
772 class(*),
pointer :: input_data_buffer(:,:,:,:)
773 character(len=128) :: error_string
775 integer,
dimension(:),
allocatable :: file_ids
776 logical,
parameter :: debug_sc = .false.
781 field_loop:
do ifield = 1,
size(this%FMS_diag_fields)
782 diag_field => this%FMS_diag_fields(ifield)
783 if(.not. diag_field%is_registered()) cycle
784 if(debug_sc)
call mpp_error(note,
"fms_diag_send_complete:: var: "//diag_field%get_varname())
786 allocate (file_ids(
size(diag_field%get_file_ids() )))
787 file_ids = diag_field%get_file_ids()
788 math = diag_field%get_math_needs_to_be_done()
790 doing_math:
if (
size(file_ids) .ge. 1 .and. math)
then
792 has_input_buff:
if (diag_field%has_input_data_buffer())
then
793 call diag_field%prepare_data_buffer()
794 input_data_buffer => diag_field%get_data_buffer()
796 call bounds%reset_bounds_from_array_4D(input_data_buffer)
797 call this%allocate_diag_field_output_buffers(input_data_buffer, ifield)
798 error_string = this%fms_diag_do_reduction(input_data_buffer, ifield, &
799 diag_field%get_mask(), diag_field%get_weight(), &
800 bounds, .false., time=diag_field%get_send_data_time())
801 call diag_field%init_data_buffer()
802 if (trim(error_string) .ne.
"")
call mpp_error(fatal,
"Field:"//trim(diag_field%get_varname()//&
803 " -"//trim(error_string)))
805 call mpp_error(fatal,
"diag_send_complete:: no input buffer allocated for field"//diag_field%get_longname())
808 call diag_field%set_math_needs_to_be_done(.false.)
810 if (
allocated(file_ids))
deallocate(file_ids)
811 if (
associated(diag_field))
nullify(diag_field)
814end subroutine do_buffer_math
818subroutine fms_diag_send_complete(this, time_step)
820 TYPE (
time_type),
INTENT(in) :: time_step
823CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
826 if (.not. this%data_was_send)
return
828 call this%do_buffer_math()
829 call this%fms_diag_do_io()
831 this%data_was_send = .false.
834end subroutine fms_diag_send_complete
840subroutine fms_diag_do_io(this, end_time)
850 integer,
allocatable :: buff_ids(:)
852 logical :: file_is_opened_this_time_step
854 logical :: force_write
855 logical :: finish_writing
857 logical,
parameter :: debug_reduct = .false.
858 class(*),
allocatable :: missing_val
859 real(r8_kind) :: mval
860 character(len=128) :: error_string
861 logical :: unlim_dim_was_increased
862 logical :: do_not_write
864 force_write = .false.
866 do i = 1,
size(this%FMS_diag_files)
867 diag_file => this%FMS_diag_files(i)
870 if (.not. diag_file%writing_on_this_pe()) cycle
876 model_time => diag_file%get_model_time()
878 if (diag_file%FMS_diag_file%is_done_writing_data()) cycle
880 call diag_file%open_diag_file(model_time, file_is_opened_this_time_step)
881 if (file_is_opened_this_time_step)
then
883 call diag_file%init_unlim_dim(this%FMS_diag_output_buffers)
885 call diag_file%write_global_metadata()
886 call diag_file%write_axis_metadata(this%diag_axis)
887 call diag_file%write_time_metadata()
888 call diag_file%write_field_metadata(this%FMS_diag_fields, this%diag_axis)
889 call diag_file%write_axis_data(this%diag_axis)
892 call diag_file%check_file_times(model_time, this%FMS_diag_output_buffers, &
893 this%FMS_diag_fields, do_not_write)
894 unlim_dim_was_increased = .false.
897 buff_ids = diag_file%FMS_diag_file%get_buffer_ids()
899 buff_loop:
do ibuff=1,
SIZE(buff_ids)
900 diag_buff => this%FMS_diag_output_buffers(buff_ids(ibuff))
901 field_yaml => diag_yaml%diag_fields(diag_buff%get_yaml_id())
902 diag_field => this%FMS_diag_fields(diag_buff%get_field_id())
905 if (.not. diag_buff%is_there_data_to_write()) cycle
906 if (diag_field%is_static() .and. diag_buff%get_unlim_dim() > 0) cycle
908 if ( diag_buff%is_time_to_finish_reduction(
end_time) .and. .not. do_not_write)
then
910 mval = diag_field%find_missing_value(missing_val)
912 if( field_yaml%has_var_reduction())
then
913 if( field_yaml%get_var_reduction() .ge.
time_average)
then
914 if(debug_reduct)
call mpp_error(note,
"fms_diag_do_io:: finishing reduction for "//diag_field%get_longname())
915 error_string = diag_buff%diag_reduction_done_wrapper( &
916 field_yaml%get_var_reduction(), &
917 mval, diag_field%get_var_is_masked(), diag_field%get_mask_variant())
920 call diag_file%write_field_data(diag_field, diag_buff, unlim_dim_was_increased)
921 call diag_buff%set_next_output(diag_file%get_next_output(), diag_file%get_next_next_output())
928 if (unlim_dim_was_increased)
then
929 call diag_file%write_time_data()
930 call diag_file%flush_diag_file()
931 call diag_file%update_next_write(model_time)
932 call diag_file%update_current_new_file_freq_index(model_time)
933 if (diag_file%is_time_to_close_file(model_time, force_write)) &
934 call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
935 this%model_end_time, diag_fields = this%FMS_diag_fields)
936 else if (force_write)
then
937 call diag_file%prepare_for_force_write()
938 call diag_file%write_time_data()
939 call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
940 this%model_end_time, diag_fields = this%FMS_diag_fields)
944end subroutine fms_diag_do_io
949function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, &
950 bounds, using_blocking, time) &
953 class(*),
intent(in) :: field_data(:,:,:,:)
954 integer,
intent(in) :: diag_field_id
955 logical,
intent(in),
target :: oor_mask(:,:,:,:)
956 real(kind=r8_kind),
intent(in) :: weight
958 logical,
intent(in) :: using_blocking
960 type(
time_type),
intent(in),
optional :: time
962 character(len=150) :: error_msg
970 integer :: reduction_method
974 integer,
pointer :: axis_ids(:)
975 logical :: is_subregional
976 logical :: reduced_k_range
983 integer :: compute_idx(2)
984 character(len=1) :: cart_axis
985 logical :: block_in_subregion
988 real(kind=r8_kind) :: missing_value
993 field_ptr => this%FMS_diag_fields(diag_field_id)
994 if (field_ptr%has_missing_value())
then
995 select type (missing_val => field_ptr%get_missing_value(
r8))
996 type is (real(kind=r8_kind))
997 missing_value = missing_val
999 call mpp_error(fatal,
"The missing value for the field:"//trim(field_ptr%get_varname())//&
1000 &
" was not allocated to the correct type. This shouldn't have happened")
1003 select type (missing_val => get_default_missing_value(
r8))
1004 type is (real(kind=r8_kind))
1005 missing_value = missing_val
1007 call mpp_error(fatal,
"The missing value for the field:"//trim(field_ptr%get_varname())//&
1008 &
" was not allocated to the correct type. This shouldn't have happened")
1012 buffer_loop:
do ids = 1,
size(field_ptr%buffer_ids)
1014 buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids)
1015 file_id = this%FMS_diag_fields(diag_field_id)%file_ids(ids)
1018 field_yaml_ptr => field_ptr%diag_field(ids)
1019 buffer_ptr => this%FMS_diag_output_buffers(buffer_id)
1020 file_ptr => this%FMS_diag_files(file_id)
1023 if (.not. file_ptr%writing_on_this_pe()) cycle
1026 if (buffer_ptr%is_done_with_math()) cycle
1028 if (
present(time))
call file_ptr%set_model_time(time)
1029 if (.not. file_ptr%time_to_start_doing_math()) cycle
1032 if (.not. using_blocking)
then
1034 call bounds_out%reset_bounds_from_array_4D(buffer_ptr%buffer(:,:,:,:,1))
1038 if (.not. bounds%has_halos)
then
1040 call bounds_in%reset_bounds_from_array_4D(field_data)
1043 is_subregional = file_ptr%is_regional()
1044 reduced_k_range = field_yaml_ptr%has_var_zbounds()
1047 is_subregional_reduced_k_range:
if (is_subregional .or. reduced_k_range)
then
1048 call buffer_ptr%get_axis_ids(axis_ids)
1049 block_in_subregion = .true.
1050 axis_loops:
do i = 1,
size(axis_ids)
1052 if (.not. block_in_subregion) cycle
1054 select type (diag_axis => this%diag_axis(axis_ids(i))%axis)
1056 sindex = diag_axis%get_starting_index()
1057 eindex = diag_axis%get_ending_index()
1058 compute_idx = diag_axis%get_compute_indices()
1059 starting=sindex-compute_idx(1)+1
1060 ending=eindex-compute_idx(1)+1
1061 if (using_blocking)
then
1063 if (.not. block_in_subregion) cycle
1066 call bounds_in%rebase_input(bounds, starting, ending, i)
1069 call bounds_out%rebase_output(starting, ending, i)
1072 call bounds_in%update_index(starting, ending, i, .false.)
1075 call bounds_out%update_index(1, ending-starting+1, i, .true.)
1081 if (.not. block_in_subregion) cycle
1082 endif is_subregional_reduced_k_range
1085 reduction_method = field_yaml_ptr%get_var_reduction()
1086 if (
present(time))
call buffer_ptr%update_buffer_time(time)
1087 call buffer_ptr%set_send_data_called()
1088 select case(reduction_method)
1090 error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1091 bounds_in, bounds_out, missing_value)
1092 if (trim(error_msg) .ne.
"")
then
1096 error_msg = buffer_ptr%do_time_min_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1097 bounds_in, bounds_out, missing_value)
1098 if (trim(error_msg) .ne.
"")
then
1102 error_msg = buffer_ptr%do_time_max_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1103 bounds_in, bounds_out, missing_value)
1104 if (trim(error_msg) .ne.
"")
then
1108 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1109 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value())
1110 if (trim(error_msg) .ne.
"")
then
1114 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1115 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1117 if (trim(error_msg) .ne.
"")
then
1121 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1122 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1123 weight=weight, pow_value=field_yaml_ptr%get_pow_value())
1124 if (trim(error_msg) .ne.
"")
then
1128 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1129 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1130 weight=weight, pow_value = 2)
1131 if (trim(error_msg) .ne.
"")
then
1135 if(.not.
present(time))
call mpp_error(fatal, &
1136 "fms_diag_do_reduction:: time must be present when using diurnal reductions")
1138 call buffer_ptr%set_diurnal_section_index(time)
1139 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1140 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1142 if (trim(error_msg) .ne.
"")
then
1146 error_msg =
"The reduction method is not supported. "//&
1147 "Only none, min, max, sum, average, power, rms, and diurnal are supported."
1150 if (field_ptr%is_static() .or. file_ptr%FMS_diag_file%is_done_writing_data())
then
1151 call buffer_ptr%set_done_with_math()
1156 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1158end function fms_diag_do_reduction
1161subroutine fms_diag_field_add_cell_measures(this, diag_field_id, area, volume)
1163 integer,
intent(in) :: diag_field_id
1164 INTEGER,
optional,
INTENT(in) :: area
1165 INTEGER,
optional,
INTENT(in) :: volume
1168 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1170 call this%FMS_diag_fields(diag_field_id)%add_area_volume(area, volume)
1172end subroutine fms_diag_field_add_cell_measures
1175subroutine fms_diag_field_add_attribute(this, diag_field_id, att_name, att_value)
1177 integer,
intent(in) :: diag_field_id
1178 character(len=*),
intent(in) :: att_name
1179 class(*),
intent(in) :: att_value(:)
1181CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1184 if ( diag_field_id .LE. 0 )
THEN
1187 if (this%FMS_diag_fields(diag_field_id)%is_registered() ) &
1188 call this%FMS_diag_fields(diag_field_id)%add_attribute(att_name, att_value)
1191end subroutine fms_diag_field_add_attribute
1194subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
1196 integer,
intent(in) :: axis_id
1197 character(len=*),
intent(in) :: att_name
1198 class(*),
intent(in) :: att_value(:)
1200 character(len=20) :: axis_names(2)
1201 character(len=20) :: set_name
1202 integer :: uncmx_ids(2)
1205CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1207 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1208 call mpp_error(fatal,
"diag_axis_add_attribute: The axis_id is not valid")
1210 select type (axis => this%diag_axis(axis_id)%axis)
1212 call axis%add_axis_attribute(att_name, att_value)
1219 if (trim(att_name) .eq.
"compress")
then
1225 if (axis%has_set_name()) set_name = axis%get_set_name()
1226 do j = 1,
size(axis_names)
1228 if (uncmx_ids(j) .eq. diag_null)
call mpp_error(fatal, &
1229 &
"Error parsing the compress attribute for axis: "//trim(axis%get_axis_name())//&
1230 &
". Be sure that the axes in the compress attribute are registered")
1232 call axis%add_structured_axis_ids(uncmx_ids)
1236end subroutine fms_diag_axis_add_attribute
1240function fms_get_field_name_from_id (this, field_id) &
1244 integer,
intent (in) :: field_id
1245 character(len=:),
allocatable :: field_name
1247 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1249 field_name = this%FMS_diag_fields(field_id)%get_varname()
1251end function fms_get_field_name_from_id
1255FUNCTION fms_get_diag_field_id_from_name(this, module_name, field_name) &
1256 result(diag_field_id)
1258 CHARACTER(len=*),
INTENT(in) :: module_name
1259 CHARACTER(len=*),
INTENT(in) :: field_name
1260 integer :: diag_field_id
1264 integer,
allocatable :: diag_field_indices(:)
1269 do i=1, this%registered_variables
1271 diag_field_id = this%FMS_diag_fields(i)%id_from_name(module_name, field_name)
1278 if (diag_field_indices(1) .ne. diag_null)
then
1279 diag_field_id = diag_not_registered
1281 deallocate(diag_field_indices)
1284 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1286END FUNCTION fms_get_diag_field_id_from_name
1291function get_diag_buffer(this, bufferid) &
1294 integer,
intent(in) :: bufferid
1296 if( (bufferid .gt. ubound(this%FMS_diag_output_buffers, 1)) .or. &
1297 (bufferid .lt. lbound(this%FMS_diag_output_buffers, 1))) &
1298 call mpp_error(fatal,
'get_diag_bufer: invalid bufferid given')
1299 rslt = this%FMS_diag_output_buffers(bufferid)
1305type(
domain2d) function fms_get_domain2d(this, ids)
1307 INTEGER,
DIMENSION(:),
INTENT(in) :: ids
1310CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1311fms_get_domain2d = null_domain2d
1313 INTEGER :: type_of_domain
1318 call mpp_error(fatal,
'diag_axis_mod::get_domain2d- The axis do not correspond to a 2d Domain')
1321 fms_get_domain2d = domain%domain2
1324END FUNCTION fms_get_domain2d
1328 integer function fms_get_axis_length(this, axis_id)
1330 INTEGER,
INTENT(in) :: axis_id
1333CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1334fms_get_axis_length = 0
1336fms_get_axis_length = 0
1338 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1339 call mpp_error(fatal,
"fms_get_axis_length: The axis_id is not valid")
1341 select type (axis => this%diag_axis(axis_id)%axis)
1342 type is (fmsdiagfullaxis_type)
1343 fms_get_axis_length = axis%axis_length()
1344 type is (fmsdiagsubaxis_type)
1345 fms_get_axis_length = axis%axis_length()
1348end function fms_get_axis_length
1352function fms_get_axis_name_from_id (this, axis_id) &
1355 INTEGER,
INTENT(in) :: axis_id
1357 character (len=:),
allocatable :: axis_name
1360CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1363 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1364 call mpp_error(fatal,
"fms_get_axis_length: The axis_id is not valid")
1367 if (axis_id .eq. null_axis_id)
then
1368 allocate(
character(len=3) :: axis_name)
1374 select type (axis => this%diag_axis(axis_id)%axis)
1375 type is (fmsdiagfullaxis_type)
1376 axis_name = axis%get_axis_name()
1379end function fms_get_axis_name_from_id
1383subroutine dump_diag_obj( filename )
1384 character(len=*),
intent(in),
optional :: filename
1388 type(fmsdiagfile_type),
pointer :: fileptr
1389 type(fmsdiagfield_type),
pointer :: fieldptr
1393 if(
present(filename) )
then
1394 open(newunit=unit_num, file=trim(filename), action=
'WRITE')
1398 if( mpp_pe() .eq. mpp_root_pe())
then
1399 write(unit_num, *)
'********** dumping diag object ***********'
1400 write(unit_num, *)
'registered_variables:', fms_diag_object%registered_variables
1401 write(unit_num, *)
'registered_axis:', fms_diag_object%registered_axis
1402 write(unit_num, *)
'initialized:', fms_diag_object%initialized
1403 write(unit_num, *)
'files_initialized:', fms_diag_object%files_initialized
1404 write(unit_num, *)
'fields_initialized:', fms_diag_object%fields_initialized
1405 write(unit_num, *)
'buffers_initialized:', fms_diag_object%buffers_initialized
1406 write(unit_num, *)
'axes_initialized:', fms_diag_object%axes_initialized
1407 write(unit_num, *)
'Files:'
1408 if( fms_diag_object%files_initialized )
then
1409 do i=1,
SIZE(fms_diag_object%FMS_diag_files)
1410 write(unit_num, *)
'File num:', i
1411 fileptr => fms_diag_object%FMS_diag_files(i)%FMS_diag_file
1412 call fileptr%dump_file_obj(unit_num)
1415 write(unit_num, *)
'files not initialized'
1417 if( fms_diag_object%fields_initialized)
then
1418 do i=1,
SIZE(fms_diag_object%FMS_diag_fields)
1419 write(unit_num, *)
'Field num:', i
1420 fieldptr => fms_diag_object%FMS_diag_fields(i)
1421 call fieldptr%dump_field_obj(unit_num)
1424 write(unit_num, *)
'fields not initialized'
1426 if(
present(filename) )
close(unit_num)
1429 call mpp_error( fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1435subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
1437 class(*),
dimension(:,:,:,:),
intent(in) :: field_data
1438 integer,
intent(in) :: field_id
1441 integer :: buffer_id
1442 integer :: num_diurnal_samples
1443 integer :: axes_length(4)
1445 class(fmsdiagoutputbuffer_type),
pointer :: ptr_diag_buffer_obj
1446 class(diagyamlfilesvar_type),
pointer :: ptr_diag_field_yaml
1447 integer,
pointer :: axis_ids(:)
1449 character(len=:),
allocatable :: var_name
1450 logical :: is_scalar
1454 if (this%FMS_diag_fields(field_id)%buffer_allocated)
return
1457 var_type = get_var_type(field_data(1, 1, 1, 1))
1460 var_name = this%FMS_diag_fields(field_id)%get_varname()
1463 is_scalar = this%FMS_diag_fields(field_id)%is_scalar()
1466 do i = 1,
size(this%FMS_diag_fields(field_id)%buffer_ids)
1467 buffer_id = this%FMS_diag_fields(field_id)%buffer_ids(i)
1468 file_id = this%FMS_diag_fields(field_id)%file_ids(i)
1471 if (.not. this%FMS_diag_files(file_id)%writing_on_this_pe()) cycle
1474 if (.not. is_scalar)
then
1475 call this%FMS_diag_output_buffers(buffer_id)%get_axis_ids(axis_ids)
1476 ndims =
size(axis_ids)
1479 yaml_id = this%FMS_diag_output_buffers(buffer_id)%get_yaml_id()
1481 ptr_diag_field_yaml => diag_yaml%diag_fields(yaml_id)
1482 num_diurnal_samples = ptr_diag_field_yaml%get_n_diurnal()
1486 axes_length(j) = this%fms_get_axis_length(axis_ids(j))
1489 if (num_diurnal_samples .ne. 0)
then
1493 ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)
1494 call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, axes_length(1:4), &
1495 this%FMS_diag_fields(field_id)%get_mask_variant(), var_name, num_diurnal_samples)
1496 call ptr_diag_buffer_obj%initialize_buffer(ptr_diag_field_yaml%get_var_reduction(), var_name)
1501 this%FMS_diag_fields(field_id)%buffer_allocated = .true.
1503 call mpp_error( fatal,
"allocate_diag_field_output_buffers: "//&
1504 "you can not use the modern diag manager without compiling with -Duse_yaml")
1506end subroutine allocate_diag_field_output_buffers
1510function fms_diag_compare_window(this, field, field_id, &
1511 is_in, ie_in, js_in, je_in, ks_in, ke_in)
result(is_phys_win)
1513 class(*),
intent(in) :: field(:,:,:,:)
1514 integer,
intent(in) :: field_id
1515 integer,
intent(in) :: is_in, js_in
1518 integer,
intent(in) :: ie_in, je_in
1521 integer,
intent(in) :: ks_in, ke_in
1522 logical :: is_phys_win
1524 integer,
pointer :: axis_ids(:)
1525 integer :: total_elements
1527 integer :: field_size
1528 integer,
allocatable :: field_shape(:)
1529 integer :: window_size
1532 field_shape = shape(field(is_in:ie_in, js_in:je_in, ks_in:ke_in, :))
1534 window_size = field_shape(1) * field_shape(2) * field_shape(3)
1537 axis_ids => this%FMS_diag_fields(field_id)%get_axis_id()
1538 do i=1,
size(axis_ids)
1539 total_elements = total_elements * this%fms_get_axis_length(axis_ids(i))
1542 if (total_elements > window_size)
then
1543 is_phys_win = .true.
1545 is_phys_win = .false.
1548 is_phys_win = .false.
1549 call mpp_error( fatal,
"fms_diag_compare_window: "//&
1550 "you can not use the modern diag manager without compiling with -Duse_yaml")
1552end function fms_diag_compare_window
1555subroutine set_time_end(this, time_end_in)
1557 type(time_type),
intent(in) :: time_end_in
1559 this%model_end_time = time_end_in
1563end module fms_diag_object_mod
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
integer, parameter end_time
Use the end of the time average bounds.
integer max_axes
Maximum number of independent axes.
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 function get_var_type(var)
gets the type of a variable
type(time_type) diag_init_time
Time diag_manager_init called. If init_time not included in diag_manager_init call,...
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.
type(time_type) function get_base_time()
gets the module variable base_time
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, parameter two_d_domain
Use the FmsNetcdfDomainFile_t fileobj.
logical pure function, public determine_if_block_is_in_region(subregion_start, subregion_end, bounds, dim)
The PEs grid points are divided further into "blocks". This function determines if a block.
logical function, dimension(:,:,:,:), allocatable, public init_mask(rmask, mask, field)
Sets the logical mask based on mask or rmask.
pure real(kind=r8_kind) function, public set_weight(weight)
Sets the weight based on the weight passed into send_data (1.0_r8_kind if the weight is not passed in...
pure character(len=128) function, public check_indices_order(is_in, ie_in, js_in, je_in)
Checks improper combinations of is, ie, js, and je.
logical function, public fms_diag_axis_object_end(axis_array)
subroutine, public diag_yaml_object_end()
Destroys the diag_yaml object.
pure character(len=120) function, dimension(2), public parse_compress_att(compress_att)
integer function, dimension(:), allocatable, public get_diag_field_ids(indices)
Gets field indices corresponding to the indices (input argument) in the sorted variable_list.
integer function, dimension(:), allocatable, public find_diag_field(diag_field_name, module_name)
Determines if a diag_field is in the diag_yaml_object.
subroutine, public diag_yaml_object_init(diag_subset_output)
Uses the yaml_parser_mod to read in the diag_table and fill in the diag_yaml object.
integer function axis_length(this)
Get the axis length of a subaxis.
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.
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 fms_diag_yaml_out(ntimes, ntiles, ndistributedfiles)
Writes an output yaml with all available information on the written files. Will only write with root ...
logical function, public fms_diag_axis_object_init(axis_array)
pure integer function, public get_axis_id_from_name(axis_name, diag_axis, naxis, set_name)
One dimensional domain used to manage shared data access between pes.
The domain2D type contains all the necessary information to define the global, compute and data domai...
Domain information for managing data on unstructured grids.
integer function, public get_ticks_per_second()
Returns the number of ticks per second.
subroutine, public get_time(time, seconds, days, ticks, err_msg)
Returns days and seconds ( < 86400 ) corresponding to a time. err_msg should be checked for any error...
character(len=15) function, public date_to_string(time, err_msg)
Get the a character string that represents the time. The format will be yyyymmdd.hhmmss.
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...
Given an input date in year, month, days, etc., creates a time_type that represents this time interva...
Given some number of seconds and days, returns the corresponding time_type.
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.
Contains buffer types and routines for the diag manager.
Type to hold the 2d domain.
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.
Type to hold the subaxis.
Data structure holding a 3D bounding box. It is commonlyused to represent the interval bounds or limi...
Object that holds all variable information.
A container for fmsDiagFile_type. This is used to create the array of files.
holds an allocated buffer0-5d object
type to hold the info a diag_field