25 module fms_diag_file_object_mod
27 use fms2_io_mod,
only: fmsnetcdffile_t, fmsnetcdfunstructureddomainfile_t, fmsnetcdfdomainfile_t, &
30 dimension_exists, register_global_attribute, flush_file
40 OPERATOR(/),
OPERATOR(+),
operator(<)
51 uppercase, lowercase, note,
mpp_max
52 use platform_mod,
only: fms_file_len
54 mpp_get_io_domain_ug_layout
59 public ::
fmsdiagfile_type, fms_diag_files_object_init, fms_diag_files_object_initialized
61 logical :: fms_diag_files_object_initialized = .false.
63 integer,
parameter :: var_string_len = 25
74 logical :: done_writing_data
78 logical :: is_file_open
80 class(fmsnetcdffile_t),
allocatable :: fms2io_fileobj
82 integer :: type_of_domain
86 character(len=:) ,
dimension(:),
allocatable :: file_metadata_from_model
88 integer,
dimension(:),
allocatable :: field_ids
89 integer,
dimension(:),
allocatable :: yaml_ids
90 logical,
dimension(:),
private,
allocatable :: field_registered
93 integer,
allocatable :: num_registered_fields
95 integer,
dimension(:),
allocatable :: axis_ids
96 integer :: number_of_axis
97 integer,
dimension(:),
allocatable :: buffer_ids
98 integer :: number_of_buffers
99 logical,
allocatable :: time_ops
101 integer :: unlim_dimension_level
102 integer :: num_time_levels
103 logical :: data_has_been_written
105 integer :: nz_subaxis
108 procedure,
public :: add_field_and_yaml_id
109 procedure,
public :: add_buffer_id
110 procedure,
public :: is_field_registered
111 procedure,
public :: init_diurnal_axis
112 procedure,
public :: has_file_metadata_from_model
113 procedure,
public :: has_fileobj
114 procedure,
public :: has_diag_yaml_file
115 procedure,
public :: set_domain_from_axis
116 procedure,
public :: set_file_domain
117 procedure,
public :: add_axes
118 procedure,
public :: add_new_axis
119 procedure,
public :: update_write_on_this_pe
120 procedure,
public :: get_write_on_this_pe
121 procedure,
public :: does_axis_exist
122 procedure,
public :: define_new_subaxis
123 procedure,
public :: add_start_time
124 procedure,
public :: set_file_time_ops
125 procedure,
public :: has_field_ids
126 procedure,
public :: get_time_ops
127 procedure,
public :: get_id
130 procedure,
public :: get_file_metadata_from_model
131 procedure,
public :: get_field_ids
133 procedure,
public :: get_file_fname
134 procedure,
public :: get_file_frequnit
135 procedure,
public :: get_file_freq
136 procedure,
public :: get_file_timeunit
137 procedure,
public :: get_file_unlimdim
138 procedure,
public :: get_file_sub_region
139 procedure,
public :: get_file_sub_region_grid_type
140 procedure,
public :: get_file_new_file_freq
141 procedure,
public :: get_filename_time
142 procedure,
public :: get_file_new_file_freq_units
143 procedure,
public :: get_file_start_time
144 procedure,
public :: get_file_duration
145 procedure,
public :: get_file_duration_units
146 procedure,
public :: get_file_varlist
147 procedure,
public :: get_file_global_meta
148 procedure,
public :: is_using_collective_writes
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)
224 if (diag_yaml%has_diag_files())
then
225 nfiles = diag_yaml%size_diag_files()
226 allocate (files_array(nfiles))
227 set_ids_loop:
do i= 1,nfiles
230 if (diag_yaml%diag_files(i)%has_file_sub_region())
then
232 obj => files_array(i)%FMS_diag_file
235 allocate(obj%sub_axis_ids(
max_axes))
236 obj%sub_axis_ids = diag_null
237 obj%write_on_this_pe = .true.
238 obj%is_subaxis_defined = .false.
239 obj%number_of_axis = 0
243 obj => files_array(i)%FMS_diag_file
246 obj%diag_yaml_file => diag_yaml%diag_files(i)
248 allocate(obj%field_ids(diag_yaml%diag_files(i)%size_file_varlist()))
249 allocate(obj%buffer_ids(diag_yaml%diag_files(i)%size_file_varlist()))
250 allocate(obj%yaml_ids(diag_yaml%diag_files(i)%size_file_varlist()))
251 allocate(obj%field_registered(diag_yaml%diag_files(i)%size_file_varlist()))
253 obj%field_ids = diag_not_registered
254 obj%yaml_ids = diag_not_registered
255 obj%buffer_ids = diag_not_registered
256 obj%field_registered = .false.
257 obj%num_registered_fields = 0
258 obj%number_of_buffers = 0
266 obj%number_of_axis = 0
269 obj%done_writing_data = .false.
274 if (obj%has_file_start_time())
then
275 obj%start_time = obj%get_file_start_time()
279 obj%last_output = obj%start_time
281 obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit())
282 obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit())
284 if (obj%has_file_new_file_freq())
then
285 obj%next_close = diag_time_inc(obj%start_time, obj%get_file_new_file_freq(), &
286 obj%get_file_new_file_freq_units())
288 if (obj%has_file_duration())
then
289 obj%next_close = diag_time_inc(obj%start_time, obj%get_file_duration(), &
290 obj%get_file_duration_units())
292 obj%next_close = diag_time_inc(obj%start_time, very_large_file_freq, diag_days)
295 obj%is_file_open = .false.
297 if(obj%has_file_duration())
then
298 obj%no_more_data = diag_time_inc(obj%start_time, obj%get_file_duration(), &
299 obj%get_file_duration_units())
301 obj%no_more_data = diag_time_inc(obj%start_time, very_large_file_freq, diag_days)
304 obj%unlim_dimension_level = 0
305 obj%num_time_levels = 0
306 obj%is_static = obj%get_file_freq() .eq. -1
311 fms_diag_files_object_init = .true.
313 fms_diag_files_object_init = .false.
317 end function fms_diag_files_object_init
321 pure logical function is_field_registered(this, field_id)
323 integer,
intent(in) :: field_id
325 is_field_registered = this%field_registered(field_id)
326 end function is_field_registered
329 subroutine add_field_and_yaml_id (this, new_field_id, yaml_id)
331 integer,
intent(in) :: new_field_id
332 integer,
intent(in) :: yaml_id
334 this%num_registered_fields = this%num_registered_fields + 1
335 if (this%num_registered_fields .le.
size(this%field_ids))
then
336 this%field_ids( this%num_registered_fields ) = new_field_id
337 this%yaml_ids( this%num_registered_fields ) = yaml_id
338 this%field_registered( this%num_registered_fields ) = .true.
340 call mpp_error(fatal,
"The file: "//this%get_file_fname()//
" has already been assigned its maximum "//&
343 end subroutine add_field_and_yaml_id
346 subroutine add_buffer_id (this, buffer_id)
348 integer,
intent(in) :: buffer_id
350 this%number_of_buffers = this%number_of_buffers + 1
351 this%buffer_ids(this%number_of_buffers) = buffer_id
353 end subroutine add_buffer_id
358 subroutine init_diurnal_axis(this, diag_axis, naxis, yaml_id)
361 integer,
intent(inout) :: naxis
362 integer,
intent(in) :: yaml_id
367 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
370 if (.not. field_yaml%has_n_diurnal())
return
373 do i = 1, this%number_of_axis
374 select type(axis=>diag_axis(this%axis_ids(i))%axis)
376 if(field_yaml%get_n_diurnal() .eq. axis%get_diurnal_axis_samples())
return
385 this%number_of_axis = this%number_of_axis + 1
386 this%axis_ids(this%number_of_axis) = naxis
388 this%number_of_axis = this%number_of_axis + 1
389 this%axis_ids(this%number_of_axis) = naxis - 1
391 end subroutine init_diurnal_axis
394 subroutine set_file_time_ops(this, VarYaml, is_static)
397 logical,
intent(in) :: is_static
398 integer,
allocatable :: var_reduct
401 if (this%is_static)
return
402 if (is_static)
return
405 if (.not.
allocated(this%time_ops))
then
406 var_reduct = varyaml%get_var_reduction()
408 select case (var_reduct)
410 this%time_ops = .true.
412 this%time_ops = .false.
418 if (this%time_ops)
then
419 if (varyaml%get_var_reduction() .eq.
time_none) &
420 call mpp_error(fatal,
"The file: "//this%get_file_fname()//&
421 " has variables that are time averaged and instantaneous")
423 if (varyaml%get_var_reduction() .ne.
time_none) &
424 call mpp_error(fatal,
"The file: "//this%get_file_fname()//&
425 " has variables that are time averaged and instantaneous")
427 end subroutine set_file_time_ops
431 pure logical function has_file_metadata_from_model (this)
433 has_file_metadata_from_model =
allocated(this%file_metadata_from_model)
434 end function has_file_metadata_from_model
438 pure logical function has_fileobj (this)
440 has_fileobj =
allocated(this%fms2io_fileobj)
441 end function has_fileobj
445 pure logical function has_diag_yaml_file (this)
447 has_diag_yaml_file =
associated(this%diag_yaml_file)
448 end function has_diag_yaml_file
452 function get_filename_time(this) &
458 file_end_time = this%next_close
459 if (this%next_close > this%no_more_data) file_end_time = this%no_more_data
460 select case (this%diag_yaml_file%get_filename_time())
462 res = this%last_output
464 res = (this%last_output + file_end_time )/2
468 end function get_filename_time
472 pure logical function has_field_ids (this)
474 has_field_ids =
allocated(this%field_ids)
475 end function has_field_ids
479 pure function get_id (this)
result (res)
487 pure function get_time_ops (this)
result (res)
491 if (.not.
allocated(this%time_ops))
then
496 end function get_time_ops
519 pure function get_file_metadata_from_model (this)
result (res)
521 character(len=:),
dimension(:),
allocatable :: res
522 res = this%file_metadata_from_model
523 end function get_file_metadata_from_model
527 pure function get_field_ids (this)
result (res)
529 integer,
dimension(:),
allocatable :: res
530 allocate(res(
size(this%field_ids)))
532 end function get_field_ids
537 pure function get_file_fname (this)
result(res)
539 character (len=:),
allocatable :: res
540 res = this%diag_yaml_file%get_file_fname()
541 end function get_file_fname
545 pure function get_file_frequnit (this)
result(res)
548 res = this%diag_yaml_file%get_file_frequnit()
549 end function get_file_frequnit
553 pure function get_file_freq (this)
result(res)
556 res = this%diag_yaml_file%get_file_freq()
557 end function get_file_freq
561 pure function get_file_timeunit (this)
result(res)
564 res = this%diag_yaml_file%get_file_timeunit()
565 end function get_file_timeunit
569 pure function get_file_unlimdim (this)
result(res)
571 character (len=:),
allocatable :: res
572 res = this%diag_yaml_file%get_file_unlimdim()
573 end function get_file_unlimdim
577 function get_file_sub_region (obj)
result(res)
580 res => obj%diag_yaml_file%get_file_sub_region()
581 end function get_file_sub_region
585 function get_file_sub_region_grid_type(this) &
592 if(this%diag_yaml_file%has_file_sub_region())
then
593 subregion => this%diag_yaml_file%get_file_sub_region()
594 res = subregion%grid_type
598 end function get_file_sub_region_grid_type
602 pure function get_file_new_file_freq (this)
result(res)
605 res = this%diag_yaml_file%get_file_new_file_freq()
606 end function get_file_new_file_freq
610 pure function get_file_new_file_freq_units (this)
result(res)
613 res = this%diag_yaml_file%get_file_new_file_freq_units()
614 end function get_file_new_file_freq_units
618 pure function get_file_start_time (this)
result(res)
621 res = this%diag_yaml_file%get_file_start_time()
622 end function get_file_start_time
626 pure function get_file_duration (this)
result(res)
629 res = this%diag_yaml_file%get_file_duration()
630 end function get_file_duration
634 pure function get_file_duration_units (this)
result(res)
637 res = this%diag_yaml_file%get_file_duration_units()
638 end function get_file_duration_units
642 pure function get_file_varlist (this)
result(res)
644 character (len=:),
allocatable,
dimension(:) :: res
645 res = this%diag_yaml_file%get_file_varlist()
646 end function get_file_varlist
650 pure function get_file_global_meta (this)
result(res)
652 character (len=MAX_STR_LEN),
allocatable,
dimension(:,:) :: res
653 res = this%diag_yaml_file%get_file_global_meta()
654 end function get_file_global_meta
658 pure function is_using_collective_writes (this)
result(res)
662 res = this%diag_yaml_file%is_using_collective_writes()
663 end function is_using_collective_writes
668 pure function is_done_writing_data (this)
result(res)
671 res = this%done_writing_data
672 if (this%is_file_open) res = .false.
673 end function is_done_writing_data
677 pure function has_file_fname (this)
result(res)
680 res = this%diag_yaml_file%has_file_fname()
681 end function has_file_fname
685 pure function has_file_frequnit (this)
result(res)
688 res = this%diag_yaml_file%has_file_frequnit()
689 end function has_file_frequnit
693 pure function has_file_freq (this)
result(res)
696 res = this%diag_yaml_file%has_file_freq()
697 end function has_file_freq
701 pure function has_file_timeunit (this)
result(res)
704 res = this%diag_yaml_file%has_file_timeunit()
705 end function has_file_timeunit
709 pure function has_file_unlimdim (this)
result(res)
712 res = this%diag_yaml_file%has_file_unlimdim()
713 end function has_file_unlimdim
717 pure function has_file_sub_region (this)
result(res)
720 res = this%diag_yaml_file%has_file_sub_region()
721 end function has_file_sub_region
725 pure function has_file_new_file_freq (this)
result(res)
728 res = this%diag_yaml_file%has_file_new_file_freq()
729 end function has_file_new_file_freq
733 pure function has_file_new_file_freq_units (this)
result(res)
736 res = this%diag_yaml_file%has_file_new_file_freq_units()
737 end function has_file_new_file_freq_units
741 pure function has_file_start_time (this)
result(res)
744 res = this%diag_yaml_file%has_file_start_time()
745 end function has_file_start_time
749 pure function has_file_duration (this)
result(res)
752 res = this%diag_yaml_file%has_file_duration()
753 end function has_file_duration
757 pure function has_file_duration_units (this)
result(res)
760 res = this%diag_yaml_file%has_file_duration_units()
761 end function has_file_duration_units
765 pure function has_file_varlist (this)
result(res)
768 res = this%diag_yaml_file%has_file_varlist()
769 end function has_file_varlist
773 pure function has_file_global_meta (this)
result(res)
776 res = this%diag_yaml_file%has_file_global_meta()
777 end function has_file_global_meta
780 subroutine set_domain_from_axis(this, diag_axis, axes)
783 integer,
intent(in) :: axes (:)
786 end subroutine set_domain_from_axis
792 subroutine set_file_domain(this, domain, type_of_domain)
794 integer,
INTENT(in) :: type_of_domain
797 if (type_of_domain .ne. this%type_of_domain)
then
806 this%type_of_domain = type_of_domain
807 this%domain => domain
814 call mpp_error(fatal,
"The file: "//this%get_file_fname()//
" has variables that are not in the same domain")
818 end subroutine set_file_domain
821 subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id, buffer_id, output_buffers)
823 integer,
INTENT(in) :: axis_ids(:)
825 integer,
intent(inout) :: naxis
827 integer,
intent(in) :: yaml_id
829 integer,
intent(in) :: buffer_id
835 logical :: is_cube_sphere
836 logical :: axis_found
837 integer,
allocatable :: var_axis_ids(:)
838 integer :: x_y_axis_id(2)
841 integer :: subregion_gridtype
842 logical :: write_on_this_pe
844 character(len=MAX_STR_LEN) :: error_mseg
846 is_cube_sphere = .false.
847 subregion_gridtype = this%get_file_sub_region_grid_type()
849 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
855 var_axis_ids = axis_ids
857 error_mseg =
"Field: "//trim(field_yaml%get_var_varname())//
" in file: "//&
858 trim(field_yaml%get_var_fname())
860 if (field_yaml%has_var_zbounds())
then
862 this%axis_ids, this%number_of_axis, this%nz_subaxis, error_mseg)
867 if (
associated(this%domain))
then
868 if (this%domain%get_ntiles() .eq. 6) is_cube_sphere = .true.
870 if (.not. this%get_write_on_this_pe())
return
871 subaxis_defined:
if (this%is_subaxis_defined)
then
872 do i = 1,
size(var_axis_ids)
873 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
876 is_x_or_y = parent_axis%is_x_or_y_axis()
877 do j = 1, this%number_of_axis
879 if(
is_parent_axis(this%axis_ids(j), var_axis_ids(i), diag_axis))
then
881 var_axis_ids(i) = this%axis_ids(j)
884 elseif (var_axis_ids(i) .eq. this%axis_ids(j))
then
889 if (.not. axis_found)
then
891 if (subregion_gridtype .eq. latlon_gridtype .and. is_cube_sphere) &
892 call mpp_error(fatal,
"If using the cube sphere and defining the subregion with latlon "//&
893 "the variable need to have the same x and y axis. Please check the variables in the file "//&
894 trim(this%get_file_fname())//
" or use indices to define the subregion.")
896 select case (subregion_gridtype)
897 case (index_gridtype)
900 case (latlon_gridtype)
902 .false., write_on_this_pe)
904 call this%update_write_on_this_pe(write_on_this_pe)
905 if (.not. this%get_write_on_this_pe()) cycle
906 call this%add_new_axis(naxis)
907 var_axis_ids(i) = naxis
909 call this%add_new_axis(var_axis_ids(i))
913 axis_found = this%does_axis_exist(var_axis_ids(i))
914 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
918 x_y_axis_id = diag_null
919 do i = 1,
size(var_axis_ids)
920 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
922 if (.not. parent_axis%is_x_or_y_axis(x_or_y))
then
923 axis_found = this%does_axis_exist(var_axis_ids(i))
924 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
926 x_y_axis_id(x_or_y) = var_axis_ids(i)
929 axis_found = this%does_axis_exist(var_axis_ids(i))
930 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
934 call this%define_new_subaxis(var_axis_ids, x_y_axis_id, is_cube_sphere, diag_axis, naxis)
935 this%is_subaxis_defined = .true.
936 endif subaxis_defined
938 do i = 1,
size(var_axis_ids)
939 axis_found = this%does_axis_exist(var_axis_ids(i))
940 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
944 call output_buffers(buffer_id)%add_axis_ids(var_axis_ids)
945 end subroutine add_axes
948 subroutine add_new_axis(this, var_axis_id)
950 integer,
intent(in) :: var_axis_id
952 this%number_of_axis = this%number_of_axis + 1
953 this%axis_ids(this%number_of_axis) = var_axis_id
954 end subroutine add_new_axis
957 subroutine update_write_on_this_pe(this, write_on_this_pe)
959 logical,
intent(in) :: write_on_this_pe
964 if (this%write_on_this_pe) this%write_on_this_pe = write_on_this_pe
966 end subroutine update_write_on_this_pe
970 function get_write_on_this_pe(this) &
977 rslt= this%write_on_this_pe
979 end function get_write_on_this_pe
983 function does_axis_exist(this, var_axis_id) &
986 integer,
intent(in) :: var_axis_id
992 do j = 1, this%number_of_axis
994 if (var_axis_id .eq. this%axis_ids(j))
then
1002 subroutine define_new_subaxis(this, var_axis_ids, x_y_axis_id, is_cube_sphere, diag_axis, naxis)
1004 integer,
INTENT(inout) :: var_axis_ids(:)
1005 integer,
INTENT(in) :: x_y_axis_id(:)
1006 logical,
intent(in) :: is_cube_sphere
1007 integer,
intent(inout) :: naxis
1010 logical :: write_on_this_pe
1013 select case (this%get_file_sub_region_grid_type())
1014 case(latlon_gridtype)
1017 call this%update_write_on_this_pe(write_on_this_pe)
1018 if (.not. this%get_write_on_this_pe())
return
1019 call this%add_new_axis(naxis)
1020 call this%add_new_axis(naxis-1)
1021 do j = 1,
size(var_axis_ids)
1022 if (x_y_axis_id(1) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis - 1
1023 if (x_y_axis_id(2) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis
1025 case (index_gridtype)
1026 do i = 1,
size(x_y_axis_id)
1027 select type (parent_axis => diag_axis(x_y_axis_id(i))%axis)
1031 call this%update_write_on_this_pe(write_on_this_pe)
1032 if (.not. this%get_write_on_this_pe())
return
1033 call this%add_new_axis(naxis)
1034 do j = 1,
size(var_axis_ids)
1035 if (x_y_axis_id(i) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis
1040 end subroutine define_new_subaxis
1045 subroutine add_start_time(this, start_time)
1047 TYPE(
time_type),
intent(in) :: start_time
1056 if (this%start_time >= start_time)
return
1062 if (this%start_time .ne. start_time)&
1063 call mpp_error(fatal,
"The variables associated with the file:"//this%get_file_fname()//
" have &
1064 &different start_time")
1068 this%model_time = start_time
1069 this%start_time = start_time
1070 this%last_output = start_time
1071 this%next_output = diag_time_inc(start_time, this%get_file_freq(), this%get_file_frequnit())
1072 this%next_next_output = diag_time_inc(this%next_output, this%get_file_freq(), this%get_file_frequnit())
1073 if (this%has_file_new_file_freq())
then
1074 this%next_close = diag_time_inc(this%start_time, this%get_file_new_file_freq(), &
1075 this%get_file_new_file_freq_units())
1077 if (this%is_static)
then
1080 this%next_close = this%start_time
1081 this%next_next_output = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1083 this%next_close = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1087 if(this%has_file_duration())
then
1088 this%no_more_data = diag_time_inc(this%start_time, this%get_file_duration(), &
1089 this%get_file_duration_units())
1091 this%no_more_data = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1099 subroutine dump_file_obj(this, unit_num)
1101 integer,
intent(in) :: unit_num
1103 write( unit_num, *)
'file id:', this%id
1104 write( unit_num, *)
'start time:',
date_to_string(this%start_time)
1105 write( unit_num, *)
'last_output',
date_to_string(this%last_output)
1106 write( unit_num, *)
'next_output',
date_to_string(this%next_output)
1107 write( unit_num, *)
'next_next_output',
date_to_string(this%next_next_output)
1110 if(
allocated(this%fms2io_fileobj))
write( unit_num, *)
'fileobj path', this%fms2io_fileobj%path
1112 write( unit_num, *)
'type_of_domain', this%type_of_domain
1113 if(
allocated(this%file_metadata_from_model))
write( unit_num, *)
'file_metadata_from_model', &
1114 this%file_metadata_from_model
1115 if(
allocated(this%field_ids))
write( unit_num, *)
'field_ids', this%field_ids
1116 if(
allocated(this%field_registered))
write( unit_num, *)
'field_registered', this%field_registered
1117 if(
allocated(this%num_registered_fields))
write( unit_num, *)
'num_registered_fields', this%num_registered_fields
1118 if(
allocated(this%axis_ids))
write( unit_num, *)
'axis_ids', this%axis_ids(1:this%number_of_axis)
1124 logical pure function is_regional(this)
1127 select type (wut=>this%FMS_diag_file)
1129 is_regional = .true.
1131 is_regional = .false.
1134 end function is_regional
1138 logical pure function is_file_static(this)
1141 is_file_static = .false.
1143 select type (fileptr=>this%FMS_diag_file)
1145 is_file_static = fileptr%is_static
1148 end function is_file_static
1151 subroutine open_diag_file(this, time_step, file_is_opened)
1153 TYPE(time_type),
intent(in) :: time_step
1154 logical,
intent(out) :: file_is_opened
1158 class(diagdomain_t),
pointer :: domain
1159 character(len=:),
allocatable :: diag_file_name
1160 character(len=FMS_FILE_LEN) :: base_name
1162 character(len=FMS_FILE_LEN) :: file_name
1163 character(len=FMS_FILE_LEN) :: temp_name
1164 character(len=128) :: start_date
1166 character(len=128) :: suffix
1175 character(len=4) :: mype_string
1176 logical :: is_regional
1177 integer,
allocatable :: pes(:)
1179 diag_file => this%FMS_diag_file
1180 domain => diag_file%domain
1182 file_is_opened = .false.
1184 if (diag_file%is_file_open)
return
1186 is_regional = .false.
1188 if (.not.
allocated(diag_file%fms2io_fileobj))
then
1189 select type (diag_file)
1192 allocate(fmsnetcdffile_t :: diag_file%fms2io_fileobj)
1193 is_regional = .true.
1196 select case (diag_file%type_of_domain)
1198 allocate(fmsnetcdffile_t :: diag_file%fms2io_fileobj)
1200 allocate(fmsnetcdfdomainfile_t :: diag_file%fms2io_fileobj)
1202 allocate(fmsnetcdfunstructureddomainfile_t :: diag_file%fms2io_fileobj)
1208 diag_file_name = diag_file%get_file_fname()
1211 if (diag_file%has_file_new_file_freq())
then
1213 pos = index(diag_file_name,
'%')
1214 if (pos > 0) base_name = diag_file_name(1:pos-1)
1215 suffix = get_time_string(diag_file_name, diag_file%get_filename_time())
1216 base_name = trim(base_name)//trim(suffix)
1218 base_name = trim(diag_file_name)
1222 file_name = trim(base_name)
1223 call get_instance_filename(base_name, file_name)
1227 IF ( prepend_date )
THEN
1228 call get_date(diag_file%start_time, year, month, day, hour, minute, second)
1229 write (start_date,
'(1I20.4, 2I2.2)') year, month, day
1231 file_name = trim(adjustl(start_date))//
'.'//trim(file_name)
1234 file_name = trim(file_name)//
".nc"
1237 if (is_regional)
then
1239 write(mype_string,
'(I0.4)')
mpp_pe()
1242 select type (domain)
1243 type is (diagdomain2d_t)
1244 temp_name = file_name
1245 call get_mosaic_tile_file(temp_name, file_name, .true., domain%domain2)
1248 file_name = trim(file_name)//
"."//trim(mype_string)
1253 select case (diag_file%type_of_domain)
1254 case (no_domain, ug_domain)
1255 if (diag_file%is_using_collective_writes())
then
1256 call mpp_error(fatal,
"Collective writes are only supported for domain-decomposed files. "// &
1257 trim(file_name)//
" is using collective writes with an unsupported domain type.")
1260 if (is_regional .and. diag_file%is_using_collective_writes())
then
1261 call mpp_error(fatal,
"Collective writes are not supported for regional runs. "// &
1262 "Disable collective writes in the diag_table yaml for file:"// &
1268 select type (fms2io_fileobj => diag_file%fms2io_fileobj)
1269 type is (fmsnetcdffile_t)
1270 if (is_regional)
then
1271 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", pelist=(/
mpp_pe()/))) &
1272 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1273 call register_global_attribute(fms2io_fileobj,
"is_subregional",
"True", str_len=4)
1276 call mpp_get_current_pelist(pes)
1278 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", pelist=pes)) &
1279 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1281 type is (fmsnetcdfdomainfile_t)
1282 select type (domain)
1283 type is (diagdomain2d_t)
1284 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", domain%Domain2, &
1285 use_netcdf_mpi = diag_file%is_using_collective_writes(), &
1286 use_collective = diag_file%is_using_collective_writes())) &
1287 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1289 type is (fmsnetcdfunstructureddomainfile_t)
1290 select type (domain)
1291 type is (diagdomainug_t)
1292 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", domain%DomainUG)) &
1293 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1297 file_is_opened = .true.
1298 diag_file%is_file_open = file_is_opened
1301 end subroutine open_diag_file
1304 subroutine write_global_metadata(this)
1307 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1309 character (len=MAX_STR_LEN),
allocatable :: yaml_file_attributes(:,:)
1311 type(diagyamlfiles_type),
pointer :: diag_file_yaml
1312 character(len=MAX_STR_LEN) :: title
1314 diag_file_yaml => this%FMS_diag_file%diag_yaml_file
1315 fms2io_fileobj => this%FMS_diag_file%fms2io_fileobj
1318 if (diag_file_yaml%has_file_global_meta())
then
1319 yaml_file_attributes = diag_file_yaml%get_file_global_meta()
1320 do i = 1,
size(yaml_file_attributes,1)
1321 call register_global_attribute(fms2io_fileobj, trim(yaml_file_attributes(i,1)), &
1322 trim(yaml_file_attributes(i,2)), str_len=len_trim(yaml_file_attributes(i,2)))
1324 deallocate(yaml_file_attributes)
1328 title = diag_yaml%get_title()
1329 call register_global_attribute(fms2io_fileobj,
'title', trim(title), &
1330 str_len=len_trim(title))
1332 end subroutine write_global_metadata
1335 subroutine write_var_metadata(fms2io_fileobj, variable_name, dimensions, long_name, units)
1336 class(fmsnetcdffile_t),
intent(inout) :: fms2io_fileobj
1337 character(len=*) ,
intent(in) :: variable_name
1338 character(len=*) ,
intent(in) :: dimensions(:)
1339 character(len=*) ,
intent(in) :: long_name
1340 character(len=*) ,
intent(in) :: units
1342 call register_field(fms2io_fileobj, variable_name, pack_size_str, dimensions)
1343 call register_variable_attribute(fms2io_fileobj, variable_name,
"long_name", &
1344 trim(long_name), str_len=len_trim(long_name))
1345 if (trim(units) .ne. no_units) &
1346 call register_variable_attribute(fms2io_fileobj, variable_name,
"units", &
1347 trim(units), str_len=len_trim(units))
1348 end subroutine write_var_metadata
1351 subroutine write_time_metadata(this)
1355 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1356 character(len=50) :: time_units_str
1357 character(len=50) :: calendar
1359 character(len=:),
allocatable :: time_var_name
1360 character(len=50) :: dimensions(2)
1362 diag_file => this%FMS_diag_file
1363 fms2io_fileobj => diag_file%fms2io_fileobj
1365 time_var_name = diag_file%get_file_unlimdim()
1366 call register_axis(fms2io_fileobj, time_var_name, unlimited)
1368 WRITE(time_units_str, 11) &
1369 trim(time_unit_list(diag_file%get_file_timeunit())), get_base_year(),&
1370 & get_base_month(), get_base_day(), get_base_hour(), get_base_minute(), get_base_second()
1371 11
FORMAT(a,
' since ', i4.4,
'-', i2.2,
'-', i2.2,
' ', i2.2,
':', i2.2,
':', i2.2)
1373 dimensions(1) =
"nv"
1374 dimensions(2) = trim(time_var_name)
1376 call write_var_metadata(fms2io_fileobj, time_var_name, dimensions(2:2), &
1377 time_var_name, time_units_str)
1380 call register_variable_attribute(fms2io_fileobj, time_var_name,
"axis",
"T", str_len=1 )
1383 calendar = valid_calendar_types(get_calendar_type())
1384 call register_variable_attribute(fms2io_fileobj, time_var_name,
"calendar_type", &
1385 uppercase(trim(calendar)), str_len=len_trim(calendar))
1386 call register_variable_attribute(fms2io_fileobj, time_var_name,
"calendar", &
1387 lowercase(trim(calendar)), str_len=len_trim(calendar))
1389 if (diag_file%get_time_ops())
then
1390 call register_variable_attribute(fms2io_fileobj, time_var_name,
"bounds", &
1391 trim(time_var_name)//
"_bnds", str_len=len_trim(time_var_name//
"_bnds"))
1395 if ( .not. dimension_exists(fms2io_fileobj,
"nv"))
then
1396 call register_axis(fms2io_fileobj,
"nv", 2)
1397 call write_var_metadata(fms2io_fileobj,
"nv", dimensions(1:1), &
1398 "vertex number", no_units)
1400 call write_var_metadata(fms2io_fileobj, time_var_name//
"_bnds", dimensions, &
1401 trim(time_var_name)//
" axis boundaries", time_units_str)
1404 end subroutine write_time_metadata
1407 subroutine write_field_data(this, field_obj, buffer_obj, unlim_dim_was_increased)
1409 type(fmsdiagfield_type),
intent(in),
target :: field_obj
1410 type(fmsdiagoutputbuffer_type),
intent(inout),
target :: buffer_obj
1411 logical,
intent(inout) :: unlim_dim_was_increased
1414 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1415 logical :: has_diurnal
1417 diag_file => this%FMS_diag_file
1418 fms2io_fileobj => diag_file%fms2io_fileobj
1422 call buffer_obj%increase_unlim_dim()
1423 if (buffer_obj%get_unlim_dim() > diag_file%unlim_dimension_level)
then
1424 diag_file%unlim_dimension_level = buffer_obj%get_unlim_dim()
1425 unlim_dim_was_increased = .true.
1429 if (diag_file%is_static)
then
1432 call buffer_obj%write_buffer(fms2io_fileobj)
1433 diag_file%data_has_been_written = .true.
1435 if (field_obj%is_static())
then
1437 if (buffer_obj%get_unlim_dim() .eq. 1)
then
1438 call buffer_obj%write_buffer(fms2io_fileobj)
1439 diag_file%data_has_been_written = .true.
1442 if (unlim_dim_was_increased) diag_file%data_has_been_written = .true.
1443 has_diurnal = buffer_obj%get_diurnal_sample_size() .gt. 1
1444 call buffer_obj%write_buffer(fms2io_fileobj, &
1445 unlim_dim_level=buffer_obj%get_unlim_dim(), is_diurnal=has_diurnal)
1449 end subroutine write_field_data
1453 logical function is_time_to_close_file (this, time_step, force_close)
1455 TYPE(time_type),
intent(in) :: time_step
1456 logical,
intent(in) :: force_close
1458 if (force_close .or. this%FMS_diag_file%done_writing_data)
then
1459 is_time_to_close_file = .true.
1460 elseif (time_step >= this%FMS_diag_file%next_close)
then
1461 is_time_to_close_file = .true.
1463 if (this%FMS_diag_file%is_static)
then
1464 is_time_to_close_file = .true.
1466 is_time_to_close_file = .false.
1473 logical function time_to_start_doing_math (this)
1475 time_to_start_doing_math = .false.
1476 if (this%FMS_diag_file%model_time >= this%FMS_diag_file%start_time)
then
1477 time_to_start_doing_math = .true.
1482 subroutine check_file_times(this, time_step, output_buffers, diag_fields, do_not_write)
1484 TYPE(time_type),
intent(in) :: time_step
1485 type(fmsdiagoutputbuffer_type),
intent(in) :: output_buffers(:)
1487 type(fmsdiagfield_type),
intent(in) :: diag_fields(:)
1488 logical,
intent(out) :: do_not_write
1492 do_not_write = .false.
1493 if (time_step > this%FMS_diag_file%next_output)
then
1494 if (this%FMS_diag_file%is_static)
return
1495 if (time_step > this%FMS_diag_file%next_next_output)
then
1496 if (this%FMS_diag_file%get_file_freq() .eq. 0)
then
1498 if (time_step .ne. this%FMS_diag_file%next_output)
then
1500 call this%FMS_diag_file%check_buffer_times(output_buffers, diag_fields)
1501 this%FMS_diag_file%next_output = time_step
1502 this%FMS_diag_file%next_next_output = time_step
1504 elseif (this%FMS_diag_file%num_registered_fields .eq. 0)
then
1507 if (this%FMS_diag_file%unlim_dimension_level .eq. 0)
then
1508 call mpp_error(note, this%FMS_diag_file%get_file_fname()//&
1509 ": diag_manager_mod: This file does not have any variables registered. Fill values will be written")
1510 this%FMS_diag_file%data_has_been_written = .true.
1511 this%FMS_diag_file%unlim_dimension_level = 1
1515 if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .false.)) &
1516 call mpp_error(fatal, this%FMS_diag_file%get_file_fname()//&
1517 ": diag_manager_mod: You skipped a time_step. Be sure that diag_send_complete is called at every "//&
1518 "time_step needed by the file.")
1522 if(this%FMS_diag_file%get_file_freq() .eq. 0)
then
1523 do_not_write = .true.
1526 end subroutine check_file_times
1529 logical function writing_on_this_pe(this)
1532 select type(diag_file => this%FMS_diag_file)
1534 writing_on_this_pe = diag_file%write_on_this_pe
1536 writing_on_this_pe = .true.
1542 subroutine write_time_data(this)
1547 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1548 TYPE(time_type) :: middle_time
1553 diag_file => this%FMS_diag_file
1554 fms2io_fileobj => diag_file%fms2io_fileobj
1557 if (.not. diag_file%data_has_been_written)
return
1559 if (diag_file%get_time_ops())
then
1560 middle_time = (diag_file%last_output+diag_file%next_output)/2
1561 dif = get_date_dif(middle_time, get_base_time(), diag_file%get_file_timeunit())
1563 dif = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
1566 call write_data(fms2io_fileobj, diag_file%get_file_unlimdim(), dif, &
1567 unlim_dim_level=diag_file%unlim_dimension_level)
1569 if (diag_file%get_time_ops())
then
1570 t1 = get_date_dif(diag_file%last_output, get_base_time(), diag_file%get_file_timeunit())
1571 t2 = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
1573 call write_data(fms2io_fileobj, trim(diag_file%get_file_unlimdim())//
"_bnds", &
1574 (/t1, t2/), unlim_dim_level=diag_file%unlim_dimension_level)
1576 if (diag_file%unlim_dimension_level .eq. 1)
then
1577 call write_data(fms2io_fileobj,
"nv", (/1, 2/))
1581 diag_file%data_has_been_written = .false.
1582 end subroutine write_time_data
1585 subroutine update_current_new_file_freq_index(this, time_step)
1587 TYPE(time_type),
intent(in) :: time_step
1591 diag_file => this%FMS_diag_file
1593 if (time_step >= diag_file%no_more_data)
then
1594 call diag_file%diag_yaml_file%increase_new_file_freq_index()
1596 if (diag_file%has_file_duration())
then
1597 diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, diag_file%get_file_duration(), &
1598 diag_file%get_file_duration_units())
1601 diag_file%done_writing_data = .true.
1602 diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, very_large_file_freq, diag_days)
1603 diag_file%next_output = diag_file%no_more_data
1604 diag_file%next_next_output = diag_file%no_more_data
1605 diag_file%last_output = diag_file%no_more_data
1609 if (diag_file%is_static) diag_file%done_writing_data = .true.
1610 end subroutine update_current_new_file_freq_index
1613 subroutine update_next_write(this, time_step)
1615 TYPE(time_type),
intent(in) :: time_step
1619 diag_file => this%FMS_diag_file
1620 if (diag_file%is_static)
then
1621 diag_file%last_output = diag_file%next_output
1622 diag_file%next_output = diag_time_inc(diag_file%next_output, very_large_file_freq, diag_days)
1623 diag_file%next_next_output = diag_time_inc(diag_file%next_output, very_large_file_freq, diag_days)
1625 diag_file%last_output = diag_file%next_output
1626 diag_file%next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
1627 diag_file%get_file_frequnit())
1628 diag_file%next_next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
1629 diag_file%get_file_frequnit())
1632 end subroutine update_next_write
1635 subroutine prepare_for_force_write(this)
1638 if (this%FMS_diag_file%unlim_dimension_level .eq. 0)
then
1639 this%FMS_diag_file%unlim_dimension_level = 1
1640 this%FMS_diag_file%data_has_been_written = .true.
1642 end subroutine prepare_for_force_write
1645 subroutine init_unlim_dim(this, output_buffers)
1647 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1650 type(fmsdiagoutputbuffer_type),
pointer :: output_buffer_obj
1653 diag_file => this%FMS_diag_file
1654 diag_file%unlim_dimension_level = 0
1655 do i = 1, diag_file%number_of_buffers
1656 output_buffer_obj => output_buffers(diag_file%buffer_ids(i))
1657 call output_buffer_obj%init_buffer_unlim_dim()
1659 end subroutine init_unlim_dim
1663 function get_num_time_levels(this) &
1668 if (this%is_regional())
then
1673 res = this%FMS_diag_file%num_time_levels
1676 res = this%FMS_diag_file%num_time_levels
1682 function get_num_tiles(this) &
1687 select case(this%FMS_diag_file%type_of_domain)
1688 case (two_d_domain, ug_domain)
1689 select type(domain => this%FMS_diag_file%domain)
1690 type is (diagdomain2d_t)
1692 type is (diagdomainug_t)
1693 res = mpp_get_ug_domain_ntiles(domain%DomainUG)
1698 end function get_num_tiles
1702 function get_ndistributedfiles(this) &
1706 integer :: io_layout(2)
1708 select case(this%FMS_diag_file%type_of_domain)
1709 case (two_d_domain, ug_domain)
1710 select type(domain => this%FMS_diag_file%domain)
1711 type is (diagdomain2d_t)
1713 res = io_layout(1) * io_layout(2)
1714 type is (diagdomainug_t)
1715 res = mpp_get_io_domain_ug_layout(domain%DomainUG)
1720 end function get_ndistributedfiles
1724 pure function get_unlim_dimension_level(this) &
1729 res = this%FMS_diag_file%unlim_dimension_level
1733 subroutine flush_diag_file(this)
1736 if (flush_nc_files)
then
1737 call flush_file(this%FMS_diag_file%fms2io_fileobj)
1739 end subroutine flush_diag_file
1743 pure function get_next_output(this) &
1746 type(time_type) :: res
1748 res = this%FMS_diag_file%next_output
1749 end function get_next_output
1753 pure function get_next_next_output(this) &
1756 type(time_type) :: res
1758 res = this%FMS_diag_file%next_next_output
1759 if (this%FMS_diag_file%is_static)
then
1760 res = this%FMS_diag_file%no_more_data
1762 end function get_next_next_output
1765 subroutine write_axis_metadata(this, diag_axis)
1767 class(fmsdiagaxiscontainer_type),
intent(in),
target :: diag_axis(:)
1770 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1772 integer :: parent_axis_id
1773 integer :: structured_ids(2)
1776 class(fmsdiagaxiscontainer_type),
pointer :: axis_ptr
1777 logical :: edges_in_file
1779 diag_file => this%FMS_diag_file
1780 fms2io_fileobj => diag_file%fms2io_fileobj
1782 do i = 1, diag_file%number_of_axis
1783 edges_in_file = .false.
1784 axis_ptr => diag_axis(diag_file%axis_ids(i))
1785 parent_axis_id = axis_ptr%axis%get_parent_axis_id()
1787 edges_id = axis_ptr%axis%get_edges_id()
1788 if (edges_id .ne. diag_null)
then
1790 if (any(diag_file%axis_ids(1:diag_file%number_of_axis) .eq. edges_id))
then
1791 edges_in_file = .true.
1793 call diag_axis(edges_id)%axis%write_axis_metadata(fms2io_fileobj, .true.)
1794 call diag_file%add_new_axis(edges_id)
1798 if (parent_axis_id .eq. diag_null)
then
1799 call axis_ptr%axis%write_axis_metadata(fms2io_fileobj, edges_in_file)
1801 call axis_ptr%axis%write_axis_metadata(fms2io_fileobj, edges_in_file, diag_axis(parent_axis_id)%axis)
1804 if (axis_ptr%axis%is_unstructured_grid())
then
1805 structured_ids = axis_ptr%axis%get_structured_axis()
1806 do k = 1,
size(structured_ids)
1807 call diag_axis(structured_ids(k))%axis%write_axis_metadata(fms2io_fileobj, .false.)
1813 end subroutine write_axis_metadata
1816 subroutine write_field_metadata(this, diag_field, diag_axis)
1818 class(fmsdiagfield_type) ,
intent(inout),
target :: diag_field(:)
1819 class(fmsdiagaxiscontainer_type),
intent(in) :: diag_axis(:)
1821 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1823 class(fmsdiagfield_type),
pointer :: field_ptr
1826 logical :: is_regional
1827 character(len=255) :: cell_measures
1828 logical :: need_associated_files
1829 character(len=FMS_FILE_LEN) :: associated_files
1831 is_regional = this%is_regional()
1833 diag_file => this%FMS_diag_file
1834 fms2io_fileobj => diag_file%fms2io_fileobj
1836 associated_files =
""
1837 need_associated_files = .false.
1838 do i = 1,
size(diag_file%field_ids)
1839 if (.not. diag_file%field_registered(i)) cycle
1840 field_ptr => diag_field(diag_file%field_ids(i))
1843 if (field_ptr%has_area())
then
1844 cell_measures =
"area: "//diag_field(field_ptr%get_area())%get_varname(to_write=.true., &
1845 filename=diag_file%get_file_fname())
1849 if (.not. diag_field(field_ptr%get_area())%is_variable_in_file(diag_file%id))
then
1850 need_associated_files = .true.
1851 call diag_field(field_ptr%get_area())%generate_associated_files_att(associated_files, diag_file%start_time)
1855 if (field_ptr%has_volume())
then
1856 cell_measures = trim(cell_measures)//
" volume: "//diag_field(field_ptr%get_volume())%get_varname(&
1857 to_write=.true., filename=diag_file%get_file_fname())
1861 if (.not. diag_field(field_ptr%get_volume())%is_variable_in_file(diag_file%id))
then
1862 need_associated_files = .true.
1863 call diag_field(field_ptr%get_volume())%generate_associated_files_att(associated_files, diag_file%start_time)
1867 call field_ptr%write_field_metadata(fms2io_fileobj, diag_file%id, diag_file%yaml_ids(i), diag_axis, &
1868 this%FMS_diag_file%get_file_unlimdim(), is_regional, cell_measures, &
1869 diag_file%is_using_collective_writes(), diag_file%axis_ids(1:diag_file%number_of_axis))
1872 if (need_associated_files) &
1873 call register_global_attribute(fms2io_fileobj,
"associated_files", trim(adjustl(associated_files)), &
1874 str_len=len_trim(adjustl(associated_files)))
1876 end subroutine write_field_metadata
1879 subroutine write_axis_data(this, diag_axis)
1881 class(fmsdiagaxiscontainer_type),
intent(in) :: diag_axis(:)
1884 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1887 integer :: parent_axis_id
1888 integer :: structured_ids(2)
1890 diag_file => this%FMS_diag_file
1891 fms2io_fileobj => diag_file%fms2io_fileobj
1893 do i = 1, diag_file%number_of_axis
1894 j = diag_file%axis_ids(i)
1895 parent_axis_id = diag_axis(j)%axis%get_parent_axis_id()
1896 if (parent_axis_id .eq. diag_null)
then
1897 call diag_axis(j)%axis%write_axis_data(fms2io_fileobj)
1899 call diag_axis(j)%axis%write_axis_data(fms2io_fileobj, diag_axis(parent_axis_id)%axis)
1902 if (diag_axis(j)%axis%is_unstructured_grid())
then
1903 structured_ids = diag_axis(j)%axis%get_structured_axis()
1904 do k = 1,
size(structured_ids)
1905 call diag_axis(structured_ids(k))%axis%write_axis_data(fms2io_fileobj)
1910 end subroutine write_axis_data
1913 subroutine close_diag_file(this, output_buffers, model_end_time, diag_fields)
1915 type(fmsdiagoutputbuffer_type),
intent(in) :: output_buffers(:)
1917 type(time_type),
intent(in) :: model_end_time
1918 type(fmsdiagfield_type),
intent(in),
optional :: diag_fields(:)
1921 if (.not. this%FMS_diag_file%is_file_open)
return
1925 select type( fms2io_fileobj => this%FMS_diag_file%fms2io_fileobj)
1926 type is (fmsnetcdfdomainfile_t)
1927 call close_file(fms2io_fileobj)
1928 type is (fmsnetcdffile_t)
1929 call close_file(fms2io_fileobj)
1930 type is (fmsnetcdfunstructureddomainfile_t)
1931 call close_file(fms2io_fileobj)
1938 this%FMS_diag_file%num_time_levels = this%FMS_diag_file%num_time_levels + &
1939 this%FMS_diag_file%unlim_dimension_level
1942 this%FMS_diag_file%unlim_dimension_level = 0
1943 this%FMS_diag_file%is_file_open = .false.
1945 if (this%FMS_diag_file%has_file_new_file_freq())
then
1946 this%FMS_diag_file%next_close = diag_time_inc(this%FMS_diag_file%next_close, &
1947 this%FMS_diag_file%get_file_new_file_freq(), &
1948 this%FMS_diag_file%get_file_new_file_freq_units())
1950 this%FMS_diag_file%next_close = model_end_time
1953 if (this%FMS_diag_file%model_time >= model_end_time) &
1954 this%FMS_diag_file%done_writing_data = .true.
1955 if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .true., diag_fields))
return
1956 end subroutine close_diag_file
1959 subroutine set_model_time(this, model_time)
1961 type(time_type),
intent(in) :: model_time
1963 if (model_time > this%FMS_diag_file%model_time) this%FMS_diag_file%model_time = model_time
1968 function get_model_time(this) &
1971 type(time_type),
pointer :: rslt
1973 rslt => this%FMS_diag_file%model_time
1974 end function get_model_time
1977 pure function get_buffer_ids (this)
1979 integer,
allocatable :: get_buffer_ids(:)
1981 allocate(get_buffer_ids(this%number_of_buffers))
1982 get_buffer_ids = this%buffer_ids(1:this%number_of_buffers)
1983 end function get_buffer_ids
1986 pure function get_number_of_buffers(this)
1988 integer :: get_number_of_buffers
1989 get_number_of_buffers = this%number_of_buffers
1990 end function get_number_of_buffers
1994 subroutine check_buffer_times(this, output_buffers, diag_fields)
1996 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1997 type(fmsdiagfield_type),
intent(in) :: diag_fields(:)
2000 type(time_type) :: current_buffer_time
2001 character(len=:),
allocatable :: field_name
2002 logical :: buffer_time_set
2003 type(fmsdiagoutputbuffer_type),
pointer :: output_buffer_obj
2005 buffer_time_set = .false.
2006 do i = 1, this%number_of_buffers
2007 output_buffer_obj => output_buffers(this%buffer_ids(i))
2008 if (diag_fields(output_buffer_obj%get_field_id())%is_static()) cycle
2009 if (.not. buffer_time_set)
then
2010 current_buffer_time = output_buffer_obj%get_buffer_time()
2011 field_name = output_buffer_obj%get_buffer_name()
2012 buffer_time_set = .true.
2014 if (current_buffer_time .ne. output_buffer_obj%get_buffer_time()) &
2015 call mpp_error(fatal,
"Send data has not been called at the same time steps for the fields:"//&
2016 field_name//
" and "//output_buffer_obj%get_buffer_name()//&
2017 " in file:"//this%get_file_fname())
2024 function has_send_data_been_called(this, output_buffers, print_warnings, diag_fields) &
2027 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
2028 logical,
intent(in) :: print_warnings
2029 type(fmsdiagfield_type),
intent(in),
optional :: diag_fields(:)
2037 if (print_warnings)
then
2038 do i = 1, this%number_of_buffers
2039 if (.not. output_buffers(this%buffer_ids(i))%is_there_data_to_write())
then
2040 field_id = output_buffers(this%buffer_ids(i))%get_field_id()
2041 call mpp_error(note,
"Send data was never called for field:"//&
2042 trim(diag_fields(field_id)%get_varname())//
" mod: "//trim(diag_fields(field_id)%get_modname())//&
2043 " in file: "//trim(this%get_file_fname())//
". Writing FILL VALUES!")
2047 do i = 1, this%number_of_buffers
2048 if (output_buffers(this%buffer_ids(i))%is_there_data_to_write())
then
2054 end function has_send_data_been_called
2056 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 create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_axis_id, nfile_axis, nz_subaxis, error_mseg)
Creates a new z subaxis to use.
subroutine, public define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges)
Defined a new diurnal axis.
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