Skip to content

Commit

Permalink
Update subroutine diagnostic_abort which calls print_state
Browse files Browse the repository at this point in the history 
Update ice_transport_remap and ice_transport_driver to call diagnostic_abort
  during some errors.
See also CICE-Consortium#622
  • Loading branch information
@apcraig
apcraig committed Aug 8, 2022
1 parent 6abb59b commit a14eb91
Show file tree
Hide file tree
Showing 3 changed files with 36 additions and 59 deletions.
60 changes: 30 additions & 30 deletions cicecore/cicedynB/analysis/ice_diagnostics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
module ice_diagnostics

use ice_kinds_mod
use ice_blocks, only: nx_block, ny_block
use ice_communicate, only: my_task, master_task
use ice_constants, only: c0, c1
use ice_calendar, only: istep1
Expand Down Expand Up @@ -112,7 +113,6 @@ module ice_diagnostics
subroutine runtime_diags (dt)

use ice_arrays_column, only: floe_rad_c
use ice_blocks, only: nx_block, ny_block
use ice_broadcast, only: broadcast_scalar
use ice_constants, only: c1, c1000, c2, p001, p5, &
field_loc_center, m2_to_km2
Expand Down Expand Up @@ -1268,7 +1268,6 @@ end subroutine runtime_diags

subroutine init_mass_diags

use ice_blocks, only: nx_block, ny_block
use ice_constants, only: field_loc_center
use ice_domain, only: distrb_info, nblocks
use ice_domain_size, only: n_iso, n_aero, ncat, max_blocks
Expand Down Expand Up @@ -1412,7 +1411,6 @@ end subroutine init_mass_diags

subroutine total_energy (work)

use ice_blocks, only: nx_block, ny_block
use ice_domain, only: nblocks
use ice_domain_size, only: ncat, nilyr, nslyr, max_blocks
use ice_grid, only: tmask
Expand Down Expand Up @@ -1499,7 +1497,6 @@ end subroutine total_energy

subroutine total_salt (work)

use ice_blocks, only: nx_block, ny_block
use ice_domain, only: nblocks
use ice_domain_size, only: ncat, nilyr, max_blocks
use ice_grid, only: tmask
Expand Down Expand Up @@ -1708,11 +1705,6 @@ end subroutine init_diags

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

Expand Down Expand Up @@ -1757,7 +1749,8 @@ subroutine print_state(plabel,i,j,iblk)
use ice_blocks, only: block, get_block
use ice_domain, only: blocks_ice
use ice_domain_size, only: ncat, nilyr, nslyr, nfsd
use ice_state, only: aice0, aicen, vicen, vsnon, uvel, vvel, &
use ice_grid, only: TLAT, TLON
use ice_state, only: aice, aice0, aicen, vicen, vsnon, uvel, vvel, &
uvelE, vvelE, uvelN, vvelN, trcrn
use ice_flux, only: uatm, vatm, potT, Tair, Qa, flw, frain, fsnow, &
fsens, flat, evap, flwout, swvdr, swvdf, swidr, swidf, rhoa, &
Expand Down Expand Up @@ -1801,13 +1794,17 @@ subroutine print_state(plabel,i,j,iblk)

this_block = get_block(blocks_ice(iblk),iblk)

write(nu_diag,*) subname,plabel
write(nu_diag,*) 'istep1, my_task, i, j, iblk:', &
write(nu_diag,*) subname,' ',trim(plabel)
write(nu_diag,*) subname,' istep1, my_task, i, j, iblk:', &
istep1, my_task, i, j, iblk
write(nu_diag,*) 'Global i and j:', &
write(nu_diag,*) subname,' Global i and j:', &
this_block%i_glob(i), &
this_block%j_glob(j)
write (nu_diag,*) subname,' Lat, Lon (degrees):', &
TLAT(i,j,iblk)*rad_to_deg, &
TLON(i,j,iblk)*rad_to_deg
write(nu_diag,*) ' '
write(nu_diag,*) 'aice ', aice(i,j,iblk)
write(nu_diag,*) 'aice0', aice0(i,j,iblk)
do n = 1, ncat
write(nu_diag,*) ' '
Expand Down Expand Up @@ -2089,20 +2086,18 @@ end subroutine print_points_state

! prints error information prior to aborting

subroutine diagnostic_abort(istop, jstop, iblk, istep1, stop_label)
subroutine diagnostic_abort(istop, jstop, iblk, stop_label)

use ice_blocks, only: block, get_block
use ice_communicate, only: my_task
use ice_domain, only: blocks_ice
use ice_grid, only: TLAT, TLON
use ice_state, only: aice

integer (kind=int_kind), intent(in) :: &
istop, jstop, & ! indices of grid cell where model aborts
iblk , & ! block index
istep1 ! time step number
iblk ! block index

character (char_len), intent(in) :: stop_label
character (len=*), intent(in) :: stop_label

! local variables

Expand All @@ -2120,18 +2115,23 @@ subroutine diagnostic_abort(istop, jstop, iblk, istep1, stop_label)

this_block = get_block(blocks_ice(iblk),iblk)

