Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update testing, in particular for diagnostics and decompositions #602

Merged
merged 3 commits into from
May 26, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
76 changes: 44 additions & 32 deletions cicecore/cicedynB/analysis/ice_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -25,19 +25,22 @@ module ice_diagnostics

implicit none
private
public :: runtime_diags, init_mass_diags, init_diags, &
print_state, print_points_state, diagnostic_abort

public :: runtime_diags, init_mass_diags, init_diags, debug_ice, &
print_state, diagnostic_abort

! diagnostic output file
character (len=char_len), public :: diag_file

! point print data

logical (kind=log_kind), public :: &
debug_model , & ! if true, debug model at high level
print_points , & ! if true, print point data
print_global ! if true, print global data

integer (kind=int_kind), public :: &
debug_model_step = 999999999 ! begin printing at istep1=debug_model_step

integer (kind=int_kind), parameter, public :: &
npnt = 2 ! total number of points to be printed

Expand Down Expand Up @@ -87,16 +90,6 @@ module ice_diagnostics
totaeron , & ! total aerosol mass
totaeros ! total aerosol mass

! printing info for routine print_state
! iblkp, ip, jp, mtask identify the grid cell to print
! character (char_len) :: plabel
integer (kind=int_kind), parameter, public :: &
check_step = 999999999, & ! begin printing at istep1=check_step
iblkp = 1, & ! block number
ip = 72, & ! i index
jp = 11, & ! j index
mtask = 0 ! my_task

!=======================================================================

contains
Expand Down Expand Up @@ -1525,20 +1518,39 @@ end subroutine init_diags

!=======================================================================

! This routine is useful for debugging.
! Calls to it should be inserted in the form (after thermo, for example)
! do iblk = 1, nblocks
! do j=jlo,jhi
! do i=ilo,ihi
! plabel = 'post thermo'
! if (istep1 >= check_step .and. iblk==iblkp .and i==ip &
! .and. j==jp .and. my_task == mtask) &
! call print_state(plabel,i,j,iblk)
! enddo
! enddo
! This routine is useful for debugging
! author Elizabeth C. Hunke, LANL

subroutine debug_ice(iblk, plabeld)

use ice_kinds_mod
use ice_calendar, only: istep1
use ice_communicate, only: my_task
use ice_blocks, only: nx_block, ny_block

character (char_len), intent(in) :: plabeld
integer (kind=int_kind), intent(in) :: iblk

! local
integer (kind=int_kind) :: i, j, m
character(len=*), parameter :: subname='(debug_ice)'

! tcraig, do this only on one point, the first point
! do m = 1, npnt
m = 1
if (istep1 >= debug_model_step .and. &
iblk == pbloc(m) .and. my_task == pmloc(m)) then
i = piloc(m)
j = pjloc(m)
call print_state(plabeld,i,j,iblk)
endif
! enddo
!
! 'use ice_diagnostics' may need to be inserted also

end subroutine debug_ice

!=======================================================================

! This routine is useful for debugging.
! author: Elizabeth C. Hunke, LANL

subroutine print_state(plabel,i,j,iblk)
Expand Down Expand Up @@ -1587,7 +1599,7 @@ subroutine print_state(plabel,i,j,iblk)

this_block = get_block(blocks_ice(iblk),iblk)

write(nu_diag,*) plabel
write(nu_diag,*) subname,plabel
write(nu_diag,*) 'istep1, my_task, i, j, iblk:', &
istep1, my_task, i, j, iblk
write(nu_diag,*) 'Global i and j:', &
Expand Down Expand Up @@ -1699,16 +1711,14 @@ subroutine print_state(plabel,i,j,iblk)
write(nu_diag,*) ' evap = ',evap (i,j,iblk)
write(nu_diag,*) ' flwout = ',flwout(i,j,iblk)
write(nu_diag,*) ' '
call flush_fileunit(nu_diag)

end subroutine print_state

!=======================================================================
#ifdef UNDEPRECATE_print_points_state

! This routine is useful for debugging.
! Calls can be inserted anywhere and it will print info on print_points points
! call print_points_state(plabel)
!
! 'use ice_diagnostics' may need to be inserted also

subroutine print_points_state(plabel,ilabel)

Expand Down Expand Up @@ -1764,6 +1774,7 @@ subroutine print_points_state(plabel,ilabel)
write(llabel,'(a)') 'pps:'//trim(llabel)
endif

