Skip to content

Commit

Permalink
output mass weighted RF in GFS_suite_stateout_update_run, it will use…
Browse files Browse the repository at this point in the history 
…d in FA
  • Loading branch information
@mzhangw
mzhangw committed Dec 5, 2019
1 parent 41086af commit 7c6a472
Show file tree
Hide file tree
Showing 3 changed files with 68 additions and 31 deletions.
22 changes: 19 additions & 3 deletions physics/GFS_suite_interstitial.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -409,7 +409,7 @@ end subroutine GFS_suite_stateout_update_finalize
!!
subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, &
tgrs, ugrs, vgrs, qgrs, dudt, dvdt, dtdt, dqdt, &
gt0, gu0, gv0, gq0, errmsg, errflg)
gt0, gu0, gv0, gq0,gq0_rf, ntiw, nqrimef, epsq, errmsg, errflg)

use machine, only: kind_phys

Expand All @@ -419,18 +419,20 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, &
integer, intent(in) :: im
integer, intent(in) :: levs
integer, intent(in) :: ntrac
real(kind=kind_phys), intent(in) :: dtp
integer, optional, intent(in) :: ntiw, nqrimef
real(kind=kind_phys), intent(in) :: dtp, epsq

real(kind=kind_phys), dimension(im,levs), intent(in) :: tgrs, ugrs, vgrs
real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: qgrs
real(kind=kind_phys), dimension(im,levs), intent(in) :: dudt, dvdt, dtdt
real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: dqdt
real(kind=kind_phys), dimension(im,levs), intent(out) :: gt0, gu0, gv0
real(kind=kind_phys), dimension(im,levs), intent(out) :: gt0, gu0, gv0, gq0_rf
real(kind=kind_phys), dimension(im,levs,ntrac), intent(out) :: gq0

character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

integer :: i, k
! Initialize CCPP error handling variables
errmsg = ''
errflg = 0
Expand All @@ -439,6 +441,20 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, &
gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp
gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp
gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp

if(present(ntiw) .and. present(nqrimef))then
do k=1,levs
do i=1,im
if(gq0(i,k,ntiw) > epsq) then
!mz gq0(i,k,nqrimef) = gq0(i,k,nqrimef)/gq0(i,k,ntiw)
gq0_rf(i,k) = gq0(i,k,nqrimef)/gq0(i,k,ntiw)
else
!mz gq0(i,k,nqrimef) = 1.
gq0_rf(i,k) = 1.
end if
end do
end do
end if

end subroutine GFS_suite_stateout_update_run

Expand Down
34 changes: 34 additions & 0 deletions physics/GFS_suite_interstitial.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1043,6 +1043,40 @@
kind = kind_phys
intent = out
optional = F
[gq0_rf]
standard_name = mass_weighted_rime_factor_updated_by_physics
long_name = mass weighted rime factor updated by physics
units = kg kg-1
dimensions = (horizontal_dimension,vertical_dimension)
type = real
kind = kind_phys
intent = out
optional = F
[ntiw]
standard_name = index_for_ice_cloud_condensate
long_name = tracer index for ice water
units = index
dimensions = ()
type = integer
intent = in
optional = T
[nqrimef]
standard_name = index_for_mass_weighted_rime_factor
long_name = tracer index for mass weighted rime factor
units = index
dimensions = ()
type = integer
intent = in
optional = T
[epsq]
standard_name = minimum_value_of_specific_humidity
long_name = floor value for specific humidity
units = kg kg-1
dimensions = ()
type = real
kind = kind_phys
intent = in
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
Expand Down
43 changes: 15 additions & 28 deletions physics/mp_fer_hires.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,6 +169,9 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &
real(kind_phys), intent(inout) :: qr(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: qi(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: qg(1:ncol,1:nlev) ! QRIMEF
! real(kind_phys), intent( out) :: qc_m(1:ncol,1:nlev)
! real(kind_phys), intent( out) :: qr_m(1:ncol,1:nlev)
! real(kind_phys), intent( out) :: qi_m(1:ncol,1:nlev)

real(kind_phys), intent(inout) :: prec(1:ncol)
! real(kind_phys) :: acprec(1:ncol) !MZ: change to local
Expand Down Expand Up @@ -260,20 +263,14 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &

!MZ* in HWRF
!-- 6/11/2010: Update cwm, F_ice, F_rain and F_rimef arrays
cwm(I,K) = QC(I,K)+QR(I,K)+QI(I,K)
!aligo
cwm(i,k) = cwm(i,k)/(1.0_kind_phys-q(i,k))
qr(i,k) = qr(i,k)/(1.0_kind_phys-q(i,k))
qi(i,k) = qi(i,k)/(1.0_kind_phys-q(i,k))
qc(i,k) = qc(i,k)/(1.0_kind_phys-q(i,k))
!aligo
cwm(I,K)=QC(I,K)+QR(I,K)+QI(I,K)
IF (QI(I,K) <= EPSQ) THEN
F_ICE(I,K)=0.
F_RIMEF(I,K)=1.
IF (T(I,K) < T_ICEK) F_ICE(I,K)=1.
ELSE
F_ICE(I,K)=MAX( 0., MIN(1., QI(I,K)/cwm(I,K) ) )
F_RIMEF(I,K)=QG(I,K) !/QI(I,K) Chunxi Nov 25,2019
F_RIMEF(I,K)=QG(I,K)!/QI(I,K)
ENDIF
IF (QR(I,K) <= EPSQ) THEN
F_RAIN(I,K)=0.
Expand All @@ -283,23 +280,15 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &

ENDDO

enddo
ENDDO

!---------------------------------------------------------------------
!*** Update the rime factor array after 3d advection
!---------------------------------------------------------------------
!MZ* in namphysics
! DO K=1,LM
! DO I=IMS,IME
! IF (QG(I,K)>EPSQ .AND. QI(I,K)>EPSQ) THEN
! F_RIMEF(I,K)=MIN(50.,MAX(1.,QG(I,K)/QI(I,K)))
! ELSE
! F_RIMEF(I,K)=1.
! ENDIF
! ENDDO
! ENDDO


!aligo
cwm(i,k) = cwm(i,k)/(1.0_kind_phys-q(i,k))
qr(i,k) = qr(i,k)/(1.0_kind_phys-q(i,k))
qi(i,k) = qi(i,k)/(1.0_kind_phys-q(i,k))
qc(i,k) = qc(i,k)/(1.0_kind_phys-q(i,k))
!aligo
!---------------------------------------------------------------------

CALL FER_HIRES( &
Expand All @@ -319,18 +308,16 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &

!.......................................................................

!Aligo Oct-23-2019
!MZ*
!Aligo Oct-23-2019
! - Convert dry qc,qr,qi back to wet mixing ratio
DO K = 1, LM
DO I= IMS, IME
cwm(i,k) = cwm(i,k)/(1.0_kind_phys+q(i,k))
qc(i,k) = qc(i,k)/(1.0_kind_phys+q(i,k))
qi(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k))
qr(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k))
ENDDO
ENDDO


ENDDO

!-----------------------------------------------------------
DO K=1,LM
Expand Down

0 comments on commit 7c6a472

Please sign in to comment.