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
103 procedure :: get_diag_buffer
109public :: fms_register_diag_field_obj
110public :: fms_register_diag_field_scalar
111public :: fms_register_diag_field_array
112public :: fms_register_static_field
113public :: fms_diag_field_add_attribute
114public :: fms_get_diag_field_id_from_name
115public :: fms_diag_object
117integer,
private :: registered_variables
118public :: dump_diag_obj
126subroutine fms_diag_object_init (this,diag_subset_output, time_init)
128 integer :: diag_subset_output
129 INTEGER,
DIMENSION(6),
OPTIONAL,
INTENT(IN) :: time_init
132 if (this%initialized)
return
139 if (.not.
present(time_init))
then
144 this%files_initialized = fms_diag_files_object_init(this%FMS_diag_files)
145 this%fields_initialized = fms_diag_fields_object_init(this%FMS_diag_fields)
146 this%buffers_initialized =fms_diag_output_buffer_init(this%FMS_diag_output_buffers,
SIZE(diag_yaml%get_diag_fields()))
147 this%registered_variables = 0
148 this%registered_axis = 0
149 this%data_was_send = .false.
150 this%initialized = .true.
153 "You must compile with -Duse_yaml to use the option use_modern_diag", fatal)
155end subroutine fms_diag_object_init
161subroutine fms_diag_object_end (this, time)
168 if (.not. this%initialized)
return
173 call this%do_buffer_math()
174 call this%fms_diag_do_io(
end_time=time)
176 do i=1,
size(this%FMS_diag_output_buffers)
177 call this%FMS_diag_output_buffers(i)%flush_buffer()
179 deallocate(this%FMS_diag_output_buffers)
181 this%initialized = .false.
184 call mpp_error(fatal,
"You can not call fms_diag_object%end without yaml")
186end subroutine fms_diag_object_end
192integer function fms_register_diag_field_obj &
193 (this, modname, varname, axes, init_time, &
194 longname, units, missing_value, varrange, mask_variant, standname, &
195 do_not_log, err_msg, interp_method, tile_count, area, volume, realm, static, &
199 CHARACTER(len=*),
INTENT(in) :: modname
200 CHARACTER(len=*),
INTENT(in) :: varname
201 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
202 INTEGER,
TARGET,
OPTIONAL,
INTENT(in) :: axes(:)
203 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: longname
204 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
205 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standname
206 class(*),
OPTIONAL,
INTENT(in) :: missing_value
207 class(*),
OPTIONAL,
INTENT(in) :: varrange(2)
208 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
209 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
210 CHARACTER(len=*),
OPTIONAL,
INTENT(out) :: err_msg
211 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
215 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
216 INTEGER,
OPTIONAL,
INTENT(in) :: area
217 INTEGER,
OPTIONAL,
INTENT(in) :: volume
218 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
220 LOGICAL,
OPTIONAL,
INTENT(in) :: static
221 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
230 integer,
allocatable :: file_ids(:)
232 integer,
allocatable :: diag_field_indices(:)
233 class(
diagdomain_t),
pointer :: null_diag_domain => null()
237CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
240 if (diag_field_indices(1) .eq. diag_null)
then
243 deallocate(diag_field_indices)
247 this%registered_variables = this%registered_variables + 1
248 fms_register_diag_field_obj = this%registered_variables
250 call this%FMS_diag_fields(this%registered_variables)%&
251 &setid(this%registered_variables)
254 fieldptr => this%FMS_diag_fields(this%registered_variables)
257 call fieldptr%set_file_ids(file_ids)
260 fieldptr%buffer_allocated = .false.
264 call fieldptr%register(modname, varname, diag_field_indices, this%diag_axis, &
265 axes=axes, longname=longname, units=units, missing_value=missing_value, varrange= varrange, &
266 mask_variant= mask_variant, standname=standname, do_not_log=do_not_log, err_msg=err_msg, &
267 interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
268 static=static, multiple_send_data=multiple_send_data)
271 if (
present(axes) .and.
present(init_time))
then
272 do i = 1,
size(file_ids)
273 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
274 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
275 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
276 if(fieldptr%get_type_of_domain() .eq.
no_domain)
then
277 call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
279 call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
281 call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
282 call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
283 fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
284 call fileptr%add_start_time(init_time)
285 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
287 elseif (
present(axes))
then
288 do i = 1,
size(file_ids)
289 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
290 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
291 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
292 call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
293 if(fieldptr%get_type_of_domain() .eq.
no_domain)
then
294 call fileptr%set_file_domain(null_diag_domain, fieldptr%get_type_of_domain())
296 call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
298 call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
299 fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
300 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
302 elseif (
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 call fileptr%add_start_time(init_time)
308 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
311 do i = 1,
size(file_ids)
312 fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
313 call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
314 call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
315 call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
321 do i = 1,
size(fieldptr%buffer_ids)
322 bufferptr => this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))
323 call bufferptr%set_field_id(this%registered_variables)
324 call bufferptr%set_yaml_id(fieldptr%buffer_ids(i))
326 yamlfptr => diag_yaml%diag_fields(fieldptr%buffer_ids(i))
327 if( yamlfptr%get_var_reduction() .eq.
time_diurnal)
then
328 call bufferptr%set_diurnal_sample_size(yamlfptr%get_n_diurnal())
330 call bufferptr%init_buffer_time(init_time)
331 call bufferptr%set_next_output(this%FMS_diag_files(file_ids(i))%get_next_output(), &
332 this%FMS_diag_files(file_ids(i))%get_next_next_output(), is_static=fieldptr%is_static())
337 deallocate(diag_field_indices)
339end function fms_register_diag_field_obj
344INTEGER FUNCTION fms_register_diag_field_scalar(this,module_name, field_name, init_time, &
345 & long_name, units, missing_value, var_range, standard_name, do_not_log, err_msg,&
346 & area, volume, realm, multiple_send_data)
348 CHARACTER(len=*),
INTENT(in) :: module_name
349 CHARACTER(len=*),
INTENT(in) :: field_name
350 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
351 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
352 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
353 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
354 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
355 CLASS(*),
OPTIONAL,
INTENT(in) :: var_range(:)
356 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
357 CHARACTER(len=*),
OPTIONAL,
INTENT(out):: err_msg
358 INTEGER,
OPTIONAL,
INTENT(in) :: area
359 INTEGER,
OPTIONAL,
INTENT(in) :: volume
360 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
361 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
366CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
368 fms_register_diag_field_scalar = this%register(&
369 & module_name, field_name, init_time=init_time, &
370 & longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
371 & standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
372 & area=area, volume=volume, realm=realm, multiple_send_data=multiple_send_data)
374end function fms_register_diag_field_scalar
379INTEGER FUNCTION fms_register_diag_field_array(this, module_name, field_name, axes, init_time, &
380 & long_name, units, missing_value, var_range, mask_variant, standard_name, verbose,&
381 & do_not_log, err_msg, interp_method, tile_count, area, volume, realm, &
382 & multiple_send_data)
384 CHARACTER(len=*),
INTENT(in) :: module_name
385 CHARACTER(len=*),
INTENT(in) :: field_name
386 INTEGER,
INTENT(in) :: axes(:)
387 TYPE(
time_type),
OPTIONAL,
INTENT(in) :: init_time
388 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
389 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
390 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
391 CLASS(*),
OPTIONAL,
INTENT(in) :: var_range(:)
392 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
393 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
394 LOGICAL,
OPTIONAL,
INTENT(in) :: verbose
395 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
396 CHARACTER(len=*),
OPTIONAL,
INTENT(out):: err_msg
397 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
401 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
402 INTEGER,
OPTIONAL,
INTENT(in) :: area
403 INTEGER,
OPTIONAL,
INTENT(in) :: volume
404 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
405 LOGICAL,
OPTIONAL,
INTENT(in) :: multiple_send_data
411CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
413 fms_register_diag_field_array = this%register( &
414 & module_name, field_name, init_time=init_time, &
415 & axes=axes, longname=long_name, units=units, missing_value=missing_value, varrange=var_range, &
416 & mask_variant=mask_variant, standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, &
417 & interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, &
418 & multiple_send_data=multiple_send_data)
420end function fms_register_diag_field_array
425INTEGER FUNCTION fms_register_static_field(this, module_name, field_name, axes, long_name, units,&
426 & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,&
427 & tile_count, area, volume, realm)
429 CHARACTER(len=*),
INTENT(in) :: module_name
430 CHARACTER(len=*),
INTENT(in) :: field_name
431 INTEGER,
DIMENSION(:),
INTENT(in) :: axes
432 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: long_name
433 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: units
434 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: standard_name
435 CLASS(*),
OPTIONAL,
INTENT(in) :: missing_value
436 CLASS(*),
OPTIONAL,
INTENT(in) :: range(:)
437 LOGICAL,
OPTIONAL,
INTENT(in) :: mask_variant
438 LOGICAL,
OPTIONAL,
INTENT(in) :: dynamic
439 LOGICAL,
OPTIONAL,
INTENT(in) :: do_not_log
440 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: interp_method
444 INTEGER,
OPTIONAL,
INTENT(in) :: tile_count
445 INTEGER,
OPTIONAL,
INTENT(in) :: area
447 INTEGER,
OPTIONAL,
INTENT(in) :: volume
449 CHARACTER(len=*),
OPTIONAL,
INTENT(in) :: realm
454CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
458 if (
size(axes) .eq. 1 .and. axes(1) .eq. null_axis_id)
then
460 fms_register_static_field = this%register( &
461 & module_name, field_name, &
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, &
467 fms_register_static_field = this%register( &
468 & module_name, field_name, axes=axes, &
469 & longname=long_name, units=units, missing_value=missing_value, varrange=range, &
470 & mask_variant=mask_variant, do_not_log=do_not_log, interp_method=interp_method, tile_count=tile_count, &
471 & standname=standard_name, area=area, volume=volume, realm=realm, &
475end function fms_register_static_field
480FUNCTION fms_diag_axis_init(this, axis_name, axis_data, units, cart_name, axis_length, long_name, direction,&
481 & set_name, edges, Domain, Domain2, DomainU, aux, req, tile_count, domain_position ) &
485 CHARACTER(len=*),
INTENT(in) :: axis_name
486 CLASS(*),
INTENT(in) :: axis_data(:)
487 CHARACTER(len=*),
INTENT(in) :: units
488 CHARACTER(len=1),
INTENT(in) :: cart_name
490 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: long_name
491 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: set_name
492 INTEGER,
INTENT(in),
OPTIONAL :: direction
493 INTEGER,
INTENT(in),
OPTIONAL :: edges
494 TYPE(
domain1d),
INTENT(in),
OPTIONAL :: domain
495 TYPE(
domain2d),
INTENT(in),
OPTIONAL :: domain2
496 TYPE(
domainug),
INTENT(in),
OPTIONAL :: domainu
497 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: aux
499 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: req
500 INTEGER,
INTENT(in),
OPTIONAL :: tile_count
501 INTEGER,
INTENT(in),
OPTIONAL :: domain_position
506CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
508 CHARACTER(len=:),
ALLOCATABLE :: edges_name
510 this%registered_axis = this%registered_axis + 1
513 &
"diag_axis_init: max_axes exceeded, increase via diag_manager_nml")
517 select type (axis => this%diag_axis(this%registered_axis)%axis )
519 if(
present(edges))
then
520 if (edges < 0 .or. edges > this%registered_axis) &
521 call mpp_error(fatal,
"diag_axit_init: The edge axis has not been defined. &
522 &Call diag_axis_init for the edge axis first")
523 select type (edges_axis => this%diag_axis(edges)%axis)
525 edges_name = edges_axis%get_axis_name()
526 call axis%set_edges(edges_name, edges)
529 call axis%register(axis_name, axis_data, units, cart_name, long_name=long_name, &
530 & direction=direction, set_name=set_name, domain=domain, domain2=domain2, domainu=domainu, aux=aux, &
533 id = this%registered_axis
534 call axis%set_axis_id(id)
537end function fms_diag_axis_init
546subroutine fms_diag_accept_data (this, diag_field_id, field_data, mask, rmask, &
547 time, is_in, js_in, ks_in, &
548 ie_in, je_in, ke_in, weight, err_msg)
550 INTEGER,
INTENT(in) :: diag_field_id
551 CLASS(*),
DIMENSION(:,:,:,:),
INTENT(in) :: field_data
552 LOGICAL,
allocatable,
INTENT(in) :: mask(:,:,:,:)
554 CLASS(*),
allocatable,
INTENT(in) :: rmask(:,:,:,:)
556 CLASS(*),
INTENT(in),
OPTIONAL :: weight
557 TYPE (
time_type),
INTENT(in),
OPTIONAL :: time
558 INTEGER,
INTENT(in),
OPTIONAL :: is_in, js_in, ks_in
559 INTEGER,
INTENT(in),
OPTIONAL :: ie_in, je_in, ke_in
560 CHARACTER(len=*),
INTENT(out),
OPTIONAL :: err_msg
562 integer :: is, js, ks
563 integer :: ie, je, ke
564 integer :: omp_num_threads
566 logical :: buffer_the_data
568 character(len=128) :: error_string
569 logical :: data_buffer_is_allocated
570 character(len=256) :: field_info
572 logical,
allocatable,
dimension(:,:,:,:) :: oor_mask
573 real(kind=r8_kind) :: field_weight
577 logical :: using_blocking
579CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
583 field_info =
" Check send data call for field:"//trim(this%FMS_diag_fields(diag_field_id)%get_varname())//&
584 " and module:"//trim(this%FMS_diag_fields(diag_field_id)%get_modname())
587 if (.not.this%FMS_diag_fields(diag_field_id)%is_static() .and. .not.
present(time)) &
588 call mpp_error(fatal,
"Time must be present if the field is not static. "//trim(field_info))
595 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
597 using_blocking = .false.
598 if ((
present(is_in) .and. .not.
present(ie_in)) .or. (
present(js_in) .and. .not.
present(je_in))) &
599 using_blocking = .true.
602 if ((
present(is_in) .and.
present(ie_in)) .or. (
present(js_in) .and.
present(je_in))) &
606 if (this%FMS_diag_fields(diag_field_id)%is_mask_variant())
then
607 if (.not.
allocated(mask) .and. .not.
allocated(rmask))
call mpp_error(fatal, &
608 "The field was registered with mask_variant, but mask or rmask are not present in the send_data call. "//&
613 if (
allocated(mask) .and.
allocated(rmask))
call mpp_error(fatal, &
614 "mask and rmask are both present in the send_data call. "//&
618 oor_mask =
init_mask(rmask, mask, field_data)
621 buffer_the_data = .false.
627 omp_num_threads = omp_get_num_threads()
628 omp_level = omp_get_level()
629 buffer_the_data = (omp_num_threads > 1 .AND. omp_level > 0)
637 IF (
PRESENT(is_in) ) is = is_in
638 IF (
PRESENT(js_in) ) js = js_in
639 IF (
PRESENT(ks_in) ) ks = ks_in
640 ie = is+
SIZE(field_data, 1)-1
641 je = js+
SIZE(field_data, 2)-1
642 ke = ks+
SIZE(field_data, 3)-1
643 IF (
PRESENT(ie_in) ) ie = ie_in
644 IF (
PRESENT(je_in) ) je = je_in
645 IF (
PRESENT(ke_in) ) ke = ke_in
647 if (.not. buffer_the_data .and. using_blocking)
then
650 buffer_the_data = check_for_slices(this%FMS_diag_fields(diag_field_id), this%diag_axis, &
656 if (this%FMS_diag_fields(diag_field_id)%get_multiple_send_data()) &
657 buffer_the_data = .true.
660 main_if:
if (buffer_the_data)
then
664 if (.not. this%data_was_send) this%data_was_send = .true.
668 if(has_halos)
call this%FMS_diag_fields(diag_field_id)%set_halo_present()
671 if(.not. this%FMS_diag_fields(diag_field_id)%has_vartype()) &
672 call this%FMS_diag_fields(diag_field_id)%set_type(field_data(1,1,1,1))
674 if (
allocated(mask) .or.
allocated(rmask))
then
675 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.true.)
677 call this%FMS_diag_fields(diag_field_id)%set_var_is_masked(.false.)
680 if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated())
then
681 data_buffer_is_allocated = &
682 this%FMS_diag_fields(diag_field_id)%allocate_data_buffer(field_data, this%diag_axis)
683 if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
684 call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask, this%diag_axis)
686 call this%FMS_diag_fields(diag_field_id)%set_send_data_time(time)
687 call this%FMS_diag_fields(diag_field_id)%set_data_buffer_is_allocated(.true.)
688 call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.true.)
690 call this%FMS_diag_fields(diag_field_id)%set_data_buffer(field_data, oor_mask, field_weight, &
691 is, js, ks, ie, je, ke)
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 error_string = bounds%set_bounds(field_data, is, ie, js, je, ks, ke, has_halos)
712 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
714 call this%allocate_diag_field_output_buffers(field_data, diag_field_id)
715 error_string = this%fms_diag_do_reduction(field_data, diag_field_id, oor_mask, field_weight, &
716 bounds, using_blocking, time=time)
717 if (trim(error_string) .ne.
"")
call mpp_error(fatal, trim(error_string)//
". "//trim(field_info))
718 call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.false.)
719 if(.not. this%FMS_diag_fields(diag_field_id)%has_mask_allocated()) &
720 call this%FMS_diag_fields(diag_field_id)%allocate_mask(oor_mask)
721 call this%FMS_diag_fields(diag_field_id)%set_mask(oor_mask, field_info)
725end subroutine fms_diag_accept_data
728subroutine do_buffer_math(this)
740 integer,
dimension(:),
allocatable :: file_field_ids
741 class(*),
pointer :: input_data_buffer(:,:,:,:)
742 character(len=128) :: error_string
744 integer,
dimension(:),
allocatable :: file_ids
745 logical,
parameter :: debug_sc = .false.
750 field_loop:
do ifield = 1,
size(this%FMS_diag_fields)
751 diag_field => this%FMS_diag_fields(ifield)
752 if(.not. diag_field%is_registered()) cycle
753 if(debug_sc)
call mpp_error(note,
"fms_diag_send_complete:: var: "//diag_field%get_varname())
755 allocate (file_ids(
size(diag_field%get_file_ids() )))
756 file_ids = diag_field%get_file_ids()
757 math = diag_field%get_math_needs_to_be_done()
759 doing_math:
if (
size(file_ids) .ge. 1 .and. math)
then
761 has_input_buff:
if (diag_field%has_input_data_buffer())
then
762 call diag_field%prepare_data_buffer()
763 input_data_buffer => diag_field%get_data_buffer()
765 call bounds%reset_bounds_from_array_4D(input_data_buffer)
766 call this%allocate_diag_field_output_buffers(input_data_buffer, ifield)
767 error_string = this%fms_diag_do_reduction(input_data_buffer, ifield, &
768 diag_field%get_mask(), diag_field%get_weight(), &
769 bounds, .false., time=diag_field%get_send_data_time())
770 call diag_field%init_data_buffer()
771 if (trim(error_string) .ne.
"")
call mpp_error(fatal,
"Field:"//trim(diag_field%get_varname()//&
772 " -"//trim(error_string)))
774 call mpp_error(fatal,
"diag_send_complete:: no input buffer allocated for field"//diag_field%get_longname())
777 call diag_field%set_math_needs_to_be_done(.false.)
779 if (
allocated(file_ids))
deallocate(file_ids)
780 if (
associated(diag_field))
nullify(diag_field)
783end subroutine do_buffer_math
787subroutine fms_diag_send_complete(this, time_step)
789 TYPE (
time_type),
INTENT(in) :: time_step
792CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
795 if (.not. this%data_was_send)
return
797 call this%do_buffer_math()
798 call this%fms_diag_do_io()
800 this%data_was_send = .false.
803end subroutine fms_diag_send_complete
809subroutine fms_diag_do_io(this, end_time)
819 integer,
allocatable :: buff_ids(:)
821 logical :: file_is_opened_this_time_step
823 logical :: force_write
824 logical :: finish_writing
826 logical,
parameter :: debug_reduct = .false.
827 class(*),
allocatable :: missing_val
828 real(r8_kind) :: mval
829 character(len=128) :: error_string
830 logical :: unlim_dim_was_increased
831 logical :: do_not_write
833 force_write = .false.
835 do i = 1,
size(this%FMS_diag_files)
836 diag_file => this%FMS_diag_files(i)
839 if (.not. diag_file%writing_on_this_pe()) cycle
845 model_time => diag_file%get_model_time()
847 if (diag_file%FMS_diag_file%is_done_writing_data()) cycle
849 call diag_file%open_diag_file(model_time, file_is_opened_this_time_step)
850 if (file_is_opened_this_time_step)
then
852 call diag_file%init_unlim_dim(this%FMS_diag_output_buffers)
854 call diag_file%write_global_metadata()
855 call diag_file%write_axis_metadata(this%diag_axis)
856 call diag_file%write_time_metadata()
857 call diag_file%write_field_metadata(this%FMS_diag_fields, this%diag_axis)
858 call diag_file%write_axis_data(this%diag_axis)
861 call diag_file%check_file_times(model_time, this%FMS_diag_output_buffers, &
862 this%FMS_diag_fields, do_not_write)
863 unlim_dim_was_increased = .false.
866 buff_ids = diag_file%FMS_diag_file%get_buffer_ids()
868 buff_loop:
do ibuff=1,
SIZE(buff_ids)
869 diag_buff => this%FMS_diag_output_buffers(buff_ids(ibuff))
870 field_yaml => diag_yaml%diag_fields(diag_buff%get_yaml_id())
871 diag_field => this%FMS_diag_fields(diag_buff%get_field_id())
874 if (.not. diag_buff%is_there_data_to_write()) cycle
876 if ( diag_buff%is_time_to_finish_reduction(
end_time) .and. .not. do_not_write)
then
878 mval = diag_field%find_missing_value(missing_val)
880 if( field_yaml%has_var_reduction())
then
881 if( field_yaml%get_var_reduction() .ge.
time_average)
then
882 if(debug_reduct)
call mpp_error(note,
"fms_diag_do_io:: finishing reduction for "//diag_field%get_longname())
883 error_string = diag_buff%diag_reduction_done_wrapper( &
884 field_yaml%get_var_reduction(), &
885 mval, diag_field%get_var_is_masked(), diag_field%get_mask_variant())
888 call diag_file%write_field_data(diag_field, diag_buff, unlim_dim_was_increased)
889 call diag_buff%set_next_output(diag_file%get_next_output(), diag_file%get_next_next_output())
896 if (unlim_dim_was_increased)
then
897 call diag_file%write_time_data()
898 call diag_file%flush_diag_file()
899 call diag_file%update_next_write(model_time)
900 call diag_file%update_current_new_file_freq_index(model_time)
901 if (diag_file%is_time_to_close_file(model_time, force_write)) &
902 call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
903 this%model_end_time, diag_fields = this%FMS_diag_fields)
904 else if (force_write)
then
905 call diag_file%prepare_for_force_write()
906 call diag_file%write_time_data()
907 call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
908 this%model_end_time, diag_fields = this%FMS_diag_fields)
912end subroutine fms_diag_do_io
917function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, &
918 bounds, using_blocking, time) &
921 class(*),
intent(in) :: field_data(:,:,:,:)
922 integer,
intent(in) :: diag_field_id
923 logical,
intent(in),
target :: oor_mask(:,:,:,:)
924 real(kind=r8_kind),
intent(in) :: weight
926 logical,
intent(in) :: using_blocking
928 type(
time_type),
intent(in),
optional :: time
930 character(len=150) :: error_msg
938 integer :: reduction_method
942 integer,
pointer :: axis_ids(:)
943 logical :: is_subregional
944 logical :: reduced_k_range
951 integer :: compute_idx(2)
952 character(len=1) :: cart_axis
953 logical :: block_in_subregion
956 real(kind=r8_kind) :: missing_value
961 field_ptr => this%FMS_diag_fields(diag_field_id)
962 if (field_ptr%has_missing_value())
then
963 select type (missing_val => field_ptr%get_missing_value(
r8))
964 type is (real(kind=r8_kind))
965 missing_value = missing_val
967 call mpp_error(fatal,
"The missing value for the field:"//trim(field_ptr%get_varname())//&
968 &
" was not allocated to the correct type. This shouldn't have happened")
971 select type (missing_val => get_default_missing_value(
r8))
972 type is (real(kind=r8_kind))
973 missing_value = missing_val
975 call mpp_error(fatal,
"The missing value for the field:"//trim(field_ptr%get_varname())//&
976 &
" was not allocated to the correct type. This shouldn't have happened")
980 buffer_loop:
do ids = 1,
size(field_ptr%buffer_ids)
982 buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids)
983 file_id = this%FMS_diag_fields(diag_field_id)%file_ids(ids)
986 field_yaml_ptr => field_ptr%diag_field(ids)
987 buffer_ptr => this%FMS_diag_output_buffers(buffer_id)
988 file_ptr => this%FMS_diag_files(file_id)
991 if (.not. file_ptr%writing_on_this_pe()) cycle
994 if (buffer_ptr%is_done_with_math()) cycle
996 if (
present(time))
call file_ptr%set_model_time(time)
997 if (.not. file_ptr%time_to_start_doing_math()) cycle
1000 if (.not. using_blocking)
then
1002 call bounds_out%reset_bounds_from_array_4D(buffer_ptr%buffer(:,:,:,:,1))
1006 if (.not. bounds%has_halos)
then
1008 call bounds_in%reset_bounds_from_array_4D(field_data)
1011 is_subregional = file_ptr%is_regional()
1012 reduced_k_range = field_yaml_ptr%has_var_zbounds()
1015 is_subregional_reduced_k_range:
if (is_subregional .or. reduced_k_range)
then
1016 call buffer_ptr%get_axis_ids(axis_ids)
1017 block_in_subregion = .true.
1018 axis_loops:
do i = 1,
size(axis_ids)
1020 if (.not. block_in_subregion) cycle
1022 select type (diag_axis => this%diag_axis(axis_ids(i))%axis)
1024 sindex = diag_axis%get_starting_index()
1025 eindex = diag_axis%get_ending_index()
1026 compute_idx = diag_axis%get_compute_indices()
1027 starting=sindex-compute_idx(1)+1
1028 ending=eindex-compute_idx(1)+1
1029 if (using_blocking)
then
1031 if (.not. block_in_subregion) cycle
1034 call bounds_in%rebase_input(bounds, starting, ending, i)
1037 call bounds_out%rebase_output(starting, ending, i)
1040 call bounds_in%update_index(starting, ending, i, .false.)
1043 call bounds_out%update_index(1, ending-starting+1, i, .true.)
1049 if (.not. block_in_subregion) cycle
1050 endif is_subregional_reduced_k_range
1053 reduction_method = field_yaml_ptr%get_var_reduction()
1054 if (
present(time))
call buffer_ptr%update_buffer_time(time)
1055 call buffer_ptr%set_send_data_called()
1056 select case(reduction_method)
1058 error_msg = buffer_ptr%do_time_none_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_min_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1065 bounds_in, bounds_out, missing_value)
1066 if (trim(error_msg) .ne.
"")
then
1070 error_msg = buffer_ptr%do_time_max_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1071 bounds_in, bounds_out, missing_value)
1072 if (trim(error_msg) .ne.
"")
then
1076 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1077 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value())
1078 if (trim(error_msg) .ne.
"")
then
1082 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1083 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1085 if (trim(error_msg) .ne.
"")
then
1089 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1090 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1091 weight=weight, pow_value=field_yaml_ptr%get_pow_value())
1092 if (trim(error_msg) .ne.
"")
then
1096 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1097 field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
1098 weight=weight, pow_value = 2)
1099 if (trim(error_msg) .ne.
"")
then
1103 if(.not.
present(time))
call mpp_error(fatal, &
1104 "fms_diag_do_reduction:: time must be present when using diurnal reductions")
1106 call buffer_ptr%set_diurnal_section_index(time)
1107 error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
1108 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 =
"The reduction method is not supported. "//&
1115 "Only none, min, max, sum, average, power, rms, and diurnal are supported."
1118 if (field_ptr%is_static() .or. file_ptr%FMS_diag_file%is_done_writing_data())
then
1119 call buffer_ptr%set_done_with_math()
1124 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1126end function fms_diag_do_reduction
1129subroutine fms_diag_field_add_cell_measures(this, diag_field_id, area, volume)
1131 integer,
intent(in) :: diag_field_id
1132 INTEGER,
optional,
INTENT(in) :: area
1133 INTEGER,
optional,
INTENT(in) :: volume
1136 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1138 call this%FMS_diag_fields(diag_field_id)%add_area_volume(area, volume)
1140end subroutine fms_diag_field_add_cell_measures
1143subroutine fms_diag_field_add_attribute(this, diag_field_id, att_name, att_value)
1145 integer,
intent(in) :: diag_field_id
1146 character(len=*),
intent(in) :: att_name
1147 class(*),
intent(in) :: att_value(:)
1149CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1152 if ( diag_field_id .LE. 0 )
THEN
1155 if (this%FMS_diag_fields(diag_field_id)%is_registered() ) &
1156 call this%FMS_diag_fields(diag_field_id)%add_attribute(att_name, att_value)
1159end subroutine fms_diag_field_add_attribute
1162subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value)
1164 integer,
intent(in) :: axis_id
1165 character(len=*),
intent(in) :: att_name
1166 class(*),
intent(in) :: att_value(:)
1168 character(len=20) :: axis_names(2)
1169 character(len=20) :: set_name
1170 integer :: uncmx_ids(2)
1173CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1175 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1176 call mpp_error(fatal,
"diag_axis_add_attribute: The axis_id is not valid")
1178 select type (axis => this%diag_axis(axis_id)%axis)
1180 call axis%add_axis_attribute(att_name, att_value)
1187 if (trim(att_name) .eq.
"compress")
then
1193 if (axis%has_set_name()) set_name = axis%get_set_name()
1194 do j = 1,
size(axis_names)
1196 if (uncmx_ids(j) .eq. diag_null)
call mpp_error(fatal, &
1197 &
"Error parsing the compress attribute for axis: "//trim(axis%get_axis_name())//&
1198 &
". Be sure that the axes in the compress attribute are registered")
1200 call axis%add_structured_axis_ids(uncmx_ids)
1204end subroutine fms_diag_axis_add_attribute
1208function fms_get_field_name_from_id (this, field_id) &
1212 integer,
intent (in) :: field_id
1213 character(len=:),
allocatable :: field_name
1215 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1217 field_name = this%FMS_diag_fields(field_id)%get_varname()
1219end function fms_get_field_name_from_id
1223FUNCTION fms_get_diag_field_id_from_name(this, module_name, field_name) &
1224 result(diag_field_id)
1226 CHARACTER(len=*),
INTENT(in) :: module_name
1227 CHARACTER(len=*),
INTENT(in) :: field_name
1228 integer :: diag_field_id
1232 integer,
allocatable :: diag_field_indices(:)
1237 do i=1, this%registered_variables
1239 diag_field_id = this%FMS_diag_fields(i)%id_from_name(module_name, field_name)
1246 if (diag_field_indices(1) .ne. diag_null)
then
1247 diag_field_id = diag_not_registered
1249 deallocate(diag_field_indices)
1252 CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1254END FUNCTION fms_get_diag_field_id_from_name
1259function get_diag_buffer(this, bufferid) &
1262 integer,
intent(in) :: bufferid
1264 if( (bufferid .gt. ubound(this%FMS_diag_output_buffers, 1)) .or. &
1265 (bufferid .lt. lbound(this%FMS_diag_output_buffers, 1))) &
1266 call mpp_error(fatal,
'get_diag_bufer: invalid bufferid given')
1267 rslt = this%FMS_diag_output_buffers(bufferid)
1273type(
domain2d) function fms_get_domain2d(this, ids)
1275 INTEGER,
DIMENSION(:),
INTENT(in) :: ids
1278CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1279fms_get_domain2d = null_domain2d
1281 INTEGER :: type_of_domain
1286 call mpp_error(fatal,
'diag_axis_mod::get_domain2d- The axis do not correspond to a 2d Domain')
1289 fms_get_domain2d = domain%domain2
1292END FUNCTION fms_get_domain2d
1296 integer function fms_get_axis_length(this, axis_id)
1298 INTEGER,
INTENT(in) :: axis_id
1301CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1302fms_get_axis_length = 0
1304fms_get_axis_length = 0
1306 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1307 call mpp_error(fatal,
"fms_get_axis_length: The axis_id is not valid")
1309 select type (axis => this%diag_axis(axis_id)%axis)
1310 type is (fmsdiagfullaxis_type)
1311 fms_get_axis_length = axis%axis_length()
1312 type is (fmsdiagsubaxis_type)
1313 fms_get_axis_length = axis%axis_length()
1316end function fms_get_axis_length
1320function fms_get_axis_name_from_id (this, axis_id) &
1323 INTEGER,
INTENT(in) :: axis_id
1325 character (len=:),
allocatable :: axis_name
1328CALL mpp_error(fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1331 if (axis_id < 0 .and. axis_id > this%registered_axis) &
1332 call mpp_error(fatal,
"fms_get_axis_length: The axis_id is not valid")
1335 if (axis_id .eq. null_axis_id)
then
1336 allocate(
character(len=3) :: axis_name)
1342 select type (axis => this%diag_axis(axis_id)%axis)
1343 type is (fmsdiagfullaxis_type)
1344 axis_name = axis%get_axis_name()
1347end function fms_get_axis_name_from_id
1351subroutine dump_diag_obj( filename )
1352 character(len=*),
intent(in),
optional :: filename
1356 type(fmsdiagfile_type),
pointer :: fileptr
1357 type(fmsdiagfield_type),
pointer :: fieldptr
1361 if(
present(filename) )
then
1362 open(newunit=unit_num, file=trim(filename), action=
'WRITE')
1366 if( mpp_pe() .eq. mpp_root_pe())
then
1367 write(unit_num, *)
'********** dumping diag object ***********'
1368 write(unit_num, *)
'registered_variables:', fms_diag_object%registered_variables
1369 write(unit_num, *)
'registered_axis:', fms_diag_object%registered_axis
1370 write(unit_num, *)
'initialized:', fms_diag_object%initialized
1371 write(unit_num, *)
'files_initialized:', fms_diag_object%files_initialized
1372 write(unit_num, *)
'fields_initialized:', fms_diag_object%fields_initialized
1373 write(unit_num, *)
'buffers_initialized:', fms_diag_object%buffers_initialized
1374 write(unit_num, *)
'axes_initialized:', fms_diag_object%axes_initialized
1375 write(unit_num, *)
'Files:'
1376 if( fms_diag_object%files_initialized )
then
1377 do i=1,
SIZE(fms_diag_object%FMS_diag_files)
1378 write(unit_num, *)
'File num:', i
1379 fileptr => fms_diag_object%FMS_diag_files(i)%FMS_diag_file
1380 call fileptr%dump_file_obj(unit_num)
1383 write(unit_num, *)
'files not initialized'
1385 if( fms_diag_object%fields_initialized)
then
1386 do i=1,
SIZE(fms_diag_object%FMS_diag_fields)
1387 write(unit_num, *)
'Field num:', i
1388 fieldptr => fms_diag_object%FMS_diag_fields(i)
1389 call fieldptr%dump_field_obj(unit_num)
1392 write(unit_num, *)
'fields not initialized'
1394 if(
present(filename) )
close(unit_num)
1397 call mpp_error( fatal,
"You can not use the modern diag manager without compiling with -Duse_yaml")
1403subroutine allocate_diag_field_output_buffers(this, field_data, field_id)
1405 class(*),
dimension(:,:,:,:),
intent(in) :: field_data
1406 integer,
intent(in) :: field_id
1409 integer :: buffer_id
1410 integer :: num_diurnal_samples
1411 integer :: axes_length(4)
1413 class(fmsdiagoutputbuffer_type),
pointer :: ptr_diag_buffer_obj
1414 class(diagyamlfilesvar_type),
pointer :: ptr_diag_field_yaml
1415 integer,
pointer :: axis_ids(:)
1417 character(len=:),
allocatable :: var_name
1418 logical :: is_scalar
1422 if (this%FMS_diag_fields(field_id)%buffer_allocated)
return
1425 var_type = get_var_type(field_data(1, 1, 1, 1))
1428 var_name = this%FMS_diag_fields(field_id)%get_varname()
1431 is_scalar = this%FMS_diag_fields(field_id)%is_scalar()
1434 do i = 1,
size(this%FMS_diag_fields(field_id)%buffer_ids)
1435 buffer_id = this%FMS_diag_fields(field_id)%buffer_ids(i)
1436 file_id = this%FMS_diag_fields(field_id)%file_ids(i)
1439 if (.not. this%FMS_diag_files(file_id)%writing_on_this_pe()) cycle
1442 if (.not. is_scalar)
then
1443 call this%FMS_diag_output_buffers(buffer_id)%get_axis_ids(axis_ids)
1444 ndims =
size(axis_ids)
1447 yaml_id = this%FMS_diag_output_buffers(buffer_id)%get_yaml_id()
1449 ptr_diag_field_yaml => diag_yaml%diag_fields(yaml_id)
1450 num_diurnal_samples = ptr_diag_field_yaml%get_n_diurnal()
1454 axes_length(j) = this%fms_get_axis_length(axis_ids(j))
1457 if (num_diurnal_samples .ne. 0)
then
1461 ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id)
1462 call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, axes_length(1:4), &
1463 this%FMS_diag_fields(field_id)%get_mask_variant(), var_name, num_diurnal_samples)
1464 call ptr_diag_buffer_obj%initialize_buffer(ptr_diag_field_yaml%get_var_reduction(), var_name)
1469 this%FMS_diag_fields(field_id)%buffer_allocated = .true.
1471 call mpp_error( fatal,
"allocate_diag_field_output_buffers: "//&
1472 "you can not use the modern diag manager without compiling with -Duse_yaml")
1474end subroutine allocate_diag_field_output_buffers
1478function fms_diag_compare_window(this, field, field_id, &
1479 is_in, ie_in, js_in, je_in, ks_in, ke_in)
result(is_phys_win)
1481 class(*),
intent(in) :: field(:,:,:,:)
1482 integer,
intent(in) :: field_id
1483 integer,
intent(in) :: is_in, js_in
1486 integer,
intent(in) :: ie_in, je_in
1489 integer,
intent(in) :: ks_in, ke_in
1490 logical :: is_phys_win
1492 integer,
pointer :: axis_ids(:)
1493 integer :: total_elements
1495 integer :: field_size
1496 integer,
allocatable :: field_shape(:)
1497 integer :: window_size
1500 field_shape = shape(field(is_in:ie_in, js_in:je_in, ks_in:ke_in, :))
1502 window_size = field_shape(1) * field_shape(2) * field_shape(3)
1505 axis_ids => this%FMS_diag_fields(field_id)%get_axis_id()
1506 do i=1,
size(axis_ids)
1507 total_elements = total_elements * this%fms_get_axis_length(axis_ids(i))
1510 if (total_elements > window_size)
then
1511 is_phys_win = .true.
1513 is_phys_win = .false.
1516 is_phys_win = .false.
1517 call mpp_error( fatal,
"fms_diag_compare_window: "//&
1518 "you can not use the modern diag manager without compiling with -Duse_yaml")
1520end function fms_diag_compare_window
1523subroutine set_time_end(this, time_end_in)
1525 type(time_type),
intent(in) :: time_end_in
1527 this%model_end_time = time_end_in
1531end 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)
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 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)
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