Skip to content

Commit

Permalink
1. do some code cleanup
Browse files Browse the repository at this point in the history 
 2. correct tracer diffusions definition before/after PBL in
GFS_PBL_generic
  • Loading branch information
@mzhangw
mzhangw committed Nov 14, 2019
1 parent a312444 commit 380229c
Show file tree
Hide file tree
Showing 6 changed files with 14 additions and 90 deletions.
7 changes: 0 additions & 7 deletions physics/GFS_MP_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -300,13 +300,6 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt
! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then
! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1)
! endif
! compute fractional srflag
!if(imp_physics == imp_physics_fer_hires) then
! total_precip = tprcp(i)
! if (total_precip > rainmin) then
! srflag(i) = (ice(i)+csnow)/total_precip
! endif
!else
total_precip = snow0(i)+ice0(i)+graupel0(i)+rain0(i)+rainc(i)
if (total_precip > rainmin) then
srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip
Expand Down
6 changes: 4 additions & 2 deletions physics/GFS_PBL_generic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -135,7 +135,8 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac,
vdftra(i,k,2) = qgrs(i,k,ntcw)
vdftra(i,k,3) = qgrs(i,k,ntiw)
vdftra(i,k,4) = qgrs(i,k,ntrw)
vdftra(i,k,5) = qgrs(i,k,ntoz)
vdftra(i,k,5) = qgrs(i,k,nqrimef)
vdftra(i,k,6) = qgrs(i,k,ntoz)
enddo
enddo

Expand Down Expand Up @@ -388,7 +389,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac,
dqdt(i,k,ntcw) = dvdftra(i,k,2)
dqdt(i,k,ntiw) = dvdftra(i,k,3)
dqdt(i,k,ntrw) = dvdftra(i,k,4)
dqdt(i,k,ntoz) = dvdftra(i,k,5)
dqdt(i,k,nqrimef) = dvdftra(i,k,5)
dqdt(i,k,ntoz) = dvdftra(i,k,6)
enddo
enddo

Expand Down
57 changes: 0 additions & 57 deletions physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -723,32 +723,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Model%sup, Model%kdt, me, &
clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs

! elseif (Model%imp_physics == 15) then ! F-A cloud scheme


! if(Model%me==0) then
! write(0,*)'F-A: progclduni max(cldcov), min(cldcov) =' &
! ,maxval(cldcov),minval(cldcov)
! write(0,*)'F-A: progclduni max(ccnd_c), min(ccnd_c) =' &
! ,maxval(ccnd(:,:,1)),minval(ccnd(:,:,1))
! write(0,*)'F-A: progclduni max(ccnd_i), min(ccnd_i) =' &
! ,maxval(ccnd(:,:,2)),minval(ccnd(:,:,2))
! write(0,*)'F-A: progclduni max(ccnd_r), min(ccnd_r) =' &
! ,maxval(ccnd(:,:,3)),minval(ccnd(:,:,3))
! write(0,*)'F-A: progclduni max(ccnd_s), min(ccnd_s) =' &
! ,maxval(ccnd(:,:,4)),minval(ccnd(:,:,4))
! write(0,*)'F-A:-----------------------------------'
! endif

! call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs
! Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, &
! IM, LMK, LMP, cldcov, &
! effrl, effri, effrr, effrs, Model%effr_in, &
! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs

! if(Model%me==0) write(0,*)'F-A: progclduni max(clouds(:,:,1)),&
! min(clouds(:,:,1)) = ' &
! ,maxval(clouds(:,:,1)),minval(clouds(:,:,1))

elseif (Model%imp_physics == 11) then ! GFDL cloud scheme

Expand All @@ -774,8 +748,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs
endif

! elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then ! Thompson / WSM6 cloud micrphysics scheme
!MZ
elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 .or. &
Model%imp_physics == 15) then
if (Model%kdt == 1) then
Expand All @@ -784,20 +756,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Tbd%phy_f3d(:,:,Model%nseffr) = 250.
endif

! if(Model%me==0) then
! write(0,*)'F-A: progcld5 max(cldcov), min(cldcov) =' &
! ,maxval(cldcov),minval(cldcov)
! write(0,*)'F-A: progcld5 max(ccnd_c), min(ccnd_c) =' &
! ,maxval(ccnd(:,:,1)),minval(ccnd(:,:,1))
! write(0,*)'F-A: progcld5 max(ccnd_i), min(ccnd_i) =' &
! ,maxval(ccnd(:,:,2)),minval(ccnd(:,:,2))
! write(0,*)'F-A: progcld5 max(ccnd_r), min(ccnd_r) =' &
! ,maxval(ccnd(:,:,3)),minval(ccnd(:,:,3))
! write(0,*)'F-A: progcld5 max(ccnd_s), min(ccnd_s) =' &
! ,maxval(ccnd(:,:,4)),minval(ccnd(:,:,4))
! write(0,*)'F-A:-----------------------------------'
! endif

call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs
Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, &
ntrac-1, ntcw-1,ntiw-1,ntrw-1, &
Expand All @@ -808,25 +766,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), &
clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs

