Skip to content

Commit

Permalink
fv3atm NOAA-EMC#15:Add support for GEFS-Aerosols restart capability
Browse files Browse the repository at this point in the history
  • Loading branch information
junwang-noaa committed Dec 16, 2019
1 parent 5d51b12 commit 833461e
Show file tree
Hide file tree
Showing 4 changed files with 57 additions and 11 deletions.
21 changes: 20 additions & 1 deletion atmos_model.F90
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,8 @@ module atmos_model_mod
logical,parameter :: flip_vc = .true.
#endif

real(kind=IPD_kind_phys), parameter :: zero=0.0, one=1.0
real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, &
one = 1.0_IPD_kind_phys

contains

Expand Down Expand Up @@ -1462,6 +1463,24 @@ subroutine update_atmos_chemistry(state, rc)
enddo
enddo

! -- zero out accumulated fields
!$OMP parallel do default (none) &
!$OMP shared (nj, ni, Atm_block, IPD_Control, IPD_Data) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
ib = i + Atm_block%isc - 1
nb = Atm_block%blkno(ib,jb)
ix = Atm_block%ixp(ib,jb)
IPD_Data(nb)%coupling%rainc_cpl(ix) = zero
if (.not.IPD_Control%cplflx) then
IPD_Data(nb)%coupling%rain_cpl(ix) = zero
IPD_Data(nb)%coupling%snow_cpl(ix) = zero
end if
enddo
enddo

if (IPD_Control%debug) then
! -- diagnostics
write(6,'("update_atmos: prsi - min/max/avg",3g16.6)') minval(prsi), maxval(prsi), sum(prsi)/size(prsi)
Expand Down
8 changes: 6 additions & 2 deletions gfsphysics/GFS_layer/GFS_physics_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3184,9 +3184,13 @@ subroutine GFS_physics_driver &
dtdt(1:im,:) = Stateout%gt0(1:im,:)
endif ! end if_ldiag3d/cnvgwd

if (Model%ldiag3d) then
if (Model%ldiag3d .or. Model%cplchm) then
dqdt(1:im,:,1) = Stateout%gq0(1:im,:,1)
endif ! end if_ldiag3d
endif ! end if_ldiag3d/cplchm

if (Model%cplchm) then
Coupling%dqdti(1:im,:) = zero
endif ! end if_cplchm

#ifdef GFS_HYDRO
call get_phi(im, ix, levs, ntrac, Stateout%gt0, Stateout%gq0, &
Expand Down
38 changes: 30 additions & 8 deletions gfsphysics/GFS_layer/GFS_radiation_driver.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2116,18 +2116,40 @@ subroutine GFS_radiation_driver &
Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt)
Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb)
Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop)
enddo
enddo

! Anning adds optical depth and emissivity output
tem1 = 0.
tem2 = 0.
do k=ibtc,itop
tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel
tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel
if (Model%lsswr .and. (nday > 0)) then
do j = 1, 3
do i = 1, IM
tem0d = raddt * cldsa(i,j)
itop = mtopa(i,j) - kd
ibtc = mbota(i,j) - kd
tem1 = 0.
do k=ibtc,itop
tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel
enddo
Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
enddo
Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1
Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
enddo
enddo
endif

if (Model%lslwr) then
do j = 1, 3
do i = 1, IM
tem0d = raddt * cldsa(i,j)
itop = mtopa(i,j) - kd
ibtc = mbota(i,j) - kd
tem2 = 0.
do k=ibtc,itop
tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel
enddo
Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
enddo
enddo
endif

endif

endif ! end_if_lssav
Expand Down
1 change: 1 addition & 0 deletions gfsphysics/physics/sflx.f
Original file line number Diff line number Diff line change
Expand Up @@ -251,6 +251,7 @@ subroutine sflx &
runoff2 = 0.0
runoff3 = 0.0
snomlt = 0.0
rc = 0.0

! --- ... define local variable ice to achieve:
! sea-ice case, ice = 1
Expand Down

0 comments on commit 833461e

Please sign in to comment.