Skip to content

Commit

Permalink
Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics in…
Browse files Browse the repository at this point in the history
…to HAFS_fer_hires
  • Loading branch information
mzhangw committed Feb 7, 2020
2 parents 8d87e55 + 73f9f09 commit 27c1fcb
Show file tree
Hide file tree
Showing 24 changed files with 2,461 additions and 158 deletions.
17 changes: 12 additions & 5 deletions physics/GFS_DCNV_generic.F90
Original file line number Diff line number Diff line change
Expand Up @@ -17,17 +17,17 @@ end subroutine GFS_DCNV_generic_pre_finalize
!! \htmlinclude GFS_DCNV_generic_pre_run.html
!!
#endif
subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, &
subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca, cplchm,&
isppt_deep, gu0, gv0, gt0, gq0_water_vapor, &
save_u, save_v, save_t, save_qv, ca_deep, &
errmsg, errflg)
dqdti, errmsg, errflg)

use machine, only: kind_phys
use machine, only: kind_phys

implicit none

integer, intent(in) :: im, levs
logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, isppt_deep
logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep
real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0
real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0
real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0
Expand All @@ -37,9 +37,12 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca,
real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t
real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv
real(kind=kind_phys), dimension(im), intent(in) :: ca_deep
! dqdti only allocated if cplchm is .true.
real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

real(kind=kind_phys), parameter :: zero = 0.0d0
integer :: i, k

! Initialize CCPP error handling variables
Expand Down Expand Up @@ -70,14 +73,18 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, do_cnvgwd, do_ca,
enddo
endif

if (ldiag3d .or. isppt_deep) then
if (ldiag3d .or. cplchm .or. isppt_deep) then
do k=1,levs
do i=1,im
save_qv(i,k) = gq0_water_vapor(i,k)
enddo
enddo
endif

if (cplchm) then
dqdti = zero
endif

end subroutine GFS_DCNV_generic_pre_run

end module GFS_DCNV_generic_pre
Expand Down
17 changes: 17 additions & 0 deletions physics/GFS_DCNV_generic.meta
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,14 @@
type = logical
intent = in
optional = F
[cplchm]
standard_name = flag_for_chemistry_coupling
long_name = flag controlling cplchm collection (default off)
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[isppt_deep]
standard_name = flag_for_combination_of_sppt_with_isppt_deep
long_name = switch for combination with isppt_deep.
Expand Down Expand Up @@ -130,6 +138,15 @@
kind = kind_phys
intent = in
optional = F
[dqdti]
standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection
long_name = instantaneous moisture tendency due to convection
units = kg kg-1 s-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = inout
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
42 changes: 32 additions & 10 deletions physics/GFS_rrtmg_post.F90
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ end subroutine GFS_rrtmg_post_init
!!
subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, &
cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, &
cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, &
errmsg, errflg)

use machine, only: kind_phys
Expand All @@ -41,7 +41,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
type(GFS_diag_type), intent(inout) :: Diag
type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw

integer, intent(in) :: im, lm, ltp, kt, kb, kd
integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday
real(kind=kind_phys), intent(in) :: raddt

real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp
Expand Down Expand Up @@ -152,18 +152,40 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, &
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
8 changes: 8 additions & 0 deletions physics/GFS_rrtmg_post.meta
Original file line number Diff line number Diff line change
Expand Up @@ -180,6 +180,14 @@
kind = kind_phys
intent = in
optional = F
[nday]
standard_name = daytime_points_dimension
long_name = daytime points dimension
units = count
dimensions = ()
type = integer
intent = in
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
9 changes: 5 additions & 4 deletions physics/GFS_surface_generic.F90
Original file line number Diff line number Diff line change
Expand Up @@ -187,10 +187,11 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc,

if (cplflx) then
do i=1,im
islmsk_cice(i) = int(slimskin_cpl(i)+0.5)
if(islmsk_cice(i) == 4)then
flag_cice(i) = .true.
ulwsfc_cice(i) = ulwsfcin_cpl(i)
islmsk_cice(i) = nint(slimskin_cpl(i))
flag_cice(i) = (islmsk_cice(i) == 4)

