mom_checksums::hchksum Interface Reference

Detailed Description

Checksums an array (2d or 3d) staggered at tracer points.

Definition at line 49 of file MOM_checksums.F90.

Private functions
subroutine	chksum_h_2d (array_m, mesg, HI_m, haloshift, omit_corners, scale, logunit)
	Checksums a 2d array staggered at tracer points. More...
subroutine	chksum_h_3d (array_m, mesg, HI_m, haloshift, omit_corners, scale, logunit)
	Checksums a 3d array staggered at tracer points. More...

Detailed Description

Checksums an array (2d or 3d) staggered at tracer points.

Definition at line 49 of file MOM_checksums.F90.

Functions and subroutines

chksum_h_2d()

subroutine mom_checksums::hchksum::chksum_h_2d ( real, dimension(hi_m%isd:,hi_m%jsd:), intent(in), target  array_m, character(len=*), intent(in)  mesg, type(hor_index_type), intent(in), target  HI_m, integer, intent(in), optional  haloshift, logical, intent(in), optional  omit_corners, real, intent(in), optional  scale, integer, intent(in), optional  logunit  )

private

Checksums a 2d array staggered at tracer points.

Parameters

[in]	hi_m	Horizontal index bounds of the model grid
[in]	array_m	Field array on the model grid
[in]	mesg	An identifying message
[in]	haloshift	The width of halos to check (default 0)
[in]	omit_corners	If true, avoid checking diagonal shifts
[in]	scale	A scaling factor for this array.
[in]	logunit	IO unit for checksum logging

