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)
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_done_writing_data (this)
result(res)
661 res = this%done_writing_data
662 if (this%is_file_open) res = .false.
663 end function is_done_writing_data
667 pure function has_file_fname (this)
result(res)
670 res = this%diag_yaml_file%has_file_fname()
671 end function has_file_fname
675 pure function has_file_frequnit (this)
result(res)
678 res = this%diag_yaml_file%has_file_frequnit()
679 end function has_file_frequnit
683 pure function has_file_freq (this)
result(res)
686 res = this%diag_yaml_file%has_file_freq()
687 end function has_file_freq
691 pure function has_file_timeunit (this)
result(res)
694 res = this%diag_yaml_file%has_file_timeunit()
695 end function has_file_timeunit
699 pure function has_file_unlimdim (this)
result(res)
702 res = this%diag_yaml_file%has_file_unlimdim()
703 end function has_file_unlimdim
707 pure function has_file_sub_region (this)
result(res)
710 res = this%diag_yaml_file%has_file_sub_region()
711 end function has_file_sub_region
715 pure function has_file_new_file_freq (this)
result(res)
718 res = this%diag_yaml_file%has_file_new_file_freq()
719 end function has_file_new_file_freq
723 pure function has_file_new_file_freq_units (this)
result(res)
726 res = this%diag_yaml_file%has_file_new_file_freq_units()
727 end function has_file_new_file_freq_units
731 pure function has_file_start_time (this)
result(res)
734 res = this%diag_yaml_file%has_file_start_time()
735 end function has_file_start_time
739 pure function has_file_duration (this)
result(res)
742 res = this%diag_yaml_file%has_file_duration()
743 end function has_file_duration
747 pure function has_file_duration_units (this)
result(res)
750 res = this%diag_yaml_file%has_file_duration_units()
751 end function has_file_duration_units
755 pure function has_file_varlist (this)
result(res)
758 res = this%diag_yaml_file%has_file_varlist()
759 end function has_file_varlist
763 pure function has_file_global_meta (this)
result(res)
766 res = this%diag_yaml_file%has_file_global_meta()
767 end function has_file_global_meta
770 subroutine set_domain_from_axis(this, diag_axis, axes)
773 integer,
intent(in) :: axes (:)
776 end subroutine set_domain_from_axis
782 subroutine set_file_domain(this, domain, type_of_domain)
784 integer,
INTENT(in) :: type_of_domain
787 if (type_of_domain .ne. this%type_of_domain)
then
796 this%type_of_domain = type_of_domain
797 this%domain => domain
804 call mpp_error(fatal,
"The file: "//this%get_file_fname()//
" has variables that are not in the same domain")
808 end subroutine set_file_domain
811 subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id, buffer_id, output_buffers)
813 integer,
INTENT(in) :: axis_ids(:)
815 integer,
intent(inout) :: naxis
817 integer,
intent(in) :: yaml_id
819 integer,
intent(in) :: buffer_id
825 logical :: is_cube_sphere
826 logical :: axis_found
827 integer,
allocatable :: var_axis_ids(:)
828 integer :: x_y_axis_id(2)
831 integer :: subregion_gridtype
832 logical :: write_on_this_pe
834 is_cube_sphere = .false.
835 subregion_gridtype = this%get_file_sub_region_grid_type()
837 field_yaml => diag_yaml%get_diag_field_from_id(yaml_id)
843 var_axis_ids = axis_ids
845 if (field_yaml%has_var_zbounds())
then
847 this%axis_ids, this%number_of_axis, this%nz_subaxis)
852 if (
associated(this%domain))
then
853 if (this%domain%get_ntiles() .eq. 6) is_cube_sphere = .true.
855 if (.not. this%get_write_on_this_pe())
return
856 subaxis_defined:
if (this%is_subaxis_defined)
then
857 do i = 1,
size(var_axis_ids)
858 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
861 is_x_or_y = parent_axis%is_x_or_y_axis()
862 do j = 1, this%number_of_axis
864 if(
is_parent_axis(this%axis_ids(j), var_axis_ids(i), diag_axis))
then
866 var_axis_ids(i) = this%axis_ids(j)
869 elseif (var_axis_ids(i) .eq. this%axis_ids(j))
then
874 if (.not. axis_found)
then
876 if (subregion_gridtype .eq. latlon_gridtype .and. is_cube_sphere) &
877 call mpp_error(fatal,
"If using the cube sphere and defining the subregion with latlon "//&
878 "the variable need to have the same x and y axis. Please check the variables in the file "//&
879 trim(this%get_file_fname())//
" or use indices to define the subregion.")
881 select case (subregion_gridtype)
882 case (index_gridtype)
885 case (latlon_gridtype)
887 .false., write_on_this_pe)
889 call this%update_write_on_this_pe(write_on_this_pe)
890 if (.not. this%get_write_on_this_pe()) cycle
891 call this%add_new_axis(naxis)
892 var_axis_ids(i) = naxis
894 call this%add_new_axis(var_axis_ids(i))
898 axis_found = this%does_axis_exist(var_axis_ids(i))
899 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
903 x_y_axis_id = diag_null
904 do i = 1,
size(var_axis_ids)
905 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
907 if (.not. parent_axis%is_x_or_y_axis(x_or_y))
then
908 axis_found = this%does_axis_exist(var_axis_ids(i))
909 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
911 x_y_axis_id(x_or_y) = var_axis_ids(i)
914 axis_found = this%does_axis_exist(var_axis_ids(i))
915 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
919 call this%define_new_subaxis(var_axis_ids, x_y_axis_id, is_cube_sphere, diag_axis, naxis)
920 this%is_subaxis_defined = .true.
921 endif subaxis_defined
923 do i = 1,
size(var_axis_ids)
924 axis_found = this%does_axis_exist(var_axis_ids(i))
925 if (.not. axis_found)
call this%add_new_axis(var_axis_ids(i))
929 call output_buffers(buffer_id)%add_axis_ids(var_axis_ids)
930 end subroutine add_axes
933 subroutine add_new_axis(this, var_axis_id)
935 integer,
intent(in) :: var_axis_id
937 this%number_of_axis = this%number_of_axis + 1
938 this%axis_ids(this%number_of_axis) = var_axis_id
939 end subroutine add_new_axis
942 subroutine update_write_on_this_pe(this, write_on_this_pe)
944 logical,
intent(in) :: write_on_this_pe
949 if (this%write_on_this_pe) this%write_on_this_pe = write_on_this_pe
951 end subroutine update_write_on_this_pe
955 function get_write_on_this_pe(this) &
962 rslt= this%write_on_this_pe
964 end function get_write_on_this_pe
968 function does_axis_exist(this, var_axis_id) &
971 integer,
intent(in) :: var_axis_id
977 do j = 1, this%number_of_axis
979 if (var_axis_id .eq. this%axis_ids(j))
then
987 subroutine define_new_subaxis(this, var_axis_ids, x_y_axis_id, is_cube_sphere, diag_axis, naxis)
989 integer,
INTENT(inout) :: var_axis_ids(:)
990 integer,
INTENT(in) :: x_y_axis_id(:)
991 logical,
intent(in) :: is_cube_sphere
992 integer,
intent(inout) :: naxis
995 logical :: write_on_this_pe
998 select case (this%get_file_sub_region_grid_type())
999 case(latlon_gridtype)
1002 call this%update_write_on_this_pe(write_on_this_pe)
1003 if (.not. this%get_write_on_this_pe())
return
1004 call this%add_new_axis(naxis)
1005 call this%add_new_axis(naxis-1)
1006 do j = 1,
size(var_axis_ids)
1007 if (x_y_axis_id(1) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis - 1
1008 if (x_y_axis_id(2) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis
1010 case (index_gridtype)
1011 do i = 1,
size(x_y_axis_id)
1012 select type (parent_axis => diag_axis(x_y_axis_id(i))%axis)
1016 call this%update_write_on_this_pe(write_on_this_pe)
1017 if (.not. this%get_write_on_this_pe())
return
1018 call this%add_new_axis(naxis)
1019 do j = 1,
size(var_axis_ids)
1020 if (x_y_axis_id(i) .eq. var_axis_ids(j)) var_axis_ids(j) = naxis
1025 end subroutine define_new_subaxis
1030 subroutine add_start_time(this, start_time)
1032 TYPE(
time_type),
intent(in) :: start_time
1041 if (this%start_time >= start_time)
return
1047 if (this%start_time .ne. start_time)&
1048 call mpp_error(fatal,
"The variables associated with the file:"//this%get_file_fname()//
" have &
1049 &different start_time")
1053 this%model_time = start_time
1054 this%start_time = start_time
1055 this%last_output = start_time
1056 this%next_output = diag_time_inc(start_time, this%get_file_freq(), this%get_file_frequnit())
1057 this%next_next_output = diag_time_inc(this%next_output, this%get_file_freq(), this%get_file_frequnit())
1058 if (this%has_file_new_file_freq())
then
1059 this%next_close = diag_time_inc(this%start_time, this%get_file_new_file_freq(), &
1060 this%get_file_new_file_freq_units())
1062 if (this%is_static)
then
1065 this%next_close = this%start_time
1066 this%next_next_output = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1068 this%next_close = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1072 if(this%has_file_duration())
then
1073 this%no_more_data = diag_time_inc(this%start_time, this%get_file_duration(), &
1074 this%get_file_duration_units())
1076 this%no_more_data = diag_time_inc(this%start_time, very_large_file_freq, diag_days)
1084 subroutine dump_file_obj(this, unit_num)
1086 integer,
intent(in) :: unit_num
1088 write( unit_num, *)
'file id:', this%id
1089 write( unit_num, *)
'start time:',
date_to_string(this%start_time)
1090 write( unit_num, *)
'last_output',
date_to_string(this%last_output)
1091 write( unit_num, *)
'next_output',
date_to_string(this%next_output)
1092 write( unit_num, *)
'next_next_output',
date_to_string(this%next_next_output)
1095 if(
allocated(this%fms2io_fileobj))
write( unit_num, *)
'fileobj path', this%fms2io_fileobj%path
1097 write( unit_num, *)
'type_of_domain', this%type_of_domain
1098 if(
allocated(this%file_metadata_from_model))
write( unit_num, *)
'file_metadata_from_model', &
1099 this%file_metadata_from_model
1100 if(
allocated(this%field_ids))
write( unit_num, *)
'field_ids', this%field_ids
1101 if(
allocated(this%field_registered))
write( unit_num, *)
'field_registered', this%field_registered
1102 if(
allocated(this%num_registered_fields))
write( unit_num, *)
'num_registered_fields', this%num_registered_fields
1103 if(
allocated(this%axis_ids))
write( unit_num, *)
'axis_ids', this%axis_ids(1:this%number_of_axis)
1109 logical pure function is_regional(this)
1112 select type (wut=>this%FMS_diag_file)
1114 is_regional = .true.
1116 is_regional = .false.
1119 end function is_regional
1123 logical pure function is_file_static(this)
1126 is_file_static = .false.
1128 select type (fileptr=>this%FMS_diag_file)
1130 is_file_static = fileptr%is_static
1133 end function is_file_static
1136 subroutine open_diag_file(this, time_step, file_is_opened)
1138 TYPE(time_type),
intent(in) :: time_step
1139 logical,
intent(out) :: file_is_opened
1143 class(diagdomain_t),
pointer :: domain
1144 character(len=:),
allocatable :: diag_file_name
1145 character(len=FMS_FILE_LEN) :: base_name
1147 character(len=FMS_FILE_LEN) :: file_name
1148 character(len=FMS_FILE_LEN) :: temp_name
1149 character(len=128) :: start_date
1151 character(len=128) :: suffix
1160 character(len=4) :: mype_string
1161 logical :: is_regional
1162 integer,
allocatable :: pes(:)
1164 diag_file => this%FMS_diag_file
1165 domain => diag_file%domain
1167 file_is_opened = .false.
1169 if (diag_file%is_file_open)
return
1171 is_regional = .false.
1173 if (.not.
allocated(diag_file%fms2io_fileobj))
then
1174 select type (diag_file)
1177 allocate(fmsnetcdffile_t :: diag_file%fms2io_fileobj)
1178 is_regional = .true.
1181 select case (diag_file%type_of_domain)
1183 allocate(fmsnetcdffile_t :: diag_file%fms2io_fileobj)
1185 allocate(fmsnetcdfdomainfile_t :: diag_file%fms2io_fileobj)
1187 allocate(fmsnetcdfunstructureddomainfile_t :: diag_file%fms2io_fileobj)
1193 diag_file_name = diag_file%get_file_fname()
1196 if (diag_file%has_file_new_file_freq())
then
1198 pos = index(diag_file_name,
'%')
1199 if (pos > 0) base_name = diag_file_name(1:pos-1)
1200 suffix = get_time_string(diag_file_name, diag_file%get_filename_time())
1201 base_name = trim(base_name)//trim(suffix)
1203 base_name = trim(diag_file_name)
1207 file_name = trim(base_name)
1208 call get_instance_filename(base_name, file_name)
1212 IF ( prepend_date )
THEN
1213 call get_date(diag_file%start_time, year, month, day, hour, minute, second)
1214 write (start_date,
'(1I20.4, 2I2.2)') year, month, day
1216 file_name = trim(adjustl(start_date))//
'.'//trim(file_name)
1219 file_name = trim(file_name)//
".nc"
1222 if (is_regional)
then
1224 write(mype_string,
'(I0.4)')
mpp_pe()
1227 select type (domain)
1228 type is (diagdomain2d_t)
1229 temp_name = file_name
1230 call get_mosaic_tile_file(temp_name, file_name, .true., domain%domain2)
1233 file_name = trim(file_name)//
"."//trim(mype_string)
1237 select type (fms2io_fileobj => diag_file%fms2io_fileobj)
1238 type is (fmsnetcdffile_t)
1239 if (is_regional)
then
1240 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", pelist=(/
mpp_pe()/))) &
1241 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1242 call register_global_attribute(fms2io_fileobj,
"is_subregional",
"True", str_len=4)
1245 call mpp_get_current_pelist(pes)
1247 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", pelist=pes)) &
1248 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1250 type is (fmsnetcdfdomainfile_t)
1251 select type (domain)
1252 type is (diagdomain2d_t)
1253 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", domain%Domain2)) &
1254 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1256 type is (fmsnetcdfunstructureddomainfile_t)
1257 select type (domain)
1258 type is (diagdomainug_t)
1259 if (.not. open_file(fms2io_fileobj, file_name,
"overwrite", domain%DomainUG)) &
1260 &
call mpp_error(fatal,
"Error opening the file:"//file_name)
1264 file_is_opened = .true.
1265 diag_file%is_file_open = file_is_opened
1268 end subroutine open_diag_file
1271 subroutine write_global_metadata(this)
1274 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1276 character (len=MAX_STR_LEN),
allocatable :: yaml_file_attributes(:,:)
1278 type(diagyamlfiles_type),
pointer :: diag_file_yaml
1280 diag_file_yaml => this%FMS_diag_file%diag_yaml_file
1281 fms2io_fileobj => this%FMS_diag_file%fms2io_fileobj
1283 if (diag_file_yaml%has_file_global_meta())
then
1284 yaml_file_attributes = diag_file_yaml%get_file_global_meta()
1285 do i = 1,
size(yaml_file_attributes,1)
1286 call register_global_attribute(fms2io_fileobj, trim(yaml_file_attributes(i,1)), &
1287 trim(yaml_file_attributes(i,2)), str_len=len_trim(yaml_file_attributes(i,2)))
1289 deallocate(yaml_file_attributes)
1291 end subroutine write_global_metadata
1294 subroutine write_var_metadata(fms2io_fileobj, variable_name, dimensions, long_name, units)
1295 class(fmsnetcdffile_t),
intent(inout) :: fms2io_fileobj
1296 character(len=*) ,
intent(in) :: variable_name
1297 character(len=*) ,
intent(in) :: dimensions(:)
1298 character(len=*) ,
intent(in) :: long_name
1299 character(len=*) ,
intent(in) :: units
1301 call register_field(fms2io_fileobj, variable_name, pack_size_str, dimensions)
1302 call register_variable_attribute(fms2io_fileobj, variable_name,
"long_name", &
1303 trim(long_name), str_len=len_trim(long_name))
1304 if (trim(units) .ne. no_units) &
1305 call register_variable_attribute(fms2io_fileobj, variable_name,
"units", &
1306 trim(units), str_len=len_trim(units))
1307 end subroutine write_var_metadata
1310 subroutine write_time_metadata(this)
1314 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1315 character(len=50) :: time_units_str
1316 character(len=50) :: calendar
1318 character(len=:),
allocatable :: time_var_name
1319 character(len=50) :: dimensions(2)
1321 diag_file => this%FMS_diag_file
1322 fms2io_fileobj => diag_file%fms2io_fileobj
1324 time_var_name = diag_file%get_file_unlimdim()
1325 call register_axis(fms2io_fileobj, time_var_name, unlimited)
1327 WRITE(time_units_str, 11) &
1328 trim(time_unit_list(diag_file%get_file_timeunit())), get_base_year(),&
1329 & get_base_month(), get_base_day(), get_base_hour(), get_base_minute(), get_base_second()
1330 11
FORMAT(a,
' since ', i4.4,
'-', i2.2,
'-', i2.2,
' ', i2.2,
':', i2.2,
':', i2.2)
1332 dimensions(1) =
"nv"
1333 dimensions(2) = trim(time_var_name)
1335 call write_var_metadata(fms2io_fileobj, time_var_name, dimensions(2:2), &
1336 time_var_name, time_units_str)
1339 call register_variable_attribute(fms2io_fileobj, time_var_name,
"axis",
"T", str_len=1 )
1342 calendar = valid_calendar_types(get_calendar_type())
1343 call register_variable_attribute(fms2io_fileobj, time_var_name,
"calendar_type", &
1344 uppercase(trim(calendar)), str_len=len_trim(calendar))
1345 call register_variable_attribute(fms2io_fileobj, time_var_name,
"calendar", &
1346 lowercase(trim(calendar)), str_len=len_trim(calendar))
1348 if (diag_file%get_time_ops())
then
1349 call register_variable_attribute(fms2io_fileobj, time_var_name,
"bounds", &
1350 trim(time_var_name)//
"_bnds", str_len=len_trim(time_var_name//
"_bnds"))
1354 if ( .not. dimension_exists(fms2io_fileobj,
"nv"))
then
1355 call register_axis(fms2io_fileobj,
"nv", 2)
1356 call write_var_metadata(fms2io_fileobj,
"nv", dimensions(1:1), &
1357 "vertex number", no_units)
1359 call write_var_metadata(fms2io_fileobj, time_var_name//
"_bnds", dimensions, &
1360 trim(time_var_name)//
" axis boundaries", time_units_str)
1363 end subroutine write_time_metadata
1366 subroutine write_field_data(this, field_obj, buffer_obj, unlim_dim_was_increased)
1368 type(fmsdiagfield_type),
intent(in),
target :: field_obj
1369 type(fmsdiagoutputbuffer_type),
intent(inout),
target :: buffer_obj
1370 logical,
intent(inout) :: unlim_dim_was_increased
1373 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1374 logical :: has_diurnal
1376 diag_file => this%FMS_diag_file
1377 fms2io_fileobj => diag_file%fms2io_fileobj
1381 call buffer_obj%increase_unlim_dim()
1382 if (buffer_obj%get_unlim_dim() > diag_file%unlim_dimension_level)
then
1383 diag_file%unlim_dimension_level = buffer_obj%get_unlim_dim()
1384 unlim_dim_was_increased = .true.
1388 if (diag_file%is_static)
then
1391 call buffer_obj%write_buffer(fms2io_fileobj)
1392 diag_file%data_has_been_written = .true.
1394 if (field_obj%is_static())
then
1396 if (buffer_obj%get_unlim_dim() .eq. 1)
then
1397 call buffer_obj%write_buffer(fms2io_fileobj)
1398 diag_file%data_has_been_written = .true.
1401 if (unlim_dim_was_increased) diag_file%data_has_been_written = .true.
1402 has_diurnal = buffer_obj%get_diurnal_sample_size() .gt. 1
1403 call buffer_obj%write_buffer(fms2io_fileobj, &
1404 unlim_dim_level=buffer_obj%get_unlim_dim(), is_diurnal=has_diurnal)
1408 end subroutine write_field_data
1412 logical function is_time_to_close_file (this, time_step, force_close)
1414 TYPE(time_type),
intent(in) :: time_step
1415 logical,
intent(in) :: force_close
1417 if (force_close .or. this%FMS_diag_file%done_writing_data)
then
1418 is_time_to_close_file = .true.
1419 elseif (time_step >= this%FMS_diag_file%next_close)
then
1420 is_time_to_close_file = .true.
1422 if (this%FMS_diag_file%is_static)
then
1423 is_time_to_close_file = .true.
1425 is_time_to_close_file = .false.
1432 logical function time_to_start_doing_math (this)
1434 time_to_start_doing_math = .false.
1435 if (this%FMS_diag_file%model_time >= this%FMS_diag_file%start_time)
then
1436 time_to_start_doing_math = .true.
1441 subroutine check_file_times(this, time_step, output_buffers, diag_fields, do_not_write)
1443 TYPE(time_type),
intent(in) :: time_step
1444 type(fmsdiagoutputbuffer_type),
intent(in) :: output_buffers(:)
1446 type(fmsdiagfield_type),
intent(in) :: diag_fields(:)
1447 logical,
intent(out) :: do_not_write
1451 do_not_write = .false.
1452 if (time_step > this%FMS_diag_file%next_output)
then
1453 if (this%FMS_diag_file%is_static)
return
1454 if (time_step > this%FMS_diag_file%next_next_output)
then
1455 if (this%FMS_diag_file%get_file_freq() .eq. 0)
then
1457 if (time_step .ne. this%FMS_diag_file%next_output)
then
1459 call this%FMS_diag_file%check_buffer_times(output_buffers, diag_fields)
1460 this%FMS_diag_file%next_output = time_step
1461 this%FMS_diag_file%next_next_output = time_step
1463 elseif (this%FMS_diag_file%num_registered_fields .eq. 0)
then
1466 if (this%FMS_diag_file%unlim_dimension_level .eq. 0)
then
1467 call mpp_error(note, this%FMS_diag_file%get_file_fname()//&
1468 ": diag_manager_mod: This file does not have any variables registered. Fill values will be written")
1469 this%FMS_diag_file%data_has_been_written = .true.
1470 this%FMS_diag_file%unlim_dimension_level = 1
1474 if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .false.)) &
1475 call mpp_error(fatal, this%FMS_diag_file%get_file_fname()//&
1476 ": diag_manager_mod: You skipped a time_step. Be sure that diag_send_complete is called at every "//&
1477 "time_step needed by the file.")
1481 if(this%FMS_diag_file%get_file_freq() .eq. 0)
then
1482 do_not_write = .true.
1485 end subroutine check_file_times
1488 logical function writing_on_this_pe(this)
1491 select type(diag_file => this%FMS_diag_file)
1493 writing_on_this_pe = diag_file%write_on_this_pe
1495 writing_on_this_pe = .true.
1501 subroutine write_time_data(this)
1506 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1507 TYPE(time_type) :: middle_time
1512 diag_file => this%FMS_diag_file
1513 fms2io_fileobj => diag_file%fms2io_fileobj
1516 if (.not. diag_file%data_has_been_written)
return
1518 if (diag_file%get_time_ops())
then
1519 middle_time = (diag_file%last_output+diag_file%next_output)/2
1520 dif = get_date_dif(middle_time, get_base_time(), diag_file%get_file_timeunit())
1522 dif = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
1525 call write_data(fms2io_fileobj, diag_file%get_file_unlimdim(), dif, &
1526 unlim_dim_level=diag_file%unlim_dimension_level)
1528 if (diag_file%get_time_ops())
then
1529 t1 = get_date_dif(diag_file%last_output, get_base_time(), diag_file%get_file_timeunit())
1530 t2 = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
1532 call write_data(fms2io_fileobj, trim(diag_file%get_file_unlimdim())//
"_bnds", &
1533 (/t1, t2/), unlim_dim_level=diag_file%unlim_dimension_level)
1535 if (diag_file%unlim_dimension_level .eq. 1)
then
1536 call write_data(fms2io_fileobj,
"nv", (/1, 2/))
1540 diag_file%data_has_been_written = .false.
1541 end subroutine write_time_data
1544 subroutine update_current_new_file_freq_index(this, time_step)
1546 TYPE(time_type),
intent(in) :: time_step
1550 diag_file => this%FMS_diag_file
1552 if (time_step >= diag_file%no_more_data)
then
1553 call diag_file%diag_yaml_file%increase_new_file_freq_index()
1555 if (diag_file%has_file_duration())
then
1556 diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, diag_file%get_file_duration(), &
1557 diag_file%get_file_duration_units())
1560 diag_file%done_writing_data = .true.
1561 diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, very_large_file_freq, diag_days)
1562 diag_file%next_output = diag_file%no_more_data
1563 diag_file%next_next_output = diag_file%no_more_data
1564 diag_file%last_output = diag_file%no_more_data
1568 if (diag_file%is_static) diag_file%done_writing_data = .true.
1569 end subroutine update_current_new_file_freq_index
1572 subroutine update_next_write(this, time_step)
1574 TYPE(time_type),
intent(in) :: time_step
1578 diag_file => this%FMS_diag_file
1579 if (diag_file%is_static)
then
1580 diag_file%last_output = diag_file%next_output
1581 diag_file%next_output = diag_time_inc(diag_file%next_output, very_large_file_freq, diag_days)
1582 diag_file%next_next_output = diag_time_inc(diag_file%next_output, very_large_file_freq, diag_days)
1584 diag_file%last_output = diag_file%next_output
1585 diag_file%next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
1586 diag_file%get_file_frequnit())
1587 diag_file%next_next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
1588 diag_file%get_file_frequnit())
1591 end subroutine update_next_write
1594 subroutine prepare_for_force_write(this)
1597 if (this%FMS_diag_file%unlim_dimension_level .eq. 0)
then
1598 this%FMS_diag_file%unlim_dimension_level = 1
1599 this%FMS_diag_file%data_has_been_written = .true.
1601 end subroutine prepare_for_force_write
1604 subroutine init_unlim_dim(this, output_buffers)
1606 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1609 type(fmsdiagoutputbuffer_type),
pointer :: output_buffer_obj
1612 diag_file => this%FMS_diag_file
1613 diag_file%unlim_dimension_level = 0
1614 do i = 1, diag_file%number_of_buffers
1615 output_buffer_obj => output_buffers(diag_file%buffer_ids(i))
1616 call output_buffer_obj%init_buffer_unlim_dim()
1618 end subroutine init_unlim_dim
1622 function get_num_time_levels(this) &
1627 if (this%is_regional())
then
1632 res = this%FMS_diag_file%num_time_levels
1635 res = this%FMS_diag_file%num_time_levels
1641 function get_num_tiles(this) &
1646 select case(this%FMS_diag_file%type_of_domain)
1647 case (two_d_domain, ug_domain)
1648 select type(domain => this%FMS_diag_file%domain)
1649 type is (diagdomain2d_t)
1651 type is (diagdomainug_t)
1652 res = mpp_get_ug_domain_ntiles(domain%DomainUG)
1657 end function get_num_tiles
1661 function get_ndistributedfiles(this) &
1665 integer :: io_layout(2)
1667 select case(this%FMS_diag_file%type_of_domain)
1668 case (two_d_domain, ug_domain)
1669 select type(domain => this%FMS_diag_file%domain)
1670 type is (diagdomain2d_t)
1672 res = io_layout(1) * io_layout(2)
1673 type is (diagdomainug_t)
1674 res = mpp_get_io_domain_ug_layout(domain%DomainUG)
1679 end function get_ndistributedfiles
1683 pure function get_unlim_dimension_level(this) &
1688 res = this%FMS_diag_file%unlim_dimension_level
1692 subroutine flush_diag_file(this)
1695 if (flush_nc_files)
then
1696 call flush_file(this%FMS_diag_file%fms2io_fileobj)
1698 end subroutine flush_diag_file
1702 pure function get_next_output(this) &
1705 type(time_type) :: res
1707 res = this%FMS_diag_file%next_output
1708 end function get_next_output
1712 pure function get_next_next_output(this) &
1715 type(time_type) :: res
1717 res = this%FMS_diag_file%next_next_output
1718 if (this%FMS_diag_file%is_static)
then
1719 res = this%FMS_diag_file%no_more_data
1721 end function get_next_next_output
1724 subroutine write_axis_metadata(this, diag_axis)
1726 class(fmsdiagaxiscontainer_type),
intent(in),
target :: diag_axis(:)
1729 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1731 integer :: parent_axis_id
1732 integer :: structured_ids(2)
1735 class(fmsdiagaxiscontainer_type),
pointer :: axis_ptr
1736 logical :: edges_in_file
1738 diag_file => this%FMS_diag_file
1739 fms2io_fileobj => diag_file%fms2io_fileobj
1741 do i = 1, diag_file%number_of_axis
1742 edges_in_file = .false.
1743 axis_ptr => diag_axis(diag_file%axis_ids(i))
1744 parent_axis_id = axis_ptr%axis%get_parent_axis_id()
1746 edges_id = axis_ptr%axis%get_edges_id()
1747 if (edges_id .ne. diag_null)
then
1749 if (any(diag_file%axis_ids(1:diag_file%number_of_axis) .eq. edges_id))
then
1750 edges_in_file = .true.
1752 call diag_axis(edges_id)%axis%write_axis_metadata(fms2io_fileobj, .true.)
1753 call diag_file%add_new_axis(edges_id)
1757 if (parent_axis_id .eq. diag_null)
then
1758 call axis_ptr%axis%write_axis_metadata(fms2io_fileobj, edges_in_file)
1760 call axis_ptr%axis%write_axis_metadata(fms2io_fileobj, edges_in_file, diag_axis(parent_axis_id)%axis)
1763 if (axis_ptr%axis%is_unstructured_grid())
then
1764 structured_ids = axis_ptr%axis%get_structured_axis()
1765 do k = 1,
size(structured_ids)
1766 call diag_axis(structured_ids(k))%axis%write_axis_metadata(fms2io_fileobj, .false.)
1772 end subroutine write_axis_metadata
1775 subroutine write_field_metadata(this, diag_field, diag_axis)
1777 class(fmsdiagfield_type) ,
intent(inout),
target :: diag_field(:)
1778 class(fmsdiagaxiscontainer_type),
intent(in) :: diag_axis(:)
1780 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1782 class(fmsdiagfield_type),
pointer :: field_ptr
1785 logical :: is_regional
1786 character(len=255) :: cell_measures
1787 logical :: need_associated_files
1788 character(len=FMS_FILE_LEN) :: associated_files
1790 is_regional = this%is_regional()
1792 diag_file => this%FMS_diag_file
1793 fms2io_fileobj => diag_file%fms2io_fileobj
1795 associated_files =
""
1796 need_associated_files = .false.
1797 do i = 1,
size(diag_file%field_ids)
1798 if (.not. diag_file%field_registered(i)) cycle
1799 field_ptr => diag_field(diag_file%field_ids(i))
1802 if (field_ptr%has_area())
then
1803 cell_measures =
"area: "//diag_field(field_ptr%get_area())%get_varname(to_write=.true.)
1807 if (.not. diag_field(field_ptr%get_area())%is_variable_in_file(diag_file%id))
then
1808 need_associated_files = .true.
1809 call diag_field(field_ptr%get_area())%generate_associated_files_att(associated_files, diag_file%start_time)
1813 if (field_ptr%has_volume())
then
1814 cell_measures = trim(cell_measures)//
" volume: "//diag_field(field_ptr%get_volume())%get_varname(to_write=.true.)
1818 if (.not. diag_field(field_ptr%get_volume())%is_variable_in_file(diag_file%id))
then
1819 need_associated_files = .true.
1820 call diag_field(field_ptr%get_volume())%generate_associated_files_att(associated_files, diag_file%start_time)
1824 call field_ptr%write_field_metadata(fms2io_fileobj, diag_file%id, diag_file%yaml_ids(i), diag_axis, &
1825 this%FMS_diag_file%get_file_unlimdim(), is_regional, cell_measures)
1828 if (need_associated_files) &
1829 call register_global_attribute(fms2io_fileobj,
"associated_files", trim(adjustl(associated_files)), &
1830 str_len=len_trim(adjustl(associated_files)))
1832 end subroutine write_field_metadata
1835 subroutine write_axis_data(this, diag_axis)
1837 class(fmsdiagaxiscontainer_type),
intent(in) :: diag_axis(:)
1840 class(fmsnetcdffile_t),
pointer :: fms2io_fileobj
1843 integer :: parent_axis_id
1844 integer :: structured_ids(2)
1846 diag_file => this%FMS_diag_file
1847 fms2io_fileobj => diag_file%fms2io_fileobj
1849 do i = 1, diag_file%number_of_axis
1850 j = diag_file%axis_ids(i)
1851 parent_axis_id = diag_axis(j)%axis%get_parent_axis_id()
1852 if (parent_axis_id .eq. diag_null)
then
1853 call diag_axis(j)%axis%write_axis_data(fms2io_fileobj)
1855 call diag_axis(j)%axis%write_axis_data(fms2io_fileobj, diag_axis(parent_axis_id)%axis)
1858 if (diag_axis(j)%axis%is_unstructured_grid())
then
1859 structured_ids = diag_axis(j)%axis%get_structured_axis()
1860 do k = 1,
size(structured_ids)
1861 call diag_axis(structured_ids(k))%axis%write_axis_data(fms2io_fileobj)
1866 end subroutine write_axis_data
1869 subroutine close_diag_file(this, output_buffers, model_end_time, diag_fields)
1871 type(fmsdiagoutputbuffer_type),
intent(in) :: output_buffers(:)
1873 type(time_type),
intent(in) :: model_end_time
1874 type(fmsdiagfield_type),
intent(in),
optional :: diag_fields(:)
1877 if (.not. this%FMS_diag_file%is_file_open)
return
1881 select type( fms2io_fileobj => this%FMS_diag_file%fms2io_fileobj)
1882 type is (fmsnetcdfdomainfile_t)
1883 call close_file(fms2io_fileobj)
1884 type is (fmsnetcdffile_t)
1885 call close_file(fms2io_fileobj)
1886 type is (fmsnetcdfunstructureddomainfile_t)
1887 call close_file(fms2io_fileobj)
1894 this%FMS_diag_file%num_time_levels = this%FMS_diag_file%num_time_levels + &
1895 this%FMS_diag_file%unlim_dimension_level
1898 this%FMS_diag_file%unlim_dimension_level = 0
1899 this%FMS_diag_file%is_file_open = .false.
1901 if (this%FMS_diag_file%has_file_new_file_freq())
then
1902 this%FMS_diag_file%next_close = diag_time_inc(this%FMS_diag_file%next_close, &
1903 this%FMS_diag_file%get_file_new_file_freq(), &
1904 this%FMS_diag_file%get_file_new_file_freq_units())
1906 this%FMS_diag_file%next_close = model_end_time
1909 if (this%FMS_diag_file%model_time >= model_end_time) &
1910 this%FMS_diag_file%done_writing_data = .true.
1911 if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .true., diag_fields))
return
1912 end subroutine close_diag_file
1915 subroutine set_model_time(this, model_time)
1917 type(time_type),
intent(in) :: model_time
1919 if (model_time > this%FMS_diag_file%model_time) this%FMS_diag_file%model_time = model_time
1924 function get_model_time(this) &
1927 type(time_type),
pointer :: rslt
1929 rslt => this%FMS_diag_file%model_time
1930 end function get_model_time
1933 pure function get_buffer_ids (this)
1935 integer,
allocatable :: get_buffer_ids(:)
1937 allocate(get_buffer_ids(this%number_of_buffers))
1938 get_buffer_ids = this%buffer_ids(1:this%number_of_buffers)
1939 end function get_buffer_ids
1942 pure function get_number_of_buffers(this)
1944 integer :: get_number_of_buffers
1945 get_number_of_buffers = this%number_of_buffers
1946 end function get_number_of_buffers
1950 subroutine check_buffer_times(this, output_buffers, diag_fields)
1952 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1953 type(fmsdiagfield_type),
intent(in) :: diag_fields(:)
1956 type(time_type) :: current_buffer_time
1957 character(len=:),
allocatable :: field_name
1958 logical :: buffer_time_set
1959 type(fmsdiagoutputbuffer_type),
pointer :: output_buffer_obj
1961 buffer_time_set = .false.
1962 do i = 1, this%number_of_buffers
1963 output_buffer_obj => output_buffers(this%buffer_ids(i))
1964 if (diag_fields(output_buffer_obj%get_field_id())%is_static()) cycle
1965 if (.not. buffer_time_set)
then
1966 current_buffer_time = output_buffer_obj%get_buffer_time()
1967 field_name = output_buffer_obj%get_buffer_name()
1968 buffer_time_set = .true.
1970 if (current_buffer_time .ne. output_buffer_obj%get_buffer_time()) &
1971 call mpp_error(fatal,
"Send data has not been called at the same time steps for the fields:"//&
1972 field_name//
" and "//output_buffer_obj%get_buffer_name()//&
1973 " in file:"//this%get_file_fname())
1980 function has_send_data_been_called(this, output_buffers, print_warnings, diag_fields) &
1983 type(fmsdiagoutputbuffer_type),
intent(in),
target :: output_buffers(:)
1984 logical,
intent(in) :: print_warnings
1985 type(fmsdiagfield_type),
intent(in),
optional :: diag_fields(:)
1993 if (print_warnings)
then
1994 do i = 1, this%number_of_buffers
1995 if (.not. output_buffers(this%buffer_ids(i))%is_there_data_to_write())
then
1996 field_id = output_buffers(this%buffer_ids(i))%get_field_id()
1997 call mpp_error(note,
"Send data was never called for field:"//&
1998 trim(diag_fields(field_id)%get_varname())//
" mod: "//trim(diag_fields(field_id)%get_modname())//&
1999 " in file: "//trim(this%get_file_fname())//
". Writing FILL VALUES!")
2003 do i = 1, this%number_of_buffers
2004 if (output_buffers(this%buffer_ids(i))%is_there_data_to_write())
then
2010 end function has_send_data_been_called
2012 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