if (flag_cice(i)) then
! ulwsfc_cice(i) = ulwsfcin_cpl(i)
dusfc_cice(i) = dusfcin_cpl(i)
dvsfc_cice(i) = dvsfcin_cpl(i)
dtsfc_cice(i) = dtsfcin_cpl(i)
Expand Down
79 changes: 48 additions & 31 deletions physics/cu_ntiedtke.F90
Original file line number Diff line number Diff line change
Expand Up @@ -148,7 +148,7 @@ end subroutine cu_ntiedtke_finalize
!-----------------------------------------------------------------------
! level 1 subroutine 'tiecnvn'
!-----------------------------------------------------------------
subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
evap,hfx,zprecc,lmask,lq,ix,km,dt,dx,kbot,ktop,kcnv,&
ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg)
!-----------------------------------------------------------------
Expand All @@ -162,13 +162,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
integer, dimension( lq ), intent(in) :: lmask
real(kind=kind_phys), dimension( lq ), intent(in ) :: evap, hfx, dx
real(kind=kind_phys), dimension( ix , km ), intent(inout) :: pu, pv, pt, pqv
real(kind=kind_phys), dimension( ix , km ), intent(in ) :: poz, prsl, pomg, pqvf, ptf
real(kind=kind_phys), dimension( ix , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf
real(kind=kind_phys), dimension( ix , km+1 ), intent(in ) :: pzz, prsi
! DH* TODO - check dimensions of clw, ktrac+2 seems to be smaller
! than the actual dimensions (ok as long as only indices 1 and 2
! are accessed here, and as long as these contain what is expected);
! better to expand into the cloud-ice and cloud-water components *DH
real(kind=kind_phys), dimension( ix , km, ktrac+2 ), intent(inout ) :: clw
real(kind=kind_phys), dimension( ix , km, ktrac ), intent(inout ) :: clw

integer, dimension( lq ), intent(out) :: kbot, ktop, kcnv
real(kind=kind_phys), dimension( lq ), intent(out) :: zprecc
Expand All @@ -188,13 +184,13 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
real(kind=kind_phys) ztp1(lq,km), zqp1(lq,km), ztu(lq,km), zqu(lq,km),&
& zlu(lq,km), zlude(lq,km), zmfu(lq,km), zmfd(lq,km), zmfude_rate(lq,km),&
& zqsat(lq,km), zrain(lq)
real(kind=kind_phys) pcen(lq,km,ktrac),ptenc(lq,km,ktrac)
real(kind=kind_phys),allocatable :: pcen(:,:,:),ptenc(:,:,:)

integer icbot(lq), ictop(lq), ktype(lq), lndj(lq)
logical locum(lq)
!
real(kind=kind_phys) ztmst,fliq,fice,ztc,zalf,tt
integer i,j,k,k1,n,km1
integer i,j,k,k1,n,km1,ktracer
real(kind=kind_phys) ztpp1
real(kind=kind_phys) zew,zqs,zcor
!
Expand Down Expand Up @@ -246,9 +242,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
zqs = min(0.5,zqs)
zcor = 1./(1.-vtmpc1*zqs)
zqsat(j,k1)=zqs*zcor
pqte(j,k1)=pqvf(j,k)
pqte(j,k1)=pqvf(j,k)+(pqv(j,k)-qvdi(j,k))/ztmst
zqq(j,k1) =pqte(j,k1)
ptte(j,k1)=ptf(j,k)
ptte(j,k1)=ptf(j,k)+(pt(j,k)-tdi(j,k))/ztmst
ztt(j,k1) =ptte(j,k1)
ud_mf(j,k1)=0.
dd_mf(j,k1)=0.
Expand All @@ -258,16 +254,33 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
end do
end do

do n=1,ktrac
do k=1,km
k1=km-k+1
do j=1,lq
pcen(j,k1,n) = clw(j,k,n+2)
ptenc(j,k1,n)= 0.
if(ktrac > 2) then
ktracer = ktrac - 2
allocate(pcen(lq,km,ktracer))
allocate(ptenc(lq,km,ktracer))
do n=1,ktracer
do k=1,km
k1=km-k+1
do j=1,lq
pcen(j,k1,n) = clw(j,k,n+2)
ptenc(j,k1,n)= 0.
end do
end do
end do
end do

else
ktracer = 2
allocate(pcen(lq,km,ktracer))
allocate(ptenc(lq,km,ktracer))
do n=1,ktracer
do k=1,km
do j=1,lq
pcen(j,k,n) = 0.
ptenc(j,k,n)= 0.
end do
end do
end do
end if

! print *, "pgeo=",pgeo(1,:)
! print *, "pgeoh=",pgeoh(1,:)
! print *, "pap=",pap(1,:)
Expand All @@ -289,7 +302,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
& zqp1, pum1, pvm1, pverv, zqsat,&
& pqhfl, ztmst, pap, paph, pgeo, &
& ptte, pqte, pvom, pvol, prsfc,&
& pssfc, locum, ktrac, pcen, ptenc,&
& pssfc, locum, ktracer, pcen, ptenc,&
& ktype, icbot, ictop, ztu, zqu, &
& zlu, zlude, zmfu, zmfd, zrain,&
& pcte, phhfl, lndj, pgeoh, zmfude_rate, dx)
Expand All @@ -314,7 +327,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
pt(j,k) = ztp1(j,k1)+(ptte(j,k1)-ztt(j,k1))*ztmst
pqv(j,k)= zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst
ud_mf(j,k)= zmfu(j,k1)*ztmst
dd_mf(j,k)= zmfd(j,k1)*ztmst
dd_mf(j,k)= -zmfd(j,k1)*ztmst
dt_mf(j,k)= zmfude_rate(j,k1)*ztmst
cnvw(j,k) = zlude(j,k1)*ztmst*g/(prsi(j,k)-prsi(j,k+1))
cnvc(j,k) = 0.04 * log(1. + 675. * ud_mf(j,k))
Expand Down Expand Up @@ -343,17 +356,21 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, &
end do
end do
endif

