Checksums a 3d array staggered at tracer points.
952 type(hor_index_type),
intent(in) :: HI
953 real,
dimension(HI%isd:,HI%jsd:,:),
intent(in) :: array
954 character(len=*),
intent(in) :: mesg
955 integer,
optional,
intent(in) :: haloshift
956 logical,
optional,
intent(in) :: omit_corners
957 real,
optional,
intent(in) :: scale
958 integer,
optional,
intent(in) :: logunit
960 real,
allocatable,
dimension(:,:,:) :: rescaled_array
964 real :: aMean, aMin, aMax
965 integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift
966 integer :: bcN, bcS, bcE, bcW
967 logical :: do_corners
969 if (checkfornans)
then
970 if (is_nan(array(hi%isc:hi%iec,hi%jsc:hi%jec,:))) &
971 call chksum_error(fatal,
'NaN detected: '//trim(mesg))
976 scaling = 1.0 ;
if (
present(scale)) scaling = scale
977 iounit = error_unit;
if(
present(logunit)) iounit = logunit
979 if (calculatestatistics)
then
980 if (
present(scale))
then
981 allocate( rescaled_array(lbound(array,1):ubound(array,1), &
982 lbound(array,2):ubound(array,2), &
983 lbound(array,3):ubound(array,3)) )
984 rescaled_array(:,:,:) = 0.0
985 do k=1,
size(array,3) ;
do j=hi%jsc,hi%jec ;
do i=hi%isc,hi%iec
986 rescaled_array(i,j,k) = scale*array(i,j,k)
987 enddo ;
enddo ;
enddo
989 call substats(hi, rescaled_array, amean, amin, amax)
990 deallocate(rescaled_array)
992 call substats(hi, array, amean, amin, amax)
996 call chk_sum_msg(
"h-point:", amean, amin, amax, mesg, iounit)
999 if (.not.writechksums)
return
1001 hshift = default_shift
1002 if (
present(haloshift)) hshift = haloshift
1003 if (hshift<0) hshift = hi%ied-hi%iec
1005 if ( hi%isc-hshift<hi%isd .or. hi%iec+hshift>hi%ied .or. &
1006 hi%jsc-hshift<hi%jsd .or. hi%jec+hshift>hi%jed )
then
1007 write(0,*)
'chksum_h_3d: haloshift =',hshift
1008 write(0,*)
'chksum_h_3d: isd,isc,iec,ied=',hi%isd,hi%isc,hi%iec,hi%ied
1009 write(0,*)
'chksum_h_3d: jsd,jsc,jec,jed=',hi%jsd,hi%jsc,hi%jec,hi%jed
1010 call chksum_error(fatal,
'Error in chksum_h_3d '//trim(mesg))
1013 bc0 =
subchk(array, hi, 0, 0, scaling)
1016 if (is_root_pe())
call chk_sum_msg(
"h-point:", bc0, mesg, iounit)
1020 do_corners = .true. ;
if (
present(omit_corners)) do_corners = .not.omit_corners
1022 if (do_corners)
then
1023 bcsw =
subchk(array, hi, -hshift, -hshift, scaling)
1024 bcse =
subchk(array, hi, hshift, -hshift, scaling)
1025 bcnw =
subchk(array, hi, -hshift, hshift, scaling)
1026 bcne =
subchk(array, hi, hshift, hshift, scaling)
1029 call chk_sum_msg(
"h-point:", bc0, bcsw, bcse, bcnw, bcne, mesg, iounit)
1031 bcs =
subchk(array, hi, 0, -hshift, scaling)
1032 bce =
subchk(array, hi, hshift, 0, scaling)
1033 bcw =
subchk(array, hi, -hshift, 0, scaling)
1034 bcn =
subchk(array, hi, 0, hshift, scaling)
1037 call chk_sum_msg_nsew(
"h-point:", bc0, bcn, bcs, bce, bcw, mesg, iounit)
1042 integer function subchk(array, HI, di, dj, scale)
1043 type(hor_index_type),
intent(in) :: HI
1044 real,
dimension(HI%isd:,HI%jsd:,:),
intent(in) :: array
1045 integer,
intent(in) :: di
1046 integer,
intent(in) :: dj
1047 real,
intent(in) :: scale
1048 integer :: i, j, k, bc
1050 do k=lbound(array,3),ubound(array,3) ;
do j=hi%jsc+dj,hi%jec+dj ;
do i=hi%isc+di,hi%iec+di
1051 bc = bitcount(abs(scale*array(i,j,k)))
1053 enddo ;
enddo ;
enddo
1054 call sum_across_pes(
subchk)
1058 subroutine substats(HI, array, aMean, aMin, aMax)
1059 type(hor_index_type),
intent(in) :: HI
1060 real,
dimension(HI%isd:,HI%jsd:,:),
intent(in) :: array
1061 real,
intent(out) :: aMean, aMin, aMax
1063 integer :: i, j, k, n
1065 amin = array(hi%isc,hi%jsc,1)
1066 amax = array(hi%isc,hi%jsc,1)
1068 do k=lbound(array,3),ubound(array,3) ;
do j=hi%jsc,hi%jec ;
do i=hi%isc,hi%iec
1069 amin = min(amin, array(i,j,k))
1070 amax = max(amax, array(i,j,k))
1072 enddo ;
enddo ;
enddo
1073 amean = reproducing_sum(array(hi%isc:hi%iec,hi%jsc:hi%jec,:))
1074 call sum_across_pes(n)
1075 call min_across_pes(amin)
1076 call max_across_pes(amax)
1077 amean = amean / real(n)