Skip to content

Commit

Permalink
Add allocation checks for accumulating history variables. (#631)
Browse files Browse the repository at this point in the history
  • Loading branch information
@dabail10
dabail10 authored Sep 10, 2021
1 parent 6e89728 commit 554a302
Show file tree
Hide file tree
Showing 3 changed files with 72 additions and 47 deletions.
58 changes: 40 additions & 18 deletions cicecore/cicedynB/analysis/ice_history.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1624,6 +1624,8 @@ subroutine init_hist (dt)
write(nu_diag,*) 'The following variables will be ', &
'written to the history tape: '
write(nu_diag,101) 'description','units','variable','frequency','x'
if (num_avail_hist_fields_tot == 0) &
write(nu_diag,*) '*** WARNING: NO HISTORY FIELDS WILL BE WRITTEN ***'
do n=1,num_avail_hist_fields_tot
if (avail_hist_fields(n)%vhistfreq_n /= 0) &
write(nu_diag,100) avail_hist_fields(n)%vdesc, &
Expand Down Expand Up @@ -1888,13 +1890,16 @@ subroutine accum_hist (dt)
!$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, &
!$OMP k,n,qn,ns,sn,rho_ocn,rho_ice,Tice,Sbr,phi,rhob,dfresh,dfsalt, &
!$OMP worka,workb,worka3,Tinz4d,Sinz4d,Tsnz4d)

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

if (allocated(a2D)) then

workb(:,:) = aice_init(:,:,iblk)

! if (f_example(1:1) /= 'x') &
Expand Down Expand Up @@ -2879,6 +2884,10 @@ subroutine accum_hist (dt)
call accum_hist_field(n_siforceintstry, iblk, worka(:,:), a2D)
endif

endif ! if (allocated(a2D))

if (allocated(a3Dc)) then

! 3D category fields
if (f_aicen (1:1) /= 'x') &
call accum_hist_field(n_aicen-n2D, iblk, ncat_hist, &
Expand Down Expand Up @@ -2959,6 +2968,10 @@ subroutine accum_hist (dt)
call accum_hist_field(n_siitdsnthick-n2D, iblk, ncat_hist, worka3(:,:,:), a3Dc)
endif

endif ! if (allocated(a3Dc))

if (allocated(a4Di)) then

! example for 3D field (x,y,z)
! if (f_field3dz (1:1) /= 'x') &
! call accum_hist_field(n_field3dz-n3Dccum, iblk, nzilyr, &
Expand Down Expand Up @@ -2996,6 +3009,10 @@ subroutine accum_hist (dt)
Sinz4d(:,:,1:nzilyr,1:ncat_hist), a4Di)
endif

endif ! if (allocated(a3Dc))

if (allocated(a4Ds)) then

if (f_Tsnz (1:1) /= 'x') then
Tsnz4d(:,:,:,:) = c0
do n = 1, ncat_hist
Expand All @@ -3012,25 +3029,30 @@ subroutine accum_hist (dt)
Tsnz4d(:,:,1:nzslyr,1:ncat_hist), a4Ds)
endif

! Calculate aggregate surface melt flux by summing category values
if (f_fmeltt_ai(1:1) /= 'x') then
do ns = 1, nstreams
if (n_fmeltt_ai(ns) /= 0) then
worka(:,:) = c0
do j = jlo, jhi
do i = ilo, ihi
if (tmask(i,j,iblk)) then
do n=1,ncat_hist
worka(i,j) = worka(i,j) + a3Dc(i,j,n,n_fmelttn_ai(ns)-n2D,iblk)
enddo ! n
endif ! tmask
enddo ! i
enddo ! j
a2D(:,:,n_fmeltt_ai(ns),iblk) = worka(:,:)
endif
enddo
endif
endif ! if (allocated(a4Ds))

if (allocated(a3Dc) .and. allocated(a2D)) then

! Calculate aggregate surface melt flux by summing category values
if (f_fmeltt_ai(1:1) /= 'x') then
do ns = 1, nstreams
if (n_fmeltt_ai(ns) /= 0) then
worka(:,:) = c0
do j = jlo, jhi
do i = ilo, ihi
if (tmask(i,j,iblk)) then
do n=1,ncat_hist
worka(i,j) = worka(i,j) + a3Dc(i,j,n,n_fmelttn_ai(ns)-n2D,iblk)
enddo ! n
endif ! tmask
enddo ! i
enddo ! j
a2D(:,:,n_fmeltt_ai(ns),iblk) = worka(:,:)
endif
enddo
endif

endif
!---------------------------------------------------------------
! accumulate other history output
!---------------------------------------------------------------
Expand Down
58 changes: 29 additions & 29 deletions cicecore/cicedynB/analysis/ice_history_bgc.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -778,9 +778,9 @@ subroutine init_hist_bgc_2D

! 2D variables

if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then
if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then

do ns = 1, nstreams
do ns = 1, nstreams
if (histfreq(ns) /= 'x') then

if (f_iso(1:1) /= 'x') then
Expand Down Expand Up @@ -1782,9 +1782,9 @@ subroutine init_hist_bgc_2D
ns, f_hbri)

endif ! histfreq(ns) /= 'x'
enddo ! nstreams
enddo ! nstreams