!
if (ktrac > 0) then
do n=1,ktrac
do k=1,km
k1=km-k+1
do j=1,lq
clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst
end do
end do
end do
end if
! Currently, vertical mixing of tracers are turned off
! if(ktrac > 2) then
! do n=1,ktrac-2
! do k=1,km
! k1=km-k+1
! do j=1,lq
! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst
! end do
! end do
! end do
! end if
deallocate(pcen)
deallocate(ptenc)
!
return
end subroutine cu_ntiedtke_run
Expand Down
22 changes: 20 additions & 2 deletions physics/cu_ntiedtke.meta
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,24 @@
kind = kind_phys
intent = inout
optional = F
[tdi]
standard_name = air_temperature
long_name = mid-layer temperature
units = K
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[qvdi]
standard_name = water_vapor_specific_humidity
long_name = water vapor specific humidity
units = kg kg-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[pqvf]
standard_name = moisture_tendency_due_to_dynamics
long_name = moisture tendency due to dynamics only
Expand Down Expand Up @@ -254,8 +272,8 @@
intent = out
optional = F
[ktrac]
standard_name = number_of_total_tracers
long_name = number of total tracers
standard_name = number_of_tracers_for_convective_transport
long_name = number of tracers for convective transport
units = count
dimensions = ()
type = integer
Expand Down
6 changes: 6 additions & 0 deletions physics/docs/ccpp_doxyfile
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,7 @@ INPUT = pdftxt/mainpage.txt \
pdftxt/GFS_SFCSICE.txt \
pdftxt/GFS_HEDMF.txt \
pdftxt/GFS_SATMEDMF.txt \
pdftxt/GFS_SATMEDMFVDIFQ.txt \
pdftxt/GFS_GWDPS.txt \
pdftxt/GFS_OZPHYS.txt \
pdftxt/GFS_H2OPHYS.txt \
Expand Down Expand Up @@ -189,6 +190,11 @@ INPUT = pdftxt/mainpage.txt \
../mfpblt.f \
../mfscu.f \
../tridi.f \
### satmedmfvdifq
../satmedmfvdifq.F \
../mfpbltq.f \
../mfscuq.f \
../tridi.f \
### Orographic Gravity Wave
../gwdps.f \
### Rayleigh Dampling
Expand Down
Loading

0 comments on commit 27c1fcb

Please sign in to comment.