Skip to content

Commit

Permalink
Update fms_diag_reduction_methods.F90
Browse files Browse the repository at this point in the history
  • Loading branch information
@ganganoaa
ganganoaa authored Jul 25, 2023
1 parent fd3b88f commit 0825006
Showing 1 changed file with 35 additions and 29 deletions.
64 changes: 35 additions & 29 deletions diag_manager/fms_diag_reduction_methods.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -138,7 +138,7 @@ subroutine real_copy_set(out_data, in_data, val, err_msg)
if (present(val)) then
out_data = val
else
call mpp_error(FATL, 'fms_diag_reduction_methods_mod::real_copy_set both in_data and val can be absent')
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::real_copy_set both in_data and val can be absent')
end if
END IF
end subroutine real_copy_set
Expand Down Expand Up @@ -291,10 +291,10 @@ subroutine fms_diag_update_extremum(flag, buffer_obj, field_data, recon_bounds,
call update_scalar_extremum(flag, field_data, ptr_buffer, mask, sample, &
recon_bounds, (/i,j,k/), (/i1,j1,k1/))
class default
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::fms_diag_update_extremum &
regional buffer_obj is not one of the support buffer types: outputBuffer0d_type &
outputBuffer1d_type outputBuffer2d_type outputBuffer3d_type &
outputBuffer4d_type outputBuffer5d_type')
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::fms_diag_update_extremum'//&
' regional buffer_obj is not one of the support buffer types: outputBuffer0d_type'//&
' outputBuffer1d_type outputBuffer2d_type outputBuffer3d_type'//&
' outputBuffer4d_type outputBuffer5d_type')
end select
end if
END DO
Expand All @@ -317,10 +317,10 @@ subroutine fms_diag_update_extremum(flag, buffer_obj, field_data, recon_bounds,
type is (outputBuffer5d_type)
call update_array_extremum(flag, field_data, ptr_buffer, mask, sample, recon_bounds, reduced_k_range)
class default
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::fms_diag_update_extremum in reduced_k_range_if &
regional buffer_obj is not one of the support buffer types: outputBuffer0d_type &
outputBuffer1d_type outputBuffer2d_type outputBuffer3d_type &
outputBuffer4d_type outputBuffer5d_type')
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::fms_diag_update_extremum in reduced_k_range_if'//&
' regional buffer_obj is not one of the support buffer types: outputBuffer0d_type'//&
' outputBuffer1d_type outputBuffer2d_type outputBuffer3d_type'//&
' outputBuffer4d_type outputBuffer5d_type')
end select
ELSE !< does not have reduced_k_range
debug_diag_if: IF ( debug_diag_manager ) THEN
Expand Down Expand Up @@ -349,10 +349,10 @@ subroutine fms_diag_update_extremum(flag, buffer_obj, field_data, recon_bounds,
type is (outputBuffer5d_type)
call update_array_extremum(flag, field_data, ptr_buffer, mask, sample, recon_bounds, reduced_k_range)
class default
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::fms_diag_update_extremum &
regional buffer_obj is not one of the support buffer types: outputBuffer0d_type &
outputBuffer1d_type outputBuffer2d_type outputBuffer3d_type &
outputBuffer4d_type outputBuffer5d_type')
call mpp_error(FATAL, 'fms_diag_reduction_methods_mod::fms_diag_update_extremum'//&
' regional buffer_obj is not one of the support buffer types: outputBuffer0d_type'//&
' outputBuffer1d_type outputBuffer2d_type outputBuffer3d_type'//&
' outputBuffer4d_type outputBuffer5d_type')
end select
END IF reduced_k_range_if
end if regional_if
Expand Down Expand Up @@ -424,7 +424,7 @@ subroutine fms_diag_update_extremum(flag, buffer_obj, field_data, recon_bounds,
end select
end subroutine fms_diag_update_extremum

!> @brief Updates individual element of buffer
!> @brief Updates individual element of the buffer associated with indices in running_indx1 and running_indx2
subroutine update_scalar_extremum(flag, field_data, buffer, mask, sample, recon_bounds, &
running_indx1, running_indx2)
integer, intent(in) :: flag !< Flag indicating maximum(time_max) or minimum(time_min)
Expand Down Expand Up @@ -499,7 +499,7 @@ subroutine update_scalar_extremum(flag, field_data, buffer, mask, sample, recon_
type is (real(kind=r8_kind))
select type (buffer)
type is (real(kind=r8_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
! Update the buffer with the current minimum
where (mask(i-is+1+hi,j-js+1+hj,k,:) .AND. field_data(i-is+1+hi,j-js+1+hj,k,:) <&
buffer(i1,j1,k1,:,sample))
Expand All @@ -511,15 +511,15 @@ subroutine update_scalar_extremum(flag, field_data, buffer, mask, sample, recon_
buffer(i1,j1,k1,:,sample))
buffer(i1,j1,k1,:,sample) = field_data(i-is+1+hi,j-js+1+hj,k,:)
end where
end if
endif minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_scalar_extremum"//&
" buffer type does not match with field_data type.")
end select
type is (integer(kind=i4_kind))
select type (buffer)
type is (integer(kind=i4_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
! Update the buffer with the current minimum
where (mask(i-is+1+hi,j-js+1+hj,k,:) .AND. field_data(i-is+1+hi,j-js+1+hj,k,:) <&
buffer(i1,j1,k1,:,sample))
Expand All @@ -531,15 +531,15 @@ subroutine update_scalar_extremum(flag, field_data, buffer, mask, sample, recon_
buffer(i1,j1,k1,:,sample))
buffer(i1,j1,k1,:,sample) = field_data(i-is+1+hi,j-js+1+hj,k,:)
end where
end if
endif minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_scalar_extremum"//&
" buffer type does not match with field_data type.")
end select
type is (integer(kind=i8_kind))
select type (buffer)
type is (integer(kind=i8_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
! Update the buffer with the current minimum
where (mask(i-is+1+hi,j-js+1+hj,k,:) .AND. field_data(i-is+1+hi,j-js+1+hj,k,:) <&
buffer(i1,j1,k1,:,sample))
Expand All @@ -551,7 +551,7 @@ subroutine update_scalar_extremum(flag, field_data, buffer, mask, sample, recon_
buffer(i1,j1,k1,:,sample))
buffer(i1,j1,k1,:,sample) = field_data(i-is+1+hi,j-js+1+hj,k,:)
end where
end if
end if minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_scalar_extremum"//&
" buffer type does not match with field_data type.")
Expand All @@ -561,7 +561,7 @@ subroutine update_scalar_extremum(flag, field_data, buffer, mask, sample, recon_
end select
end subroutine update_scalar_extremum

!> @brief Updates a chunk of buffer
!> @brief Updates a chunk of the buffer defined by the bounds in recon_bounds
subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_bounds, reduced_k_range)
integer :: flag !< Flag indicating maximum(time_max) or minimum(time_min)
class(*), intent(in) :: field_data(:,:,:,:) !< Field data
Expand All @@ -580,6 +580,12 @@ subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_b
integer :: f3, f4 !< Updated starting and ending indices in the J dimension
type(fmsDiagIbounds_type) :: IJKBounds !< Bounding object for the I, J, and K indices

!> Check flag for unsupported operation
if (flag .ne. time_max .and. flag .ne. time_min) then
call mpp_error(FATAL, "fms_diag_reduction_methods_mod::fms_diag_scalar_extremum &
unsupported reduction method")
endif

!> Get the `bounds3D` member of the `recon_bounds`
IJKBounds = recon_bounds%get_bounds3D() !< Assignment of data structure with intrinsic type members may work!!!

Expand All @@ -602,7 +608,7 @@ subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_b
type is (real(kind=r4_kind))
select type (buffer)
type is (real(kind=r4_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
!> Update the buffer with the current minimum
if (reduced_k_range) then
! recon_bounds must have ks = ksr and ke = ker
Expand All @@ -626,15 +632,15 @@ subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_b
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample)) &
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample) = field_data(f1:f2,f3:f4,ks:ke,:)
end if
end if
end if minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_array_extremum"//&
" buffer type does not match with field_data type.")
end select
type is (real(kind=r8_kind))
select type (buffer)
type is (real(kind=r8_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
!> Update the buffer with the current minimum
if (reduced_k_range) then
! recon_bounds must have ks = ksr and ke = ker
Expand All @@ -658,15 +664,15 @@ subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_b
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample)) &
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample) = field_data(f1:f2,f3:f4,ks:ke,:)
end if
end if
end if minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_array_extremum"//&
" buffer type does not match with field_data type.")
end select
type is (integer(kind=i4_kind))
select type (buffer)
type is (integer(kind=i4_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
!> Update the buffer with the current minimum
if (reduced_k_range) then
! recon_bounds must have ks = ksr and ke = ker
Expand All @@ -690,15 +696,15 @@ subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_b
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample)) &
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample) = field_data(f1:f2,f3:f4,ks:ke,:)
end if
end if
end if minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_array_extremum"//&
" buffer type does not match with field_data type.")
end select
type is (integer(kind=i8_kind))
select type (buffer)
type is (integer(kind=i8_kind))
if (flag .eq. time_min) then
minimum_if: if (flag .eq. time_min) then
!> Update the buffer with the current minimum
if (reduced_k_range) then
! recon_bounds must have ks = ksr and ke = ker
Expand All @@ -722,7 +728,7 @@ subroutine update_array_extremum(flag, field_data, buffer, mask, sample, recon_b
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample)) &
buffer(is-hi:ie-hi,js-hj:je-hj,ks:ke,:,sample) = field_data(f1:f2,f3:f4,ks:ke,:)
end if
end if
end if minimum_if
class default
call mpp_error( FATAL, "fms_diag_reduction_methods_mod::update_array_extremum"//&
" buffer type does not match with field_data type.")
Expand Down

0 comments on commit 0825006

Please sign in to comment.