write(nu_diag,*) subname
write(nu_diag,*) trim(llabel),'istep1, my_task, i, j, iblk=', &
istep1, my_task, i, j, iblk
write(nu_diag,*) trim(llabel),'Global i and j=', &
Expand Down Expand Up @@ -1842,12 +1853,13 @@ subroutine print_points_state(plabel,ilabel)
write(nu_diag,*) ' evap = ',evap (i,j,iblk)
write(nu_diag,*) ' flwout = ',flwout(i,j,iblk)
write(nu_diag,*) ' '
call flush_fileunit(nu_diag)

endif ! my_task
enddo ! ncnt

end subroutine print_points_state

#endif
!=======================================================================

! prints error information prior to aborting
Expand Down
36 changes: 18 additions & 18 deletions cicecore/cicedynB/dynamics/ice_transport_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -272,7 +272,7 @@ subroutine transport_remap (dt)
trmask ! = 1. if tracer is present, = 0. otherwise

logical (kind=log_kind) :: &
l_stop ! if true, abort the model
ckflag ! if true, abort the model

integer (kind=int_kind) :: &
istop, jstop ! indices of grid cell where model aborts
Expand Down Expand Up @@ -327,7 +327,7 @@ subroutine transport_remap (dt)
!---! Initialize, update ghost cells, fill tracer arrays.
!---!-------------------------------------------------------------------

l_stop = .false.
ckflag = .false.
istop = 0
jstop = 0

Expand Down Expand Up @@ -605,10 +605,10 @@ subroutine transport_remap (dt)

if (my_task == master_task) then
fieldid = subname//':000'
call global_conservation (l_stop, fieldid, &
call global_conservation (ckflag, fieldid, &
asum_init(0), asum_final(0))

if (l_stop) then
if (ckflag) then
write (nu_diag,*) 'istep1, my_task =', &
istep1, my_task
write (nu_diag,*) 'transport: conservation error, cat 0'
Expand All @@ -618,11 +618,11 @@ subroutine transport_remap (dt)
do n = 1, ncat
write(fieldid,'(a,i3.3)') subname,n
call global_conservation &
(l_stop, fieldid, &
(ckflag, fieldid, &
asum_init(n), asum_final(n), &
atsum_init(:,n), atsum_final(:,n))

if (l_stop) then
if (ckflag) then
write (nu_diag,*) 'istep1, my_task, cat =', &
istep1, my_task, n
write (nu_diag,*) 'transport: conservation error, cat ',n
Expand All @@ -639,15 +639,15 @@ subroutine transport_remap (dt)
!-------------------------------------------------------------------

if (l_monotonicity_check) then
!$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,l_stop,istop,jstop)
!$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,ckflag,istop,jstop)
do iblk = 1, nblocks
this_block = get_block(blocks_ice(iblk),iblk)
ilo = this_block%ilo
ihi = this_block%ihi
jlo = this_block%jlo
jhi = this_block%jhi

l_stop = .false.
ckflag = .false.
istop = 0
jstop = 0

Expand All @@ -657,10 +657,10 @@ subroutine transport_remap (dt)
ilo, ihi, jlo, jhi, &
tmin(:,:,:,n,iblk), tmax(:,:,:,n,iblk), &
aim (:,:, n,iblk), trm (:,:,:,n,iblk), &
l_stop, &
ckflag, &
istop, jstop)

