Skip to content

Commit

Permalink
physics/GFS_debug.F90: extended debugging capabilities, option to cal…
Browse files Browse the repository at this point in the history 
…culate and print checksum based on Adler 32-bit algorithm
  • Loading branch information
@climbfuji
climbfuji committed Nov 5, 2018
1 parent 007ed06 commit b2250fe
Showing 1 changed file with 109 additions and 18 deletions.
127 changes: 109 additions & 18 deletions physics/GFS_debug.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,11 @@ module GFS_diagtoscreen

public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize

#define PRINT_SUM
public print_my_stuff, chksum_int, chksum_real

#define PRINT_CHKSUM
!#define PRINT_SUM

interface print_var
module procedure print_logic_0d
module procedure print_int_0d
Expand All @@ -18,10 +22,10 @@ module GFS_diagtoscreen
end interface

integer, parameter :: ISTART = 1
integer, parameter :: IEND = 11
integer, parameter :: IEND = 9999999

integer, parameter :: KSTART = 1
integer, parameter :: KEND = 11
integer, parameter :: KEND = 9999999

contains

Expand Down Expand Up @@ -86,7 +90,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
integer, intent(out) :: errflg

!--- local variables
integer :: impi, iomp, ierr
integer :: impi, iomp, ierr, n
integer :: mpirank, mpisize, mpicomm
integer :: omprank, ompsize

Expand Down Expand Up @@ -115,7 +119,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
!$OMP BARRIER
#endif
#ifdef MPI
call MPI_BARRIER(mpicomm,ierr)
! call MPI_BARRIER(mpicomm,ierr)
#endif

do impi=0,mpisize-1
Expand Down Expand Up @@ -230,6 +234,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
call print_var(mpirank,omprank, Tbd%blkno, 'Tbd%phy_fctd' , Tbd%phy_fctd)
call print_var(mpirank,omprank, Tbd%blkno, 'Tbd%phy_f2d' , Tbd%phy_f2d)
call print_var(mpirank,omprank, Tbd%blkno, 'Tbd%phy_f3d' , Tbd%phy_f3d)
do n=1,size(Tbd%phy_f3d(1,1,:))
call print_var(mpirank,omprank, Tbd%blkno, 'Tbd%phy_f3d_n' , Tbd%phy_f3d(:,:,n))
end do
call print_var(mpirank,omprank, Tbd%blkno, 'Tbd%blkno' , Tbd%blkno)
! Diag (incomplete)
call print_var(mpirank,omprank, Tbd%blkno, 'Diag%topfsw%upfxc', Diag%topfsw%upfxc)
Expand Down Expand Up @@ -410,15 +417,15 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
#endif
end do
#ifdef MPI
call MPI_BARRIER(mpicomm,ierr)
! call MPI_BARRIER(mpicomm,ierr)
#endif
end do

#ifdef OPENMP
!$OMP BARRIER
#endif
#ifdef MPI
call MPI_BARRIER(mpicomm,ierr)
! call MPI_BARRIER(mpicomm,ierr)
#endif

end subroutine GFS_diagtoscreen_run
Expand All @@ -431,7 +438,7 @@ subroutine print_logic_0d(mpirank,omprank,blkno,name,var)
character(len=*), intent(in) :: name
logical, intent(in) :: var

