30 module fms_diag_axis_object_mod
35 use platform_mod,
only: r8_kind, r4_kind, i4_kind, i8_kind
42 use fms2_io_mod,
only: fmsnetcdffile_t, fmsnetcdfdomainfile_t, fmsnetcdfunstructureddomainfile_t, &
44 use fms_diag_yaml_mod,
only:
subregion_type, diag_yaml, max_subaxes
68 procedure :: get_ntiles
89 INTEGER ,
private :: axis_id
107 class(fmsDiagAxis_type),
allocatable :: axis
113 CHARACTER(len=:),
ALLOCATABLE ,
private :: subaxis_name
114 INTEGER ,
private :: starting_index
116 INTEGER ,
private :: ending_index
118 INTEGER ,
private :: parent_axis_id
119 INTEGER ,
private :: compute_idx(2)
120 INTEGER,
allocatable,
private :: global_idx(:)
121 real(kind=r4_kind),
allocatable,
private :: zbounds(:)
133 INTEGER ,
private :: ndiurnal_samples
134 CHARACTER(len=:),
ALLOCATABLE,
private :: axis_name
135 CHARACTER(len=:),
ALLOCATABLE,
private :: long_name
136 CHARACTER(len=:),
ALLOCATABLE,
private :: units
137 INTEGER ,
private :: edges_id
138 CHARACTER(len=:),
ALLOCATABLE,
private :: edges_name
139 CLASS(*),
ALLOCATABLE,
private :: diurnal_data(:)
149 CHARACTER(len=:),
ALLOCATABLE,
private :: axis_name
150 CHARACTER(len=:),
ALLOCATABLE,
private :: units
151 CHARACTER(len=:),
ALLOCATABLE,
private :: long_name
152 CHARACTER(len=1) ,
private :: cart_name
153 CLASS(*),
ALLOCATABLE,
private :: axis_data(:)
154 CHARACTER(len=:),
ALLOCATABLE,
private :: type_of_data
156 integer,
ALLOCATABLE,
private :: subaxis(:)
157 integer ,
private :: nsubaxis
159 INTEGER ,
private :: type_of_domain
161 INTEGER ,
private :: length
162 INTEGER ,
private :: direction
163 INTEGER,
ALLOCATABLE,
private :: edges_id
165 CHARACTER(len=:),
ALLOCATABLE,
private :: edges_name
167 CHARACTER(len=:),
ALLOCATABLE,
private :: aux
169 CHARACTER(len=128) ,
private :: req
170 INTEGER ,
private :: tile_count
172 INTEGER ,
private :: num_attributes
173 INTEGER ,
private :: domain_position
174 integer,
allocatable ,
private :: structured_ids(:)
176 CHARACTER(len=:),
ALLOCATABLE,
private :: set_name
205 & set_name, Domain, Domain2, DomainU, aux, req, tile_count, domain_position, axis_length )
207 CHARACTER(len=*),
INTENT(in) :: axis_name
208 class(*),
INTENT(in) :: axis_data(:)
209 CHARACTER(len=*),
INTENT(in) :: units
210 CHARACTER(len=1),
INTENT(in) :: cart_name
211 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: long_name
212 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: set_name
213 INTEGER,
INTENT(in),
OPTIONAL :: direction
214 TYPE(
domain1d),
INTENT(in),
OPTIONAL :: Domain
215 TYPE(
domain2d),
INTENT(in),
OPTIONAL :: Domain2
216 TYPE(
domainug),
INTENT(in),
OPTIONAL :: DomainU
217 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: aux
219 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: req
220 INTEGER,
INTENT(in),
OPTIONAL :: tile_count
221 INTEGER,
INTENT(in),
OPTIONAL :: domain_position
222 integer,
intent(in),
optional :: axis_length
224 this%axis_name = trim(axis_name)
225 this%units = trim(units)
226 this%cart_name = uppercase(cart_name)
229 if (
present(long_name)) this%long_name = trim(long_name)
231 select type (axis_data)
232 type is (real(kind=r8_kind))
233 allocate(real(kind=r8_kind) :: this%axis_data(axis_length))
234 this%axis_data = axis_data
235 this%length = axis_length
236 this%type_of_data =
"double"
237 type is (real(kind=r4_kind))
238 allocate(real(kind=r4_kind) :: this%axis_data(axis_length))
239 this%axis_data = axis_data
240 this%length = axis_length
241 this%type_of_data =
"float"
243 call mpp_error(fatal,
"The axis_data in your diag_axis_init call is not a supported type. &
244 & Currently only r4 and r8 data is supported.")
248 if (
present(domain))
then
249 if (
present(domain2) .or.
present(domainu))
call mpp_error(fatal, &
250 "The presence of Domain with any other domain type is prohibited. "//&
251 "Check you diag_axis_init call for axis_name:"//trim(axis_name))
253 call this%axis_domain%set(domain=domain)
254 else if (
present(domain2))
then
255 if (
present(domainu))
call mpp_error(fatal, &
256 "The presence of Domain2 with any other domain type is prohibited. "//&
257 "Check you diag_axis_init call for axis_name:"//trim(axis_name))
259 call this%axis_domain%set(domain2=domain2)
261 else if (
present(domainu))
then
263 call this%axis_domain%set(domainu=domainu)
268 if (
present(tile_count)) this%tile_count = tile_count
270 this%domain_position = center
271 if (
present(domain_position)) this%domain_position = domain_position
275 if (
present(direction)) this%direction = direction
278 if (
present(aux)) this%aux = trim(aux)
279 if (
present(req)) this%req = trim(req)
281 if (
present(set_name)) this%set_name = trim(set_name)
283 if (max_subaxes .gt. 0)
then
284 allocate(this%subaxis(max_subaxes))
285 this%subaxis = diag_null
289 this%num_attributes = 0
295 character(len=*),
intent(in) :: att_name
296 class(*),
intent(in) :: att_value(:)
300 if (.not.
allocated(this%attributes)) &
303 this%num_attributes = this%num_attributes + 1
305 j = this%num_attributes
306 call this%attributes(j)%add(att_name, att_value)
312 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
313 logical,
INTENT(IN) :: edges_in_file
319 character(len=:),
ALLOCATABLE :: axis_edges_name
320 character(len=:),
pointer :: axis_name
321 integer :: axis_length
325 integer :: type_of_domain
326 logical :: is_subaxis
327 logical :: needs_domain_decomposition
329 integer :: domain_decomposition(4)
332 needs_domain_decomposition = .false.
336 axis_name => this%axis_name
337 axis_length = this%length
339 type_of_domain = this%type_of_domain
342 axis_name => this%subaxis_name
343 axis_length = this%ending_index - this%starting_index + 1
344 if (
allocated(this%global_idx))
then
345 needs_domain_decomposition = .true.
346 domain_decomposition(1:2) = this%global_idx
347 domain_decomposition(3) = this%starting_index
348 domain_decomposition(4) = this%ending_index
351 if (
present(parent_axis))
then
352 select type(parent_axis)
354 diag_axis => parent_axis
359 call this%write_diurnal_metadata(fms2io_fileobj)
364 select type (fms2io_fileobj)
367 type is (fmsnetcdffile_t)
370 call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
371 if (needs_domain_decomposition)
then
372 call register_variable_attribute(fms2io_fileobj, axis_name,
"domain_decomposition", &
373 domain_decomposition)
375 type is (fmsnetcdfdomainfile_t)
376 select case (type_of_domain)
381 call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
384 call register_axis(fms2io_fileobj, axis_name, diag_axis%cart_name, domain_position=diag_axis%domain_position)
385 call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
387 type is (fmsnetcdfunstructureddomainfile_t)
388 select case (type_of_domain)
392 call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
397 call register_field(fms2io_fileobj, axis_name, diag_axis%type_of_data, (/axis_name/))
402 if(
allocated(diag_axis%long_name)) &
403 call register_variable_attribute(fms2io_fileobj, axis_name,
"long_name", diag_axis%long_name, &
404 str_len=len_trim(diag_axis%long_name))
406 if (diag_axis%cart_name .NE.
"N") &
407 call register_variable_attribute(fms2io_fileobj, axis_name,
"axis", diag_axis%cart_name, str_len=1)
409 if (trim(diag_axis%units) .NE.
"none") &
410 call register_variable_attribute(fms2io_fileobj, axis_name,
"units", diag_axis%units, &
411 str_len=len_trim(diag_axis%units))
413 select case (diag_axis%direction)
415 call register_variable_attribute(fms2io_fileobj, axis_name,
"positive",
"up", str_len=2)
417 call register_variable_attribute(fms2io_fileobj, axis_name,
"positive",
"down", str_len=4)
421 if (.not. edges_in_file .and.
allocated(diag_axis%edges_name) .and. .not. is_subaxis)
then
422 call register_variable_attribute(fms2io_fileobj, axis_name,
"edges", diag_axis%edges_name, &
423 str_len=len_trim(diag_axis%edges_name))
426 if(
allocated(diag_axis%attributes))
then
427 do i = 1, diag_axis%num_attributes
428 select type (att_value => diag_axis%attributes(i)%att_value)
429 type is (
character(len=*))
430 call register_variable_attribute(fms2io_fileobj, axis_name, diag_axis%attributes(i)%att_name, &
431 trim(att_value(1)), str_len=len_trim(att_value(1)))
433 call register_variable_attribute(fms2io_fileobj, axis_name, diag_axis%attributes(i)%att_name, att_value)
443 class(fmsnetcdffile_t),
INTENT(INOUT) :: fms2io_fileobj
448 integer :: global_io_index(2)
451 call this%get_global_io_domain(global_io_index)
452 call write_data(fms2io_fileobj, this%axis_name, this%axis_data(global_io_index(1):global_io_index(2)))
454 i = this%starting_index
455 j = this%ending_index
457 if (
present(parent_axis))
then
458 select type(parent_axis)
460 call write_data(fms2io_fileobj, this%subaxis_name, parent_axis%axis_data(i:j))
464 call write_data(fms2io_fileobj, this%axis_name, this%diurnal_data)
472 integer,
intent(inout) :: naxis
474 integer,
intent(in) :: n_diurnal_samples
476 logical,
intent(in) :: is_edges
479 CHARACTER(32) :: axis_name
480 CHARACTER(32) :: long_name
481 CHARACTER(32) :: edges_name
482 CHARACTER(128) :: units
483 real(kind=r8_kind),
allocatable :: diurnal_data(:)
492 WRITE (axis_name,
'(a,i2.2)')
'time_of_day_edges_', n_diurnal_samples
493 long_name =
"time of day edges"
494 allocate(diurnal_data(n_diurnal_samples + 1))
495 diurnal_data(1) = 0.0
497 do i = 1, n_diurnal_samples
498 diurnal_data(i+1) = 24.0* real(i)/n_diurnal_samples
501 WRITE (axis_name,
'(a,i2.2)')
'time_of_day_', n_diurnal_samples
502 long_name =
"time of day"
503 allocate(diurnal_data(n_diurnal_samples))
505 do i = 1, n_diurnal_samples
506 diurnal_data(i) = 24.0*(real(i)-0.5)/n_diurnal_samples
508 WRITE (edges_name,
'(a,i2.2)')
'time_of_day_edges_', n_diurnal_samples
513 11
FORMAT(a,
' since ',i4.4,
'-',i2.2,
'-',i2.2,
' ',i2.2,
':',i2.2,
':',i2.2)
516 select type (diurnal_axis => diag_axis(naxis)%axis)
518 diurnal_axis%axis_id = naxis
519 diurnal_axis%ndiurnal_samples = n_diurnal_samples
520 diurnal_axis%axis_name = trim(axis_name)
521 diurnal_axis%long_name = trim(long_name)
522 diurnal_axis%units = trim(units)
523 diurnal_axis%diurnal_data = diurnal_data
524 diurnal_axis%edges_id = edges_id
526 WRITE (edges_name,
'(a,i2.2)')
'time_of_day_edges_', n_diurnal_samples
527 diurnal_axis%edges_name = trim(edges_name)
546 integer,
intent(in) :: axis_ids(2)
550 allocate(this%structured_ids(2))
551 this%structured_ids = axis_ids
565 rslt = this%structured_ids
578 if (
allocated(this%edges_id))
get_edges_id = this%edges_id
585 integer,
intent(out) :: global_io_index(2)
587 type(
domain2d),
pointer :: io_domain
589 global_io_index(1) = 1
590 global_io_index(2) = this%length
592 if (
allocated(this%axis_domain))
then
593 select type(domain => this%axis_domain)
596 if (this%cart_name .eq.
"X")
then
598 position=this%domain_position)
599 elseif (this%cart_name .eq.
"Y")
then
601 position=this%domain_position)
615 if (
allocated(this%axis_domain))
then
616 axis_length = this%axis_domain%length(this%cart_name, this%domain_position, this%length)
632 if (
allocated(this%aux)) rslt = trim(this%aux) .ne.
""
643 if (
allocated(this%set_name)) rslt = trim(this%set_name) .ne.
""
651 integer,
optional,
intent(inout) :: x_or_y
655 select case (trim(this%cart_name))
664 if (
present(x_or_y)) x_or_y = diag_null
673 character(len=:),
allocatable :: rslt
683 character(len=:),
allocatable :: rslt
691 integer,
intent(in) :: axis_id
693 this%axis_id = axis_id
700 CHARACTER(len=*),
intent(in) :: edges_name
701 integer,
intent(in) :: edges_id
707 this%edges_name = edges_name
708 this%edges_id = edges_id
713 subroutine get_indices(this, compute_idx, corners_indices, starting_index, ending_index, need_to_define_axis)
715 integer,
intent(in) :: compute_idx(:)
716 class(*),
intent(in) :: corners_indices(:)
717 integer,
intent(out) :: starting_index
719 integer,
intent(out) :: ending_index
721 logical,
intent(out) :: need_to_define_axis
724 integer :: subregion_start
725 integer :: subregion_end
730 select type (corners_indices)
731 type is (
integer(kind=i4_kind))
732 subregion_start = minval(corners_indices)
733 subregion_end = maxval(corners_indices)
737 need_to_define_axis = .false.
738 starting_index = diag_null
739 ending_index = diag_null
742 if (compute_idx(1) < subregion_start .and. compute_idx(2) < subregion_start)
return
743 if (compute_idx(1) > subregion_end .and. compute_idx(2) > subregion_end)
return
745 need_to_define_axis = .true.
746 if (compute_idx(1) >= subregion_start .and. compute_idx(2) >= subregion_end)
then
748 starting_index = compute_idx(1)
749 ending_index = subregion_end
750 else if (compute_idx(1) >= subregion_start .and. compute_idx(2) <= subregion_end)
then
752 starting_index = compute_idx(1)
753 ending_index = compute_idx(2)
754 else if (compute_idx(1) <= subregion_start .and. compute_idx(2) <= subregion_end)
then
756 starting_index = subregion_start
757 ending_index = compute_idx(2)
758 else if (compute_idx(1) <= subregion_start .and. compute_idx(2) >= subregion_end)
then
760 starting_index = subregion_start
761 ending_index = subregion_end
764 if (this%domain_position .ne. center)
then
765 if (subregion_end - subregion_start + 1 .eq. 1)
then
767 if (ending_index .eq. compute_idx(2)) need_to_define_axis = .false.
769 if (ending_index - starting_index + 1 .eq. 1)
then
771 if (starting_index .eq. compute_idx(2) .or. ending_index .eq. compute_idx(1)) &
772 need_to_define_axis = .false.
782 integer,
intent(inout) :: compute_idx(:)
783 logical,
intent(out) :: need_to_define_axis
784 integer,
optional,
intent(in) :: tile_number
787 need_to_define_axis = .false.
788 compute_idx = diag_null
790 if (.not.
allocated(this%axis_domain))
then
792 if (this%cart_name .eq.
"X" .or. this%cart_name .eq.
"Y")
then
794 compute_idx(2) =
size(this%axis_data)
795 need_to_define_axis = .true.
800 select type(domain => this%axis_domain)
802 if (
present(tile_number))
then
806 need_to_define_axis = .false.
812 select case (this%cart_name)
815 & position=this%domain_position)
816 need_to_define_axis = .true.
819 & position=this%domain_position)
820 need_to_define_axis = .true.
828 subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, compute_idx, &
829 global_idx, zbounds, nz_subaxis)
831 integer ,
intent(in) :: starting_index
832 integer ,
intent(in) :: ending_index
833 integer ,
intent(in) :: axis_id
834 integer ,
intent(in) :: parent_id
835 character(len=*) ,
intent(in) :: parent_axis_name
836 integer ,
intent(in) :: compute_idx(2)
838 integer,
optional,
intent(in) :: global_idx(2)
840 real(kind=r4_kind),
optional,
intent(in) :: zbounds(2)
841 integer,
optional,
intent(in) :: nz_subaxis
845 character(len=2) :: nsubaxis_char
848 if (
present(nz_subaxis)) nsubaxis = nz_subaxis
850 this%axis_id = axis_id
851 this%starting_index = starting_index
852 this%ending_index = ending_index
853 this%parent_axis_id = parent_id
854 write(nsubaxis_char,
'(i2.2)') nsubaxis
855 this%subaxis_name = trim(parent_axis_name)//
"_sub"//nsubaxis_char
856 this%compute_idx = compute_idx
858 if (
present(zbounds))
then
860 allocate(this%zbounds(2))
861 this%zbounds = zbounds
864 if (
present(global_idx))
then
866 allocate(this%global_idx(2))
867 this%global_idx = global_idx
878 res = this%ending_index - this%starting_index + 1
886 indx = this%starting_index
894 indx = this%ending_index
902 indx = this%compute_idx
921 function get_length(this, cart_axis, domain_position, global_length) &
924 character(len=*),
INTENT(IN) :: cart_axis
925 integer,
INTENT(IN) :: domain_position
926 integer,
INTENT(IN) :: global_length
932 if (trim(cart_axis) ==
"X")
call mpp_get_compute_domain(this%Domain2, xsize=length, position=domain_position)
933 if (trim(cart_axis) ==
"Y")
call mpp_get_compute_domain(this%Domain2, ysize=length, position=domain_position)
936 length = global_length
945 TYPE(
domain1d),
INTENT(in),
OPTIONAL :: Domain
946 TYPE(
domain2d),
INTENT(in),
OPTIONAL :: Domain2
947 TYPE(
domainug),
INTENT(in),
OPTIONAL :: DomainU
953 this%Domain2 = domain2
955 this%DomainUG = domainu
964 if (
allocated(axis_array))
call mpp_error(fatal,
"The diag_axis containers is already allocated")
976 if (
allocated(axis_array))
deallocate(axis_array)
989 logical,
intent(in),
optional :: is_regional
991 character(len=:),
allocatable :: axis_name
995 axis_name = this%axis_name
996 if (
present(is_regional))
then
997 if (is_regional)
then
998 if (this%cart_name .eq.
"X" .or. this%cart_name .eq.
"Y") axis_name = axis_name//
"_sub01"
1002 axis_name = this%subaxis_name
1013 if (this%cart_name .eq.
"Z")
is_z_axis = .true.
1019 character(len=*),
intent(in) :: cart_name
1021 select case (cart_name)
1022 case (
"X",
"Y",
"Z",
"T",
"U",
"N")
1024 call mpp_error(fatal,
"diag_axit_init: Invalid cart_name: "//cart_name//&
1025 "The acceptable values are X, Y, Z, T, U, N.")
1031 integer,
INTENT(IN) :: domain_position
1033 select case (domain_position)
1034 case (center, north, east)
1036 call mpp_error(fatal,
"diag_axit_init: Invalid domain_positon. &
1037 &The acceptable values are NORTH, EAST, CENTER")
1043 integer,
INTENT(IN) :: direction
1045 select case(direction)
1048 call mpp_error(fatal,
"diag_axit_init: Invalid direction. &
1049 &The acceptable values are-1 0 1")
1056 integer,
INTENT(IN) :: axis_id(:)
1057 integer,
INTENT(OUT) :: domain_type
1059 character(len=*),
INTENT(IN) :: var_name
1067 do i = 1,
size(axis_id)
1069 select type (axis => diag_axis(j)%axis)
1072 if (domain_type .ne. axis%type_of_domain)
then
1077 if ((axis%type_of_domain .eq.
two_d_domain .and.
size(axis_id) > 1) &
1078 & .or. axis%type_of_domain .eq.
ug_domain)
then
1079 domain_type = axis%type_of_domain
1080 domain => axis%axis_domain
1083 call mpp_error(fatal,
"The variable:"//trim(var_name)//
" has axis that are not in the same domain")
1094 integer,
intent(inout) :: naxis
1096 integer,
intent(in) :: is_x_or_y
1098 logical,
intent(out) :: write_on_this_pe
1100 integer :: compute_idx(2)
1101 integer :: global_idx(2)
1102 integer :: starting_index
1103 integer :: ending_index
1105 call parent_axis%get_compute_domain(compute_idx, write_on_this_pe, tile_number=subregion%tile)
1106 if (.not. write_on_this_pe)
return
1110 call parent_axis%get_indices(compute_idx, subregion%corners(:,is_x_or_y), starting_index, ending_index, &
1113 if (.not. write_on_this_pe)
return
1115 select type(corners=> subregion%corners)
1116 type is (
integer(kind=i4_kind))
1117 global_idx(1) = minval(corners(:,is_x_or_y))
1118 global_idx(2) = maxval(corners(:,is_x_or_y))
1122 call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, &
1123 starting_index, ending_index, compute_idx, global_idx)
1130 integer,
INTENT(in) :: axis_ids(:)
1131 integer,
intent(inout) :: naxis
1133 logical,
intent(in) :: is_cube_sphere
1134 logical,
intent(out) :: write_on_this_pe
1139 integer :: lat_indices(2)
1140 integer :: lon_indices(2)
1141 integer :: compute_idx(2)
1142 integer :: starting_index(2)
1144 integer :: ending_index(2)
1145 logical :: need_to_define_axis(2)
1147 integer :: parent_axis_ids(2)
1148 logical :: is_x_y_axis
1149 integer :: compute_idx_2(2, 2)
1150 integer :: global_idx (2, 2)
1152 write_on_this_pe = .false.
1153 need_to_define_axis = .true.
1154 parent_axis_ids = diag_null
1159 select type (corners => subregion%corners)
1160 type is (real(kind=r4_kind))
1161 lon(1) = minval(corners(:,1))
1162 lon(2) = maxval(corners(:,1))
1163 lat(1) = minval(corners(:,2))
1164 lat(2) = maxval(corners(:,2))
1167 if_is_cube_sphere:
if (is_cube_sphere)
then
1169 call get_local_indices_cubesphere(lat(1), lat(2), lon(1), lon(2),&
1170 & lon_indices(1), lon_indices(2), lat_indices(1), lat_indices(2))
1171 loop_over_axis_ids:
do i = 1,
size(axis_ids)
1172 select_axis_type:
select type (parent_axis => diag_axis(axis_ids(i))%axis)
1175 call parent_axis%get_compute_domain(compute_idx, is_x_y_axis)
1178 if (.not. is_x_y_axis) cycle
1182 if (parent_axis%cart_name .eq.
"X")
then
1183 call parent_axis%get_indices(compute_idx, lon_indices, starting_index(1), ending_index(1), &
1184 need_to_define_axis(1))
1185 parent_axis_ids(1) = axis_ids(i)
1186 compute_idx_2(1,:) = compute_idx
1187 global_idx(1,:) = lon_indices
1188 else if (parent_axis%cart_name .eq.
"Y")
then
1189 call parent_axis%get_indices(compute_idx, lat_indices, starting_index(2), ending_index(2), &
1190 need_to_define_axis(2))
1191 parent_axis_ids(2) = axis_ids(i)
1192 compute_idx_2(2,:) = compute_idx
1193 global_idx(2,:) = lat_indices
1195 end select select_axis_type
1196 enddo loop_over_axis_ids
1197 else if_is_cube_sphere
1198 loop_over_axis_ids2:
do i = 1,
size(axis_ids)
1199 select type (parent_axis => diag_axis(axis_ids(i))%axis)
1202 call parent_axis%get_compute_domain(compute_idx, is_x_y_axis)
1205 if (.not. is_x_y_axis) cycle
1208 if (parent_axis%cart_name .eq.
"X")
then
1209 select type(adata=>parent_axis%axis_data)
1210 type is (real(kind=r8_kind))
1211 lon_indices(1) =
nearest_index(real(lon(1), kind=r8_kind), adata)
1212 lon_indices(2) =
nearest_index(real(lon(2), kind=r8_kind), adata)
1213 type is (real(kind=r4_kind))
1214 lon_indices(1) =
nearest_index(real(lon(1), kind=r4_kind), adata)
1215 lon_indices(2) =
nearest_index(real(lon(2), kind=r4_kind), adata)
1217 call parent_axis%get_indices(compute_idx, lon_indices, starting_index(1), ending_index(1), &
1218 need_to_define_axis(1))
1219 parent_axis_ids(1) = axis_ids(i)
1220 compute_idx_2(1,:) = compute_idx
1221 global_idx(1,:) = lon_indices
1222 else if (parent_axis%cart_name .eq.
"Y")
then
1223 select type(adata=>parent_axis%axis_data)
1224 type is (real(kind=r8_kind))
1225 lat_indices(1) =
nearest_index(real(lat(1), kind=r8_kind), adata)
1226 lat_indices(2) =
nearest_index(real(lat(2), kind=r8_kind), adata)
1227 type is (real(kind=r4_kind))
1228 lat_indices(1) =
nearest_index(real(lat(1), kind=r4_kind), adata)
1229 lat_indices(2) =
nearest_index(real(lat(2), kind=r4_kind), adata)
1231 call parent_axis%get_indices(compute_idx, lat_indices, starting_index(2), ending_index(2), &
1232 need_to_define_axis(2))
1233 parent_axis_ids(2) = axis_ids(i)
1234 compute_idx_2(2,:) = compute_idx
1235 global_idx(2,:) = lat_indices
1238 enddo loop_over_axis_ids2
1239 endif if_is_cube_sphere
1242 if (any(.not. need_to_define_axis ))
return
1245 write_on_this_pe = .true.
1247 do i = 1,
size(parent_axis_ids)
1248 if (parent_axis_ids(i) .eq. diag_null) cycle
1249 select type (parent_axis => diag_axis(parent_axis_ids(i))%axis)
1251 call define_new_axis(diag_axis, parent_axis, naxis, parent_axis_ids(i), &
1252 starting_index(i), ending_index(i), compute_idx_2(i,:), global_idx(i,:))
1260 starting_index, ending_index, compute_idx, global_idx, new_axis_id, zbounds, &
1265 integer,
intent(inout) :: naxis
1267 integer,
intent(in) :: parent_id
1268 integer,
intent(in) :: starting_index
1269 integer,
intent(in) :: ending_index
1270 integer,
intent(in) :: compute_idx(2)
1272 integer,
optional,
intent(in) :: global_idx(2)
1274 integer,
optional,
intent(out) :: new_axis_id
1275 real(kind=r4_kind),
optional,
intent(in) :: zbounds(2)
1276 integer,
optional,
intent(in) :: nz_subaxis
1282 parent_axis%nsubaxis = parent_axis%nsubaxis + 1
1283 parent_axis%subaxis(parent_axis%nsubaxis) = naxis
1287 diag_axis(naxis)%axis%axis_id = naxis
1288 if (
present(new_axis_id)) new_axis_id = naxis
1290 select type (sub_axis => diag_axis(naxis)%axis)
1292 call sub_axis%fill_subaxis(starting_index, ending_index, naxis, parent_id, &
1293 parent_axis%axis_name, compute_idx, global_idx=global_idx, zbounds=zbounds, nz_subaxis=nz_subaxis)
1300 result(parent_axis_id)
1303 integer :: parent_axis_id
1307 parent_axis_id = diag_null
1309 parent_axis_id = this%parent_axis_id
1311 parent_axis_id = diag_null
1322 integer :: sub_axis_id
1324 sub_axis_id = this%axis_id
1327 if (this%cart_name .ne.
"Z") sub_axis_id = this%subaxis(this%nsubaxis)
1336 class(*),
intent(in) :: compress_att(:)
1337 character(len=120) :: axis_names(2)
1341 select type (compress_att)
1342 type is (
character(len=*))
1343 read(compress_att(1),*, iostat=ios) axis_names
1344 if (ios .ne. 0) axis_names =
""
1355 character(len=*),
intent(in) :: axis_name
1356 integer,
intent(in) :: naxis
1357 character(len=*),
intent(in) :: set_name
1364 select type(axis => diag_axis(i)%axis)
1366 if (trim(axis%axis_name) .eq. trim(axis_name))
then
1367 if (trim(axis%set_name) .eq. trim(set_name))
then
1380 result(n_diurnal_samples)
1383 integer :: n_diurnal_samples
1385 n_diurnal_samples = this%ndiurnal_samples
1391 class(fmsnetcdffile_t),
intent(inout) :: fms2io_fileobj
1393 call register_axis(fms2io_fileobj, this%axis_name,
size(this%diurnal_data))
1395 call register_variable_attribute(fms2io_fileobj, this%axis_name,
"units", &
1396 &trim(this%units), str_len=len_trim(this%units))
1397 call register_variable_attribute(fms2io_fileobj, this%axis_name,
"long_name", &
1398 &trim(this%long_name), str_len=len_trim(this%long_name))
1399 if (this%edges_id .ne. diag_null) &
1400 call register_variable_attribute(fms2io_fileobj, this%axis_name,
"edges", &
1401 &trim(this%edges_name), str_len=len_trim(this%edges_name))
1406 real(kind=r4_kind),
intent(in) :: zbounds(2)
1407 integer,
intent(inout) :: var_axis_ids(:)
1409 integer,
intent(inout) :: naxis
1411 integer,
intent(inout) :: file_axis_id(:)
1412 integer,
intent(inout) :: nfile_axis
1414 integer,
intent(inout) :: nz_subaxis
1417 class(*),
pointer :: zaxis_data(:)
1418 integer :: subaxis_indices(2)
1421 integer :: subaxis_id
1422 logical :: axis_found
1425 axis_found = .false.
1426 do i = 1, nfile_axis
1427 select type (axis => diag_axis(file_axis_id(i))%axis)
1429 if (axis%zbounds(1) .eq. zbounds(1) .and. axis%zbounds(2) .eq. zbounds(2))
then
1431 subaxis_id = file_axis_id(i)
1438 do i = 1,
size(var_axis_ids)
1439 select type (parent_axis => diag_axis(var_axis_ids(i))%axis)
1441 if (parent_axis%cart_name .eq.
"Z")
then
1443 if (axis_found)
then
1444 var_axis_ids(i) = subaxis_id
1447 zaxis_data => parent_axis%axis_data
1449 select type(zaxis_data)
1450 type is (real(kind=r4_kind))
1452 subaxis_indices(1) =
nearest_index(real(zbounds(1)), real(zaxis_data))
1453 subaxis_indices(2) =
nearest_index(real(zbounds(2)), real(zaxis_data))
1454 type is (real(kind=r8_kind))
1455 subaxis_indices(1) =
nearest_index(real(zbounds(1)), real(zaxis_data))
1456 subaxis_indices(2) =
nearest_index(real(zbounds(2)), real(zaxis_data))
1459 nz_subaxis = nz_subaxis + 1
1460 call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, &
1461 &subaxis_indices(1), subaxis_indices(2), (/lbound(zaxis_data,1), ubound(zaxis_data,1)/), &
1462 &new_axis_id=subaxis_id, zbounds=zbounds, nz_subaxis=nz_subaxis)
1463 var_axis_ids(i) = subaxis_id
1475 integer,
intent(in) :: axis_id
1476 integer,
intent(in) :: parent_axis_id
1482 select type(axis => diag_axis(axis_id)%axis)
1484 if (axis%parent_axis_id .eq. parent_axis_id) rslt = .true.
1489 end module fms_diag_axis_object_mod
integer, parameter direction_down
The axis points down if positive.
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
integer, parameter no_domain
Use the FmsNetcdfFile_t fileobj.
integer max_axis_attributes
Maximum number of user definable attributes per axis.
character(len=6) pack_size_str
Pack size as a string to be used in fms2_io register call set to "double" or "float".
integer max_axes
Maximum number of independent axes.
integer, parameter is_x_axis
integer indicating that it is a x axis
integer, parameter is_y_axis
integer indicating that it is a y axis
integer function get_base_day()
gets the module variable base_day
integer, parameter ug_domain
Use the FmsNetcdfUnstructuredDomainFile_t fileobj.
integer, parameter direction_up
The axis points up if positive.
integer function get_base_month()
gets the module variable base_month
integer function get_base_second()
gets the module variable base_second
integer, parameter two_d_domain
Use the FmsNetcdfDomainFile_t fileobj.
Attribute type for diagnostic fields.
Type to hold the attributes of the field/axis/file.
subroutine, public get_local_indexes(latStart, latEnd, lonStart, lonEnd, istart, iend, jstart, jend)
Find the local start and local end indexes on the local PE for regional output.
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:
subroutine get_global_io_domain(this, global_io_index)
Get the starting and ending indices of the global io domain of the axis.
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.
pure character(len=:) function, allocatable get_axis_name(this, is_regional)
integer function get_length(this, cart_axis, domain_position, global_length)
Get the length of a 2D domain.
integer function get_ending_index(this)
Accesses its member ending_index.
logical function, public fms_diag_axis_object_end(axis_array)
subroutine check_if_valid_domain_position(domain_position)
Check if a domain_position is valid and crashes if it isn't.
logical function is_x_or_y_axis(this, x_or_y)
Determine if an axis object is an x or y axis.
pure logical function is_unstructured_grid(this)
subroutine set_axis_id(this, axis_id)
Set the axis_id.
pure logical function is_z_axis(this)
integer function axis_length(this)
Get the axis length of a subaxis.
pure integer function get_diurnal_axis_samples(this)
integer function get_ntiles(this)
Get the ntiles in a domain.
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.
pure integer function, public get_axis_id_from_name(axis_name, diag_axis, naxis, set_name)
subroutine get_compute_domain(this, compute_idx, need_to_define_axis, tile_number)
subroutine, public define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges)
Defined a new diurnal axis.
pure integer function, dimension(2) get_structured_axis(this)
pure logical function has_aux(this)
Determine if an axis object has an auxiliary name.
subroutine add_structured_axis_ids(this, axis_ids)
subroutine check_if_valid_cart_name(cart_name)
Check if a cart_name is valid and crashes if it isn't.
subroutine write_axis_metadata(this, fms2io_fileobj, edges_in_file, parent_axis)
Write the axis meta data to an open fileobj.
subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, compute_idx, global_idx, zbounds, nz_subaxis)
Fills in the information needed to define a subaxis.
logical function, public fms_diag_axis_object_init(axis_array)
pure integer function get_subaxes_id(this)
integer function get_starting_index(this)
Accesses its member starting_index.
subroutine get_indices(this, compute_idx, corners_indices, starting_index, ending_index, need_to_define_axis)
Determine if the subRegion is in the current PE. If it is, determine the starting and ending indices ...
pure integer function get_parent_axis_id(this)
subroutine check_if_valid_direction(direction)
Check if a direction is valid and crashes if it isn't.
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.
subroutine register_diag_axis_obj(this, axis_name, axis_data, units, cart_name, long_name, direction, set_name, Domain, Domain2, DomainU, aux, req, tile_count, domain_position, axis_length)
Initialize the axis.
subroutine write_axis_data(this, fms2io_fileobj, parent_axis)
Write the axis data to an open fms2io_fileobj.
subroutine, public define_new_axis(diag_axis, parent_axis, naxis, parent_id, starting_index, ending_index, compute_idx, global_idx, new_axis_id, zbounds, nz_subaxis)
Creates a new subaxis and fills it will all the information it needs.
integer function get_axis_length(this)
Get the length of the axis.
pure character(len=:) function, allocatable get_set_name(this)
Get the set name of an axis object.
pure character(len=120) function, dimension(2), public parse_compress_att(compress_att)
subroutine set_edges(this, edges_name, edges_id)
Set the name and ids of the edges.
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 add_axis_attribute(this, att_name, att_value)
Add an attribute to an axis.
subroutine write_diurnal_metadata(this, fms2io_fileobj)
pure logical function has_set_name(this)
Determine if an axis object has a set_name.
pure integer function get_edges_id(this)
integer function, dimension(2) get_compute_indices(this)
Accesses its member compute_indices.
subroutine, public get_domain_and_domain_type(diag_axis, axis_id, domain_type, domain, var_name)
Loop through a variable's axis_id to determine and return the domain type and domain to use.
subroutine set_axis_domain(this, Domain, Domain2, DomainU)
Set the axis domain.
pure character(len=:) function, allocatable get_aux(this)
Get the auxiliary name of an axis object.
integer function, dimension(size(domain%tile_id(:))) mpp_get_tile_id(domain)
Returns the tile_id on current pe.
integer function mpp_get_ntile_count(domain)
Returns number of tiles in mosaic.
type(domain2d) function, pointer mpp_get_io_domain(domain)
Set user stack size.
These routines retrieve the axis specifications associated with the compute domains....
These routines retrieve the axis specifications associated with the global domains....
One dimensional domain used to manage shared data access between pes.
The domain2D type contains all the necessary information to define the global, compute and data domai...
Domain information for managing data on unstructured grids.
integer function stdout()
This function returns the current standard fortran unit numbers for output.
integer function mpp_pe()
Returns processor ID.
Type to hold the 1d domain.
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.
type to hold the sub region information about a file