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

Clean up code and add several minor features #750

Merged
merged 12 commits into from
Aug 15, 2022
64 changes: 30 additions & 34 deletions cicecore/cicedynB/analysis/ice_diagnostics.F90
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 @@ -1249,9 +1249,6 @@ subroutine runtime_diags (dt)
endif ! print_points
endif ! my_task = master_task

799 format (27x,a24)
800 format (a25,2x,f24.17)
801 format (a25,2x,1pe24.17)
899 format (27x,a24,2x,a24)
900 format (a25,2x,f24.17,2x,f24.17)
901 format (a25,2x,1pe24.17,2x,1pe24.17)
Expand All @@ -1268,7 +1265,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 +1408,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 +1494,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,16 +1702,10 @@ 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

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

if (istep1 >= debug_model_step) then
Expand Down Expand Up @@ -1757,7 +1745,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 +1790,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 +2082,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 +2111,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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In the old code the global block ID was always printed, here it is only printed if istop and jstop are not both greater than zero, i.e. if we go through the else branch.

I think "Global block" should also be printed by print_state to keep the same amount of info. Sorry I missed that on my first review.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm adding it now. Good idea.

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
2 changes: 0 additions & 2 deletions cicecore/cicedynB/analysis/ice_diagnostics_bgc.F90
Original file line number Diff line number Diff line change
Expand Up @@ -846,7 +846,6 @@ subroutine bgc_diags
802 format (f24.17,2x,f24.17)
803 format (a25,2x,a25)
900 format (a25,2x,f24.17,2x,f24.17)
902 format (a25,10x,f6.1,1x,f6.1,9x,f6.1,1x,f6.1)
1020 format (a30,2x,i6) ! integer

end subroutine bgc_diags
Expand Down Expand Up @@ -1068,7 +1067,6 @@ subroutine zsal_diags
803 format (a25,2x,a25)
900 format (a25,2x,f24.17,2x,f24.17)
902 format (a25,10x,f6.1,1x,f6.1,9x,f6.1,1x,f6.1)
903 format (a25,5x,i4,1x,i4,1x,i4,1x,i4,7x,i4,1x,i4,1x,i4,1x,i4)

end subroutine zsal_diags

Expand Down
1 change: 0 additions & 1 deletion cicecore/cicedynB/analysis/ice_history_fsd.F90
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,6 @@ subroutine init_hist_fsd_2D

integer (kind=int_kind) :: ns
integer (kind=int_kind) :: nml_error ! namelist i/o error flag
real (kind=dbl_kind) :: secday
logical (kind=log_kind) :: tr_fsd, wave_spec

character(len=*), parameter :: subname = '(init_hist_fsd_2D)'
Expand Down
2 changes: 1 addition & 1 deletion cicecore/cicedynB/analysis/ice_history_shared.F90
Original file line number Diff line number Diff line change
Expand Up @@ -765,7 +765,7 @@ subroutine construct_filename(ncfile,suffix,ns)
iyear = myear
imonth = mmonth
iday = mday
isec = msec - dt
isec = int(msec - dt,int_kind)

! construct filename
if (write_ic) then
Expand Down
3 changes: 1 addition & 2 deletions cicecore/cicedynB/analysis/ice_history_snow.F90
Original file line number Diff line number Diff line change
Expand Up @@ -263,7 +263,6 @@ subroutine accum_hist_snow (iblk)

use ice_arrays_column, only: meltsliq
use ice_blocks, only: block, nx_block, ny_block
use ice_domain, only: blocks_ice
use ice_flux, only: fsloss
use ice_history_shared, only: n2D, a2D, a3Dc, ncat_hist, &
accum_hist_field, nzslyr
Expand All @@ -275,7 +274,7 @@ subroutine accum_hist_snow (iblk)
! local variables

integer (kind=int_kind) :: &
i, j, k, n
k, n