write(0,'(2a,3i4,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, var
write(0,'(2a,3i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, var

end subroutine print_logic_0d

Expand All @@ -443,7 +450,7 @@ subroutine print_int_0d(mpirank,omprank,blkno,name,var)
character(len=*), intent(in) :: name
integer, intent(in) :: var

write(0,'(2a,3i4,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, var
write(0,'(2a,3i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, var

end subroutine print_int_0d

Expand All @@ -460,10 +467,12 @@ subroutine print_int_1d(mpirank,omprank,blkno,name,var)
integer :: i

#ifdef PRINT_SUM
write(0,'(2a,3i4,3i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
write(0,'(2a,3i6,3i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
#elif defined(PRINT_CHKSUM)
write(0,'(2a,3i6,i20,2i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_int(size(var),var), minval(var), maxval(var)
#else
do i=ISTART,min(IEND,size(var(:)))
write(0,'(2a,3i4,i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
write(0,'(2a,3i6,i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
end do
#endif

Expand All @@ -479,7 +488,7 @@ subroutine print_real_0d(mpirank,omprank,blkno,name,var)
character(len=*), intent(in) :: name
real(kind_phys), intent(in) :: var

write(0,'(2a,3i4,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, var
write(0,'(2a,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, var

end subroutine print_real_0d

Expand All @@ -496,10 +505,12 @@ subroutine print_real_1d(mpirank,omprank,blkno,name,var)
integer :: i

#ifdef PRINT_SUM
write(0,'(2a,3i4,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
#elif defined(PRINT_CHKSUM)
write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),var), minval(var), maxval(var)
#else
do i=ISTART,min(IEND,size(var(:)))
write(0,'(2a,3i4,i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
write(0,'(2a,3i6,i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
end do
#endif

Expand All @@ -518,11 +529,13 @@ subroutine print_real_2d(mpirank,omprank,blkno,name,var)
integer :: k, i

#ifdef PRINT_SUM
write(0,'(2a,3i4,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
#elif defined(PRINT_CHKSUM)
write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var)
#else
do i=ISTART,min(IEND,size(var(:,1)))
do k=KSTART,min(KEND,size(var(1,:)))
write(0,'(2a,3i4,2i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, var(i,k)
write(0,'(2a,3i6,2i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, var(i,k)
end do
end do
#endif
Expand All @@ -542,19 +555,97 @@ subroutine print_real_3d(mpirank,omprank,blkno,name,var)
integer :: k, i, l

#ifdef PRINT_SUM
write(0,'(2a,3i4,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
write(0,'(2a,3i6,3e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, sum(var), minval(var), maxval(var)
#elif defined(PRINT_CHKSUM)
write(0,'(2a,3i6,i20,2e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, chksum_real(size(var),reshape(var,(/size(var)/))), minval(var), maxval(var)
#else
do i=ISTART,min(IEND,size(var(:,1,1)))
do k=KSTART,min(KEND,size(var(1,:,1)))
do l=1,size(var(1,1,:))
write(0,'(2a,3i4,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, l, var(i,k,l)
write(0,'(2a,3i6,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, l, var(i,k,l)
end do
end do
end do
#endif

end subroutine print_real_3d

function chksum_int(N, var) result(hash)
implicit none
integer, intent(in) :: N
integer, dimension(1:N), intent(in) :: var
integer*8, dimension(1:N) :: int_var
integer*8 :: a, b, i, hash
integer*8, parameter :: mod_adler=65521

a=1
b=0
i=1
hash = 0
int_var = TRANSFER(var, a, N)

do i= 1, N
a = MOD(a + int_var(i), mod_adler)
b = MOD(b+a, mod_adler)
end do

hash = ior(b * 65536, a)

end function chksum_int

function chksum_real(N, var) result(hash)
use machine, only: kind_phys
implicit none
integer, intent(in) :: N
real(kind_phys), dimension(1:N), intent(in) :: var
integer*8, dimension(1:N) :: int_var
integer*8 :: a, b, i, hash
integer*8, parameter :: mod_adler=65521

a=1
b=0
i=1
hash = 0
int_var = TRANSFER(var, a, N)

do i= 1, N
a = MOD(a + int_var(i), mod_adler)
b = MOD(b+a, mod_adler)
end do

hash = ior(b * 65536, a)

end function chksum_real

function print_my_stuff(mpitoprint,omptoprint) result(flag)
#ifdef MPI
use mpi
#endif
#ifdef OPENMP
use omp_lib
#endif
implicit none
integer, intent(in) :: mpitoprint, omptoprint
logical :: flag
integer :: ompthread, mpirank, ierr
#ifdef MPI
call MPI_COMM_RANK(MPI_COMM_WORLD, mpirank, ierr)
#else
mpirank = 0
#endif
#ifdef OPENMP
ompthread = OMP_GET_THREAD_NUM()
#else
ompthread = 0
#endif

if (mpitoprint==mpirank .and. omptoprint==ompthread) then
flag = .true.
else
flag = .false.
end if
end function print_my_stuff

end module GFS_diagtoscreen


Expand Down

0 comments on commit b2250fe

Please sign in to comment.