! if(Model%me==0) then
! write(0,*)'F-A: progcld5 max(cldsa1), min(cldsa1) =' &
! ,maxval(cldsa(:,1)),minval(cldsa(:,1))
! write(0,*)'F-A: progcld5 max(cldsa2), min(cldsa2) =' &
! ,maxval(cldsa(:,2)),minval(cldsa(:,2))
! write(0,*)'F-A: progcld5 max(cldsa3), min(cldsa3) =' &
! ,maxval(cldsa(:,3)),minval(cldsa(:,3))
! write(0,*)'F-A: progcld5 max(cldsa4), min(cldsa4) =' &
! ,maxval(cldsa(:,4)),minval(cldsa(:,4))
! write(0,*)'F-A: progcld5 max(cldsa5), min(cldsa5) =' &
! ,maxval(cldsa(:,5)),minval(cldsa(:,5))
! write(0,*)'F-A:-----------------------------------'
! endif

endif ! end if_imp_physics

! endif ! end_if_ntcw

! CCPP
do k = 1, LMK
do i = 1, IM
clouds1(i,k) = clouds(i,k,1)
Expand Down
1 change: 0 additions & 1 deletion physics/module_MP_FER_HIRES.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2529,7 +2529,6 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS)
!-----------------------------------------------------------------------
! LOCAL VARIABLES
!-----------------------------------------------------------------------
!MZ type(ESMF_VM) :: VM
REAL :: BBFR,DTPH,Thour_print,RDIS,BETA6
INTEGER :: I,J,L,K
INTEGER :: etampnew_unit1
Expand Down
22 changes: 4 additions & 18 deletions physics/mp_fer_hires.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ module mp_fer_hires
!> \section arg_table_mp_fer_hires_init Argument Table
!! \htmlinclude mp_fer_hires_init.html
!!
subroutine mp_fer_hires_init(NCOL, NLEV, Model, imp_physics, &
subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, &
imp_physics_fer_hires, &
restart, &
f_ice,f_rain,f_rimef, &
Expand All @@ -39,12 +39,11 @@ subroutine mp_fer_hires_init(NCOL, NLEV, Model, imp_physics, &

USE machine, ONLY : kind_phys
USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR
USE GFS_typedefs, ONLY : GFS_control_type
implicit none

type(GFS_control_type), intent(in) :: Model
integer, intent(in) :: ncol
integer, intent(in) :: nlev
real(kind_phys), intent(in) :: dtp
integer, intent(in) :: imp_physics
integer, intent(in) :: imp_physics_fer_hires
integer, intent(in) :: mpicomm
Expand All @@ -61,7 +60,7 @@ subroutine mp_fer_hires_init(NCOL, NLEV, Model, imp_physics, &

! Local variables
integer :: ims, ime, lm,i,k
real(kind=kind_phys) :: DT_MICRO
!real(kind=kind_phys) :: DT_MICRO

! Initialize the CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -104,10 +103,7 @@ subroutine mp_fer_hires_init(NCOL, NLEV, Model, imp_physics, &
ENDIF
!MZ: fer_hires_init() in HWRF


DT_MICRO=Model%dtp

CALL FERRIER_INIT_HR(DT_MICRO,mpicomm,mpirank,mpiroot,threads)
CALL FERRIER_INIT_HR(dtp,mpicomm,mpirank,mpiroot,threads)

if (mpirank==mpiroot) write (0,*)'F-A: FERRIER_INIT_HR finished ...'
if (errflg /= 0 ) return
Expand Down Expand Up @@ -193,7 +189,6 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &
integer :: lowlyr(1:ncol)
integer :: dx1
!real(kind_phys) :: mprates(1:ncol,1:nlev,d_ss)
real(kind_phys) :: sm(1:ncol), xland(1:ncol)
real(kind_phys) :: DTPHS,PCPCOL,RDTPHS,TNEW
real(kind_phys) :: ql(1:nlev),tl(1:nlev)
real(kind_phys) :: rainnc(1:ncol),rainncv(1:ncol)
Expand Down Expand Up @@ -243,14 +238,6 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &
! determining where RHgrd should be set to 0.98 in the coarse domain when running HAFS.
DX1=NINT(DX(1))



!ZM: module_SOLVER_GRID_COMP.F90
DO I = IMS, IME
!Sfcprop%sm(i)=1.; if(Sfcprop%slmsk(i) > 0.5 ) Sfcprop%sm(i)=0.
sm(i) = 1.; if(slmsk(i) > 0.5) sm(i)=0.
ENDDO

!-----------------------------------------------------------------------
!*** NOTE: THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP.
!*** THE WRF PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1
Expand All @@ -263,7 +250,6 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV &
DO I=IMS,IME
!
LOWLYR(I)=1
XLAND(I)=SM(I)+1.
!
!-----------------------------------------------------------------------
!*** FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE
Expand Down
11 changes: 6 additions & 5 deletions physics/mp_fer_hires.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,12 +17,13 @@
type = integer
intent = in
optional = F
[Model]
standard_name = GFS_control_type_instance
long_name = Fortran DDT containing FV3-GFS model control parameters
units = DDT
[dtp]
standard_name = time_step_for_physics
long_name = physics timestep
units = s
dimensions = ()
type = GFS_control_type
type = real
kind = kind_phys
intent = in
optional = F
[imp_physics]
Expand Down

0 comments on commit 380229c

Please sign in to comment.