Skip to content

Commit

Permalink
Update CICE from Consortium/main (NOAA-EMC#62)
Browse files Browse the repository at this point in the history 
* Fix CESMCOUPLED compile issue in icepack. (CICE-Consortium#823)
* Update global reduction implementation to improve performance, fix VP bug (CICE-Consortium#824)
* Update VP global sum to exclude local implementation with tripole grids
* Add functionality to change hist_avg for each stream (CICE-Consortium#827)
* Update Icepack to #6703bc533c968 May 22, 2023 (CICE-Consortium#829)
* Fix for mesh check in CESM driver (CICE-Consortium#830)
* Namelist option for time axis position. (CICE-Consortium#839)
  • Loading branch information
@DeniseWorthen
DeniseWorthen committed May 10, 2024
1 parent a4cc8f6 commit 6bc1c14
Show file tree
Hide file tree
Showing 57 changed files with 2,738 additions and 1,719 deletions.
162 changes: 2 additions & 160 deletions cicecore/cicedyn/analysis/ice_diagnostics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -261,10 +261,8 @@ subroutine runtime_diags (dt)
!$OMP END PARALLEL DO
extentn = c0
extents = c0
extentn = global_sum(work1, distrb_info, field_loc_center, &
tarean)
extents = global_sum(work1, distrb_info, field_loc_center, &
tareas)
extentn = global_sum(work1, distrb_info, field_loc_center, tarean)
extents = global_sum(work1, distrb_info, field_loc_center, tareas)
extentn = extentn * m2_to_km2
extents = extents * m2_to_km2

Expand Down Expand Up @@ -1945,162 +1943,6 @@ subroutine print_state(plabel,i,j,iblk)
end subroutine print_state

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

! This routine is useful for debugging.

subroutine print_points_state(plabel,ilabel)

use ice_grid, only: grid_ice
use ice_blocks, only: block, get_block
use ice_domain, only: blocks_ice
use ice_domain_size, only: ncat, nilyr, nslyr
use ice_state, only: aice0, aicen, vicen, vsnon, uvel, vvel, &
uvelE, vvelE, uvelE, vvelE, trcrn
use ice_flux, only: uatm, vatm, potT, Tair, Qa, flw, frain, fsnow, &
fsens, flat, evap, flwout, swvdr, swvdf, swidr, swidf, rhoa, &
frzmlt, sst, sss, Tf, Tref, Qref, Uref, uocn, vocn, strtltxU, strtltyU

character (len=*), intent(in),optional :: plabel
integer , intent(in),optional :: ilabel

! local variables

real (kind=dbl_kind) :: &
eidebug, esdebug, &
qi, qs, &
puny

integer (kind=int_kind) :: m, n, k, i, j, iblk, nt_Tsfc, nt_qice, nt_qsno
character(len=256) :: llabel

type (block) :: &
this_block ! block information for current block

character(len=*), parameter :: subname = '(print_points_state)'
! ----------------------

call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, &
nt_qsno_out=nt_qsno)
call icepack_query_parameters(puny_out=puny)
call icepack_warnings_flush(nu_diag)
if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
file=__FILE__, line=__LINE__)

do m = 1, npnt
if (my_task == pmloc(m)) then
i = piloc(m)
j = pjloc(m)
iblk = pbloc(m)
this_block = get_block(blocks_ice(iblk),iblk)

if (present(ilabel)) then
write(llabel,'(i6,a1,i3,a1)') ilabel,':',m,':'
else
write(llabel,'(i3,a1)') m,':'
endif
if (present(plabel)) then
write(llabel,'(a)') 'pps:'//trim(plabel)//':'//trim(llabel)
else
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=', &
this_block%i_glob(i), &
this_block%j_glob(j)
write(nu_diag,*) trim(llabel),'aice0=', aice0(i,j,iblk)

do n = 1, ncat
write(nu_diag,*) trim(llabel),'aicen=', n,aicen(i,j,n,iblk)
write(nu_diag,*) trim(llabel),'vicen=', n,vicen(i,j,n,iblk)
write(nu_diag,*) trim(llabel),'vsnon=', n,vsnon(i,j,n,iblk)
if (aicen(i,j,n,iblk) > puny) then
write(nu_diag,*) trim(llabel),'hin=', n,vicen(i,j,n,iblk)/aicen(i,j,n,iblk)
write(nu_diag,*) trim(llabel),'hsn=', n,vsnon(i,j,n,iblk)/aicen(i,j,n,iblk)
endif
write(nu_diag,*) trim(llabel),'Tsfcn=',n,trcrn(i,j,nt_Tsfc,n,iblk)
enddo

eidebug = c0
do n = 1,ncat
do k = 1,nilyr
qi = trcrn(i,j,nt_qice+k-1,n,iblk)
write(nu_diag,*) trim(llabel),'qice= ',n,k, qi
eidebug = eidebug + qi
enddo
enddo
write(nu_diag,*) trim(llabel),'qice=',eidebug

esdebug = c0
do n = 1,ncat
if (vsnon(i,j,n,iblk) > puny) then
do k = 1,nslyr
qs = trcrn(i,j,nt_qsno+k-1,n,iblk)
write(nu_diag,*) trim(llabel),'qsnow=',n,k, qs
esdebug = esdebug + qs
enddo
endif
enddo
write(nu_diag,*) trim(llabel),'qsnow=',esdebug

write(nu_diag,*) trim(llabel),'uvel=',uvel(i,j,iblk)
write(nu_diag,*) trim(llabel),'vvel=',vvel(i,j,iblk)
if (grid_ice == 'C') then
write(nu_diag,*) trim(llabel),'uvelE=',uvelE(i,j,iblk)
write(nu_diag,*) trim(llabel),'vvelN=',vvelN(i,j,iblk)
elseif (grid_ice == 'CD') then
write(nu_diag,*) trim(llabel),'uvelE=',uvelE(i,j,iblk)
write(nu_diag,*) trim(llabel),'vvelE=',vvelE(i,j,iblk)
write(nu_diag,*) trim(llabel),'uvelN=',uvelN(i,j,iblk)
write(nu_diag,*) trim(llabel),'vvelN=',vvelN(i,j,iblk)
endif

write(nu_diag,*) ' '
write(nu_diag,*) 'atm states and fluxes'
write(nu_diag,*) ' uatm = ',uatm (i,j,iblk)
write(nu_diag,*) ' vatm = ',vatm (i,j,iblk)
write(nu_diag,*) ' potT = ',potT (i,j,iblk)
write(nu_diag,*) ' Tair = ',Tair (i,j,iblk)
write(nu_diag,*) ' Qa = ',Qa (i,j,iblk)
write(nu_diag,*) ' rhoa = ',rhoa (i,j,iblk)
write(nu_diag,*) ' swvdr = ',swvdr(i,j,iblk)
write(nu_diag,*) ' swvdf = ',swvdf(i,j,iblk)
write(nu_diag,*) ' swidr = ',swidr(i,j,iblk)
write(nu_diag,*) ' swidf = ',swidf(i,j,iblk)
write(nu_diag,*) ' flw = ',flw (i,j,iblk)
write(nu_diag,*) ' frain = ',frain(i,j,iblk)
write(nu_diag,*) ' fsnow = ',fsnow(i,j,iblk)
write(nu_diag,*) ' '
write(nu_diag,*) 'ocn states and fluxes'
write(nu_diag,*) ' frzmlt = ',frzmlt (i,j,iblk)
write(nu_diag,*) ' sst = ',sst (i,j,iblk)
write(nu_diag,*) ' sss = ',sss (i,j,iblk)
write(nu_diag,*) ' Tf = ',Tf (i,j,iblk)
write(nu_diag,*) ' uocn = ',uocn (i,j,iblk)
write(nu_diag,*) ' vocn = ',vocn (i,j,iblk)
write(nu_diag,*) ' strtltxU= ',strtltxU(i,j,iblk)
write(nu_diag,*) ' strtltyU= ',strtltyU(i,j,iblk)
write(nu_diag,*) ' '
write(nu_diag,*) 'srf states and fluxes'
write(nu_diag,*) ' Tref = ',Tref (i,j,iblk)
write(nu_diag,*) ' Qref = ',Qref (i,j,iblk)
write(nu_diag,*) ' Uref = ',Uref (i,j,iblk)
write(nu_diag,*) ' fsens = ',fsens (i,j,iblk)
write(nu_diag,*) ' flat = ',flat (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)

endif ! my_task
enddo ! ncnt

end subroutine print_points_state
#endif
!=======================================================================

! prints error information prior to aborting

Expand Down
4 changes: 2 additions & 2 deletions cicecore/cicedyn/analysis/ice_history.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -263,7 +263,7 @@ subroutine init_hist (dt)
trim(tmpstr2), file=__FILE__, line=__LINE__)
endif
end do

close(nu_nml)
call release_fileunit(nu_nml)
endif
Expand Down Expand Up @@ -2225,7 +2225,7 @@ subroutine accum_hist (dt)
n4Dfcum = n4Dscum + num_avail_hist_fields_4Df ! should equal num_avail_hist_fields_tot

do ns = 1,nstreams
if (.not. hist_avg) then ! write snapshots
if (.not. hist_avg(ns)) then ! write snapshots
do n = 1,n2D
if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) &
a2D(:,:,n,:) = c0
Expand Down
6 changes: 3 additions & 3 deletions cicecore/cicedyn/analysis/ice_history_pond.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,14 +100,14 @@ subroutine init_hist_pond_2D
trim(nml_filename), &
file=__FILE__, line=__LINE__)
endif

! goto this namelist in file
call goto_nml(nu_nml,trim(nml_name),nml_error)
if (nml_error /= 0) then
call abort_ice(subname//'ERROR: searching for '// trim(nml_name), &
file=__FILE__, line=__LINE__)
endif

! read namelist
nml_error = 1
do while (nml_error > 0)
Expand All @@ -121,7 +121,7 @@ subroutine init_hist_pond_2D
trim(tmpstr2), file=__FILE__, line=__LINE__)
endif
end do