write (nu_diag,*) 'istep1, my_task, iblk =', &
istep1, my_task, iblk
write (nu_diag,*) 'Global block:', this_block%block_id
if (istop > 0 .and. jstop > 0) &
write (nu_diag,*) 'Global i and j:', &
this_block%i_glob(istop), &
this_block%j_glob(jstop)
write (nu_diag,*) 'Lat, Lon:', &
TLAT(istop,jstop,iblk)*rad_to_deg, &
TLON(istop,jstop,iblk)*rad_to_deg
write (nu_diag,*) 'aice:', &
aice(istop,jstop,iblk)
call flush_fileunit(nu_diag)
if (istop > 0 .and. jstop > 0) then
call print_state(trim(stop_label),istop,jstop,iblk)
else
write (nu_diag,*) subname,' istep1, my_task, iblk =', &
istep1, my_task, iblk
write (nu_diag,*) subname,' Global block:', this_block%block_id
write (nu_diag,*) subname,' Global i and j:', &
this_block%i_glob(istop), &
this_block%j_glob(jstop)
write (nu_diag,*) subname,' Lat, Lon (degrees):', &
TLAT(istop,jstop,iblk)*rad_to_deg, &
TLON(istop,jstop,iblk)*rad_to_deg
write (nu_diag,*) subname,' aice:', &
aice(istop,jstop,iblk)
endif
call flush_fileunit(nu_diag)
call abort_ice (subname//'ERROR: '//trim(stop_label))

end subroutine diagnostic_abort
Expand Down
4 changes: 1 addition & 3 deletions cicecore/cicedynB/dynamics/ice_transport_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -688,9 +688,7 @@ subroutine transport_remap (dt)
istop, jstop)

if (ckflag) then
write (nu_diag,*) 'istep1, my_task, iblk, cat =', &
istep1, my_task, iblk, n
call abort_ice(subname//'ERROR: monotonicity error')
call diagnostic_abort(istop,jstop,iblk,' monotonicity error')
endif
enddo ! n

Expand Down
31 changes: 5 additions & 26 deletions cicecore/cicedynB/dynamics/ice_transport_remap.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,11 +30,13 @@ module ice_transport_remap

use ice_kinds_mod
use ice_blocks, only: nx_block, ny_block
use ice_calendar, only: istep1
use ice_communicate, only: my_task
use ice_constants, only: c0, c1, c2, c12, p333, p4, p5, p6, &
eps13, eps16, &
field_loc_center, field_type_scalar, &
field_loc_NEcorner, field_type_vector
use ice_diagnostics, only: diagnostic_abort
use ice_domain_size, only: max_blocks, ncat
use ice_fileunits, only: nu_diag
use ice_exit, only: abort_ice
Expand Down Expand Up @@ -329,7 +331,6 @@ subroutine horizontal_remap (dt, ntrace, &
tarear, hm, &
xav, yav, xxav, yyav
! xyav, xxxav, xxyav, xyyav, yyyav
use ice_calendar, only: istep1
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

real (kind=dbl_kind), intent(in) :: &
Expand Down Expand Up @@ -556,14 +557,7 @@ subroutine horizontal_remap (dt, ntrace, &
istop, jstop)

if (l_stop) then
write(nu_diag,*) 'istep1, my_task, iblk =', &
istep1, my_task, iblk
write (nu_diag,*) 'Global block:', this_block%block_id
if (istop > 0 .and. jstop > 0) &
write(nu_diag,*) 'Global i and j:', &
this_block%i_glob(istop), &
this_block%j_glob(jstop)
call abort_ice(subname//'ERROR: bad departure points')
call diagnostic_abort(istop,jstop,iblk,'bad departure points')
endif

enddo ! iblk
Expand Down Expand Up @@ -832,15 +826,7 @@ subroutine horizontal_remap (dt, ntrace, &
mm (:,:,0,iblk))

if (l_stop) then
this_block = get_block(blocks_ice(iblk),iblk)
write (nu_diag,*) 'istep1, my_task, iblk, cat =', &
istep1, my_task, iblk, '0'
write (nu_diag,*) 'Global block:', this_block%block_id
if (istop > 0 .and. jstop > 0) &
write(nu_diag,*) 'Global i and j:', &
this_block%i_glob(istop), &
this_block%j_glob(jstop)
call abort_ice (subname//'ERROR: negative area (open water)')
call diagnostic_abort(istop,jstop,iblk,'negative area (open water)')
endif

! ice categories
Expand All @@ -858,14 +844,7 @@ subroutine horizontal_remap (dt, ntrace, &
tm (:,:,:,n,iblk))

if (l_stop) then
write (nu_diag,*) 'istep1, my_task, iblk, cat =', &
istep1, my_task, iblk, n
write (nu_diag,*) 'Global block:', this_block%block_id
if (istop > 0 .and. jstop > 0) &
write(nu_diag,*) 'Global i and j:', &
this_block%i_glob(istop), &
this_block%j_glob(jstop)
call abort_ice (subname//'ERROR: negative area (ice)')
call diagnostic_abort(istop,jstop,iblk,'negative area (ice)')
endif
enddo ! n

Expand Down

0 comments on commit a14eb91

Please sign in to comment.