Skip to content

Add allocation checks for accumulating history variables. #631

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.

Sign up for GitHub

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

Merged
dabail10 merged 1 commit into from
Sep 10, 2021
Merged

Add allocation checks for accumulating history variables. #631

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
58 changes: 40 additions & 18 deletions cicecore/cicedynB/analysis/ice_history.F90
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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