From a14eb91b3a475f68153670ea697da5e88d03f9af Mon Sep 17 00:00:00 2001 From: apcraig Date: Mon, 8 Aug 2022 16:12:09 -0600 Subject: [PATCH] Update subroutine diagnostic_abort which calls print_state Update ice_transport_remap and ice_transport_driver to call diagnostic_abort during some errors. See also #622 --- .../cicedynB/analysis/ice_diagnostics.F90 | 60 +++++++++---------- .../dynamics/ice_transport_driver.F90 | 4 +- .../cicedynB/dynamics/ice_transport_remap.F90 | 31 ++-------- 3 files changed, 36 insertions(+), 59 deletions(-) diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index ec5ad05fa..ea76e4639 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics.F90 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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, & @@ -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,*) ' ' @@ -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 @@ -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 diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index 390631eaa..ceb5651d2 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -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 diff --git a/cicecore/cicedynB/dynamics/ice_transport_remap.F90 b/cicecore/cicedynB/dynamics/ice_transport_remap.F90 index 330816529..ea51b559f 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_remap.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_remap.F90 @@ -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 @@ -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) :: & @@ -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 @@ -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 @@ -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