26 module fms_diag_file_object_mod
28 use fms2_io_mod,
only: fmsnetcdffile_t, fmsnetcdfunstructureddomainfile_t, fmsnetcdfdomainfile_t, &
31 dimension_exists, register_global_attribute, flush_file
41 OPERATOR(/),
OPERATOR(+),
operator(<)
52 uppercase, lowercase, note,
mpp_max
53 use platform_mod,
only: fms_file_len
55 mpp_get_io_domain_ug_layout
60 public ::
fmsdiagfile_type, fms_diag_files_object_init, fms_diag_files_object_initialized
62 logical :: fms_diag_files_object_initialized = .false.
64 integer,
parameter :: var_string_len = 25
75 logical :: done_writing_data
79 logical :: is_file_open
81 class(fmsnetcdffile_t),
allocatable :: fms2io_fileobj
83 integer :: type_of_domain
87 character(len=:) ,
dimension(:),
allocatable :: file_metadata_from_model
89 integer,
dimension(:),
allocatable :: field_ids
90 integer,
dimension(:),
allocatable :: yaml_ids
91 logical,
dimension(:),
private,
allocatable :: field_registered
94 integer,
allocatable :: num_registered_fields
96 integer,
dimension(:),
allocatable :: axis_ids
97 integer :: number_of_axis
98 integer,
dimension(:),
allocatable :: buffer_ids
99 integer :: number_of_buffers
100 logical,
allocatable :: time_ops
102 integer :: unlim_dimension_level
103 integer :: num_time_levels
104 logical :: data_has_been_written
106 integer :: nz_subaxis
109 procedure,
public :: add_field_and_yaml_id
110 procedure,
public :: add_buffer_id
111 procedure,
public :: is_field_registered
112 procedure,
public :: init_diurnal_axis
113 procedure,
public :: has_file_metadata_from_model
114 procedure,
public :: has_fileobj
115 procedure,
public :: has_diag_yaml_file
116 procedure,
public :: set_domain_from_axis
117 procedure,
public :: set_file_domain
118 procedure,
public :: add_axes
119 procedure,
public :: add_new_axis
120 procedure,
public :: update_write_on_this_pe
121 procedure,
public :: get_write_on_this_pe
122 procedure,
public :: does_axis_exist
123 procedure,
public :: define_new_subaxis
124 procedure,
public :: add_start_time
125 procedure,
public :: set_file_time_ops
126 procedure,
public :: has_field_ids
127 procedure,
public :: get_time_ops
128 procedure,
public :: get_id
131 procedure,
public :: get_file_metadata_from_model
132 procedure,
public :: get_field_ids
134 procedure,
public :: get_file_fname
135 procedure,
public :: get_file_frequnit
136 procedure,
public :: get_file_freq
137 procedure,
public :: get_file_timeunit
138 procedure,
public :: get_file_unlimdim
139 procedure,
public :: get_file_sub_region
140 procedure,
public :: get_file_sub_region_grid_type
141 procedure,
public :: get_file_new_file_freq
142 procedure,
public :: get_filename_time
143 procedure,
public :: get_file_new_file_freq_units
144 procedure,
public :: get_file_start_time
145 procedure,
public :: get_file_duration
146 procedure,
public :: get_file_duration_units
147 procedure,
public :: get_file_varlist
148 procedure,
public :: get_file_global_meta
149 procedure,
public :: is_done_writing_data
150 procedure,
public :: has_file_fname
151 procedure,
public :: has_file_frequnit
152 procedure,
public :: has_file_freq
153 procedure,
public :: has_file_timeunit
154 procedure,
public :: has_file_unlimdim
155 procedure,
public :: has_file_sub_region
156 procedure,
public :: has_file_new_file_freq
157 procedure,
public :: has_file_new_file_freq_units
158 procedure,
public :: has_file_start_time
159 procedure,
public :: has_file_duration
160 procedure,
public :: has_file_duration_units
161 procedure,
public :: has_file_varlist
162 procedure,
public :: has_file_global_meta
163 procedure,
public :: dump_file_obj
164 procedure,
public :: get_buffer_ids
165 procedure,
public :: get_number_of_buffers
166 procedure,
public :: has_send_data_been_called
167 procedure,
public :: check_buffer_times
171 integer,
dimension(:),
allocatable :: sub_axis_ids
172 logical :: write_on_this_pe
173 logical :: is_subaxis_defined
181 procedure :: is_regional
182 procedure :: is_file_static
183 procedure :: open_diag_file
184 procedure :: write_global_metadata
185 procedure :: write_time_metadata
186 procedure :: write_field_data
187 procedure :: write_axis_metadata
188 procedure :: write_field_metadata
189 procedure :: write_axis_data
190 procedure :: writing_on_this_pe
191 procedure :: check_file_times
192 procedure :: is_time_to_close_file
193 procedure :: write_time_data
194 procedure :: update_next_write
195 procedure :: prepare_for_force_write
196 procedure :: init_unlim_dim
197 procedure :: update_current_new_file_freq_index
198 procedure :: get_unlim_dimension_level
199 procedure :: get_num_time_levels
200 procedure :: get_num_tiles
201 procedure :: get_ndistributedfiles
202 procedure :: flush_diag_file
203 procedure :: get_next_output
204 procedure :: get_next_next_output
205 procedure :: close_diag_file
206 procedure :: set_model_time
207 procedure :: get_model_time
208 procedure :: time_to_start_doing_math
218 logical function fms_diag_files_object_init (files_array)
223 if (diag_yaml%has_diag_files())
then
224 nfiles = diag_yaml%size_diag_files()
225 allocate (files_array(nfiles))
226 set_ids_loop:
do i= 1,nfiles
229 if (diag_yaml%diag_files(i)%has_file_sub_region())
then
231 obj => files_array(i)%FMS_diag_file
234 allocate(obj%sub_axis_ids(
max_axes))
235 obj%sub_axis_ids = diag_null
236 obj%write_on_this_pe = .true.
237 obj%is_subaxis_defined = .false.
238 obj%number_of_axis = 0
242 obj => files_array(i)%FMS_diag_file
245 obj%diag_yaml_file => diag_yaml%diag_files(i)
247 allocate(obj%field_ids(diag_yaml%diag_files(i)%size_file_varlist()))
248 allocate(obj%buffer_ids(diag_yaml%diag_files(i)%size_file_varlist()))
249 allocate(obj%yaml_ids(diag_yaml%diag_files(i)%size_file_varlist()))
250 allocate(obj%field_registered(diag_yaml%diag_files(i)%size_file_varlist()))
252 obj%field_ids = diag_not_registered
253 obj%yaml_ids = diag_not_registered
254 obj%buffer_ids = diag_not_registered
255 obj%field_registered = .false.
256 obj%num_registered_fields = 0
257 obj%number_of_buffers = 0
265 obj%number_of_axis = 0
268 obj%done_writing_data = .false.
273 if (obj%has_file_start_time())
then
274 obj%start_time = obj%get_file_start_time()
278 obj%last_output = obj%start_time
280 obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit())
281 obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit())
283 if (obj%has_file_new_file_freq())
then
284 obj%next_close = diag_time_inc(obj%start_time, obj%get_file_new_file_freq(), &
285 obj%get_file_new_file_freq_units())
287 if (obj%has_file_duration())
then
288 obj%next_close = diag_time_inc(obj%start_time, obj%get_file_duration(), &
289 obj%get_file_duration_units())
291 obj%next_close = diag_time_inc(obj%start_time, very_large_file_freq, diag_days)
294 obj%is_file_open = .false.
296 if(obj%has_file_duration())
then
297 obj%no_more_data = diag_time_inc(obj%start_time, obj%get_file_duration(), &
298 obj%get_file_duration_units())
300 obj%no_more_data = diag_time_inc(obj%start_time, very_large_file_freq, diag_days)
303 obj%unlim_dimension_level = 0
304 obj%num_time_levels = 0
305 obj%is_static = obj%get_file_freq() .eq. -1
310 fms_diag_files_object_init = .true.
312 fms_diag_files_object_init = .false.
316 end function fms_diag_files_object_init
320 pure logical function is_field_registered(this, field_id)
322 integer,
intent(in) :: field_id
324 is_field_registered = this%field_registered(field_id)
325 end function is_field_registered
328 subroutine add_field_and_yaml_id (this, new_field_id, yaml_id)
330 integer,
intent(in) :: new_field_id
331 integer,
intent(in) :: yaml_id
333 this%num_registered_fields = this%num_registered_fields + 1
334 if (this%num_registered_fields .le.
size(this%field_ids))
then
335 this%field_ids( this%num_registered_fields ) = new_field_id
336 this%yaml_ids( this%num_registered_fields ) = yaml_id
337 this%field_registered( this%num_registered_fields ) = .true.
339 call mpp_error(fatal,
"The file: "//this%get_file_fname()//
" has already been assigned its maximum "//&
342 end subroutine add_field_and_yaml_id
345 subroutine add_buffer_id (this, buffer_id)
347 integer,
intent(in) :: buffer_id
349 this%number_of_buffers = this%number_of_buffers + 1
350 this%buffer_ids(this%number_of_buffers) = buffer_id
352 end subroutine add_buffer_id
357 subroutine init_diurnal_axis(this, diag_axis, naxis, yaml_id)
360 integer,
intent(inout) :: naxis
361 integer,
intent(in) :: yaml_id
366 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
369 if (.not. field_yaml%has_n_diurnal())
return
372 do i = 1, this%number_of_axis
373 select type(axis=>diag_axis(this%axis_ids(i))%axis)
375 if(field_yaml%get_n_diurnal() .eq. axis%get_diurnal_axis_samples())
return
384 this%number_of_axis = this%number_of_axis + 1
385 this%axis_ids(this%number_of_axis) = naxis
387 this%number_of_axis = this%number_of_axis + 1
388 this%axis_ids(this%number_of_axis) = naxis - 1
390 end subroutine init_diurnal_axis
393 subroutine set_file_time_ops(this, VarYaml, is_static)
396 logical,
intent(in) :: is_static
397 integer,
allocatable :: var_reduct
400 if (this%is_static)
return
401 if (is_static)
return
404 if (.not.
allocated(this%time_ops))
then
405 var_reduct = varyaml%get_var_reduction()
407 select case (var_reduct)
409 this%time_ops = .true.
411 this%time_ops = .false.
417 if (this%time_ops)
then
418 if (varyaml%get_var_reduction() .eq.
time_none) &
419 call mpp_error(fatal,
"The file: "//this%get_file_fname()//&
420 " has variables that are time averaged and instantaneous")
422 if (varyaml%get_var_reduction() .ne.
time_none) &
423 call mpp_error(fatal,
"The file: "//this%get_file_fname()//&
424 " has variables that are time averaged and instantaneous")
426 end subroutine set_file_time_ops
430 pure logical function has_file_metadata_from_model (this)
432 has_file_metadata_from_model =
allocated(this%file_metadata_from_model)
433 end function has_file_metadata_from_model
437 pure logical function has_fileobj (this)
439 has_fileobj =
allocated(this%fms2io_fileobj)
440 end function has_fileobj
444 pure logical function has_diag_yaml_file (this)
446 has_diag_yaml_file =
associated(this%diag_yaml_file)
447 end function has_diag_yaml_file
451 function get_filename_time(this) &
456 select case (this%diag_yaml_file%get_filename_time())
458 res = this%last_output
460 res = (this%last_output + this%next_close)/2
462 res = this%next_close
464 end function get_filename_time
468 pure logical function has_field_ids (this)
470 has_field_ids =
allocated(this%field_ids)
471 end function has_field_ids
475 pure function get_id (this)
result (res)
483 pure function get_time_ops (this)
result (res)
487 if (.not.
allocated(this%time_ops))
then
492 end function get_time_ops
515 pure function get_file_metadata_from_model (this)
result (res)
517 character(len=:),
dimension(:),
allocatable :: res
518 res = this%file_metadata_from_model
519 end function get_file_metadata_from_model
523 pure function get_field_ids (this)
result (res)
525 integer,
dimension(:),
allocatable :: res
526 allocate(res(
size(this%field_ids)))
528 end function get_field_ids
533 pure function get_file_fname (this)
result(res)
535 character (len=:),
allocatable :: res
536 res = this%diag_yaml_file%get_file_fname()
537 end function get_file_fname
541 pure function get_file_frequnit (this)
result(res)
544 res = this%diag_yaml_file%get_file_frequnit()
545 end function get_file_frequnit
549 pure function get_file_freq (this)
result(res)
552 res = this%diag_yaml_file%get_file_freq()
553 end function get_file_freq
557 pure function get_file_timeunit (this)
result(res)
560 res = this%diag_yaml_file%get_file_timeunit()
561 end function get_file_timeunit
565 pure function get_file_unlimdim (this)
result(res)
567 character (len=:),
allocatable :: res
568 res = this%diag_yaml_file%get_file_unlimdim()
569 end function get_file_unlimdim
573 function get_file_sub_region (obj)
result(res)
576 res => obj%diag_yaml_file%get_file_sub_region()
577 end function get_file_sub_region
581 function get_file_sub_region_grid_type(this) &
588 if(this%diag_yaml_file%has_file_sub_region())
then
589 subregion => this%diag_yaml_file%get_file_sub_region()
590 res = subregion%grid_type
594 end function get_file_sub_region_grid_type
598 pure function get_file_new_file_freq (this)
result(res)
601 res = this%diag_yaml_file%get_file_new_file_freq()
602 end function get_file_new_file_freq
606 pure function get_file_new_file_freq_units (this)
result(res)
609 res = this%diag_yaml_file%get_file_new_file_freq_units()
610 end function get_file_new_file_freq_units
614 pure function get_file_start_time (this)
result(res)
617 res = this%diag_yaml_file%get_file_start_time()
618 end function get_file_start_time
622 pure function get_file_duration (this)
result(res)
625 res = this%diag_yaml_file%get_file_duration()
626 end function get_file_duration
630 pure function get_file_duration_units (this)
result(res)
633 res = this%diag_yaml_file%get_file_duration_units()
634 end function get_file_duration_units
638 pure function get_file_varlist (this)
result(res)
640 character (len=:),
allocatable,
dimension(:) :: res
641 res = this%diag_yaml_file%get_file_varlist()
642 end function get_file_varlist
646 pure function get_file_global_meta (this)
result(res)
648 character (len=MAX_STR_LEN),
allocatable,
dimension(:,:) :: res
649 res = this%diag_yaml_file%get_file_global_meta()
650 end function get_file_global_meta
654 pure function is_done_writing_data (this)
result(res)
657 res = this%done_writing_data
658 if (this%is_file_open) res = .false.
659 end function is_done_writing_data
663 pure function has_file_fname (this)
result(res)
666 res = this%diag_yaml_file%has_file_fname()
667 end function has_file_fname
671 pure function has_file_frequnit (this)
result(res)
674 res = this%diag_yaml_file%has_file_frequnit()
675 end function has_file_frequnit
679 pure function has_file_freq (this)
result(res)
682 res = this%diag_yaml_file%has_file_freq()
683 end function has_file_freq
687 pure function has_file_timeunit (this)
result(res)
690 res = this%diag_yaml_file%has_file_timeunit()
691 end function has_file_timeunit
695 pure function has_file_unlimdim (this)
result(res)
698 res = this%diag_yaml_file%has_file_unlimdim()
699 end function has_file_unlimdim
703 pure function has_file_sub_region (this)
result(res)
706 res = this%diag_yaml_file%has_file_sub_region()
707 end function has_file_sub_region
711 pure function has_file_new_file_freq (this)
result(res)
714 res = this%diag_yaml_file%has_file_new_file_freq()
715 end function has_file_new_file_freq
719 pure function has_file_new_file_freq_units (this)
result(res)
722 res = this%diag_yaml_file%has_file_new_file_freq_units()
723 end function has_file_new_file_freq_units
727 pure function has_file_start_time (this)
result(res)
730 res = this%diag_yaml_file%has_file_start_time()
731 end function has_file_start_time
735 pure function has_file_duration (this)
result(res)
738 res = this%diag_yaml_file%has_file_duration()
739 end function has_file_duration
743 pure function has_file_duration_units (this)
result(res)
746 res = this%diag_yaml_file%has_file_duration_units()
747 end function has_file_duration_units
751 pure function has_file_varlist (this)
result(res)
754 res = this%diag_yaml_file%has_file_varlist()
755 end function has_file_varlist
759 pure function has_file_global_meta (this)
result(res)
762 res = this%diag_yaml_file%has_file_global_meta()
763 end function has_file_global_meta
766 subroutine set_domain_from_axis(this, diag_axis, axes)
769 integer,
intent(in) :: axes (:)
772 end subroutine set_domain_from_axis
778 subroutine set_file_domain(this, domain, type_of_domain)
780 integer,
INTENT(in) :: type_of_domain
783 if (type_of_domain .ne. this%type_of_domain)
then
792 this%type_of_domain = type_of_domain
793 this%domain => domain
800 call mpp_error(fatal,
"The file: "//this%get_file_fname()//
" has variables that are not in the same domain")
804 end subroutine set_file_domain
807 subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id, buffer_id, output_buffers)
809 integer,
INTENT(in) :: axis_ids(:)
811 integer,
intent(inout) :: naxis
813 integer,
intent(in) :: yaml_id
815 integer,
intent(in) :: buffer_id
821 logical :: is_cube_sphere
822 logical :: axis_found
823 integer,
allocatable :: var_axis_ids(:)
824 integer :: x_y_axis_id(2)
827 integer :: subregion_gridtype
828 logical :: write_on_this_pe
830 is_cube_sphere = .false.
831 subregion_gridtype = this%get_file_sub_region_grid_type()
833 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
839 var_axis_ids = axis_ids
841 if (field_yaml%has_var_zbounds())
then
843 this%axis_ids, this%number_of_axis, this%nz_subaxis)
848 if (
associated(this%domain))
then
849 if (this%domain%get_ntiles() .eq. 6) is_cube_sphere = .true.
851 if (.not. this%get_write_on_this_pe())
return
852 subaxis_defined:
if (this%is_subaxis_defined)
then
853 do i = 1,
size(var_axis_ids)
854 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
857 is_x_or_y = parent_axis%is_x_or_y_axis()
858 do j = 1, this%number_of_axis
860 if(
is_parent_axis(this%axis_ids(j), var_axis_ids(i), diag_axis))
then
862 var_axis_ids(i) = this%axis_ids(j)
865 elseif (var_axis_ids(i) .eq. this%axis_ids(j))
then
870 if (.not. axis_found)
then
872 if (subregion_gridtype .eq. latlon_gridtype .and. is_cube_sphere) &
873 call mpp_error(fatal,
"If using the cube sphere and defining the subregion with latlon "//&
874 "the variable need to have the same x and y axis. Please check the variables in the file "//&
875 trim(this%get_file_fname())//
" or use indices to define the subregion.")
877 select case (subregion_gridtype)
878 case (index_gridtype)
881 case (latlon_gridtype)
883 .false., write_on_this_pe)
885 call this%update_write_on_this_pe(write_on_this_pe)
886 if (.not. this%get_write_on_this_pe()) cycle
887 call this%add_new_axis(naxis)
888 var_axis_ids(i) = naxis
890 call this%add_new_axis(var_axis_ids(i))
894 axis_found = this%does_axis_exist(var_axis_ids(i))
895 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
899 x_y_axis_id = diag_null
900 do i = 1,
size(var_axis_ids)
901 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
903 if (.not. parent_axis%is_x_or_y_axis(x_or_y))
then
904 axis_found = this%does_axis_exist(var_axis_ids(i))
905 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
907 x_y_axis_id(x_or_y) = var_axis_ids(i)
910 axis_found = this%does_axis_exist(var_axis_ids(i))
911 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
915 call this%define_new_subaxis(var_axis_ids, x_y_axis_id, is_cube_sphere, diag_axis, naxis)
916 this%is_subaxis_defined = .true.
917 endif subaxis_defined
919 do i = 1,
size(var_axis_ids)
920 axis_found = this%does_axis_exist(var_axis_ids(i))
921 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
925 call output_buffers(buffer_id)%add_axis_ids(var_axis_ids)
926 end subroutine add_axes
929 subroutine add_new_axis(this, var_axis_id)
931 integer,
intent(in) :: var_axis_id
933 this%number_of_axis = this%number_of_axis + 1
934 this%axis_ids(this%number_of_axis) = var_axis_id
935 end subroutine add_new_axis
938 subroutine update_write_on_this_pe(this, write_on_this_pe)
940 logical,
intent(in) :: write_on_this_pe
945 if (this%write_on_this_pe) this%write_on_this_pe = write_on_this_pe
947 end subroutine update_write_on_this_pe
951 function get_write_on_this_pe(this) &
958 rslt= this%write_on_this_pe
960 end function get_write_on_this_pe
964 function does_axis_exist(this, var_axis_id) &
967 integer,
intent(in) :: var_axis_id
973 do j = 1, this%number_of_axis
975 if (var_axis_id .eq. this%axis_ids(j))
then
983 subroutine define_new_subaxis(this, var_axis_ids, x_y_axis_id, is_cube_sphere, diag_axis, naxis)
985 integer,
INTENT(inout) :: var_axis_ids(:)
986 integer,
INTENT(in) :: x_y_axis_id(:)
987 logical,
intent(in) :: is_cube_sphere
988 integer,
intent(inout) :: naxis
991 logical :: write_on_this_pe
994 select case (this%get_file_sub_region_grid_type())
995 case(latlon_gridtype)
998 call this%update_write_on_this_pe(write_on_this_pe)
999 if (.not. this%get_write_on_this_pe())
return
1000 call this%add_new_axis(naxis)
1001 call this%add_new_axis(naxis-1)
1002 do j = 1,
size(var_axis_ids)
1003 if (x_y_axis_id(1) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis - 1
1004 if (x_y_axis_id(2) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis
1006 case (index_gridtype)
1007 do i = 1,
size(x_y_axis_id)
1008 select type (parent_axis => diag_axis(x_y_axis_id(i))%axis)
1012 call this%update_write_on_this_pe(write_on_this_pe)
1013 if (.not. this%get_write_on_this_pe())
return
1014 call this%add_new_axis(naxis)
1015 do j = 1,
size(var_axis_ids)
1016 if (x_y_axis_id(i) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis
1021 end subroutine define_new_subaxis
1026 subroutine add_start_time(this, start_time)
1028 TYPE(
time_type),
intent(in) :: start_time
1037 if (this%start_time >= start_time)
return
1043 if (this%start_time .ne. start_time)&
1044 call mpp_error(fatal,
"The variables associated with the file:"//this%get_file_fname()//
" have &
1045 &different start_time")
1049 this%model_time = start_time
1050 this%start_time = start_time
1051 this%last_output = start_time
1052 this%next_output = diag_time_inc(start_time, this%get_file_freq(), this%get_file_frequnit())
1053 this%next_next_output = diag_time_inc(this%next_output, this%get_file_freq(), this%get_file_frequnit())
1054 if (this%has_file_new_file_freq())
then
1055 this%next_close = diag_time_inc(this%start_time, this%get_file_new_file_freq(), &
1056 this%get_file_new_file_freq_units())
1058 if (this%is_static)
then
1061 this%next_close = this%start_time
1062 this%next_next_output = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1064 this%next_close = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1068 if(this%has_file_duration())
then
1069 this%no_more_data = diag_time_inc(this%start_time, this%get_file_duration(), &
1070 this%get_file_duration_units())
1072 this%no_more_data = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1080 subroutine dump_file_obj(this, unit_num)
1082 integer,
intent(in) :: unit_num
1084 write( unit_num, *)
'file id:', this%id
1085 write( unit_num, *)
'start time:',
date_to_string(this%start_time)
1086 write( unit_num, *)
'last_output',
date_to_string(this%last_output)
1087 write( unit_num, *)
'next_output',
date_to_string(this%next_output)
1088 write( unit_num, *)
'next_next_output',
date_to_string(this%next_next_output)
1091 if(
allocated(this%fms2io_fileobj))
write( unit_num, *)
'fileobj path', this%fms2io_fileobj%path
1093 write( unit_num, *)
'type_of_domain', this%type_of_domain
1094 if(
allocated(this%file_metadata_from_model))
write( unit_num, *)
'file_metadata_from_model', &
1095 this%file_metadata_from_model
1096 if(
allocated(this%field_ids))
write( unit_num, *)
'field_ids', this%field_ids
1097 if(
allocated(this%field_registered))
write( unit_num, *)
'field_registered', this%field_registered
1098 if(
allocated(this%num_registered_fields))
write( unit_num, *)
'num_registered_fields', this%num_registered_fields
1099 if(
allocated(this%axis_ids))
write( unit_num, *)
'axis_ids', this%axis_ids(1:this%number_of_axis)
1105 logical pure function is_regional(this)
1108 select type (wut=>this%FMS_diag_file)
1110 is_regional = .true.
1112 is_regional = .false.
1115 end function is_regional
1119 logical pure function is_file_static(this)
1122 is_file_static = .false.
1124 select type (fileptr=>this%FMS_diag_file)
1126 is_file_static = fileptr%is_static
1129 end function is_file_static
1132 subroutine open_diag_file(this, time_step, file_is_opened)
1134 TYPE(time_type),
intent(in) :: time_step
1135 logical,
intent(out) :: file_is_opened
1139 class(diagdomain_t),
pointer :: domain
1140 character(len=:),
allocatable :: diag_file_name
1141 character(len=FMS_FILE_LEN) :: base_name
1143 character(len=FMS_FILE_LEN) :: file_name
1144 character(len=FMS_FILE_LEN) :: temp_name
1145 character(len=128) :: start_date
1147 character(len=128) :: suffix
1156 character(len=4) :: mype_string
1157 logical :: is_regional
1158 integer,
allocatable :: pes(:)
1160 diag_file => this%FMS_diag_file
1161 domain => diag_file%domain
1163 file_is_opened = .false.
1165 if (diag_file%is_file_open)
return
1167 is_regional = .false.
1169 if (.not.
allocated(diag_file%fms2io_fileobj))
then
1170 select type (diag_file)
1173 allocate(fmsnetcdffile_t :: diag_file%fms2io_fileobj)
1174 is_regional = .true.
1177 select case (diag_file%type_of_domain)
1179 allocate(fmsnetcdffile_t :: diag_file%fms2io_fileobj)
1181 allocate(fmsnetcdfdomainfile_t :: diag_file%fms2io_fileobj)
1183 allocate(fmsnetcdfunstructureddomainfile_t :: diag_file%fms2io_fileobj)
1189 diag_file_name = diag_file%get_file_fname()
1192 if (diag_file%has_file_new_file_freq())
then
1194 pos = index(diag_file_name,
'%')
1195 if (pos > 0) base_name = diag_file_name(1:pos-1)
1196 suffix = get_time_string(diag_file_name, diag_file%get_filename_time())
1197 base_name = trim(base_name)//trim(suffix)
1199 base_name = trim(diag_file_name)
1203 file_name = trim(base_name)
1204 call get_instance_filename(base_name, file_name)
1208 IF ( prepend_date )
THEN
1209 call get_date(diag_file%start_time, year, month, day, hour, minute, second)
1210 write (start_date,
'(1I20.4, 2I2.2)') year, month, day
1212 file_name = trim(adjustl(start_date))//
'.'//trim(file_name)
1215 file_name = trim(file_name)//
".nc"
1218 if (is_regional)
then
1220 write(mype_string,
'(I0.4)')
mpp_pe()
1223 select type (domain)
1224 type is (diagdomain2d_t)
1225 temp_name = file_name
1226 call get_mosaic_tile_file(temp_name, file_name, .true., domain%domain2)
1229 file_name = trim(file_name)//
"."//trim(mype_string)
1233 select type (fms2io_fileobj => diag_file%fms2io_fileobj)
1234 type is (fmsnetcdffile_t)
1235 if (is_regional)
then
1236 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", pelist=(/
mpp_pe()/))) &
1237 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1238 call register_global_attribute(fms2io_fileobj,
"is_subregional",
"True", str_len=4)
1241 call mpp_get_current_pelist(pes)
1243 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", pelist=pes)) &
1244 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1246 type is (fmsnetcdfdomainfile_t)
1247 select type (domain)
1248 type is (diagdomain2d_t)
1249 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", domain%Domain2)) &
1250 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1252 type is (fmsnetcdfunstructureddomainfile_t)
1253 select type (domain)
1254 type is (diagdomainug_t)
1255 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", domain%DomainUG)) &
1256 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1260 file_is_opened = .true.
1261 diag_file%is_file_open = file_is_opened
1264 end subroutine open_diag_file
1267 subroutine write_global_metadata(this)
1270 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1272 character (len=MAX_STR_LEN),
allocatable :: yaml_file_attributes(:,:)
1274 type(diagyamlfiles_type),
pointer :: diag_file_yaml
1276 diag_file_yaml => this%FMS_diag_file%diag_yaml_file
1277 fms2io_fileobj => this%FMS_diag_file%fms2io_fileobj
1279 if (diag_file_yaml%has_file_global_meta())
then
1280 yaml_file_attributes = diag_file_yaml%get_file_global_meta()
1281 do i = 1,
size(yaml_file_attributes,1)
1282 call register_global_attribute(fms2io_fileobj, trim(yaml_file_attributes(i,1)), &
1283 trim(yaml_file_attributes(i,2)), str_len=len_trim(yaml_file_attributes(i,2)))
1285 deallocate(yaml_file_attributes)
1287 end subroutine write_global_metadata
1290 subroutine write_var_metadata(fms2io_fileobj, variable_name, dimensions, long_name, units)
1291 class(fmsnetcdffile_t),
intent(inout) :: fms2io_fileobj
1292 character(len=*) ,
intent(in) :: variable_name
1293 character(len=*) ,
intent(in) :: dimensions(:)
1294 character(len=*) ,
intent(in) :: long_name
1295 character(len=*) ,
intent(in) :: units
1297 call register_field(fms2io_fileobj, variable_name, pack_size_str, dimensions)
1298 call register_variable_attribute(fms2io_fileobj, variable_name,
"long_name", &
1299 trim(long_name), str_len=len_trim(long_name))
1300 if (trim(units) .ne. no_units) &
1301 call register_variable_attribute(fms2io_fileobj, variable_name,
"units", &
1302 trim(units), str_len=len_trim(units))
1303 end subroutine write_var_metadata
1306 subroutine write_time_metadata(this)
1310 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1311 character(len=50) :: time_units_str
1312 character(len=50) :: calendar
1314 character(len=:),
allocatable :: time_var_name
1315 character(len=50) :: dimensions(2)
1317 diag_file => this%FMS_diag_file
1318 fms2io_fileobj => diag_file%fms2io_fileobj
1320 time_var_name = diag_file%get_file_unlimdim()
1321 call register_axis(fms2io_fileobj, time_var_name, unlimited)
1323 WRITE(time_units_str, 11) &
1324 trim(time_unit_list(diag_file%get_file_timeunit())), get_base_year(),&
1325 & get_base_month(), get_base_day(), get_base_hour(), get_base_minute(), get_base_second()
1326 11
FORMAT(a,
' since ', i4.4,
'-', i2.2,
'-', i2.2,
' ', i2.2,
':', i2.2,
':', i2.2)
1328 dimensions(1) =
"nv"
1329 dimensions(2) = trim(time_var_name)
1331 call write_var_metadata(fms2io_fileobj, time_var_name, dimensions(2:2), &
1332 time_var_name, time_units_str)
1335 call register_variable_attribute(fms2io_fileobj, time_var_name,
"axis",
"T", str_len=1 )
1338 calendar = valid_calendar_types(get_calendar_type())
1339 call register_variable_attribute(fms2io_fileobj, time_var_name,
"calendar_type", &
1340 uppercase(trim(calendar)), str_len=len_trim(calendar))
1341 call register_variable_attribute(fms2io_fileobj, time_var_name,
"calendar", &
1342 lowercase(trim(calendar)), str_len=len_trim(calendar))
1344 if (diag_file%get_time_ops())
then
1345 call register_variable_attribute(fms2io_fileobj, time_var_name,
"bounds", &
1346 trim(time_var_name)//
"_bnds", str_len=len_trim(time_var_name//
"_bnds"))
1350 if ( .not. dimension_exists(fms2io_fileobj,
"nv"))
then
1351 call register_axis(fms2io_fileobj,
"nv", 2)
1352 call write_var_metadata(fms2io_fileobj,
"nv", dimensions(1:1), &
1353 "vertex number", no_units)
1355 call write_var_metadata(fms2io_fileobj, time_var_name//
"_bnds", dimensions, &
1356 trim(time_var_name)//
" axis boundaries", time_units_str)
1359 end subroutine write_time_metadata
1362 subroutine write_field_data(this, field_obj, buffer_obj, unlim_dim_was_increased)
1364 type(fmsdiagfield_type),
intent(in),
target :: field_obj
1365 type(fmsdiagoutputbuffer_type),
intent(inout),
target :: buffer_obj
1366 logical,
intent(inout) :: unlim_dim_was_increased
1369 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1370 logical :: has_diurnal
1372 diag_file => this%FMS_diag_file
1373 fms2io_fileobj => diag_file%fms2io_fileobj
1377 call buffer_obj%increase_unlim_dim()
1378 if (buffer_obj%get_unlim_dim() > diag_file%unlim_dimension_level)
then
1379 diag_file%unlim_dimension_level = buffer_obj%get_unlim_dim()
1380 unlim_dim_was_increased = .true.
1384 if (diag_file%is_static)
then
1387 call buffer_obj%write_buffer(fms2io_fileobj)
1388 diag_file%data_has_been_written = .true.
1390 if (field_obj%is_static())
then
1392 if (buffer_obj%get_unlim_dim() .eq. 1)
then
1393 call buffer_obj%write_buffer(fms2io_fileobj)
1394 diag_file%data_has_been_written = .true.
1397 if (unlim_dim_was_increased) diag_file%data_has_been_written = .true.
1398 has_diurnal = buffer_obj%get_diurnal_sample_size() .gt. 1
1399 call buffer_obj%write_buffer(fms2io_fileobj, &
1400 unlim_dim_level=buffer_obj%get_unlim_dim(), is_diurnal=has_diurnal)
1404 end subroutine write_field_data
1408 logical function is_time_to_close_file (this, time_step, force_close)
1410 TYPE(time_type),
intent(in) :: time_step
1411 logical,
intent(in) :: force_close
1413 if (force_close)
then
1414 is_time_to_close_file = .true.
1415 elseif (time_step >= this%FMS_diag_file%next_close)
then
1416 is_time_to_close_file = .true.
1418 if (this%FMS_diag_file%is_static)
then
1419 is_time_to_close_file = .true.
1421 is_time_to_close_file = .false.
1428 logical function time_to_start_doing_math (this)
1430 time_to_start_doing_math = .false.
1431 if (this%FMS_diag_file%model_time >= this%FMS_diag_file%start_time)
then
1432 time_to_start_doing_math = .true.
1437 subroutine check_file_times(this, time_step, output_buffers, diag_fields, do_not_write)
1439 TYPE(time_type),
intent(in) :: time_step
1440 type(fmsdiagoutputbuffer_type),
intent(in) :: output_buffers(:)
1442 type(fmsdiagfield_type),
intent(in) :: diag_fields(:)
1443 logical,
intent(out) :: do_not_write
1447 do_not_write = .false.
1448 if (time_step > this%FMS_diag_file%next_output)
then
1449 if (this%FMS_diag_file%is_static)
return
1450 if (time_step > this%FMS_diag_file%next_next_output)
then
1451 if (this%FMS_diag_file%get_file_freq() .eq. 0)
then
1453 if (time_step .ne. this%FMS_diag_file%next_output)
then
1455 call this%FMS_diag_file%check_buffer_times(output_buffers, diag_fields)
1456 this%FMS_diag_file%next_output = time_step
1457 this%FMS_diag_file%next_next_output = time_step
1459 elseif (this%FMS_diag_file%num_registered_fields .eq. 0)
then
1462 if (this%FMS_diag_file%unlim_dimension_level .eq. 0)
then
1463 call mpp_error(note, this%FMS_diag_file%get_file_fname()//&
1464 ": diag_manager_mod: This file does not have any variables registered. Fill values will be written")
1465 this%FMS_diag_file%data_has_been_written = .true.
1466 this%FMS_diag_file%unlim_dimension_level = 1
1470 if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .false.)) &
1471 call mpp_error(fatal, this%FMS_diag_file%get_file_fname()//&
1472 ": diag_manager_mod: You skipped a time_step. Be sure that diag_send_complete is called at every "//&
1473 "time_step needed by the file.")
1477 if(this%FMS_diag_file%get_file_freq() .eq. 0)
then
1478 do_not_write = .true.
1481 end subroutine check_file_times
1484 logical function writing_on_this_pe(this)
1487 select type(diag_file => this%FMS_diag_file)
1489 writing_on_this_pe = diag_file%write_on_this_pe
1491 writing_on_this_pe = .true.
1497 subroutine write_time_data(this)
1502 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1503 TYPE(time_type) :: middle_time
1508 diag_file => this%FMS_diag_file
1509 fms2io_fileobj => diag_file%fms2io_fileobj
1512 if (.not. diag_file%data_has_been_written)
return
1514 if (diag_file%get_time_ops())
then
1515 middle_time = (diag_file%last_output+diag_file%next_output)/2
1516 dif = get_date_dif(middle_time, get_base_time(), diag_file%get_file_timeunit())
1518 dif = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
1521 call write_data(fms2io_fileobj, diag_file%get_file_unlimdim(), dif, &
1522 unlim_dim_level=diag_file%unlim_dimension_level)
1524 if (diag_file%get_time_ops())
then
1525 t1 = get_date_dif(diag_file%last_output, get_base_time(), diag_file%get_file_timeunit())
1526 t2 = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
1528 call write_data(fms2io_fileobj, trim(diag_file%get_file_unlimdim())//
"_bnds", &
1529 (/t1, t2/), unlim_dim_level=diag_file%unlim_dimension_level)
1531 if (diag_file%unlim_dimension_level .eq. 1)
then
1532 call write_data(fms2io_fileobj,
"nv", (/1, 2/))
1536 diag_file%data_has_been_written = .false.
1537 end subroutine write_time_data
1540 subroutine update_current_new_file_freq_index(this, time_step)
1542 TYPE(time_type),
intent(in) :: time_step
1546 diag_file => this%FMS_diag_file
1548 if (time_step >= diag_file%no_more_data)
then
1549 call diag_file%diag_yaml_file%increase_new_file_freq_index()
1551 if (diag_file%has_file_duration())
then
1552 diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, diag_file%get_file_duration(), &
1553 diag_file%get_file_duration_units())
1556 diag_file%done_writing_data = .true.
1557 diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, very_large_file_freq, diag_days)
1558 diag_file%next_output = diag_file%no_more_data
1559 diag_file%next_next_output = diag_file%no_more_data
1560 diag_file%last_output = diag_file%no_more_data
1564 if (diag_file%is_static) diag_file%done_writing_data = .true.
1565 end subroutine update_current_new_file_freq_index
1568 subroutine update_next_write(this, time_step)
1570 TYPE(time_type),
intent(in) :: time_step
1574 diag_file => this%FMS_diag_file
1575 if (diag_file%is_static)
then
1576 diag_file%last_output = diag_file%next_output
1577 diag_file%next_output = diag_time_inc(diag_file%next_output, very_large_file_freq, diag_days)
1578 diag_file%next_next_output = diag_time_inc(diag_file%next_output, very_large_file_freq, diag_days)
1580 diag_file%last_output = diag_file%next_output
1581 diag_file%next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
1582 diag_file%get_file_frequnit())
1583 diag_file%next_next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
1584 diag_file%get_file_frequnit())
1587 end subroutine update_next_write
1590 subroutine prepare_for_force_write(this)
1593 if (this%FMS_diag_file%unlim_dimension_level .eq. 0)
then
1594 this%FMS_diag_file%unlim_dimension_level = 1
1595 this%FMS_diag_file%data_has_been_written = .true.
1597 end subroutine prepare_for_force_write
1600 subroutine init_unlim_dim(this, output_buffers)
1602 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1605 type(fmsdiagoutputbuffer_type),
pointer :: output_buffer_obj
1608 diag_file => this%FMS_diag_file
1609 diag_file%unlim_dimension_level = 0
1610 do i = 1, diag_file%number_of_buffers
1611 output_buffer_obj => output_buffers(diag_file%buffer_ids(i))
1612 call output_buffer_obj%init_buffer_unlim_dim()
1614 end subroutine init_unlim_dim
1618 function get_num_time_levels(this) &
1623 if (this%is_regional())
then
1628 res = this%FMS_diag_file%num_time_levels
1631 res = this%FMS_diag_file%num_time_levels
1637 function get_num_tiles(this) &
1642 select case(this%FMS_diag_file%type_of_domain)
1643 case (two_d_domain, ug_domain)
1644 select type(domain => this%FMS_diag_file%domain)
1645 type is (diagdomain2d_t)
1647 type is (diagdomainug_t)
1648 res = mpp_get_ug_domain_ntiles(domain%DomainUG)
1653 end function get_num_tiles
1657 function get_ndistributedfiles(this) &
1661 integer :: io_layout(2)
1663 select case(this%FMS_diag_file%type_of_domain)
1664 case (two_d_domain, ug_domain)
1665 select type(domain => this%FMS_diag_file%domain)
1666 type is (diagdomain2d_t)
1668 res = io_layout(1) * io_layout(2)
1669 type is (diagdomainug_t)
1670 res = mpp_get_io_domain_ug_layout(domain%DomainUG)
1675 end function get_ndistributedfiles
1679 pure function get_unlim_dimension_level(this) &
1684 res = this%FMS_diag_file%unlim_dimension_level
1688 subroutine flush_diag_file(this)
1691 if (flush_nc_files)
then
1692 call flush_file(this%FMS_diag_file%fms2io_fileobj)
1694 end subroutine flush_diag_file
1698 pure function get_next_output(this) &
1701 type(time_type) :: res
1703 res = this%FMS_diag_file%next_output
1704 end function get_next_output
1708 pure function get_next_next_output(this) &
1711 type(time_type) :: res
1713 res = this%FMS_diag_file%next_next_output
1714 if (this%FMS_diag_file%is_static)
then
1715 res = this%FMS_diag_file%no_more_data
1717 end function get_next_next_output
1720 subroutine write_axis_metadata(this, diag_axis)
1722 class(fmsdiagaxiscontainer_type),
intent(in),
target :: diag_axis(:)
1725 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1727 integer :: parent_axis_id
1728 integer :: structured_ids(2)
1731 class(fmsdiagaxiscontainer_type),
pointer :: axis_ptr
1732 logical :: edges_in_file
1734 diag_file => this%FMS_diag_file
1735 fms2io_fileobj => diag_file%fms2io_fileobj
1737 do i = 1, diag_file%number_of_axis
1738 edges_in_file = .false.
1739 axis_ptr => diag_axis(diag_file%axis_ids(i))
1740 parent_axis_id = axis_ptr%axis%get_parent_axis_id()
1742 edges_id = axis_ptr%axis%get_edges_id()
1743 if (edges_id .ne. diag_null)
then
1745 if (any(diag_file%axis_ids(1:diag_file%number_of_axis) .eq. edges_id))
then
1746 edges_in_file = .true.
1748 call diag_axis(edges_id)%axis%write_axis_metadata(fms2io_fileobj, .true.)
1749 call diag_file%add_new_axis(edges_id)
1753 if (parent_axis_id .eq. diag_null)
then
1754 call axis_ptr%axis%write_axis_metadata(fms2io_fileobj, edges_in_file)
1756 call axis_ptr%axis%write_axis_metadata(fms2io_fileobj, edges_in_file, diag_axis(parent_axis_id)%axis)
1759 if (axis_ptr%axis%is_unstructured_grid())
then
1760 structured_ids = axis_ptr%axis%get_structured_axis()
1761 do k = 1,
size(structured_ids)
1762 call diag_axis(structured_ids(k))%axis%write_axis_metadata(fms2io_fileobj, .false.)
1768 end subroutine write_axis_metadata
1771 subroutine write_field_metadata(this, diag_field, diag_axis)
1773 class(fmsdiagfield_type) ,
intent(inout),
target :: diag_field(:)
1774 class(fmsdiagaxiscontainer_type),
intent(in) :: diag_axis(:)
1776 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1778 class(fmsdiagfield_type),
pointer :: field_ptr
1781 logical :: is_regional
1782 character(len=255) :: cell_measures
1783 logical :: need_associated_files
1784 character(len=FMS_FILE_LEN) :: associated_files
1786 is_regional = this%is_regional()
1788 diag_file => this%FMS_diag_file
1789 fms2io_fileobj => diag_file%fms2io_fileobj
1791 associated_files =
""
1792 need_associated_files = .false.
1793 do i = 1,
size(diag_file%field_ids)
1794 if (.not. diag_file%field_registered(i)) cycle
1795 field_ptr => diag_field(diag_file%field_ids(i))
1798 if (field_ptr%has_area())
then
1799 cell_measures =
"area: "//diag_field(field_ptr%get_area())%get_varname(to_write=.true.)
1803 if (.not. diag_field(field_ptr%get_area())%is_variable_in_file(diag_file%id))
then
1804 need_associated_files = .true.
1805 call diag_field(field_ptr%get_area())%generate_associated_files_att(associated_files, diag_file%start_time)
1809 if (field_ptr%has_volume())
then
1810 cell_measures = trim(cell_measures)//
" volume: "//diag_field(field_ptr%get_volume())%get_varname(to_write=.true.)
1814 if (.not. diag_field(field_ptr%get_volume())%is_variable_in_file(diag_file%id))
then
1815 need_associated_files = .true.
1816 call diag_field(field_ptr%get_volume())%generate_associated_files_att(associated_files, diag_file%start_time)
1820 call field_ptr%write_field_metadata(fms2io_fileobj, diag_file%id, diag_file%yaml_ids(i), diag_axis, &
1821 this%FMS_diag_file%get_file_unlimdim(), is_regional, cell_measures)
1824 if (need_associated_files) &
1825 call register_global_attribute(fms2io_fileobj,
"associated_files", trim(adjustl(associated_files)), &
1826 str_len=len_trim(adjustl(associated_files)))
1828 end subroutine write_field_metadata
1831 subroutine write_axis_data(this, diag_axis)
1833 class(fmsdiagaxiscontainer_type),
intent(in) :: diag_axis(:)
1836 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1839 integer :: parent_axis_id
1840 integer :: structured_ids(2)
1842 diag_file => this%FMS_diag_file
1843 fms2io_fileobj => diag_file%fms2io_fileobj
1845 do i = 1, diag_file%number_of_axis
1846 j = diag_file%axis_ids(i)
1847 parent_axis_id = diag_axis(j)%axis%get_parent_axis_id()
1848 if (parent_axis_id .eq. diag_null)
then
1849 call diag_axis(j)%axis%write_axis_data(fms2io_fileobj)
1851 call diag_axis(j)%axis%write_axis_data(fms2io_fileobj, diag_axis(parent_axis_id)%axis)
1854 if (diag_axis(j)%axis%is_unstructured_grid())
then
1855 structured_ids = diag_axis(j)%axis%get_structured_axis()
1856 do k = 1,
size(structured_ids)
1857 call diag_axis(structured_ids(k))%axis%write_axis_data(fms2io_fileobj)
1862 end subroutine write_axis_data
1865 subroutine close_diag_file(this, output_buffers, model_end_time, diag_fields)
1867 type(fmsdiagoutputbuffer_type),
intent(in) :: output_buffers(:)
1869 type(time_type),
intent(in) :: model_end_time
1870 type(fmsdiagfield_type),
intent(in),
optional :: diag_fields(:)
1873 if (.not. this%FMS_diag_file%is_file_open)
return
1877 select type( fms2io_fileobj => this%FMS_diag_file%fms2io_fileobj)
1878 type is (fmsnetcdfdomainfile_t)
1879 call close_file(fms2io_fileobj)
1880 type is (fmsnetcdffile_t)
1881 call close_file(fms2io_fileobj)
1882 type is (fmsnetcdfunstructureddomainfile_t)
1883 call close_file(fms2io_fileobj)
1890 this%FMS_diag_file%num_time_levels = this%FMS_diag_file%num_time_levels + &
1891 this%FMS_diag_file%unlim_dimension_level
1894 this%FMS_diag_file%unlim_dimension_level = 0
1895 this%FMS_diag_file%is_file_open = .false.
1897 if (this%FMS_diag_file%has_file_new_file_freq())
then
1898 this%FMS_diag_file%next_close = diag_time_inc(this%FMS_diag_file%next_close, &
1899 this%FMS_diag_file%get_file_new_file_freq(), &
1900 this%FMS_diag_file%get_file_new_file_freq_units())
1902 this%FMS_diag_file%next_close = model_end_time
1905 if (this%FMS_diag_file%model_time >= model_end_time) &
1906 this%FMS_diag_file%done_writing_data = .true.
1907 if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .true., diag_fields))
return
1908 end subroutine close_diag_file
1911 subroutine set_model_time(this, model_time)
1913 type(time_type),
intent(in) :: model_time
1915 if (model_time > this%FMS_diag_file%model_time) this%FMS_diag_file%model_time = model_time
1920 function get_model_time(this) &
1923 type(time_type),
pointer :: rslt
1925 rslt => this%FMS_diag_file%model_time
1926 end function get_model_time
1929 pure function get_buffer_ids (this)
1931 integer,
allocatable :: get_buffer_ids(:)
1933 allocate(get_buffer_ids(this%number_of_buffers))
1934 get_buffer_ids = this%buffer_ids(1:this%number_of_buffers)
1935 end function get_buffer_ids
1938 pure function get_number_of_buffers(this)
1940 integer :: get_number_of_buffers
1941 get_number_of_buffers = this%number_of_buffers
1942 end function get_number_of_buffers
1946 subroutine check_buffer_times(this, output_buffers, diag_fields)
1948 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1949 type(fmsdiagfield_type),
intent(in) :: diag_fields(:)
1952 type(time_type) :: current_buffer_time
1953 character(len=:),
allocatable :: field_name
1954 logical :: buffer_time_set
1955 type(fmsdiagoutputbuffer_type),
pointer :: output_buffer_obj
1957 buffer_time_set = .false.
1958 do i = 1, this%number_of_buffers
1959 output_buffer_obj => output_buffers(this%buffer_ids(i))
1960 if (diag_fields(output_buffer_obj%get_field_id())%is_static()) cycle
1961 if (.not. buffer_time_set)
then
1962 current_buffer_time = output_buffer_obj%get_buffer_time()
1963 field_name = output_buffer_obj%get_buffer_name()
1964 buffer_time_set = .true.
1966 if (current_buffer_time .ne. output_buffer_obj%get_buffer_time()) &
1967 call mpp_error(fatal,
"Send data has not been called at the same time steps for the fields:"//&
1968 field_name//
" and "//output_buffer_obj%get_buffer_name()//&
1969 " in file:"//this%get_file_fname())
1976 function has_send_data_been_called(this, output_buffers, print_warnings, diag_fields) &
1979 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1980 logical,
intent(in) :: print_warnings
1981 type(fmsdiagfield_type),
intent(in),
optional :: diag_fields(:)
1989 if (print_warnings)
then
1990 do i = 1, this%number_of_buffers
1991 if (.not. output_buffers(this%buffer_ids(i))%is_there_data_to_write())
then
1992 field_id = output_buffers(this%buffer_ids(i))%get_field_id()
1993 call mpp_error(note,
"Send data was never called for field:"//&
1994 trim(diag_fields(field_id)%get_varname())//
" mod: "//trim(diag_fields(field_id)%get_modname())//&
1995 " in file: "//trim(this%get_file_fname())//
". Writting FILL VALUES!")
1999 do i = 1, this%number_of_buffers
2000 if (output_buffers(this%buffer_ids(i))%is_there_data_to_write())
then
2006 end function has_send_data_been_called
2008 end module fms_diag_file_object_mod
character(len=8) no_units
String indicating that the variable has no units.
integer, parameter sub_regional
This is a file with a sub_region use the FmsNetcdfFile_t fileobj.
integer, parameter max_str_len
Max length for a string.
integer function get_base_minute()
gets the module variable base_minute
integer function get_base_year()
gets the module variable base_year
integer function get_base_hour()
gets the module variable base_hour
logical flush_nc_files
Control if diag_manager will force a flush of the netCDF file on each write. Note: changing this to ....
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
character(len=7) avg_name
Name of the average fields.
integer, parameter end_time
Use the end of the time average bounds.
character(len=6) pack_size_str
Pack size as a string to be used in fms2_io register call set to "double" or "float".
type(time_type) function get_base_time()
gets the module variable base_time
integer max_axes
Maximum number of independent axes.
integer function get_base_day()
gets the module variable base_day
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 ug_domain
Use the FmsNetcdfUnstructuredDomainFile_t fileobj.
integer, parameter time_diurnal
The reduction method is diurnal.
integer, parameter time_power
The reduction method is average with exponents.
logical prepend_date
Should the history file have the start date prepended to the file name. .TRUE. is only supported if t...
integer, parameter begin_time
Use the begining of the time average bounds.
integer, parameter time_average
The reduction method is average of values.
integer function get_base_month()
gets the module variable base_month
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 middle_time
Use the middle of the time average bounds.
integer, parameter time_none
There is no reduction method.
integer function get_base_second()
gets the module variable base_second
integer, parameter time_max
The reduction method is max value.
integer, parameter two_d_domain
Use the FmsNetcdfDomainFile_t fileobj.
Close a netcdf or domain file opened with open_file or open_virtual_file.
Opens a given netcdf or domain file.
Add a dimension to a given file.
Defines a new field within the given file Example usage:
Write data to a defined field within a file Example usage:
character(len=128) function, public get_time_string(filename, current_time)
This function determines a string based on current time. This string is used as suffix in output file...
real function, public get_date_dif(t2, t1, units)
Return the difference between two times in units.
subroutine, public define_new_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_sphere, write_on_this_pe)
Fill in the subaxis object for a subRegion defined by lat lon.
subroutine, public define_new_subaxis_index(parent_axis, subRegion, diag_axis, naxis, is_x_or_y, write_on_this_pe)
Fill in the subaxis object for a subRegion defined by index.
subroutine, public define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges)
Defined a new diurnal axis.
subroutine, public create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_axis_id, nfile_axis, nz_subaxis)
Creates a new z subaxis to use.
logical function, public is_parent_axis(axis_id, parent_axis_id, diag_axis)
Determine if the diag_axis(parent_axis_id) is the parent of diag_axis(axis_id)
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.
Object that holds the information of the diag_yaml.
integer function mpp_get_ntile_count(domain)
Returns number of tiles in mosaic.
integer function, dimension(2) mpp_get_io_domain_layout(domain)
Set user stack size.
integer function stdout()
This function returns the current standard fortran unit numbers for output.
integer function mpp_npes()
Returns processor count for current pelist.
integer function mpp_pe()
Returns processor ID.
Reduction operations. Find the max of scalar a from the PEs in pelist result is also automatically br...
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.
character(len=24) function, public valid_calendar_types(ncal, err_msg)
Returns a character string that describes the calendar type corresponding to the input integer.
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...
integer function, public get_calendar_type()
Returns default calendar type for mapping from time to date.
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 unstructured domain.
Type to hold the diagnostic axis description.
Type to hold the diag_axis (either subaxis or a full axis)
Type to hold the diurnal axis.
Type to hold the diagnostic axis description.
Type to hold the subaxis.
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 diag_file information
type to hold the info a diag_field
type to hold the sub region information about a file