mom_checksums::qchksum Interface Reference

Detailed Description

Definition at line 65 of file MOM_checksums.F90.

Private functions
subroutine	chksum_b_2d (array, mesg, HI, haloshift, symmetric, omit_corners, scale)
	chksum_B_2d performs checksums on a 2d array staggered at corner points. More...
subroutine	chksum_b_3d (array, mesg, HI, haloshift, symmetric, omit_corners, scale)
	chksum_B_3d performs checksums on a 3d array staggered at corner points. More...

Functions and subroutines

chksum_b_2d()

subroutine mom_checksums::qchksum::chksum_b_2d ( real, dimension(hi%isdb:,hi%jsdb:), intent(in)  array, character(len=*), intent(in)  mesg, type(hor_index_type), intent(in)  HI, integer, intent(in), optional  haloshift, logical, intent(in), optional  symmetric, logical, intent(in), optional  omit_corners, real, intent(in), optional  scale  )

private

chksum_B_2d performs checksums on a 2d array staggered at corner points.

Parameters

[in]	hi	A horizontal index type
[in]	array	The array to be checksummed
[in]	mesg	An identifying message
[in]	haloshift	The width of halos to check (default 0)
[in]	symmetric	If true, do the checksums on the full symmetric computational domain.
[in]	omit_corners	If true, avoid checking diagonal shifts
[in]	scale	A scaling factor for this array.

Definition at line 285 of file MOM_checksums.F90.

  type(hor_index_type), intent(in) :: hi     !< A horizontal index type
  real, dimension(HI%IsdB:,HI%JsdB:), &
                        intent(in) :: array !< 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) :: symmetric !< If true, do the checksums on the
                                                !! full symmetric computational domain.
  logical,    optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts
  real,       optional, intent(in) :: scale     !< A scaling factor for this array.

  real :: scaling
  integer :: bc0, bcsw, bcse, bcnw, bcne, hshift
  integer :: bcn, bcs, bce, bcw
  logical :: do_corners, sym, sym_stats

  if (checkfornans) then
    if (is_nan(array(hi%IscB:hi%IecB,hi%JscB:hi%JecB))) &
      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

  sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric
  if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif
  if (calculatestatistics) call substats(hi, array, mesg, sym_stats, scaling)

  if (.not.writechksums) return

  hshift = default_shift
  if (present(haloshift)) hshift = haloshift
  if (hshift<0) hshift = hi%ied-hi%iec

  if ( hi%iscB-hshift<hi%isdB .or. hi%iecB+hshift>hi%iedB .or. &
       hi%jscB-hshift<hi%jsdB .or. hi%jecB+hshift>hi%jedB ) then
    write(0,*) 'chksum_B_2d: haloshift =',hshift
    write(0,*) 'chksum_B_2d: isd,isc,iec,ied=',hi%isdB,hi%iscB,hi%iecB,hi%iedB
    write(0,*) 'chksum_B_2d: jsd,jsc,jec,jed=',hi%jsdB,hi%jscB,hi%jecB,hi%jedB
    call chksum_error(fatal,'Error in chksum_B_2d '//trim(mesg))
  endif

  bc0 = subchk(array, hi, 0, 0, scaling)

  sym = .false. ; if (present(symmetric)) sym = symmetric

  if ((hshift==0) .and. .not.sym) then
    if (is_root_pe()) call chk_sum_msg("B-point:",bc0,mesg)
    return
  endif

  do_corners = .true. ; if (present(omit_corners)) do_corners = .not.omit_corners

  if (do_corners) then
    if (sym) then
      bcsw = subchk(array, hi, -hshift-1, -hshift-1, scaling)
      bcse = subchk(array, hi, hshift, -hshift-1, scaling)
      bcnw = subchk(array, hi, -hshift-1, hshift, scaling)
    else
      bcsw = subchk(array, hi, -hshift, -hshift, scaling)
      bcse = subchk(array, hi, hshift, -hshift, scaling)
      bcnw = subchk(array, hi, -hshift, hshift, scaling)
    endif
    bcne = subchk(array, hi, hshift, hshift, scaling)

    if (is_root_pe()) call chk_sum_msg("B-point:",bc0,bcsw,bcse,bcnw,bcne,mesg)
  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("B-point:",bc0,bcn,bcs,bce,bcw,mesg)
  endif

  contains

  integer function subchk(array, HI, di, dj, scale)
    type(hor_index_type), intent(in) :: hi
    real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array
    integer, intent(in) :: di, dj
    real, intent(in) :: scale
    integer :: bitcount, i, j, bc
    subchk = 0
    ! This line deliberately uses the h-point computational domain.
    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,1000000000)
  end function subchk

  subroutine substats(HI, array, mesg, sym_stats, scale)
    type(hor_index_type), intent(in) :: hi
    real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array
    character(len=*), intent(in) :: mesg
    logical, intent(in) :: sym_stats
    real, intent(in) :: scale
    integer :: i, j, n, isb, jsb
    real :: amean, amin, amax

    isb = hi%isc ; if (sym_stats) isb = hi%isc-1
    jsb = hi%jsc ; if (sym_stats) jsb = hi%jsc-1

    amin = array(hi%isc,hi%jsc) ; amax = amin
    do j=jsb,hi%JecB ; do i=isb,hi%IecB
      amin = min(amin, array(i,j))
      amax = max(amax, array(i,j))
    enddo ; enddo
    ! This line deliberately uses the h-point computational domain.
    amean = reproducing_sum(array(hi%isc:hi%iec,hi%jsc:hi%jec))
    n = (1 + hi%jec - hi%jsc) * (1 + hi%iec - hi%isc)
    call sum_across_pes(n)
    call min_across_pes(amin)
    call max_across_pes(amax)
    amean = amean / real(n)
    if (is_root_pe()) call chk_sum_msg("B-point:",amean*scale,amin*scale,amax*scale,mesg)
  end subroutine substats

