#define MPI
#define OPENMP
!> \file GFS_debug.F90
module GFS_diagtoscreen
private
public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize
public print_my_stuff, chksum_int, chksum_real, print_var
! Calculating the checksum leads to segmentation faults with gfortran (bug in malloc?),
! thus print the sum of the array instead of the checksum.
#ifdef __GFORTRAN__
#define PRINT_SUM
#else
#define PRINT_CHKSUM
#endif
interface print_var
module procedure print_logic_0d
module procedure print_int_0d
module procedure print_int_1d
module procedure print_real_0d
module procedure print_real_1d
module procedure print_real_2d
module procedure print_real_3d
end interface
integer, parameter :: ISTART = 1
integer, parameter :: IEND = 9999999
integer, parameter :: KSTART = 1
integer, parameter :: KEND = 9999999
contains
subroutine GFS_diagtoscreen_init ()
end subroutine GFS_diagtoscreen_init
subroutine GFS_diagtoscreen_finalize ()
end subroutine GFS_diagtoscreen_finalize
subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, &
Grid, Tbd, Cldprop, Radtend, Diag, blkno)
#ifdef MPI
use mpi
#endif
#ifdef OPENMP
use omp_lib
#endif
use machine, only: kind_phys
use GFS_typedefs, only: GFS_control_type, GFS_statein_type, &
GFS_stateout_type, GFS_sfcprop_type, &
GFS_coupling_type, GFS_grid_type, &
GFS_tbd_type, GFS_cldprop_type, &
GFS_radtend_type, GFS_diag_type
implicit none
!--- interface variables
type(GFS_control_type), intent(in ) :: Model
type(GFS_statein_type), intent(in ) :: Statein
type(GFS_stateout_type), intent(in ) :: Stateout
type(GFS_sfcprop_type), intent(in ) :: Sfcprop
type(GFS_coupling_type), intent(in ) :: Coupling
type(GFS_grid_type), intent(in ) :: Grid
type(GFS_tbd_type), intent(in ) :: Tbd
type(GFS_cldprop_type), intent(in ) :: Cldprop
type(GFS_radtend_type), intent(in ) :: Radtend
type(GFS_diag_type), intent(in ) :: Diag
integer, intent(in ) :: blkno
!--- local variables
integer :: impi, iomp, ierr, n
integer :: mpirank, mpisize, mpicomm
integer :: omprank, ompsize
#ifdef MPI
mpicomm = MPI_COMM_WORLD
mpirank = Model%me
call MPI_COMM_SIZE(mpicomm, mpisize, ierr)
#else
mpirank = 0
mpisize = 1
mpicomm = 0
#endif
#ifdef OPENMP
omprank = OMP_GET_THREAD_NUM()
ompsize = OMP_GET_NUM_THREADS()
#else
omprank = 0
ompsize = 1
#endif
#ifdef OPENMP
!$OMP BARRIER
#endif
#ifdef MPI
! call MPI_BARRIER(mpicomm,ierr)
#endif
do impi=0,mpisize-1
do iomp=0,ompsize-1
if (mpirank==impi .and. omprank==iomp) then
! Sfcprop
call print_var(mpirank,omprank, blkno, 'Sfcprop%slmsk' , Sfcprop%slmsk)
call print_var(mpirank,omprank, blkno, 'Sfcprop%oceanfrac', Sfcprop%oceanfrac)
call print_var(mpirank,omprank, blkno, 'Sfcprop%landfrac' , Sfcprop%landfrac)
call print_var(mpirank,omprank, blkno, 'Sfcprop%lakefrac' , Sfcprop%lakefrac)
call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfc' , Sfcprop%tsfc)
call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfco' , Sfcprop%tsfco)
call print_var(mpirank,omprank, blkno, 'Sfcprop%tsfcl' , Sfcprop%tsfcl)
call print_var(mpirank,omprank, blkno, 'Sfcprop%tisfc' , Sfcprop%tisfc)
call print_var(mpirank,omprank, blkno, 'Sfcprop%snowd' , Sfcprop%snowd)
call print_var(mpirank,omprank, blkno, 'Sfcprop%zorl' , Sfcprop%zorl)
call print_var(mpirank,omprank, blkno, 'Sfcprop%zorlo' , Sfcprop%zorlo)
call print_var(mpirank,omprank, blkno, 'Sfcprop%zorll' , Sfcprop%zorll)
call print_var(mpirank,omprank, blkno, 'Sfcprop%fice' , Sfcprop%fice)
call print_var(mpirank,omprank, blkno, 'Sfcprop%hprime' , Sfcprop%hprime)
call print_var(mpirank,omprank, blkno, 'Sfcprop%sncovr' , Sfcprop%sncovr)
call print_var(mpirank,omprank, blkno, 'Sfcprop%snoalb' , Sfcprop%snoalb)
call print_var(mpirank,omprank, blkno, 'Sfcprop%alvsf' , Sfcprop%alvsf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%alnsf' , Sfcprop%alnsf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%alvwf' , Sfcprop%alvwf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%alnwf' , Sfcprop%alnwf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%facsf' , Sfcprop%facsf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%facwf' , Sfcprop%facwf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%slope' , Sfcprop%slope)
call print_var(mpirank,omprank, blkno, 'Sfcprop%shdmin' , Sfcprop%shdmin)
call print_var(mpirank,omprank, blkno, 'Sfcprop%shdmax' , Sfcprop%shdmax)
call print_var(mpirank,omprank, blkno, 'Sfcprop%tg3' , Sfcprop%tg3)
call print_var(mpirank,omprank, blkno, 'Sfcprop%vfrac' , Sfcprop%vfrac)
call print_var(mpirank,omprank, blkno, 'Sfcprop%vtype' , Sfcprop%vtype)
call print_var(mpirank,omprank, blkno, 'Sfcprop%stype' , Sfcprop%stype)
call print_var(mpirank,omprank, blkno, 'Sfcprop%uustar' , Sfcprop%uustar)
call print_var(mpirank,omprank, blkno, 'Sfcprop%oro' , Sfcprop%oro)
call print_var(mpirank,omprank, blkno, 'Sfcprop%oro_uf' , Sfcprop%oro_uf)
call print_var(mpirank,omprank, blkno, 'Sfcprop%hice' , Sfcprop%hice)
call print_var(mpirank,omprank, blkno, 'Sfcprop%weasd' , Sfcprop%weasd)
call print_var(mpirank,omprank, blkno, 'Sfcprop%canopy' , Sfcprop%canopy)
call print_var(mpirank,omprank, blkno, 'Sfcprop%ffmm' , Sfcprop%ffmm)
call print_var(mpirank,omprank, blkno, 'Sfcprop%ffhh' , Sfcprop%ffhh)
call print_var(mpirank,omprank, blkno, 'Sfcprop%f10m' , Sfcprop%f10m)
call print_var(mpirank,omprank, blkno, 'Sfcprop%tprcp' , Sfcprop%tprcp)
call print_var(mpirank,omprank, blkno, 'Sfcprop%srflag' , Sfcprop%srflag)
call print_var(mpirank,omprank, blkno, 'Sfcprop%slc' , Sfcprop%slc)
call print_var(mpirank,omprank, blkno, 'Sfcprop%smc' , Sfcprop%smc)
call print_var(mpirank,omprank, blkno, 'Sfcprop%stc' , Sfcprop%stc)
call print_var(mpirank,omprank, blkno, 'Sfcprop%t2m' , Sfcprop%t2m)
call print_var(mpirank,omprank, blkno, 'Sfcprop%q2m' , Sfcprop%q2m)
if (Model%nstf_name(1)>0) then
call print_var(mpirank,omprank, blkno, 'Sfcprop%tref ', Sfcprop%tref)
call print_var(mpirank,omprank, blkno, 'Sfcprop%z_c ', Sfcprop%z_c)
call print_var(mpirank,omprank, blkno, 'Sfcprop%c_0 ', Sfcprop%c_0)
call print_var(mpirank,omprank, blkno, 'Sfcprop%c_d ', Sfcprop%c_d)
call print_var(mpirank,omprank, blkno, 'Sfcprop%w_0 ', Sfcprop%w_0)
call print_var(mpirank,omprank, blkno, 'Sfcprop%w_d ', Sfcprop%w_d)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xt ', Sfcprop%xt)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xs ', Sfcprop%xs)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xu ', Sfcprop%xu)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xv ', Sfcprop%xv)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xz ', Sfcprop%xz)
call print_var(mpirank,omprank, blkno, 'Sfcprop%zm ', Sfcprop%zm)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xtts ', Sfcprop%xtts)
call print_var(mpirank,omprank, blkno, 'Sfcprop%xzts ', Sfcprop%xzts)
call print_var(mpirank,omprank, blkno, 'Sfcprop%d_conv ', Sfcprop%d_conv)
call print_var(mpirank,omprank, blkno, 'Sfcprop%ifd ', Sfcprop%ifd)
call print_var(mpirank,omprank, blkno, 'Sfcprop%dt_cool ', Sfcprop%dt_cool)
call print_var(mpirank,omprank, blkno, 'Sfcprop%qrain ', Sfcprop%qrain)
end if
! CCPP only
!if (Model%lsm == Model%lsm_ruc) then
! call print_var(mpirank,omprank, blkno, 'Sfcprop%sh2o', Sfcprop%sh2o)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%smois', Sfcprop%smois)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%tslb', Sfcprop%tslb)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%zs', Sfcprop%zs)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%clw_surf', Sfcprop%clw_surf)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%qwv_surf', Sfcprop%qwv_surf)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%cndm_surf', Sfcprop%cndm_surf)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%flag_frsoil', Sfcprop%flag_frsoil)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%rhofr', Sfcprop%rhofr)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%tsnow', Sfcprop%tsnow)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%snowfallac ', Sfcprop%snowfallac)
! call print_var(mpirank,omprank, blkno, 'Sfcprop%acsnow ', Sfcprop%acsnow)
!end if
! Radtend
call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%upfxc', Radtend%sfcfsw(:)%upfxc)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%dnfxc', Radtend%sfcfsw(:)%dnfxc)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%upfx0', Radtend%sfcfsw(:)%upfx0)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcfsw%dnfx0', Radtend%sfcfsw(:)%dnfx0)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%upfxc', Radtend%sfcflw(:)%upfxc)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%upfx0', Radtend%sfcflw(:)%upfx0)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%dnfxc', Radtend%sfcflw(:)%dnfxc)
call print_var(mpirank,omprank, blkno, 'Radtend%sfcflw%dnfx0', Radtend%sfcflw(:)%dnfx0)
call print_var(mpirank,omprank, blkno, 'Radtend%htrsw', Radtend%htrsw)
call print_var(mpirank,omprank, blkno, 'Radtend%htrlw', Radtend%htrlw)
call print_var(mpirank,omprank, blkno, 'Radtend%sfalb', Radtend%sfalb)
call print_var(mpirank,omprank, blkno, 'Radtend%coszen', Radtend%coszen)
call print_var(mpirank,omprank, blkno, 'Radtend%tsflw', Radtend%tsflw)
call print_var(mpirank,omprank, blkno, 'Radtend%semis', Radtend%semis)
call print_var(mpirank,omprank, blkno, 'Radtend%coszdg', Radtend%coszdg)
call print_var(mpirank,omprank, blkno, 'Radtend%swhc', Radtend%swhc)
call print_var(mpirank,omprank, blkno, 'Radtend%lwhc', Radtend%lwhc)
call print_var(mpirank,omprank, blkno, 'Radtend%lwhd', Radtend%lwhd)
! Tbd
call print_var(mpirank,omprank, blkno, 'Tbd%icsdsw' , Tbd%icsdsw)
call print_var(mpirank,omprank, blkno, 'Tbd%icsdlw' , Tbd%icsdlw)
call print_var(mpirank,omprank, blkno, 'Tbd%ozpl' , Tbd%ozpl)
call print_var(mpirank,omprank, blkno, 'Tbd%h2opl' , Tbd%h2opl)
call print_var(mpirank,omprank, blkno, 'Tbd%rann' , Tbd%rann)
call print_var(mpirank,omprank, blkno, 'Tbd%acv' , Tbd%acv)
call print_var(mpirank,omprank, blkno, 'Tbd%acvb' , Tbd%acvb)
call print_var(mpirank,omprank, blkno, 'Tbd%acvt' , Tbd%acvt)
if (Model%do_sppt) then
call print_var(mpirank,omprank, blkno, 'Tbd%dtdtr' , Tbd%dtdtr)
call print_var(mpirank,omprank, blkno, 'Tbd%dtotprcp' , Tbd%dtotprcp)
call print_var(mpirank,omprank, blkno, 'Tbd%dcnvprcp' , Tbd%dcnvprcp)
call print_var(mpirank,omprank, blkno, 'Tbd%drain_cpl' , Tbd%drain_cpl)
call print_var(mpirank,omprank, blkno, 'Tbd%dsnow_cpl' , Tbd%dsnow_cpl)
end if
if (Model%nctp > 0 .and. Model%cscnv) then
call print_var(mpirank,omprank, blkno, 'Tbd%phy_fctd' , Tbd%phy_fctd)
end if
call print_var(mpirank,omprank, blkno, 'Tbd%phy_f2d' , Tbd%phy_f2d)
call print_var(mpirank,omprank, blkno, 'Tbd%phy_f3d' , Tbd%phy_f3d)
do n=1,size(Tbd%phy_f3d(1,1,:))
call print_var(mpirank,omprank, blkno, 'Tbd%phy_f3d_n' , Tbd%phy_f3d(:,:,n))
end do
call print_var(mpirank,omprank, blkno, 'Tbd%in_nm' , Tbd%in_nm)
call print_var(mpirank,omprank, blkno, 'Tbd%ccn_nm' , Tbd%ccn_nm)
call print_var(mpirank,omprank, blkno, 'Tbd%aer_nm' , Tbd%aer_nm)
! Diag
!call print_var(mpirank,omprank, blkno, 'Diag%fluxr ', Diag%fluxr)
!do n=1,size(Diag%fluxr(1,:))
! call print_var(mpirank,omprank, blkno, 'Diag%fluxr_n ', Diag%fluxr(:,n))
!end do
call print_var(mpirank,omprank, blkno, 'Diag%srunoff ', Diag%srunoff)
call print_var(mpirank,omprank, blkno, 'Diag%evbsa ', Diag%evbsa)
call print_var(mpirank,omprank, blkno, 'Diag%evcwa ', Diag%evcwa)
call print_var(mpirank,omprank, blkno, 'Diag%snohfa ', Diag%snohfa)
call print_var(mpirank,omprank, blkno, 'Diag%transa ', Diag%transa)
call print_var(mpirank,omprank, blkno, 'Diag%sbsnoa ', Diag%sbsnoa)
call print_var(mpirank,omprank, blkno, 'Diag%snowca ', Diag%snowca)
call print_var(mpirank,omprank, blkno, 'Diag%soilm ', Diag%soilm)
call print_var(mpirank,omprank, blkno, 'Diag%tmpmin ', Diag%tmpmin)
call print_var(mpirank,omprank, blkno, 'Diag%tmpmax ', Diag%tmpmax)
call print_var(mpirank,omprank, blkno, 'Diag%dusfc ', Diag%dusfc)
call print_var(mpirank,omprank, blkno, 'Diag%dvsfc ', Diag%dvsfc)
call print_var(mpirank,omprank, blkno, 'Diag%dtsfc ', Diag%dtsfc)
call print_var(mpirank,omprank, blkno, 'Diag%dqsfc ', Diag%dqsfc)
call print_var(mpirank,omprank, blkno, 'Diag%totprcp ', Diag%totprcp)
call print_var(mpirank,omprank, blkno, 'Diag%totice ', Diag%totice)
call print_var(mpirank,omprank, blkno, 'Diag%totsnw ', Diag%totsnw)
call print_var(mpirank,omprank, blkno, 'Diag%totgrp ', Diag%totgrp)
call print_var(mpirank,omprank, blkno, 'Diag%totprcpb ', Diag%totprcpb)
call print_var(mpirank,omprank, blkno, 'Diag%toticeb ', Diag%toticeb)
call print_var(mpirank,omprank, blkno, 'Diag%totsnwb ', Diag%totsnwb)
call print_var(mpirank,omprank, blkno, 'Diag%totgrpb ', Diag%totgrpb)
call print_var(mpirank,omprank, blkno, 'Diag%suntim ', Diag%suntim)
call print_var(mpirank,omprank, blkno, 'Diag%runoff ', Diag%runoff)
call print_var(mpirank,omprank, blkno, 'Diag%ep ', Diag%ep)
call print_var(mpirank,omprank, blkno, 'Diag%cldwrk ', Diag%cldwrk)
call print_var(mpirank,omprank, blkno, 'Diag%dugwd ', Diag%dugwd)
call print_var(mpirank,omprank, blkno, 'Diag%dvgwd ', Diag%dvgwd)
call print_var(mpirank,omprank, blkno, 'Diag%psmean ', Diag%psmean)
call print_var(mpirank,omprank, blkno, 'Diag%cnvprcp ', Diag%cnvprcp)
call print_var(mpirank,omprank, blkno, 'Diag%cnvprcpb ', Diag%cnvprcpb)
call print_var(mpirank,omprank, blkno, 'Diag%spfhmin ', Diag%spfhmin)
call print_var(mpirank,omprank, blkno, 'Diag%spfhmax ', Diag%spfhmax)
call print_var(mpirank,omprank, blkno, 'Diag%u10mmax ', Diag%u10mmax)
call print_var(mpirank,omprank, blkno, 'Diag%v10mmax ', Diag%v10mmax)
call print_var(mpirank,omprank, blkno, 'Diag%wind10mmax ', Diag%wind10mmax)
call print_var(mpirank,omprank, blkno, 'Diag%rain ', Diag%rain)
call print_var(mpirank,omprank, blkno, 'Diag%rainc ', Diag%rainc)
call print_var(mpirank,omprank, blkno, 'Diag%ice ', Diag%ice)
call print_var(mpirank,omprank, blkno, 'Diag%snow ', Diag%snow)
call print_var(mpirank,omprank, blkno, 'Diag%graupel ', Diag%graupel)
call print_var(mpirank,omprank, blkno, 'Diag%u10m ', Diag%u10m)
call print_var(mpirank,omprank, blkno, 'Diag%v10m ', Diag%v10m)
call print_var(mpirank,omprank, blkno, 'Diag%dpt2m ', Diag%dpt2m)
call print_var(mpirank,omprank, blkno, 'Diag%zlvl ', Diag%zlvl)
call print_var(mpirank,omprank, blkno, 'Diag%psurf ', Diag%psurf)
call print_var(mpirank,omprank, blkno, 'Diag%hpbl ', Diag%hpbl)
call print_var(mpirank,omprank, blkno, 'Diag%pwat ', Diag%pwat)
call print_var(mpirank,omprank, blkno, 'Diag%t1 ', Diag%t1)
call print_var(mpirank,omprank, blkno, 'Diag%q1 ', Diag%q1)
call print_var(mpirank,omprank, blkno, 'Diag%u1 ', Diag%u1)
call print_var(mpirank,omprank, blkno, 'Diag%v1 ', Diag%v1)
call print_var(mpirank,omprank, blkno, 'Diag%chh ', Diag%chh)
call print_var(mpirank,omprank, blkno, 'Diag%cmm ', Diag%cmm)
call print_var(mpirank,omprank, blkno, 'Diag%epi ', Diag%epi)
call print_var(mpirank,omprank, blkno, 'Diag%smcwlt2 ', Diag%smcwlt2)
call print_var(mpirank,omprank, blkno, 'Diag%smcref2 ', Diag%smcref2)
call print_var(mpirank,omprank, blkno, 'Diag%sr ', Diag%sr)
call print_var(mpirank,omprank, blkno, 'Diag%tdomr ', Diag%tdomr)
call print_var(mpirank,omprank, blkno, 'Diag%tdomzr ', Diag%tdomzr)
call print_var(mpirank,omprank, blkno, 'Diag%tdomip ', Diag%tdomip)
call print_var(mpirank,omprank, blkno, 'Diag%tdoms ', Diag%tdoms)
! CCPP only
!if (Model%lsm == Model%lsm_ruc) then
! call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Sfcprop%wetness)
!else
call print_var(mpirank,omprank, blkno, 'Diag%wet1 ', Diag%wet1)
!end if
call print_var(mpirank,omprank, blkno, 'Diag%skebu_wts ', Diag%skebu_wts)
call print_var(mpirank,omprank, blkno, 'Diag%skebv_wts ', Diag%skebv_wts)
call print_var(mpirank,omprank, blkno, 'Diag%sppt_wts ', Diag%sppt_wts)
call print_var(mpirank,omprank, blkno, 'Diag%shum_wts ', Diag%shum_wts)
call print_var(mpirank,omprank, blkno, 'Diag%zmtnblck ', Diag%zmtnblck)
if (Model%ldiag3d) then
call print_var(mpirank,omprank, blkno, 'Diag%du3dt ', Diag%du3dt)
do n=1,size(Diag%du3dt(1,1,:))
call print_var(mpirank,omprank, blkno, 'Diag%du3dt_n ', Diag%du3dt(:,:,n))
end do
call print_var(mpirank,omprank, blkno, 'Diag%dv3dt ', Diag%dv3dt)
do n=1,size(Diag%dv3dt(1,1,:))
call print_var(mpirank,omprank, blkno, 'Diag%dv3dt_n ', Diag%dv3dt(:,:,n))
end do
call print_var(mpirank,omprank, blkno, 'Diag%dt3dt ', Diag%dt3dt)
do n=1,size(Diag%dt3dt(1,1,:))
call print_var(mpirank,omprank, blkno, 'Diag%dt3dt_n ', Diag%dt3dt(:,:,n))
end do
call print_var(mpirank,omprank, blkno, 'Diag%dq3dt ', Diag%dq3dt)
do n=1,size(Diag%dq3dt(1,1,:))
call print_var(mpirank,omprank, blkno, 'Diag%dq3dt_n ', Diag%dq3dt(:,:,n))
end do
call print_var(mpirank,omprank, blkno, 'Diag%upd_mf ', Diag%upd_mf)
call print_var(mpirank,omprank, blkno, 'Diag%dwn_mf ', Diag%dwn_mf)
call print_var(mpirank,omprank, blkno, 'Diag%det_mf ', Diag%det_mf)
call print_var(mpirank,omprank, blkno, 'Diag%cldcov ', Diag%cldcov)
end if
if(Model%lradar) then
call print_var(mpirank,omprank, blkno, 'Diag%refl_10cm ', Diag%refl_10cm)
end if
! CCPP only
!if (Model%do_mynnedmf) then
! call print_var(mpirank,omprank, blkno, 'Diag%edmf_a ', Diag%edmf_a)
! call print_var(mpirank,omprank, blkno, 'Diag%edmf_w ', Diag%edmf_w)
! call print_var(mpirank,omprank, blkno, 'Diag%edmf_qt ', Diag%edmf_qt)
! call print_var(mpirank,omprank, blkno, 'Diag%edmf_thl ', Diag%edmf_thl)
! call print_var(mpirank,omprank, blkno, 'Diag%edmf_ent ', Diag%edmf_ent)
! call print_var(mpirank,omprank, blkno, 'Diag%edmf_qc ', Diag%edmf_qc)
! call print_var(mpirank,omprank, blkno, 'Diag%nupdraft ', Diag%nupdraft)
! call print_var(mpirank,omprank, blkno, 'Diag%maxMF ', Diag%maxMF)
! call print_var(mpirank,omprank, blkno, 'Diag%ktop_shallow', Diag%ktop_shallow)
! call print_var(mpirank,omprank, blkno, 'Diag%exch_h ', Diag%exch_h)
! call print_var(mpirank,omprank, blkno, 'Diag%exch_m ', Diag%exch_m)
!end if
! Statein
call print_var(mpirank,omprank, blkno, 'Statein%phii' , Statein%phii)
call print_var(mpirank,omprank, blkno, 'Statein%prsi' , Statein%prsi)
call print_var(mpirank,omprank, blkno, 'Statein%prsik' , Statein%prsik)
call print_var(mpirank,omprank, blkno, 'Statein%phil' , Statein%phil)
call print_var(mpirank,omprank, blkno, 'Statein%prsl' , Statein%prsl)
call print_var(mpirank,omprank, blkno, 'Statein%prslk' , Statein%prslk)
call print_var(mpirank,omprank, blkno, 'Statein%pgr' , Statein%pgr)
call print_var(mpirank,omprank, blkno, 'Statein%ugrs' , Statein%ugrs)
call print_var(mpirank,omprank, blkno, 'Statein%vgrs' , Statein%vgrs)
call print_var(mpirank,omprank, blkno, 'Statein%vvl' , Statein%vvl)
call print_var(mpirank,omprank, blkno, 'Statein%tgrs' , Statein%tgrs)
call print_var(mpirank,omprank, blkno, 'Statein%qgrs' , Statein%qgrs)
do n=1,size(Statein%qgrs(1,1,:))
call print_var(mpirank,omprank, blkno, 'Statein%qgrs_n', Statein%qgrs(:,:,n))
end do
call print_var(mpirank,omprank, blkno, 'Statein%diss_est', Statein%diss_est)
call print_var(mpirank,omprank, blkno, 'Statein%smc' , Statein%smc)
call print_var(mpirank,omprank, blkno, 'Statein%stc' , Statein%stc)
call print_var(mpirank,omprank, blkno, 'Statein%slc' , Statein%slc)
! Stateout
call print_var(mpirank,omprank, blkno, 'Stateout%gu0', Stateout%gu0)
call print_var(mpirank,omprank, blkno, 'Stateout%gv0', Stateout%gv0)
call print_var(mpirank,omprank, blkno, 'Stateout%gt0', Stateout%gt0)
call print_var(mpirank,omprank, blkno, 'Stateout%gq0', Stateout%gq0)
do n=1,size(Stateout%gq0(1,1,:))
call print_var(mpirank,omprank, blkno, 'Stateout%gq0_n', Stateout%gq0(:,:,n))
end do
! Coupling
call print_var(mpirank,omprank, blkno, 'Coupling%nirbmdi', Coupling%nirbmdi)
call print_var(mpirank,omprank, blkno, 'Coupling%nirdfdi', Coupling%nirdfdi)
call print_var(mpirank,omprank, blkno, 'Coupling%visbmdi', Coupling%visbmdi)
call print_var(mpirank,omprank, blkno, 'Coupling%visdfdi', Coupling%visdfdi)
call print_var(mpirank,omprank, blkno, 'Coupling%nirbmui', Coupling%nirbmui)
call print_var(mpirank,omprank, blkno, 'Coupling%nirdfui', Coupling%nirdfui)
call print_var(mpirank,omprank, blkno, 'Coupling%visbmui', Coupling%visbmui)
call print_var(mpirank,omprank, blkno, 'Coupling%visdfui', Coupling%visdfui)
call print_var(mpirank,omprank, blkno, 'Coupling%sfcdsw ', Coupling%sfcdsw )
call print_var(mpirank,omprank, blkno, 'Coupling%sfcnsw ', Coupling%sfcnsw )
call print_var(mpirank,omprank, blkno, 'Coupling%sfcdlw ', Coupling%sfcdlw )
if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm) then
call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl)
call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl)
end if
if (Model%cplflx) then
call print_var(mpirank,omprank, blkno, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dtsfcin_cpl ', Coupling%dtsfcin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dqsfcin_cpl ', Coupling%dqsfcin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%ulwsfcin_cpl', Coupling%ulwsfcin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%tseain_cpl ', Coupling%tseain_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%tisfcin_cpl ', Coupling%tisfcin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%ficein_cpl ', Coupling%ficein_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%hicein_cpl ', Coupling%hicein_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%hsnoin_cpl ', Coupling%hsnoin_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dusfc_cpl ', Coupling%dusfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvsfc_cpl ', Coupling%dvsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dtsfc_cpl ', Coupling%dtsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dqsfc_cpl ', Coupling%dqsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dlwsfc_cpl ', Coupling%dlwsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dswsfc_cpl ', Coupling%dswsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dnirbm_cpl ', Coupling%dnirbm_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dnirdf_cpl ', Coupling%dnirdf_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvisbm_cpl ', Coupling%dvisbm_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvisdf_cpl ', Coupling%dvisdf_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nlwsfc_cpl ', Coupling%nlwsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nswsfc_cpl ', Coupling%nswsfc_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nnirbm_cpl ', Coupling%nnirbm_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nnirdf_cpl ', Coupling%nnirdf_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nvisbm_cpl ', Coupling%nvisbm_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nvisdf_cpl ', Coupling%nvisdf_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dusfci_cpl ', Coupling%dusfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvsfci_cpl ', Coupling%dvsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dtsfci_cpl ', Coupling%dtsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dqsfci_cpl ', Coupling%dqsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dlwsfci_cpl ', Coupling%dlwsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dswsfci_cpl ', Coupling%dswsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dnirbmi_cpl ', Coupling%dnirbmi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dnirdfi_cpl ', Coupling%dnirdfi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvisbmi_cpl ', Coupling%dvisbmi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%dvisdfi_cpl ', Coupling%dvisdfi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nlwsfci_cpl ', Coupling%nlwsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nswsfci_cpl ', Coupling%nswsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nnirbmi_cpl ', Coupling%nnirbmi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nnirdfi_cpl ', Coupling%nnirdfi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nvisbmi_cpl ', Coupling%nvisbmi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%nvisdfi_cpl ', Coupling%nvisdfi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%t2mi_cpl ', Coupling%t2mi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%q2mi_cpl ', Coupling%q2mi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%u10mi_cpl ', Coupling%u10mi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%v10mi_cpl ', Coupling%v10mi_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%tsfci_cpl ', Coupling%tsfci_cpl )
call print_var(mpirank,omprank, blkno, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl )
end if
if (Model%cplchm) then
call print_var(mpirank,omprank, blkno, 'Coupling%rainc_cpl', Coupling%rainc_cpl)
call print_var(mpirank,omprank, blkno, 'Coupling%ushfsfci ', Coupling%ushfsfci )
call print_var(mpirank,omprank, blkno, 'Coupling%dkt ', Coupling%dkt )
call print_var(mpirank,omprank, blkno, 'Coupling%dqdti ', Coupling%dqdti )
end if
if (Model%do_sppt) then
call print_var(mpirank,omprank, blkno, 'Coupling%sppt_wts', Coupling%sppt_wts)
end if
if (Model%do_shum) then
call print_var(mpirank,omprank, blkno, 'Coupling%shum_wts', Coupling%shum_wts)
end if
if (Model%do_skeb) then
call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts)
call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts)
end if
if (Model%do_sfcperts) then
call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts', Coupling%sfc_wts)
end if
if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then
call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d)
call print_var(mpirank,omprank, blkno, 'Coupling%nifa2d', Coupling%nifa2d)
end if
! Grid
call print_var(mpirank,omprank, blkno, 'Grid%xlon ', Grid%xlon )
call print_var(mpirank,omprank, blkno, 'Grid%xlat ', Grid%xlat )
call print_var(mpirank,omprank, blkno, 'Grid%xlat_d', Grid%xlat_d)
call print_var(mpirank,omprank, blkno, 'Grid%sinlat', Grid%sinlat)
call print_var(mpirank,omprank, blkno, 'Grid%coslat', Grid%coslat)
call print_var(mpirank,omprank, blkno, 'Grid%area ', Grid%area )
call print_var(mpirank,omprank, blkno, 'Grid%dx ', Grid%dx )
if (Model%ntoz > 0) then
call print_var(mpirank,omprank, blkno, 'Grid%ddy_o3 ', Grid%ddy_o3 )
call print_var(mpirank,omprank, blkno, 'Grid%jindx1_o3', Grid%jindx1_o3)
call print_var(mpirank,omprank, blkno, 'Grid%jindx2_o3', Grid%jindx2_o3)
endif
if (Model%h2o_phys) then
call print_var(mpirank,omprank, blkno, 'Grid%ddy_h ', Grid%ddy_h )
call print_var(mpirank,omprank, blkno, 'Grid%jindx1_h', Grid%jindx1_h)
call print_var(mpirank,omprank, blkno, 'Grid%jindx2_h', Grid%jindx2_h)
endif
! Model/Control
! not yet
end if
#ifdef OPENMP
!$OMP BARRIER
#endif
end do
#ifdef MPI
! call MPI_BARRIER(mpicomm,ierr)
#endif
end do
#ifdef OPENMP
!$OMP BARRIER
#endif
#ifdef MPI
! call MPI_BARRIER(mpicomm,ierr)
#endif
end subroutine GFS_diagtoscreen_run
subroutine print_logic_0d(mpirank,omprank,blkno,name,var)
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
logical, intent(in) :: var
write(0,'(2a,3i6,1x,l)') 'XXX: ', trim(name), mpirank, omprank, blkno, var
end subroutine print_logic_0d
subroutine print_int_0d(mpirank,omprank,blkno,name,var)
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
integer, intent(in) :: var
write(0,'(2a,3i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, var
end subroutine print_int_0d
subroutine print_int_1d(mpirank,omprank,blkno,name,var)
use machine, only: kind_phys
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
integer, intent(in) :: var(:)
integer :: i
#ifdef PRINT_SUM
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,3i6,i6,i15)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
end do
#endif
end subroutine print_int_1d
subroutine print_real_0d(mpirank,omprank,blkno,name,var)
use machine, only: kind_phys
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
real(kind_phys), intent(in) :: var
write(0,'(2a,3i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, var
end subroutine print_real_0d
subroutine print_real_1d(mpirank,omprank,blkno,name,var)
use machine, only: kind_phys
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
real(kind_phys), intent(in) :: var(:)
integer :: i
#ifdef PRINT_SUM
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,3i6,i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, var(i)
end do
#endif
end subroutine print_real_1d
subroutine print_real_2d(mpirank,omprank,blkno,name,var)
use machine, only: kind_phys
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
real(kind_phys), intent(in) :: var(:,:)
integer :: k, i
#ifdef PRINT_SUM
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,3i6,2i6,e35.25)') 'XXX: ', trim(name), mpirank, omprank, blkno, i, k, var(i,k)
end do
end do
#endif
end subroutine print_real_2d
subroutine print_real_3d(mpirank,omprank,blkno,name,var)
use machine, only: kind_phys
implicit none
integer, intent(in) :: mpirank, omprank, blkno
character(len=*), intent(in) :: name
real(kind_phys), intent(in) :: var(:,:,:)
integer :: k, i, l
#ifdef PRINT_SUM
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,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
module GFS_abort
private
public GFS_abort_init, GFS_abort_run, GFS_abort_finalize
contains
subroutine GFS_abort_init ()
end subroutine GFS_abort_init
subroutine GFS_abort_finalize ()
end subroutine GFS_abort_finalize
subroutine GFS_abort_run (Model, blkno)
use machine, only: kind_phys
use GFS_typedefs, only: GFS_control_type
implicit none
!--- interface variables
type(GFS_control_type), intent(in ) :: Model
integer, intent(in ) :: blkno
if (Model%kdt==1 .and. blkno==4) then
if (Model%me==0) write(0,*) "GFS_abort_run: ABORTING MODEL"
call sleep(10)
stop
end if
end subroutine GFS_abort_run
end module GFS_abort