close(nu_nml)
call release_fileunit(nu_nml)
endif
Expand Down
8 changes: 5 additions & 3 deletions cicecore/cicedyn/analysis/ice_history_shared.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ module ice_history_shared
integer (kind=int_kind), public :: history_precision

logical (kind=log_kind), public :: &
hist_avg ! if true, write averaged data instead of snapshots
hist_avg(max_nstrm) ! if true, write averaged data instead of snapshots

character (len=char_len_long), public :: &
history_file , & ! output file for history
Expand Down Expand Up @@ -132,6 +132,8 @@ module ice_history_shared
time_end(max_nstrm), &
time_bounds(2)

character (len=char_len), public :: hist_time_axis

real (kind=dbl_kind), allocatable, public :: &
a2D (:,:,:,:) , & ! field accumulations/averages, 2D
a3Dz(:,:,:,:,:) , & ! field accumulations/averages, 3D vertical
Expand Down Expand Up @@ -743,7 +745,7 @@ subroutine construct_filename(ncfile,suffix,ns)
imonth,'-',iday,'-',isec,'.',trim(suffix)
else

if (hist_avg) then
if (hist_avg(ns)) then
if (histfreq(ns) == '1' .or. histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then
! do nothing
elseif (new_year) then
Expand All @@ -763,7 +765,7 @@ subroutine construct_filename(ncfile,suffix,ns)
!echmod ! of other groups (including RASM which uses CESMCOUPLED)
!echmod if (ns > 1) write(cstream,'(i1.1)') ns-1

if (hist_avg) then ! write averaged data
if (hist_avg(ns)) then ! write averaged data
if (histfreq(ns) == '1' .and. histfreq_n(ns) == 1) then ! timestep
write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') &
history_file(1:lenstr(history_file))//trim(cstream),'_inst.', &
Expand Down
2 changes: 1 addition & 1 deletion cicecore/cicedyn/analysis/ice_history_snow.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@ subroutine init_hist_snow_2D (dt)
integer (kind=int_kind) :: ns
integer (kind=int_kind) :: nml_error ! namelist i/o error flag
real (kind=dbl_kind) :: rhofresh, secday
logical (kind=log_kind) :: tr_snow
logical (kind=log_kind) :: tr_snow
character(len=char_len_long) :: tmpstr2 ! for namelist check
character(len=char_len) :: nml_name ! for namelist check

Expand Down
41 changes: 21 additions & 20 deletions cicecore/cicedyn/dynamics/ice_dyn_vp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2502,7 +2502,7 @@ function global_dot_product (nx_block , ny_block , &
vector2_x , vector2_y) &
result(dot_product)

use ice_domain, only: distrb_info
use ice_domain, only: distrb_info, ns_boundary_type
use ice_domain_size, only: max_blocks
use ice_fileunits, only: bfbflag

Expand Down Expand Up @@ -2552,8 +2552,14 @@ function global_dot_product (nx_block , ny_block , &
enddo
!$OMP END PARALLEL DO

! Use local summation result unless bfbflag is active
if (bfbflag == 'off') then
! Use faster local summation result for several bfbflag settings.
! The local implementation sums over each block, sums over local
! blocks, and calls global_sum on a scalar and should be just as accurate as
! bfbflag = 'off', 'lsum8', and 'lsum4' without the extra copies and overhead
! in the more general array global_sum. But use the array global_sum
! if bfbflag is more strict or for tripole grids (requires special masking)
if (ns_boundary_type /= 'tripole' .and. ns_boundary_type /= 'tripoleT' .and. &
(bfbflag == 'off' .or. bfbflag == 'lsum8' .or. bfbflag == 'lsum4')) then
dot_product = global_sum(sum(dot), distrb_info)
else
dot_product = global_sum(prod, distrb_info, field_loc_NEcorner)
Expand Down Expand Up @@ -3120,7 +3126,7 @@ subroutine fgmres (zetax2 , etax2 , &
j = indxUj(ij, iblk)

workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it)
workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it)
workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it)
enddo ! ij
enddo
!$OMP END PARALLEL DO
Expand Down Expand Up @@ -3151,7 +3157,6 @@ subroutine pgmres (zetax2 , etax2 , &

use ice_boundary, only: ice_HaloUpdate
use ice_domain, only: maskhalo_dyn, halo_info
use ice_fileunits, only: bfbflag
use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound

real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: &
Expand Down Expand Up @@ -3343,21 +3348,17 @@ subroutine pgmres (zetax2 , etax2 , &
workspace_x , workspace_y)

! Update workspace with boundary values
! NOTE: skipped for efficiency since this is just a preconditioner
! unless bfbflag is active
if (bfbflag /= 'off') then
call stack_fields(workspace_x, workspace_y, fld2)
call ice_timer_start(timer_bound)
if (maskhalo_dyn) then
call ice_HaloUpdate (fld2, halo_info_mask, &
field_loc_NEcorner, field_type_vector)
else
call ice_HaloUpdate (fld2, halo_info, &
field_loc_NEcorner, field_type_vector)
endif
call ice_timer_stop(timer_bound)
call unstack_fields(fld2, workspace_x, workspace_y)
call stack_fields(workspace_x, workspace_y, fld2)
call ice_timer_start(timer_bound)
if (maskhalo_dyn) then
call ice_HaloUpdate (fld2, halo_info_mask, &
field_loc_NEcorner, field_type_vector)
else
call ice_HaloUpdate (fld2, halo_info, &
field_loc_NEcorner, field_type_vector)
endif
call ice_timer_stop(timer_bound)
call unstack_fields(fld2, workspace_x, workspace_y)

!$OMP PARALLEL DO PRIVATE(iblk)
do iblk = 1, nblocks
Expand Down Expand Up @@ -3528,7 +3529,7 @@ subroutine pgmres (zetax2 , etax2 , &
j = indxUj(ij, iblk)

workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it)
workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it)
workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it)
enddo ! ij
enddo
!$OMP END PARALLEL DO
Expand Down
Loading

0 comments on commit 6bc1c14

Please sign in to comment.