19 module fms_diag_object_mod
21 use diag_data_mod,
only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, &
28 &
OPERATOR(<),
OPERATOR(==),
OPERATOR(/=),
OPERATOR(/),
OPERATOR(+),
ASSIGNMENT(=),
get_date, &
32 use fms_diag_field_object_mod,
only:
fmsdiagfield_type, fms_diag_fields_object_init, get_default_missing_value, &
43 use constants_mod,
only: seconds_per_day
50 use fms_string_utils_mod,
only:
string
64 integer,
private :: registered_buffers = 0
66 integer,
private :: registered_variables
67 integer,
private :: registered_axis
68 logical,
private :: initialized=.false.
69 logical,
private :: files_initialized=.false.
70 logical,
private :: fields_initialized=.false.
71 logical,
private :: buffers_initialized=.false.
72 logical,
private :: axes_initialized=.false.
75 procedure :: init => fms_diag_object_init
76 procedure :: diag_end => fms_diag_object_end
77 procedure :: fms_register_diag_field_scalar
78 procedure :: fms_register_diag_field_array
79 procedure :: fms_register_static_field
80 procedure :: fms_diag_axis_init
81 procedure :: register => fms_register_diag_field_obj
82 procedure :: fms_diag_field_add_attribute
83 procedure :: fms_diag_axis_add_attribute
84 procedure :: fms_get_domain2d
85 procedure :: fms_get_axis_length
86 procedure :: fms_get_diag_field_id_from_name
87 procedure :: fms_get_field_name_from_id
88 procedure :: fms_get_axis_name_from_id
89 procedure :: fms_diag_accept_data
90 procedure :: fms_diag_send_complete
91 procedure :: do_buffer_math
92 procedure :: fms_diag_do_io
93 procedure :: fms_diag_do_reduction
94 procedure :: fms_diag_field_add_cell_measures
95 procedure :: allocate_diag_field_output_buffers
96 procedure :: fms_diag_compare_window
98 procedure :: get_diag_buffer
104 public :: fms_register_diag_field_obj
105 public :: fms_register_diag_field_scalar
106 public :: fms_register_diag_field_array
107 public :: fms_register_static_field
108 public :: fms_diag_field_add_attribute
109 public :: fms_get_diag_field_id_from_name
110 public :: fms_diag_object
112 integer,
private :: registered_variables
113 public :: dump_diag_obj
121 subroutine fms_diag_object_init (this,diag_subset_output, time_init)
123 integer :: diag_subset_output
124 INTEGER,
DIMENSION(6),
OPTIONAL,
INTENT(IN) :: time_init
127 if (this%initialized)
return
134 if (.not.
present(time_init))
then
139 this%files_initialized = fms_diag_files_object_init(this%FMS_diag_files)
140 this%fields_initialized = fms_diag_fields_object_init(this%FMS_diag_fields)
141 this%buffers_initialized =fms_diag_output_buffer_init(this%FMS_diag_output_buffers,
SIZE(diag_yaml%get_diag_fields()))
142 this%registered_variables = 0
143 this%registered_axis = 0
144 this%initialized = .true.
147 "You must compile with -Duse_yaml to use the option use_modern_diag", fatal)
149 end subroutine fms_diag_object_init
155 subroutine fms_diag_object_end (this, time)
162 if (.not. this%initialized)
return
167 call this%do_buffer_math()
168 call this%fms_diag_do_io(end_time=time)
170 do i=1,
size(this%FMS_diag_output_buffers)
171 call this%FMS_diag_output_buffers(i)%flush_buffer()
173 deallocate(this%FMS_diag_output_buffers)
175 this%initialized = .false.
178 call mpp_error(fatal,
"You can not call fms_diag_object%end without yaml")
180 end subroutine fms_diag_object_end
186 integer function fms_register_diag_field_obj &
187 (this, modname, varname, axes, init_time, &
188 longname, units, missing_value, varrange, mask_variant, standname, &
189 do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static, &
193 CHARACTER(len=*),
INTENT(in) :: modname
194 CHARACTER(len=*),
INTENT(in) :: varname
195 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
196 INTEGER,
TARGET,
OPTIONAL,
INTENT(in) :: axes(:)
197 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: longname
198 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
199 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standname
200 class(*),
OPTIONAL,
INTENT(in) :: missing_value
201 class(*),
OPTIONAL,
INTENT(in) :: varrange(2)
202 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
203 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
204 CHARACTER(len=*),
OPTIONAL,
INTENT(out) :: err_msg
205 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
209 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
210 INTEGER,
OPTIONAL,
INTENT(in) :: area
211 INTEGER,
OPTIONAL,
INTENT(in) :: volume
212 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
214 LOGICAL,
OPTIONAL,
INTENT(in) :: static
215 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
224 integer,
allocatable :: file_ids(:)
226 integer,
allocatable :: diag_field_indices(:)
230 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
233 if (diag_field_indices(1) .eq. diag_null)
then
236 deallocate(diag_field_indices)
240 this%registered_variables = this%registered_variables + 1
241 fms_register_diag_field_obj = this%registered_variables
243 call this%FMS_diag_fields(this%registered_variables)%&
244 &setid(this%registered_variables)
247 fieldptr => this%FMS_diag_fields(this%registered_variables)
250 call fieldptr%set_file_ids(file_ids)
253 fieldptr%buffer_allocated = .false.
257 call fieldptr%register(modname, varname, diag_field_indices, this%diag_axis, &
258 axes=axes, longname=longname, units=units, missing_value=missing_value, varrange= varrange, &
259 mask_variant= mask_variant, standname=standname, do_not_log=do_not_log, err_msg=err_msg, &
260 interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
261 static=static, multiple_send_data=multiple_send_data)
264 if (
present(axes) .and.
present(init_time))
then
265 do i = 1,
size(file_ids)
266 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
267 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
268 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
269 if(fieldptr%get_type_of_domain() .eq.
no_domain)
then
270 call fileptr%set_file_domain(null(), fieldptr%get_type_of_domain())
272 call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
274 call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
275 call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
276 fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
277 call fileptr%add_start_time(init_time)
278 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
280 elseif (
present(axes))
then
281 do i = 1,
size(file_ids)
282 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
283 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
284 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
285 call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
286 if(fieldptr%get_type_of_domain() .eq.
no_domain)
then
287 call fileptr%set_file_domain(null(), fieldptr%get_type_of_domain())
289 call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
291 call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
292 fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
293 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
295 elseif (
present(init_time))
then
296 do i = 1,
size(file_ids)
297 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
298 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
299 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
300 call fileptr%add_start_time(init_time)
301 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
304 do i = 1,
size(file_ids)
305 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
306 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
307 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
308 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
314 do i = 1,
size(fieldptr%buffer_ids)
315 bufferptr => this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))
316 call bufferptr%set_field_id(this%registered_variables)
317 call bufferptr%set_yaml_id(fieldptr%buffer_ids(i))
319 yamlfptr => diag_yaml%diag_fields(fieldptr%buffer_ids(i))
320 if( yamlfptr%get_var_reduction() .eq.
time_diurnal)
then
321 call bufferptr%set_diurnal_sample_size(yamlfptr%get_n_diurnal())
323 call bufferptr%init_buffer_time(init_time)
324 call bufferptr%set_next_output(this%FMS_diag_files(file_ids(i))%get_next_output(), &
325 this%FMS_diag_files(file_ids(i))%get_next_next_output(), is_static=fieldptr%is_static())
330 deallocate(diag_field_indices)
332 end function fms_register_diag_field_obj
337 INTEGER FUNCTION fms_register_diag_field_scalar(this,module_name, field_name, init_time, &
338 & long_name, units, missing_value, var_range, standard_name, do_not_log, err_msg,&
339 & area, volume, realm, multiple_send_data)
341 CHARACTER(len=*),
INTENT(in) :: module_name
342 CHARACTER(len=*),
INTENT(in) :: field_name
343 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
344 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
345 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
346 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
347 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
348 CLASS(*),
OPTIONAL,
INTENT(in) :: var_range(:)
349 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
350 CHARACTER(len=*),
OPTIONAL,
INTENT(out):: err_msg
351 INTEGER,
OPTIONAL,
INTENT(in) :: area
352 INTEGER,
OPTIONAL,
INTENT(in) :: volume
353 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
354 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
359 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
361 fms_register_diag_field_scalar = this%register(&
362 & module_name, field_name, init_time=init_time, &
363 & longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
364 & standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
365 & area=area, volume=volume, realm=realm, multiple_send_data=multiple_send_data)
367 end function fms_register_diag_field_scalar
372 INTEGER FUNCTION fms_register_diag_field_array(this, module_name, field_name, axes, init_time, &
373 & long_name, units, missing_value, var_range, mask_variant, standard_name, verbose,&
374 & do_not_log, err_msg, interp_method, tile_count, area, volume, realm, &
375 & multiple_send_data)
377 CHARACTER(len=*),
INTENT(in) :: module_name
378 CHARACTER(len=*),
INTENT(in) :: field_name
379 INTEGER,
INTENT(in) :: axes(:)
380 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
381 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
382 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
383 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
384 CLASS(*),
OPTIONAL,
INTENT(in) :: var_range(:)
385 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
386 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
387 LOGICAL,
OPTIONAL,
INTENT(in) :: verbose
388 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
389 CHARACTER(len=*),
OPTIONAL,
INTENT(out):: err_msg
390 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
394 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
395 INTEGER,
OPTIONAL,
INTENT(in) :: area
396 INTEGER,
OPTIONAL,
INTENT(in) :: volume
397 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
398 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
404 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
406 fms_register_diag_field_array = this%register( &
407 & module_name, field_name, init_time=init_time, &
408 & axes=axes, longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
409 & mask_variant=mask_variant, standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
410 & interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
411 & multiple_send_data=multiple_send_data)
413 end function fms_register_diag_field_array
418 INTEGER FUNCTION fms_register_static_field(this, module_name, field_name, axes, long_name, units,&
419 & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,&
420 & tile_count, area, volume, realm)
422 CHARACTER(len=*),
INTENT(in) :: module_name
423 CHARACTER(len=*),
INTENT(in) :: field_name
424 INTEGER,
DIMENSION(:),
INTENT(in) :: axes
425 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
426 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
427 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
428 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
429 CLASS(*),
OPTIONAL,
INTENT(in) :: range(:)
430 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
431 LOGICAL,
OPTIONAL,
INTENT(in) :: dynamic
432 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
433 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
437 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
438 INTEGER,
OPTIONAL,
INTENT(in) :: area
440 INTEGER,
OPTIONAL,
INTENT(in) :: volume
442 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
447 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
451 if (
size(axes) .eq. 1 .and. axes(1) .eq. null_axis_id)
then
453 fms_register_static_field = this%register( &
454 & module_name, field_name, &
455 & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
456 & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
457 & standname=standard_name, area=area, volume=volume, realm=realm, &
460 fms_register_static_field = this%register( &
461 & module_name, field_name, axes=axes, &
462 & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
463 & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
464 & standname=standard_name, area=area, volume=volume, realm=realm, &
468 end function fms_register_static_field
473 FUNCTION fms_diag_axis_init(this, axis_name, axis_data, units, cart_name, axis_length, long_name, direction,&
474 & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position ) &
478 CHARACTER(len=*),
INTENT(in) :: axis_name
479 CLASS(*),
INTENT(in) :: axis_data(:)
480 CHARACTER(len=*),
INTENT(in) :: units
481 CHARACTER(len=1),
INTENT(in) :: cart_name
482 integer,
intent(in) :: axis_length
483 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: long_name
484 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: set_name
485 INTEGER,
INTENT(in),
OPTIONAL :: direction
486 INTEGER,
INTENT(in),
OPTIONAL :: edges
487 TYPE(
domain1d),
INTENT(in),
OPTIONAL :: domain
488 TYPE(
domain2d),
INTENT(in),
OPTIONAL :: domain2
489 TYPE(
domainug),
INTENT(in),
OPTIONAL :: domainu
490 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: aux
492 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: req
493 INTEGER,
INTENT(in),
OPTIONAL :: tile_count
494 INTEGER,
INTENT(in),
OPTIONAL :: domain_position
499 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
501 CHARACTER(len=:),
ALLOCATABLE :: edges_name
503 this%registered_axis = this%registered_axis + 1
506 &
"diag_axis_init: max_axes exceeded, increase via diag_manager_nml")
510 select type (axis => this%diag_axis(this%registered_axis)%axis )
512 if(
present(edges))
then
513 if (edges < 0 .or. edges > this%registered_axis) &
514 call mpp_error(fatal,
"diag_axit_init: The edge axis has not been defined. &
515 &Call diag_axis_init for the edge axis first")
516 select type (edges_axis => this%diag_axis(edges)%axis)
518 edges_name = edges_axis%get_axis_name()
519 call axis%set_edges(edges_name, edges)
522 call axis%register(axis_name, axis_data, units, cart_name, long_name=long_name, &
523 & direction=direction, set_name=set_name, domain=domain, domain2=domain2, domainu=domainu, aux=aux, &
524 & req=req, tile_count=tile_count, domain_position=domain_position, axis_length=axis_length)
526 id = this%registered_axis
527 call axis%set_axis_id(id)
530 end function fms_diag_axis_init
539 logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rmask, &
540 time, is_in, js_in, ks_in, &
541 ie_in, je_in, ke_in, weight, err_msg)
543 INTEGER,
INTENT(in) :: diag_field_id
544 CLASS(*),
DIMENSION(:,:,:,:),
INTENT(in) :: field_data
545 LOGICAL,
allocatable,
INTENT(in) :: mask(:,:,:,:)
547 CLASS(*),
allocatable,
INTENT(in) :: rmask(:,:,:,:)
549 CLASS(*),
INTENT(in),
OPTIONAL :: weight
550 TYPE (
time_type),
INTENT(in),
OPTIONAL :: time
551 INTEGER,
INTENT(in),
OPTIONAL :: is_in, js_in, ks_in
552 INTEGER,
INTENT(in),
OPTIONAL :: ie_in, je_in, ke_in
553 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
555 integer :: is, js, ks
556 integer :: ie, je, ke
557 integer :: omp_num_threads
559 logical :: buffer_the_data
561 character(len=128) :: error_string
562 logical :: data_buffer_is_allocated
563 character(len=256) :: field_info
565 logical,
allocatable,
dimension(:,:,:,:) :: oor_mask
566 real(kind=r8_kind) :: field_weight
570 logical :: using_blocking
572 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
576 field_info =
" Check send data call for field:"//trim(this%FMS_diag_fields(diag_field_id)%get_varname())//&
577 " and module:"//trim(this%FMS_diag_fields(diag_field_id)%get_modname())
580 if (.not.this%FMS_diag_fields(diag_field_id)%is_static() .and. .not.
present(time)) &
581 call mpp_error(fatal,
"Time must be present if the field is not static. "//trim(field_info))
588 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
590 using_blocking = .false.
591 if ((
present(is_in) .and. .not.
present(ie_in)) .or. (
present(js_in) .and. .not.
present(je_in))) &
592 using_blocking = .true.
595 if ((
present(is_in) .and.
present(ie_in)) .or. (
present(js_in) .and.
present(je_in))) &
599 if (this%FMS_diag_fields(diag_field_id)%is_mask_variant())
then
600 if (.not.
allocated(mask) .and. .not.
allocated(rmask))
call mpp_error(fatal, &
601 "The field was registered with mask_variant, but mask or rmask are not present in the send_data call. "//&
606 if (
allocated(mask) .and.
allocated(rmask))
call mpp_error(fatal, &
607 "mask and rmask are both present in the send_data call. "//&
611 oor_mask =
init_mask(rmask, mask, field_data)
614 buffer_the_data = .false.
620 omp_num_threads = omp_get_num_threads()
621 omp_level = omp_get_level()
622 buffer_the_data = (omp_num_threads > 1 .AND. omp_level > 0)
630 IF (
PRESENT(is_in) ) is = is_in
631 IF (
PRESENT(js_in) ) js = js_in
632 IF (
PRESENT(ks_in) ) ks = ks_in
633 ie = is+
SIZE(field_data, 1)-1
634 je = js+
SIZE(field_data, 2)-1
635 ke = ks+
SIZE(field_data, 3)-1
636 IF (
PRESENT(ie_in) ) ie = ie_in
637 IF (
PRESENT(je_in) ) je = je_in
638 IF (
PRESENT(ke_in) ) ke = ke_in
640 if (.not. buffer_the_data .and. using_blocking)
then
643 buffer_the_data = check_for_slices(this%FMS_diag_fields(diag_field_id), this%diag_axis, &
649 if (this%FMS_diag_fields(diag_field_id)%get_multiple_send_data()) &
650 buffer_the_data = .true.
653 main_if:
if (buffer_the_data)
then
659 if(has_halos)
call this%FMS_diag_fields(diag_field_id)%set_halo_present()
662 if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
663 call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
665 if (
allocated(mask) .or.
allocated(rmask))
then
666 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
668 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
671 if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated())
then
672 data_buffer_is_allocated = &
673 this%FMS_diag_fields(diag_field_id)%allocate_data_buffer(field_data, this%diag_axis)
674 if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
675 call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
677 call this%FMS_diag_fields(diag_field_id)%set_send_data_time(time)
678 call this%FMS_diag_fields(diag_field_id)%set_data_buffer_is_allocated(.true.)
679 call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.true.)
681 call this%FMS_diag_fields(diag_field_id)%set_data_buffer(field_data, oor_mask, field_weight, &
682 is, js, ks, ie, je, ke)
683 fms_diag_accept_data = .true.
689 if(has_halos)
call this%FMS_diag_fields(diag_field_id)%set_halo_present()
692 if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
693 call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
695 if (
allocated(mask) .or.
allocated(rmask))
then
696 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
698 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
701 error_string = bounds%set_bounds(field_data, is, ie, js, je, ks, ke, has_halos)
702 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
704 call this%allocate_diag_field_output_buffers(field_data, diag_field_id)
705 error_string = this%fms_diag_do_reduction(field_data, diag_field_id, oor_mask, field_weight, &
706 bounds, using_blocking, time=time)
707 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
708 call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.false.)
709 if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
710 call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
711 call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask, field_info)
715 fms_diag_accept_data = .false.
718 end function fms_diag_accept_data
721 subroutine do_buffer_math(this)
733 integer,
dimension(:),
allocatable :: file_field_ids
734 class(*),
pointer :: input_data_buffer(:,:,:,:)
735 character(len=128) :: error_string
737 integer,
dimension(:),
allocatable :: file_ids
738 logical,
parameter :: debug_sc = .false.
743 field_loop:
do ifield = 1,
size(this%FMS_diag_fields)
744 diag_field => this%FMS_diag_fields(ifield)
745 if(.not. diag_field%is_registered()) cycle
746 if(debug_sc)
call mpp_error(note,
"fms_diag_send_complete:: var: "//diag_field%get_varname())
748 allocate (file_ids(
size(diag_field%get_file_ids() )))
749 file_ids = diag_field%get_file_ids()
750 math = diag_field%get_math_needs_to_be_done()
752 doing_math:
if (
size(file_ids) .ge. 1 .and. math)
then
754 has_input_buff:
if (diag_field%has_input_data_buffer())
then
755 call diag_field%prepare_data_buffer()
756 input_data_buffer => diag_field%get_data_buffer()
758 call bounds%reset_bounds_from_array_4D(input_data_buffer)
759 call this%allocate_diag_field_output_buffers(input_data_buffer, ifield)
760 error_string = this%fms_diag_do_reduction(input_data_buffer, ifield, &
761 diag_field%get_mask(), diag_field%get_weight(), &
762 bounds, .false., time=diag_field%get_send_data_time())
763 call diag_field%init_data_buffer()
764 if (trim(error_string) .ne.
"")
call mpp_error(fatal,
"Field:"//trim(diag_field%get_varname()//&
765 " -"//trim(error_string)))
767 call mpp_error(fatal,
"diag_send_complete:: no input buffer allocated for field"//diag_field%get_longname())
770 call diag_field%set_math_needs_to_be_done(.false.)
772 if (
allocated(file_ids))
deallocate(file_ids)
773 if (
associated(diag_field))
nullify(diag_field)
776 end subroutine do_buffer_math
780 subroutine fms_diag_send_complete(this, time_step)
782 TYPE (
time_type),
INTENT(in) :: time_step
785 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
787 call this%do_buffer_math()
788 call this%fms_diag_do_io()
791 end subroutine fms_diag_send_complete
797 subroutine fms_diag_do_io(this, end_time)
799 type(
time_type),
optional,
target,
intent(in) :: end_time
807 integer,
allocatable :: buff_ids(:)
809 logical :: file_is_opened_this_time_step
811 logical :: force_write
812 logical :: finish_writing
814 logical,
parameter :: debug_reduct = .false.
815 class(*),
allocatable :: missing_val
816 real(r8_kind) :: mval
817 character(len=128) :: error_string
818 logical :: unlim_dim_was_increased
819 logical :: do_not_write
821 force_write = .false.
823 do i = 1,
size(this%FMS_diag_files)
824 diag_file => this%FMS_diag_files(i)
827 if (.not. diag_file%writing_on_this_pe()) cycle
828 if (diag_file%FMS_diag_file%is_done_writing_data()) cycle
830 if (
present (end_time))
then
832 model_time => end_time
834 model_time => diag_file%get_model_time()
837 call diag_file%open_diag_file(model_time, file_is_opened_this_time_step)
838 if (file_is_opened_this_time_step)
then
840 call diag_file%init_unlim_dim(this%FMS_diag_output_buffers)
842 call diag_file%write_global_metadata()
843 call diag_file%write_axis_metadata(this%diag_axis)
844 call diag_file%write_time_metadata()
845 call diag_file%write_field_metadata(this%FMS_diag_fields, this%diag_axis)
846 call diag_file%write_axis_data(this%diag_axis)
849 finish_writing = diag_file%is_time_to_write(model_time, this%FMS_diag_output_buffers, &
850 this%FMS_diag_fields, do_not_write)
851 unlim_dim_was_increased = .false.
854 buff_ids = diag_file%FMS_diag_file%get_buffer_ids()
856 buff_loop:
do ibuff=1,
SIZE(buff_ids)
857 diag_buff => this%FMS_diag_output_buffers(buff_ids(ibuff))
858 field_yaml => diag_yaml%diag_fields(diag_buff%get_yaml_id())
859 diag_field => this%FMS_diag_fields(diag_buff%get_field_id())
862 if (.not. diag_buff%is_there_data_to_write()) cycle
864 if ( diag_buff%is_time_to_finish_reduction(end_time) .and. .not. do_not_write)
then
866 mval = diag_field%find_missing_value(missing_val)
868 if( field_yaml%has_var_reduction())
then
869 if( field_yaml%get_var_reduction() .ge.
time_average)
then
870 if(debug_reduct)
call mpp_error(note,
"fms_diag_do_io:: finishing reduction for "//diag_field%get_longname())
871 error_string = diag_buff%diag_reduction_done_wrapper( &
872 field_yaml%get_var_reduction(), &
873 mval, diag_field%get_var_is_masked(), diag_field%get_mask_variant())
876 call diag_file%write_field_data(diag_field, diag_buff, unlim_dim_was_increased)
877 call diag_buff%set_next_output(diag_file%get_next_output(), diag_file%get_next_next_output())
884 if (unlim_dim_was_increased)
then
885 call diag_file%write_time_data()
886 call diag_file%flush_diag_file()
887 call diag_file%update_next_write(model_time)
890 if (finish_writing)
then
891 call diag_file%update_current_new_file_freq_index(model_time)
892 if (diag_file%is_time_to_close_file(model_time))
call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
893 diag_fields = this%FMS_diag_fields)
894 else if (force_write)
then
895 call diag_file%prepare_for_force_write()
896 call diag_file%write_time_data()
897 call diag_file%close_diag_file(this%FMS_diag_output_buffers, diag_fields = this%FMS_diag_fields)
901 end subroutine fms_diag_do_io
906 function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, &
907 bounds, using_blocking, time) &
910 class(*),
intent(in) :: field_data(:,:,:,:)
911 integer,
intent(in) :: diag_field_id
912 logical,
intent(in),
target :: oor_mask(:,:,:,:)
913 real(kind=r8_kind),
intent(in) :: weight
915 logical,
intent(in) :: using_blocking
917 type(
time_type),
intent(in),
optional :: time
919 character(len=150) :: error_msg
927 integer :: reduction_method
931 integer,
pointer :: axis_ids(:)
932 logical :: is_subregional
933 logical :: reduced_k_range
940 integer :: compute_idx(2)
941 character(len=1) :: cart_axis
942 logical :: block_in_subregion
945 real(kind=r8_kind) :: missing_value
950 field_ptr => this%FMS_diag_fields(diag_field_id)
951 if (field_ptr%has_missing_value())
then
952 select type (missing_val => field_ptr%get_missing_value(
r8))
953 type is (real(kind=r8_kind))
954 missing_value = missing_val
956 call mpp_error(fatal,
"The missing value for the field:"//trim(field_ptr%get_varname())//&
957 &
" was not allocated to the correct type. This shouldn't have happened")
960 select type (missing_val => get_default_missing_value(
r8))
961 type is (real(kind=r8_kind))
962 missing_value = missing_val
964 call mpp_error(fatal,
"The missing value for the field:"//trim(field_ptr%get_varname())//&
965 &
" was not allocated to the correct type. This shouldn't have happened")
969 buffer_loop:
do ids = 1,
size(field_ptr%buffer_ids)
971 buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids)
972 file_id = this%FMS_diag_fields(diag_field_id)%file_ids(ids)
975 field_yaml_ptr => field_ptr%diag_field(ids)
976 buffer_ptr => this%FMS_diag_output_buffers(buffer_id)
977 file_ptr => this%FMS_diag_files(file_id)
980 if (.not. file_ptr%writing_on_this_pe()) cycle
983 if (buffer_ptr%is_done_with_math()) cycle
985 if (
present(time))
call file_ptr%set_model_time(time)
988 if (.not. using_blocking)
then
990 call bounds_out%reset_bounds_from_array_4D(buffer_ptr%buffer(:,:,:,:,1))
994 if (.not. bounds%has_halos)
then
996 call bounds_in%reset_bounds_from_array_4D(field_data)
999 is_subregional = file_ptr%is_regional()
1000 reduced_k_range = field_yaml_ptr%has_var_zbounds()
1003 is_subregional_reduced_k_range:
if (is_subregional .or. reduced_k_range)
then
1004 call buffer_ptr%get_axis_ids(axis_ids)
1005 block_in_subregion = .true.
1006 axis_loops:
do i = 1,
size(axis_ids)
1008 if (.not. block_in_subregion) cycle
1010 select type (diag_axis => this%diag_axis(axis_ids(i))%axis)
1012 sindex = diag_axis%get_starting_index()
1013 eindex = diag_axis%get_ending_index()
1014 compute_idx = diag_axis%get_compute_indices()
1015 starting=sindex-compute_idx(1)+1
1016 ending=eindex-compute_idx(1)+1
1017 if (using_blocking)
then
1019 if (.not. block_in_subregion) cycle
1022 call bounds_in%rebase_input(bounds, starting, ending, i)
1025 call bounds_out%rebase_output(starting, ending, i)
1028 call bounds_in%update_index(starting, ending, i, .false.)
1031 call bounds_out%update_index(1, ending-starting+1, i, .true.)
1037 if (.not. block_in_subregion) cycle
1038 endif is_subregional_reduced_k_range
1041 reduction_method = field_yaml_ptr%get_var_reduction()
1042 if (
present(time))
call buffer_ptr%update_buffer_time(time)
1043 call buffer_ptr%set_send_data_called()
1044 select case(reduction_method)
1046 error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1047 bounds_in, bounds_out, missing_value)
1048 if (trim(error_msg) .ne.
"")
then
1052 error_msg = buffer_ptr%do_time_min_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1053 bounds_in, bounds_out, missing_value)
1054 if (trim(error_msg) .ne.
"")
then
1058 error_msg = buffer_ptr%do_time_max_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1059 bounds_in, bounds_out, missing_value)
1060 if (trim(error_msg) .ne.
"")
then
1064 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1065 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value())
1066 if (trim(error_msg) .ne.
"")
then
1070 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1071 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1073 if (trim(error_msg) .ne.
"")
then
1077 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1078 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1079 weight=weight, pow_value=field_yaml_ptr%get_pow_value())
1080 if (trim(error_msg) .ne.
"")
then
1084 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1085 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1086 weight=weight, pow_value = 2)
1087 if (trim(error_msg) .ne.
"")
then
1091 if(.not.
present(time))
call mpp_error(fatal, &
1092 "fms_diag_do_reduction:: time must be present when using diurnal reductions")
1094 call buffer_ptr%set_diurnal_section_index(time)
1095 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1096 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1098 if (trim(error_msg) .ne.
"")
then
1102 error_msg =
"The reduction method is not supported. "//&
1103 "Only none, min, max, sum, average, power, rms, and diurnal are supported."
1106 if (field_ptr%is_static() .or. file_ptr%FMS_diag_file%is_done_writing_data())
then
1107 call buffer_ptr%set_done_with_math()
1112 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1114 end function fms_diag_do_reduction
1117 subroutine fms_diag_field_add_cell_measures(this, diag_field_id, area, volume)
1119 integer,
intent(in) :: diag_field_id
1120 INTEGER,
optional,
INTENT(in) :: area
1121 INTEGER,
optional,
INTENT(in) :: volume
1124 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1126 call this%FMS_diag_fields(diag_field_id)%add_area_volume(area, volume)
1128 end subroutine fms_diag_field_add_cell_measures
1131 subroutine fms_diag_field_add_attribute(this, diag_field_id, att_name, att_value)
1133 integer,
intent(in) :: diag_field_id
1134 character(len=*),
intent(in) :: att_name
1135 class(*),
intent(in) :: att_value(:)
1137 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1140 if ( diag_field_id .LE. 0 )
THEN
1143 if (this%FMS_diag_fields(diag_field_id)%is_registered() ) &
1144 call this%FMS_diag_fields(diag_field_id)%add_attribute(att_name, att_value)
1147 end subroutine fms_diag_field_add_attribute
1150 subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
1152 integer,
intent(in) :: axis_id
1153 character(len=*),
intent(in) :: att_name
1154 class(*),
intent(in) :: att_value(:)
1156 character(len=20) :: axis_names(2)
1157 character(len=20) :: set_name
1158 integer :: uncmx_ids(2)
1161 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1163 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1164 call mpp_error(fatal,
"diag_axis_add_attribute: The axis_id is not valid")
1166 select type (axis => this%diag_axis(axis_id)%axis)
1168 call axis%add_axis_attribute(att_name, att_value)
1175 if (trim(att_name) .eq.
"compress")
then
1181 if (axis%has_set_name()) set_name = axis%get_set_name()
1182 do j = 1,
size(axis_names)
1184 if (uncmx_ids(j) .eq. diag_null)
call mpp_error(fatal, &
1185 &
"Error parsing the compress attribute for axis: "//trim(axis%get_axis_name())//&
1186 &
". Be sure that the axes in the compress attribute are registered")
1188 call axis%add_structured_axis_ids(uncmx_ids)
1192 end subroutine fms_diag_axis_add_attribute
1196 function fms_get_field_name_from_id (this, field_id) &
1200 integer,
intent (in) :: field_id
1201 character(len=:),
allocatable :: field_name
1203 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1205 field_name = this%FMS_diag_fields(field_id)%get_varname()
1207 end function fms_get_field_name_from_id
1211 FUNCTION fms_get_diag_field_id_from_name(this, module_name, field_name) &
1212 result(diag_field_id)
1214 CHARACTER(len=*),
INTENT(in) :: module_name
1215 CHARACTER(len=*),
INTENT(in) :: field_name
1216 integer :: diag_field_id
1220 integer,
allocatable :: diag_field_indices(:)
1225 do i=1, this%registered_variables
1227 diag_field_id = this%FMS_diag_fields(i)%id_from_name(module_name, field_name)
1234 if (diag_field_indices(1) .ne. diag_null)
then
1235 diag_field_id = diag_not_registered
1237 deallocate(diag_field_indices)
1240 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1242 END FUNCTION fms_get_diag_field_id_from_name
1247 function get_diag_buffer(this, bufferid) &
1250 integer,
intent(in) :: bufferid
1252 if( (bufferid .gt. ubound(this%FMS_diag_output_buffers, 1)) .or. &
1253 (bufferid .lt. lbound(this%FMS_diag_output_buffers, 1))) &
1254 call mpp_error(fatal,
'get_diag_bufer: invalid bufferid given')
1255 rslt = this%FMS_diag_output_buffers(bufferid)
1261 type(
domain2d) function fms_get_domain2d(this, ids)
1263 INTEGER,
DIMENSION(:),
INTENT(in) :: ids
1266 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1267 fms_get_domain2d = null_domain2d
1269 INTEGER :: type_of_domain
1274 call mpp_error(fatal,
'diag_axis_mod::get_domain2d- The axis do not correspond to a 2d Domain')
1277 fms_get_domain2d = domain%domain2
1280 END FUNCTION fms_get_domain2d
1284 integer function fms_get_axis_length(this, axis_id)
1286 INTEGER,
INTENT(in) :: axis_id
1289 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1290 fms_get_axis_length = 0
1292 fms_get_axis_length = 0
1294 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1295 call mpp_error(fatal,
"fms_get_axis_length: The axis_id is not valid")
1297 select type (axis => this%diag_axis(axis_id)%axis)
1298 type is (fmsdiagfullaxis_type)
1299 fms_get_axis_length = axis%axis_length()
1300 type is (fmsdiagsubaxis_type)
1301 fms_get_axis_length = axis%axis_length()
1304 end function fms_get_axis_length
1308 function fms_get_axis_name_from_id (this, axis_id) &
1311 INTEGER,
INTENT(in) :: axis_id
1313 character (len=:),
allocatable :: axis_name
1316 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1319 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1320 call mpp_error(fatal,
"fms_get_axis_length: The axis_id is not valid")
1323 if (axis_id .eq. null_axis_id)
then
1324 allocate(
character(len=3) :: axis_name)
1330 select type (axis => this%diag_axis(axis_id)%axis)
1331 type is (fmsdiagfullaxis_type)
1332 axis_name = axis%get_axis_name()
1335 end function fms_get_axis_name_from_id
1339 subroutine dump_diag_obj( filename )
1340 character(len=*),
intent(in),
optional :: filename
1344 type(fmsdiagfile_type),
pointer :: fileptr
1345 type(fmsdiagfield_type),
pointer :: fieldptr
1349 if(
present(filename) )
then
1350 open(newunit=unit_num, file=trim(filename), action=
'WRITE')
1354 if(
mpp_pe() .eq. mpp_root_pe())
then
1355 write(unit_num, *)
'********** dumping diag object ***********'
1356 write(unit_num, *)
'registered_variables:', fms_diag_object%registered_variables
1357 write(unit_num, *)
'registered_axis:', fms_diag_object%registered_axis
1358 write(unit_num, *)
'initialized:', fms_diag_object%initialized
1359 write(unit_num, *)
'files_initialized:', fms_diag_object%files_initialized
1360 write(unit_num, *)
'fields_initialized:', fms_diag_object%fields_initialized
1361 write(unit_num, *)
'buffers_initialized:', fms_diag_object%buffers_initialized
1362 write(unit_num, *)
'axes_initialized:', fms_diag_object%axes_initialized
1363 write(unit_num, *)
'Files:'
1364 if( fms_diag_object%files_initialized )
then
1365 do i=1,
SIZE(fms_diag_object%FMS_diag_files)
1366 write(unit_num, *)
'File num:', i
1367 fileptr => fms_diag_object%FMS_diag_files(i)%FMS_diag_file
1368 call fileptr%dump_file_obj(unit_num)
1371 write(unit_num, *)
'files not initialized'
1373 if( fms_diag_object%fields_initialized)
then
1374 do i=1,
SIZE(fms_diag_object%FMS_diag_fields)
1375 write(unit_num, *)
'Field num:', i
1376 fieldptr => fms_diag_object%FMS_diag_fields(i)
1377 call fieldptr%dump_field_obj(unit_num)
1380 write(unit_num, *)
'fields not initialized'
1382 if(
present(filename) )
close(unit_num)
1385 call mpp_error( fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1391 subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
1393 class(*),
dimension(:,:,:,:),
intent(in) :: field_data
1394 integer,
intent(in) :: field_id
1397 integer :: buffer_id
1398 integer :: num_diurnal_samples
1399 integer :: axes_length(4)
1401 class(fmsdiagoutputbuffer_type),
pointer :: ptr_diag_buffer_obj
1402 class(diagyamlfilesvar_type),
pointer :: ptr_diag_field_yaml
1403 integer,
pointer :: axis_ids(:)
1405 character(len=:),
allocatable :: var_name
1406 logical :: is_scalar
1410 if (this%FMS_diag_fields(field_id)%buffer_allocated)
return
1413 var_type = get_var_type(field_data(1, 1, 1, 1))
1416 var_name = this%FMS_diag_fields(field_id)%get_varname()
1419 is_scalar = this%FMS_diag_fields(field_id)%is_scalar()
1422 do i = 1,
size(this%FMS_diag_fields(field_id)%buffer_ids)
1423 buffer_id = this%FMS_diag_fields(field_id)%buffer_ids(i)
1424 file_id = this%FMS_diag_fields(field_id)%file_ids(i)
1427 if (.not. this%FMS_diag_files(file_id)%writing_on_this_pe()) cycle
1430 if (.not. is_scalar)
then
1431 call this%FMS_diag_output_buffers(buffer_id)%get_axis_ids(axis_ids)
1432 ndims =
size(axis_ids)
1435 yaml_id = this%FMS_diag_output_buffers(buffer_id)%get_yaml_id()
1437 ptr_diag_field_yaml => diag_yaml%diag_fields(yaml_id)
1438 num_diurnal_samples = ptr_diag_field_yaml%get_n_diurnal()
1442 axes_length(j) = this%fms_get_axis_length(axis_ids(j))
1445 if (num_diurnal_samples .ne. 0)
then
1449 ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)
1450 call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, axes_length(1:4), &
1451 this%FMS_diag_fields(field_id)%get_mask_variant(), var_name, num_diurnal_samples)
1452 call ptr_diag_buffer_obj%initialize_buffer(ptr_diag_field_yaml%get_var_reduction(), var_name)
1457 this%FMS_diag_fields(field_id)%buffer_allocated = .true.
1459 call mpp_error( fatal,
"allocate_diag_field_output_buffers: "//&
1460 "you can not use the modern diag manager without compiling with -Duse_yaml")
1462 end subroutine allocate_diag_field_output_buffers
1466 function fms_diag_compare_window(this, field, field_id, &
1467 is_in, ie_in, js_in, je_in, ks_in, ke_in)
result(is_phys_win)
1469 class(*),
intent(in) :: field(:,:,:,:)
1470 integer,
intent(in) :: field_id
1471 integer,
intent(in) :: is_in, js_in
1474 integer,
intent(in) :: ie_in, je_in
1477 integer,
intent(in) :: ks_in, ke_in
1478 logical :: is_phys_win
1480 integer,
pointer :: axis_ids(:)
1481 integer :: total_elements
1483 integer :: field_size
1484 integer,
allocatable :: field_shape(:)
1485 integer :: window_size
1488 field_shape = shape(field(is_in:ie_in, js_in:je_in, ks_in:ke_in, :))
1490 window_size = field_shape(1) * field_shape(2) * field_shape(3)
1493 axis_ids => this%FMS_diag_fields(field_id)%get_axis_id()
1494 do i=1,
size(axis_ids)
1495 total_elements = total_elements * this%fms_get_axis_length(axis_ids(i))
1498 if (total_elements > window_size)
then
1499 is_phys_win = .true.
1501 is_phys_win = .false.
1504 is_phys_win = .false.
1505 call mpp_error( fatal,
"fms_diag_compare_window: "//&
1506 "you can not use the modern diag manager without compiling with -Duse_yaml")
1508 end function fms_diag_compare_window
1510 end module fms_diag_object_mod
integer function get_var_type(var)
gets the type of a variable
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
type(time_type) function get_base_time()
gets the module variable base_time
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.
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.
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.
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...
logical function, dimension(:,:,:,:), allocatable, public init_mask(rmask, mask, field)
Sets the logical mask based on mask or rmask.
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.
subroutine, public diag_yaml_object_end()
Destroys the diag_yaml object.
logical function, public fms_diag_axis_object_end(axis_array)
pure integer function, public get_axis_id_from_name(axis_name, diag_axis, naxis, set_name)
integer function, dimension(:), allocatable, public get_diag_field_ids(indices)
Gets field indices corresponding to the indices (input argument) in the sorted variable_list.
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.
logical function, public fms_diag_axis_object_init(axis_array)
subroutine, public fms_diag_yaml_out()
Writes an output yaml with all available information on the written files. Will only write with root ...
integer function, dimension(:), allocatable, public find_diag_field(diag_field_name, module_name)
Determines if a diag_field is in the diag_yaml_object.
pure character(len=120) function, dimension(2), public parse_compress_att(compress_att)
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.
logical function, public fms_error_handler(routine, message, err_msg)
Facilitates the control of fatal error conditions.
character(:) function, allocatable, public string(v, fmt)
Converts a number or a Boolean value to a string.
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 stdout()
This function returns the current standard fortran unit numbers for output.
integer function mpp_pe()
Returns processor ID.
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