chksum_b_3d()

subroutine mom_checksums::qchksum::chksum_b_3d ( real, dimension(hi%isdb:,hi%jsdb:,:), intent(in)  array, character(len=*), intent(in)  mesg, type(hor_index_type), intent(in)  HI, integer, intent(in), optional  haloshift, logical, intent(in), optional  symmetric, logical, intent(in), optional  omit_corners, real, intent(in), optional  scale  )

private

chksum_B_3d performs checksums on a 3d array staggered at corner points.

Parameters

[in]	hi	A horizontal index type
[in]	array	The array to be checksummed
[in]	mesg	An identifying message
[in]	haloshift	The width of halos to check (default 0)
[in]	symmetric	If true, do the checksums on the full symmetric computational domain.
[in]	omit_corners	If true, avoid checking diagonal shifts
[in]	scale	A scaling factor for this array.

Definition at line 814 of file MOM_checksums.F90.

  type(hor_index_type),              intent(in) :: hi !< A horizontal index type
  real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< 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) :: symmetric !< If true, do the checksums on the full symmetric computational domain.
  logical,                  optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts
  real,                     optional, intent(in) :: scale     !< A scaling factor for this array.

  real :: scaling
  integer :: bc0, bcsw, bcse, bcnw, bcne, hshift
  integer :: bcn, bcs, bce, bcw
  logical :: do_corners, sym, sym_stats

  if (checkfornans) then
    if (is_nan(array(hi%IscB:hi%IecB,hi%JscB:hi%JecB,:))) &
      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

  sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric
  if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif
  if (calculatestatistics) call substats(hi, array, mesg, sym_stats, scaling)

  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_B_3d: haloshift =',hshift
    write(0,*) 'chksum_B_3d: isd,isc,iec,ied=',hi%isd,hi%isc,hi%iec,hi%ied
    write(0,*) 'chksum_B_3d: jsd,jsc,jec,jed=',hi%jsd,hi%jsc,hi%jec,hi%jed
    call chksum_error(fatal,'Error in chksum_B_3d '//trim(mesg))
  endif

  bc0 = subchk(array, hi, 0, 0, scaling)

  sym = .false. ; if (present(symmetric)) sym = symmetric

  if ((hshift==0) .and. .not.sym) then
    if (is_root_pe()) call chk_sum_msg("B-point:",bc0,mesg)
    return
  endif

  do_corners = .true. ; if (present(omit_corners)) do_corners = .not.omit_corners

  if (do_corners) then
    if (sym) then
      bcsw = subchk(array, hi, -hshift-1, -hshift-1, scaling)
      bcse = subchk(array, hi, hshift, -hshift-1, scaling)
      bcnw = subchk(array, hi, -hshift-1, hshift, scaling)
    else
      bcsw = subchk(array, hi, -hshift-1, -hshift-1, scaling)
      bcse = subchk(array, hi, hshift, -hshift-1, scaling)
      bcnw = subchk(array, hi, -hshift-1, hshift, scaling)
    endif
    bcne = subchk(array, hi, hshift, hshift, scaling)

    if (is_root_pe()) call chk_sum_msg("B-point:",bc0,bcsw,bcse,bcnw,bcne,mesg)
  else
    if (sym) then
      bcs = subchk(array, hi, 0, -hshift-1, scaling)
      bcw = subchk(array, hi, -hshift-1, 0, scaling)
    else
      bcs = subchk(array, hi, 0, -hshift, scaling)
      bcw = subchk(array, hi, -hshift, 0, scaling)
    endif
    bce = subchk(array, hi, hshift, 0, scaling)
    bcn = subchk(array, hi, 0, hshift, scaling)

    if (is_root_pe()) call chk_sum_msg_nsew("B-point:",bc0,bcn,bcs,bce,bcw,mesg)
  endif

  contains

  integer function subchk(array, HI, di, dj, scale)
    type(hor_index_type), intent(in) :: hi
    real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array
    integer, intent(in) :: di, dj
    real, intent(in) :: scale
    integer :: bitcount, i, j, k, bc
    subchk = 0
    ! This line deliberately uses the h-point computational domain.
    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,1000000000)
  end function subchk

  subroutine substats(HI, array, mesg, sym_stats, scale)
    type(hor_index_type), intent(in) :: hi
    real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array
    character(len=*), intent(in) :: mesg
    logical, intent(in) :: sym_stats
    real, intent(in) :: scale
    integer :: i, j, k, n, isb, jsb
    real :: amean, amin, amax

    isb = hi%isc ; if (sym_stats) isb = hi%isc-1
    jsb = hi%jsc ; if (sym_stats) jsb = hi%jsc-1

    amin = array(hi%isc,hi%jsc,1) ; amax = amin
    do k=lbound(array,3),ubound(array,3) ; do j=jsb,hi%JecB ; do i=isb,hi%IecB
      amin = min(amin, array(i,j,k))
      amax = max(amax, array(i,j,k))
    enddo ; enddo ; enddo
    amean = reproducing_sum(array(hi%isc:hi%iec,hi%jsc:hi%jec,:))
    n = (1 + hi%jec - hi%jsc) * (1 + hi%iec - hi%isc) * size(array,3)
    call sum_across_pes(n)
    call min_across_pes(amin)
    call max_across_pes(amax)
    amean = amean / real(n)
    if (is_root_pe()) call chk_sum_msg("B-point:",amean*scale,amin*scale,amax*scale,mesg)
  end subroutine substats

---

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

• /home/adcroft/GitHub/workspace/Gaea-stats-MOM6-examples/MOM6-examples/src/MOM6/src/framework/MOM_checksums.F90