endif ! tr_aero, etc
endif ! tr_aero, etc

end subroutine init_hist_bgc_2D

Expand Down Expand Up @@ -1841,7 +1841,7 @@ subroutine init_hist_bgc_3Db
if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
file=__FILE__, line=__LINE__)

if (z_tracers .or. solve_zsal) then
if (z_tracers .or. solve_zsal) then

do ns = 1, nstreams
if (histfreq(ns) /= 'x') then
Expand Down Expand Up @@ -1880,7 +1880,7 @@ subroutine init_hist_bgc_3Db
endif ! histfreq(ns) /= 'x'
enddo ! ns

endif ! z_tracers or solve_zsal
endif ! z_tracers or solve_zsal

end subroutine init_hist_bgc_3Db

Expand Down Expand Up @@ -2017,10 +2017,10 @@ subroutine accum_hist_bgc (iblk)
! increment field
!---------------------------------------------------------------

! 2d bgc fields
if (allocated(a2D)) then
! 2d bgc fields
if (allocated(a2D)) then

if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then
if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then

! zsalinity
if (f_fzsal (1:1) /= 'x') &
Expand Down Expand Up @@ -2082,7 +2082,7 @@ subroutine accum_hist_bgc (iblk)
enddo
endif

if (skl_bgc) then
if (skl_bgc) then

! skeletal layer bgc

Expand Down Expand Up @@ -2159,7 +2159,7 @@ subroutine accum_hist_bgc (iblk)
call accum_hist_field(n_bgc_DMS, iblk, &
sk_l*trcr(:,:,nt_bgc_DMS, iblk), a2D)

endif !skl_bgc
endif !skl_bgc

! skeletal layer and vertical bgc

Expand Down Expand Up @@ -2354,7 +2354,7 @@ subroutine accum_hist_bgc (iblk)

! vertical biogeochemistry

if (z_tracers) then
if (z_tracers) then

if (f_fzaero(1:1)/= 'x') then
do n=1,n_zaero
Expand Down Expand Up @@ -2634,30 +2634,30 @@ subroutine accum_hist_bgc (iblk)
call accum_hist_field(n_PONfrac, iblk, &
trcr(:,:,nt_zbgc_frac - 1 + nlt_bgc_PON, iblk), a2D)

endif ! z_tracers
endif ! z_tracers

! brine
if (f_hbri (1:1) /= 'x') &
call accum_hist_field(n_hbri, iblk, &
hbri(:,:,iblk), a2D)

endif ! 2d bgc tracers, tr_aero, tr_brine, solve_zsal, skl_bgc
endif ! allocated(a2D)
endif ! 2d bgc tracers, tr_aero, tr_brine, solve_zsal, skl_bgc
endif ! allocated(a2D)

! 3D category fields

if (allocated(a3Dc)) then
if (tr_brine) then
if (allocated(a3Dc)) then
if (tr_brine) then
! 3Dc bgc category fields

if (f_fbri (1:1) /= 'x') &
call accum_hist_field(n_fbri-n2D, iblk, ncat_hist, &
trcrn(:,:,nt_fbri,1:ncat_hist,iblk), a3Dc)
endif
endif ! allocated(a3Dc)
endif
endif ! allocated(a3Dc)

if (allocated(a3Db)) then
if (z_tracers .or. solve_zsal) then
if (allocated(a3Db)) then
if (z_tracers .or. solve_zsal) then
! 3Db category fields

if (f_bTin (1:1) /= 'x') then
Expand Down Expand Up @@ -2763,11 +2763,11 @@ subroutine accum_hist_bgc (iblk)
workz(:,:,1:nzblyr), a3Db)
endif

endif ! 3Db fields
endif ! allocated(a3Db)
endif ! 3Db fields
endif ! allocated(a3Db)

if (allocated(a3Da)) then
if (z_tracers) then
if (allocated(a3Da)) then
if (z_tracers) then
! 3Da category fields

if (f_zaero (1:1) /= 'x') then
Expand Down Expand Up @@ -3223,11 +3223,11 @@ subroutine init_hist_bgc_3Da
if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
file=__FILE__, line=__LINE__)

! snow+bio grid

if (z_tracers) then
! snow+bio grid
if (z_tracers) then

do ns = 1, nstreams
do ns = 1, nstreams
if (histfreq(ns) /= 'x') then

!----------------------------------------------------------------------------
Expand Down
3 changes: 3 additions & 0 deletions cicecore/cicedynB/analysis/ice_history_drag.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -263,6 +263,8 @@ subroutine accum_hist_drag (iblk)

! 2D fields

if (allocated(a2D)) then

if (f_Cdn_atm (1:1) /= 'x') &
call accum_hist_field(n_Cdn_atm, iblk, Cdn_atm(:,:,iblk), a2D)
if (f_Cdn_ocn (1:1) /= 'x') &
Expand Down Expand Up @@ -294,6 +296,7 @@ subroutine accum_hist_drag (iblk)
iblk, Cdn_ocn_skin(:,:,iblk), a2D)
end if

endif ! if(allocated(a2D))
endif ! formdrag

end subroutine accum_hist_drag
Expand Down

0 comments on commit 554a302

Please sign in to comment.