Definition at line 305 of file MOM_checksums.F90.

  type(hor_index_type), target, intent(in) :: HI_m    !< Horizontal index bounds of the model grid
  real, dimension(HI_m%isd:,HI_m%jsd:), target, intent(in) :: array_m !< Field array on the model grid
  character(len=*),                intent(in) :: mesg  !< An identifying message
  integer,               optional, intent(in) :: haloshift !< The width of halos to check (default 0)
  logical,               optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts
  real,                  optional, intent(in) :: scale     !< A scaling factor for this array.
  integer, optional, intent(in) :: logunit !< IO unit for checksum logging
 
  real, pointer :: array(:,:)           ! Field array on the input grid
  real, allocatable, dimension(:,:) :: rescaled_array
  type(hor_index_type), pointer :: HI   ! Horizontal index bounds of the input grid
  real :: scaling
  integer :: iounit !< Log IO unit
  integer :: i, j
  real :: aMean, aMin, aMax
  integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift
  integer :: bcN, bcS, bcE, bcW
  logical :: do_corners
  integer :: turns                      ! Quarter turns from input to model grid
 
  ! Rotate array to the input grid
  turns = hi_m%turns
  if (modulo(turns, 4) /= 0) then
    allocate(hi)
    call rotate_hor_index(hi_m, -turns, hi)
    allocate(array(hi%isd:hi%ied, hi%jsd:hi%jed))
    call rotate_array(array_m, -turns, array)
  else
    hi => hi_m
    array => array_m
  endif
 
  if (checkfornans) then
    if (is_nan(array(hi%isc:hi%iec,hi%jsc:hi%jec))) &
      call chksum_error(fatal, 'NaN detected: '//trim(mesg))
!   if (is_NaN(array)) &
!     call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg))
  endif
 
  scaling = 1.0 ; if (present(scale)) scaling = scale
  iounit = error_unit; if(present(logunit)) iounit = logunit
 
  if (calculatestatistics) then
    if (present(scale)) then
      allocate( rescaled_array(lbound(array,1):ubound(array,1), &
                               lbound(array,2):ubound(array,2)) )
      rescaled_array(:,:) = 0.0
      do j=hi%jsc,hi%jec ; do i=hi%isc,hi%iec
        rescaled_array(i,j) = scale*array(i,j)
      enddo ; enddo
      call substats(hi, rescaled_array, amean, amin, amax)
      deallocate(rescaled_array)
    else
      call substats(hi, array, amean, amin, amax)
    endif
 
    if (is_root_pe()) &
      call chk_sum_msg("h-point:", amean, amin, amax, mesg, iounit)
  endif
 
  if (.not.writechksums) return
 
  hshift = default_shift
  if (present(haloshift)) hshift = haloshift
  if (hshift<0) hshift = hi%ied-hi%iec
 
  if ( hi%isc-hshift<hi%isd .or. hi%iec+hshift>hi%ied .or. &
       hi%jsc-hshift<hi%jsd .or. hi%jec+hshift>hi%jed ) then
    write(0,*) 'chksum_h_2d: haloshift =',hshift
    write(0,*) 'chksum_h_2d: isd,isc,iec,ied=',hi%isd,hi%isc,hi%iec,hi%ied
    write(0,*) 'chksum_h_2d: jsd,jsc,jec,jed=',hi%jsd,hi%jsc,hi%jec,hi%jed
    call chksum_error(fatal,'Error in chksum_h_2d '//trim(mesg))
  endif
 
  bc0 = subchk(array, hi, 0, 0, scaling)
 
  if (hshift==0) then
    if (is_root_pe()) call chk_sum_msg("h-point:", bc0, mesg, iounit)
    return
  endif
 
  do_corners = .true. ; if (present(omit_corners)) do_corners = .not.omit_corners
 
  if (do_corners) then
    bcsw = subchk(array, hi, -hshift, -hshift, scaling)
    bcse = subchk(array, hi, hshift, -hshift, scaling)
    bcnw = subchk(array, hi, -hshift, hshift, scaling)
    bcne = subchk(array, hi, hshift, hshift, scaling)
 
    if (is_root_pe()) &
      call chk_sum_msg("h-point:", bc0, bcsw, bcse, bcnw, bcne, mesg, iounit)
  else
    bcs = subchk(array, hi, 0, -hshift, scaling)
    bce = subchk(array, hi, hshift, 0, scaling)
    bcw = subchk(array, hi, -hshift, 0, scaling)
    bcn = subchk(array, hi, 0, hshift, scaling)
 
    if (is_root_pe()) &
      call chk_sum_msg_nsew("h-point:", bc0, bcn, bcs, bce, bcw, mesg, iounit)
  endif
 
  contains
  integer function subchk(array, HI, di, dj, scale)
    type(hor_index_type), intent(in) ::  HI     !< A horizontal index type
    real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed
    integer, intent(in) :: di    !< i- direction array shift for this checksum
    integer, intent(in) :: dj    !< j- direction array shift for this checksum
    real, intent(in)    :: scale !< A scaling factor for this array.
    integer :: i, j, bc
    subchk = 0
    do j=hi%jsc+dj,hi%jec+dj; do i=hi%isc+di,hi%iec+di
      bc = bitcount(abs(scale*array(i,j)))
      subchk = subchk + bc
    enddo ; enddo
    call sum_across_pes(subchk)
    subchk=mod(subchk, bc_modulus)
  end function subchk
 
  subroutine substats(HI, array, aMean, aMin, aMax)
    type(hor_index_type), intent(in) ::  HI     !< A horizontal index type
    real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed
    real, intent(out) :: aMean !< Array mean
    real, intent(out) :: aMin !< Array minimum
    real, intent(out) :: aMax !< Array maximum
 
    integer :: i, j, n
 
    amin = array(hi%isc,hi%jsc)
    amax = array(hi%isc,hi%jsc)
    n = 0
    do j=hi%jsc,hi%jec ; do i=hi%isc,hi%iec
      amin = min(amin, array(i,j))
      amax = max(amax, array(i,j))
      n = n + 1
    enddo ; enddo
    amean = reproducing_sum(array(hi%isc:hi%iec,hi%jsc:hi%jec))
    call sum_across_pes(n)
    call min_across_pes(amin)
    call max_across_pes(amax)
    amean = amean / real(n)
  end subroutine substats
 

chksum_h_3d()

subroutine mom_checksums::hchksum::chksum_h_3d ( real, dimension(hi_m%isd:,hi_m%jsd:,:), intent(in), target  array_m, character(len=*), intent(in)  mesg, type(hor_index_type), intent(in), target  HI_m, integer, intent(in), optional  haloshift, logical, intent(in), optional  omit_corners, real, intent(in), optional  scale, integer, intent(in), optional  logunit  )

private

Checksums a 3d array staggered at tracer points.

Parameters

[in]	hi_m	A horizontal index type
[in]	array_m	The array to be checksummed
[in]	mesg	An identifying message
[in]	haloshift	The width of halos to check (default 0)
[in]	omit_corners	If true, avoid checking diagonal shifts
[in]	scale	A scaling factor for this array.
[in]	logunit	IO unit for checksum logging

Definition at line 1203 of file MOM_checksums.F90.

  type(hor_index_type),    target,   intent(in) :: HI_m !< A horizontal index type
  real, dimension(HI_m%isd:,HI_m%jsd:,:), target, intent(in) :: array_m !< The array to be checksummed
  character(len=*),                  intent(in) :: mesg  !< An identifying message
  integer,                 optional, intent(in) :: haloshift !< The width of halos to check (default 0)
  logical,                 optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts
  real,                    optional, intent(in) :: scale     !< A scaling factor for this array.
  integer, optional, intent(in) :: logunit !< IO unit for checksum logging
 
  real, pointer :: array(:,:,:)         ! Field array on the input grid
  real, allocatable, dimension(:,:,:) :: rescaled_array
  type(hor_index_type), pointer :: HI   ! Horizontal index bounds of the input grid
  real :: scaling
  integer :: iounit !< Log IO unit
  integer :: i, j, k
  real :: aMean, aMin, aMax
  integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift
  integer :: bcN, bcS, bcE, bcW
  logical :: do_corners
  integer :: turns                      ! Quarter turns from input to model grid
 
  ! Rotate array to the input grid
  turns = hi_m%turns
  if (modulo(turns, 4) /= 0) then
    allocate(hi)
    call rotate_hor_index(hi_m, -turns, hi)
    allocate(array(hi%isd:hi%ied, hi%jsd:hi%jed, size(array_m, 3)))
    call rotate_array(array_m, -turns, array)
  else
    hi => hi_m
    array => array_m
  endif
 
  if (checkfornans) then
    if (is_nan(array(hi%isc:hi%iec,hi%jsc:hi%jec,:))) &
      call chksum_error(fatal, 'NaN detected: '//trim(mesg))
!   if (is_NaN(array)) &
!     call chksum_error(FATAL, 'NaN detected in halo: '//trim(mesg))
  endif
 
  scaling = 1.0 ; if (present(scale)) scaling = scale
  iounit = error_unit; if(present(logunit)) iounit = logunit
 
  if (calculatestatistics) then
    if (present(scale)) then
      allocate( rescaled_array(lbound(array,1):ubound(array,1), &
                               lbound(array,2):ubound(array,2), &
                               lbound(array,3):ubound(array,3)) )
      rescaled_array(:,:,:) = 0.0
      do k=1,size(array,3) ; do j=hi%jsc,hi%jec ; do i=hi%isc,hi%iec
        rescaled_array(i,j,k) = scale*array(i,j,k)
      enddo ; enddo ; enddo
 
      call substats(hi, rescaled_array, amean, amin, amax)
      deallocate(rescaled_array)
    else
      call substats(hi, array, amean, amin, amax)
    endif
 
    if (is_root_pe()) &
      call chk_sum_msg("h-point:", amean, amin, amax, mesg, iounit)
  endif
 
  if (.not.writechksums) return
 
  hshift = default_shift
  if (present(haloshift)) hshift = haloshift
  if (hshift<0) hshift = hi%ied-hi%iec
 
  if ( hi%isc-hshift<hi%isd .or. hi%iec+hshift>hi%ied .or. &
       hi%jsc-hshift<hi%jsd .or. hi%jec+hshift>hi%jed ) then
    write(0,*) 'chksum_h_3d: haloshift =',hshift
    write(0,*) 'chksum_h_3d: isd,isc,iec,ied=',hi%isd,hi%isc,hi%iec,hi%ied
    write(0,*) 'chksum_h_3d: jsd,jsc,jec,jed=',hi%jsd,hi%jsc,hi%jec,hi%jed
    call chksum_error(fatal,'Error in chksum_h_3d '//trim(mesg))
  endif
 
  bc0 = subchk(array, hi, 0, 0, scaling)
 
  if (hshift==0) then
    if (is_root_pe()) call chk_sum_msg("h-point:", bc0, mesg, iounit)
    return
  endif
 
  do_corners = .true. ; if (present(omit_corners)) do_corners = .not.omit_corners
 
  if (do_corners) then
    bcsw = subchk(array, hi, -hshift, -hshift, scaling)
    bcse = subchk(array, hi, hshift, -hshift, scaling)
    bcnw = subchk(array, hi, -hshift, hshift, scaling)
    bcne = subchk(array, hi, hshift, hshift, scaling)
 
    if (is_root_pe()) &
      call chk_sum_msg("h-point:", bc0, bcsw, bcse, bcnw, bcne, mesg, iounit)
  else
    bcs = subchk(array, hi, 0, -hshift, scaling)
    bce = subchk(array, hi, hshift, 0, scaling)
    bcw = subchk(array, hi, -hshift, 0, scaling)
    bcn = subchk(array, hi, 0, hshift, scaling)
 
    if (is_root_pe()) &
      call chk_sum_msg_nsew("h-point:", bc0, bcn, bcs, bce, bcw, mesg, iounit)
  endif
 
  contains
 
  integer function subchk(array, HI, di, dj, scale)
    type(hor_index_type), intent(in) ::  HI     !< A horizontal index type
    real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed
    integer, intent(in) :: di    !< i- direction array shift for this checksum
    integer, intent(in) :: dj    !< j- direction array shift for this checksum
    real, intent(in)    :: scale !< A scaling factor for this array.
    integer :: i, j, k, bc
    subchk = 0
    do k=lbound(array,3),ubound(array,3) ; do j=hi%jsc+dj,hi%jec+dj ; do i=hi%isc+di,hi%iec+di
      bc = bitcount(abs(scale*array(i,j,k)))
      subchk = subchk + bc
    enddo ; enddo ; enddo
    call sum_across_pes(subchk)
    subchk=mod(subchk, bc_modulus)
  end function subchk
 
  subroutine substats(HI, array, aMean, aMin, aMax)
    type(hor_index_type), intent(in) ::  HI     !< A horizontal index type
    real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed
    real, intent(out) :: aMean !<  Array mean
    real, intent(out) :: aMin !< Array minimum
    real, intent(out) :: aMax !< Array maximum
 
    integer :: i, j, k, n
 
    amin = array(hi%isc,hi%jsc,1)
    amax = array(hi%isc,hi%jsc,1)
    n = 0
    do k=lbound(array,3),ubound(array,3) ; do j=hi%jsc,hi%jec ; do i=hi%isc,hi%iec
      amin = min(amin, array(i,j,k))
      amax = max(amax, array(i,j,k))
      n = n + 1
    enddo ; enddo ; enddo
    amean = reproducing_sum(array(hi%isc:hi%iec,hi%jsc:hi%jec,:))
    call sum_across_pes(n)
    call min_across_pes(amin)
    call max_across_pes(amax)
    amean = amean / real(n)
  end subroutine substats
 

---

The documentation for this interface was generated from the following file:

• /home/cermak/src/MOM6.devrob/src/framework/MOM_checksums.F90