if (l_stop) then
if (ckflag) then
write (nu_diag,*) 'istep1, my_task, iblk, cat =', &
istep1, my_task, iblk, n
call abort_ice(subname//'ERROR: monotonicity error')
Expand Down Expand Up @@ -1083,7 +1083,7 @@ end subroutine tracers_to_state
!
! author William H. Lipscomb, LANL

subroutine global_conservation (l_stop, fieldid, &
subroutine global_conservation (ckflag, fieldid, &
asum_init, asum_final, &
atsum_init, atsum_final)

Expand All @@ -1099,7 +1099,7 @@ subroutine global_conservation (l_stop, fieldid, &
atsum_final ! final global ice area*tracer

logical (kind=log_kind), intent(inout) :: &
l_stop ! if true, abort on return
ckflag ! if true, abort on return

! local variables

Expand All @@ -1120,7 +1120,7 @@ subroutine global_conservation (l_stop, fieldid, &
if (asum_init > puny) then
diff = asum_final - asum_init
if (abs(diff/asum_init) > puny) then
l_stop = .true.
ckflag = .true.
write (nu_diag,*)
write (nu_diag,*) subname,'Ice area conserv error ', trim(fieldid)
write (nu_diag,*) subname,' Initial global area =', asum_init
Expand All @@ -1135,7 +1135,7 @@ subroutine global_conservation (l_stop, fieldid, &
if (abs(atsum_init(nt)) > puny) then
diff = atsum_final(nt) - atsum_init(nt)
if (abs(diff/atsum_init(nt)) > puny) then
l_stop = .true.
ckflag = .true.
write (nu_diag,*)
write (nu_diag,*) subname,'Ice area*tracer conserv error ', trim(fieldid),nt
write (nu_diag,*) subname,' Tracer index =', nt
Expand Down Expand Up @@ -1323,7 +1323,7 @@ subroutine check_monotonicity (nx_block, ny_block, &
ilo, ihi, jlo, jhi, &
tmin, tmax, &
aim, trm, &
l_stop, &
ckflag, &
istop, jstop)

integer (kind=int_kind), intent(in) :: &
Expand All @@ -1341,7 +1341,7 @@ subroutine check_monotonicity (nx_block, ny_block, &
tmax ! local max tracer

logical (kind=log_kind), intent(inout) :: &
l_stop ! if true, abort on return
ckflag ! if true, abort on return

integer (kind=int_kind), intent(inout) :: &
istop, jstop ! indices of grid cell where model aborts
Expand Down Expand Up @@ -1425,7 +1425,7 @@ subroutine check_monotonicity (nx_block, ny_block, &
w1 = max(c1, abs(tmin(i,j,nt)))
w2 = max(c1, abs(tmax(i,j,nt)))
if (trm(i,j,nt) < tmin(i,j,nt)-w1*puny) then
l_stop = .true.
ckflag = .true.
istop = i
jstop = j
write (nu_diag,*) ' '
Expand All @@ -1435,7 +1435,7 @@ subroutine check_monotonicity (nx_block, ny_block, &
write (nu_diag,*) 'tmin =' , tmin(i,j,nt)
write (nu_diag,*) 'ice area =' , aim(i,j)
elseif (trm(i,j,nt) > tmax(i,j,nt)+w2*puny) then
l_stop = .true.
ckflag = .true.
istop = i
jstop = j
write (nu_diag,*) ' '
Expand Down
9 changes: 5 additions & 4 deletions cicecore/cicedynB/general/ice_flux.F90
Original file line number Diff line number Diff line change
Expand Up @@ -547,7 +547,8 @@ subroutine init_coupler_flux

integer (kind=int_kind) :: n

real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6)
integer (kind=int_kind), parameter :: max_d = 6
real (kind=dbl_kind) :: fcondtopn_d(max_d), fsurfn_d(max_d)
real (kind=dbl_kind) :: stefan_boltzmann, Tffresh
real (kind=dbl_kind) :: vonkar, zref, iceruf

Expand Down Expand Up @@ -589,7 +590,7 @@ subroutine init_coupler_flux
flw (:,:,:) = c180 ! incoming longwave rad (W/m^2)
frain (:,:,:) = c0 ! rainfall rate (kg/m2/s)
do n = 1, ncat ! conductive heat flux (W/m^2)
fcondtopn_f(:,:,n,:) = fcondtopn_d(n)
fcondtopn_f(:,:,n,:) = fcondtopn_d(min(n,max_d))
enddo
fsurfn_f = fcondtopn_f ! surface heat flux (W/m^2)
flatn_f (:,:,:,:) = c0 ! latent heat flux (kg/m2/s)
Expand All @@ -606,7 +607,7 @@ subroutine init_coupler_flux
flw (:,:,:) = 280.0_dbl_kind ! incoming longwave rad (W/m^2)
frain (:,:,:) = c0 ! rainfall rate (kg/m2/s)
do n = 1, ncat ! surface heat flux (W/m^2)
fsurfn_f(:,:,n,:) = fsurfn_d(n)
fsurfn_f(:,:,n,:) = fsurfn_d(min(n,max_d))
enddo
fcondtopn_f(:,:,:,:) = 0.0_dbl_kind ! conductive heat flux (W/m^2)
flatn_f (:,:,:,:) = -2.0_dbl_kind ! latent heat flux (W/m^2)
Expand All @@ -623,7 +624,7 @@ subroutine init_coupler_flux
flw (:,:,:) = 230.0_dbl_kind ! incoming longwave rad (W/m^2)
frain (:,:,:) = c0 ! rainfall rate (kg/m2/s)
do n = 1, ncat ! surface heat flux (W/m^2)
fsurfn_f(:,:,n,:) = fsurfn_d(n)
fsurfn_f(:,:,n,:) = fsurfn_d(min(n,max_d))
enddo
fcondtopn_f(:,:,:,:) = c0 ! conductive heat flux (W/m^2)
flatn_f (:,:,:,:) = -1.0_dbl_kind ! latent heat flux (W/m^2)
Expand Down
Loading