integer (kind=int_kind) :: &
nt_smice, nt_smliq, nt_rhos, nt_rsnw
Expand Down
6 changes: 3 additions & 3 deletions cicecore/cicedynB/dynamics/ice_dyn_evp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -98,12 +98,12 @@ subroutine evp (dt)
stress12_1, stress12_2, stress12_3, stress12_4, &
stresspT, stressmT, stress12T, &
stresspU, stressmU, stress12U
use ice_grid, only: hm, tmask, umask, umaskCD, nmask, emask, uvm, epm, npm, &
use ice_grid, only: tmask, umask, umaskCD, nmask, emask, uvm, epm, npm, &
iceumask, iceemask, icenmask, &
dxE, dxN, dxT, dxU, dyE, dyN, dyT, dyU, &
ratiodxN, ratiodxNr, ratiodyE, ratiodyEr, &
dxhy, dyhx, cxp, cyp, cxm, cym, &
tarear, uarear, earear, narear, grid_average_X2Y, tarea, uarea, &
tarear, uarear, earear, narear, grid_average_X2Y, uarea, &
grid_type, grid_ice, &
grid_atm_dynu, grid_atm_dynv, grid_ocn_dynu, grid_ocn_dynv
use ice_state, only: aice, vice, vsno, uvel, vvel, uvelN, vvelN, &
Expand Down Expand Up @@ -1408,7 +1408,7 @@ subroutine stress (nx_block, ny_block, &
csigmne, csigmnw, csigmse, csigmsw , &
csig12ne, csig12nw, csig12se, csig12sw , &
str12ew, str12we, str12ns, str12sn , &
strp_tmp, strm_tmp, tmp
strp_tmp, strm_tmp

character(len=*), parameter :: subname = '(stress)'

Expand Down
3 changes: 1 addition & 2 deletions cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90
Original file line number Diff line number Diff line change
Expand Up @@ -779,8 +779,7 @@ subroutine stepu_last(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, &

use ice_kinds_mod
use ice_constants, only : c0, c1
use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw, &
seabed_stress
use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw

implicit none

Expand Down
28 changes: 5 additions & 23 deletions cicecore/cicedynB/dynamics/ice_dyn_shared.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2326,7 +2326,7 @@ end subroutine visc_replpress
subroutine dyn_haloUpdate1(halo_info, halo_info_mask, field_loc, field_type, fld1)

use ice_boundary, only: ice_halo, ice_HaloUpdate
use ice_domain, only: nblocks, maskhalo_dyn, halo_dynbundle
use ice_domain, only: maskhalo_dyn, halo_dynbundle
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

type (ice_halo), intent(in) :: &
Expand All @@ -2342,12 +2342,6 @@ subroutine dyn_haloUpdate1(halo_info, halo_info_mask, field_loc, field_type, fld

! local variables

integer (kind=int_kind) :: &
iblk ! iblock

real (kind=dbl_kind), dimension (nx_block,ny_block,1,max_blocks) :: &
fldbundle ! work array for boundary updates

character(len=*), parameter :: subname = '(dyn_haloUpdate1)'

call ice_timer_start(timer_bound)
Expand All @@ -2370,7 +2364,7 @@ end subroutine dyn_haloUpdate1
subroutine dyn_haloUpdate2(halo_info, halo_info_mask, field_loc, field_type, fld1, fld2)

use ice_boundary, only: ice_halo, ice_HaloUpdate
use ice_domain, only: nblocks, maskhalo_dyn, halo_dynbundle
use ice_domain, only: maskhalo_dyn, halo_dynbundle
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

type (ice_halo), intent(in) :: &
Expand All @@ -2387,9 +2381,6 @@ subroutine dyn_haloUpdate2(halo_info, halo_info_mask, field_loc, field_type, fld

! local variables

integer (kind=int_kind) :: &
iblk ! iblock

real (kind=dbl_kind), dimension (nx_block,ny_block,2,max_blocks) :: &
fldbundle ! work array for boundary updates

Expand Down Expand Up @@ -2434,7 +2425,7 @@ end subroutine dyn_haloUpdate2
subroutine dyn_haloUpdate3(halo_info, halo_info_mask, field_loc, field_type, fld1, fld2, fld3)

use ice_boundary, only: ice_halo, ice_HaloUpdate
use ice_domain, only: nblocks, maskhalo_dyn, halo_dynbundle
use ice_domain, only: maskhalo_dyn, halo_dynbundle
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

type (ice_halo), intent(in) :: &
Expand All @@ -2452,9 +2443,6 @@ subroutine dyn_haloUpdate3(halo_info, halo_info_mask, field_loc, field_type, fld

! local variables

integer (kind=int_kind) :: &
iblk ! iblock

real (kind=dbl_kind), dimension (nx_block,ny_block,3,max_blocks) :: &
fldbundle ! work array for boundary updates

Expand Down Expand Up @@ -2503,7 +2491,7 @@ end subroutine dyn_haloUpdate3
subroutine dyn_haloUpdate4(halo_info, halo_info_mask, field_loc, field_type, fld1, fld2, fld3, fld4)

use ice_boundary, only: ice_halo, ice_HaloUpdate
use ice_domain, only: nblocks, maskhalo_dyn, halo_dynbundle
use ice_domain, only: maskhalo_dyn, halo_dynbundle
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

type (ice_halo), intent(in) :: &
Expand All @@ -2522,9 +2510,6 @@ subroutine dyn_haloUpdate4(halo_info, halo_info_mask, field_loc, field_type, fld

! local variables

integer (kind=int_kind) :: &
iblk ! iblock

real (kind=dbl_kind), dimension (nx_block,ny_block,4,max_blocks) :: &
fldbundle ! work array for boundary updates

Expand Down Expand Up @@ -2577,7 +2562,7 @@ end subroutine dyn_haloUpdate4
subroutine dyn_haloUpdate5(halo_info, halo_info_mask, field_loc, field_type, fld1, fld2, fld3, fld4, fld5)

use ice_boundary, only: ice_halo, ice_HaloUpdate
use ice_domain, only: nblocks, maskhalo_dyn, halo_dynbundle
use ice_domain, only: maskhalo_dyn, halo_dynbundle
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

type (ice_halo), intent(in) :: &
Expand All @@ -2597,9 +2582,6 @@ subroutine dyn_haloUpdate5(halo_info, halo_info_mask, field_loc, field_type, fld

! local variables

integer (kind=int_kind) :: &
iblk ! iblock

real (kind=dbl_kind), dimension (nx_block,ny_block,5,max_blocks) :: &
fldbundle ! work array for boundary updates

Expand Down
9 changes: 6 additions & 3 deletions cicecore/cicedynB/dynamics/ice_dyn_vp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,8 @@ module ice_dyn_vp
dim_pgmres , & ! size of pgmres Krylov subspace
maxits_fgmres , & ! max nb of iteration for fgmres
maxits_pgmres , & ! max nb of iteration for pgmres
fpfunc_andacc , & ! fixed point function for Anderson acceleration: 1: g(x) = FMGRES(A(x),b(x)), 2: g(x) = x - A(x)x + b(x)
fpfunc_andacc , & ! fixed point function for Anderson acceleration: 1:
! g(x) = FMGRES(A(x),b(x)), 2: g(x) = x - A(x)x + b(x)
dim_andacc , & ! size of Anderson minimization matrix (number of saved previous residuals)
start_andacc ! acceleration delay factor (acceleration starts at this iteration)

Expand All @@ -87,7 +88,8 @@ module ice_dyn_vp
reltol_andacc ! relative tolerance for Anderson acceleration

character (len=char_len), public :: &
precond , & ! preconditioner for fgmres: 'ident' (identity), 'diag' (diagonal), 'pgmres' (Jacobi-preconditioned GMRES)
precond , & ! preconditioner for fgmres: 'ident' (identity), 'diag' (diagonal), 'pgmres'
! (Jacobi-preconditioned GMRES)
algo_nonlin , & ! nonlinear algorithm: 'picard' (Picard iteration), 'anderson' (Anderson acceleration)
ortho_type ! type of orthogonalization for FGMRES ('cgs' or 'mgs')

Expand Down Expand Up @@ -1095,7 +1097,8 @@ subroutine anderson_solver (icellt , icellu , &
endif
#else
! Anderson solver is not usable without LAPACK; abort
call abort_ice(error_message=subname // " CICE was not compiled with LAPACK, and Anderson solver was chosen (algo_nonlin = 'anderson')" , &
call abort_ice(error_message=subname // " CICE was not compiled with LAPACK, "// &
"and Anderson solver was chosen (algo_nonlin = 'anderson')" , &
file=__FILE__, line=__LINE__)
#endif
endif
Expand Down
5 changes: 2 additions & 3 deletions cicecore/cicedynB/dynamics/ice_transport_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module ice_transport_driver
field_type_scalar, field_type_vector, &
field_loc_NEcorner, &
field_loc_Nface, field_loc_Eface
use ice_diagnostics, only: diagnostic_abort
use ice_fileunits, only: nu_diag
use ice_exit, only: abort_ice
use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
Expand Down Expand Up @@ -688,9 +689,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
Loading