Skip to content

Commit

Permalink
convert USE ESMF to ccpp mpi method; temporary constant treatment
Browse files Browse the repository at this point in the history
  • Loading branch information
@mzhangw
mzhangw committed Aug 26, 2019
1 parent 8b886b9 commit c29c3cd
Show file tree
Hide file tree
Showing 2 changed files with 75 additions and 30 deletions.
81 changes: 56 additions & 25 deletions physics/module_MP_FER_HIRES.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -107,12 +107,33 @@
MODULE MODULE_MP_FER_HIRES
!
!-----------------------------------------------------------------------------
USE MPI
USE ESMF
USE MODULE_KINDS
USE MODULE_CONSTANTS,ONLY : PI, CP, EPSQ, GRAV=>G, RHOL=>RHOWATER, &
RD=>R_D, RV=>R_V, T0C=>TIW, EPS=>EP_2, EPS1=>EP_1, CLIQ, CICE, &
XLV

#ifdef MPI
USE mpi
#endif
!MZ USE ESMF
! USE MODULE_KINDS
USE machine
!MZ
!MZ USE MODULE_CONSTANTS,ONLY : PI, CP, EPSQ, GRAV=>G, RHOL=>RHOWATER, &
!MZ RD=>R_D, RV=>R_V, T0C=>TIW, EPS=>EP_2, EPS1=>EP_1, CLIQ, CICE, &
!MZ XLV
!MZ
!MZ temporary values copied from module_CONSTANTS; need to come from host model
!side
REAL, PARAMETER :: pi=3.141592653589793 ! ludolf number
REAL, PARAMETER :: cp=1004.6 ! spec. heat for dry air at constant pressure
REAL, PARAMETER :: epsq=1.e-12 ! floor value for specific humidity (kg/kg)
REAL, PARAMETER :: grav= 9.8060226 ! gravity
REAL, PARAMETER :: RHOL=1000. ! density of water (kg/m3)
REAL, PARAMETER :: RD=287.04 ! gas constant for dry air
REAL, PARAMETER :: RV=461.6 ! gas constant for water vapor
REAL, PARAMETER :: T0C= 273.15 ! melting point
REAL, PARAMETER :: EPS=RD/RV
REAL, PARAMETER :: EPS1=RV/RD-1.
REAL, PARAMETER :: CLIQ = 4190. ! MZ: inconsistent value below
REAL, PARAMETER :: CICE = 2106.
REAL, PARAMETER :: XLV = 2.5E6
!-----------------------------------------------------------------------------
PUBLIC :: FERRIER_INIT_HR, GPVS_HR,FPVS,FPVS0,NX
!-----------------------------------------------------------------------------
Expand Down Expand Up @@ -216,6 +237,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
& F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, &
& QC,QR,QS, &
& RAINNC,RAINNCV, &
& threads, &
& ims,ime, jms,jme, lm, &
& d_ss,mprates, &
& refl_10cm )
Expand All @@ -224,6 +246,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
!-----------------------------------------------------------------------
INTEGER,INTENT(IN) :: D_SS,IMS,IME,JMS,JME,LM !ZM ,ITIMESTEP
REAL, INTENT(IN) :: DT,RHgrd
INTEGER, INTENT(IN) :: THREADS
REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme, lm):: &
& dz8w,p_phy,pi_phy,rho_phy
REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme, lm):: &
Expand Down Expand Up @@ -289,7 +312,8 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
TBPVS0(1:NX)=TBPVS0_STATE(1:NX)
!
!.......................................................................
!$omp parallel do private(j,k,i)
!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$OMP PRIVATE(j,k,i,t_phy)
!.......................................................................
DO j = jms,jme
DO k = 1,lm
Expand All @@ -304,7 +328,8 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
!.......................................................................

!.......................................................................
!$omp parallel do private(j,k,i)
!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$OMP PRIVATE(j,i,k, ACPREC, APREC, PREC,SR, TLATGS_PHY,TRAIN_PHY )
!.......................................................................
DO j = jms,jme
DO i = ims,ime
Expand All @@ -328,14 +353,15 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
!.......................................................................
!$omp end parallel do
!.......................................................................
!$omp parallel do &
!$omp private (j,i,k,lsfc,dpcol,l,p_col,thick_col,t_col,tc,q_col, &
!$omp wc_col,wc,qi,QRdum,qw,fice,frain,rimef_col,qi_col,qr_col,&
!$omp qw_col,i_index,j_index,arain,asnow,dum, &
!$omp pcond1d,pidep1d, &
!$omp piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d,pimlt1d, &
!$omp praut1d,pracw1d,prevp1d,pisub1d,pevap1d, &
!$omp dbz_col,nr_col,ns_col),SCHEDULE(dynamic)

!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$OMP PRIVATE(j,i,k,lsfc,dpcol,l,p_col,thick_col,t_col,tc,q_col, &
!$OMP wc_col,wc,qi,QRdum,qw,fice,frain,rimef_col,qi_col,qr_col,&
!$OMP qw_col,i_index,j_index,arain,asnow,dum, &
!$OMP pcond1d,pidep1d, &
!$OMP piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d,pimlt1d, &
!$OMP praut1d,pracw1d,prevp1d,pisub1d,pevap1d, &
!$OMP dbz_col,nr_col,ns_col)
!.......................................................................
DO J=JMS,JME
DO I=IMS,IME
Expand Down Expand Up @@ -532,7 +558,8 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
!-----------------------------------------------------------------------
!
!.......................................................................
!$omp parallel do private(j,k,i,wc)
!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$OMP PRIVATE(j,k,i,wc)
!.......................................................................
DO j = jms,jme
DO k = 1,lm
Expand Down Expand Up @@ -2146,10 +2173,11 @@ REAL FUNCTION CONDENSE (PP,QW,TK,WV,RHgrd,I,J,L)
!
IMPLICIT NONE
!
INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15)
REAL (KIND=HIGH_PRES), PARAMETER :: &
!MZ INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15)
! REAL (KIND=HIGH_PRES), PARAMETER :: &
REAL (KIND=kind_phys), PARAMETER :: &
& RHLIMIT=.001, RHLIMIT1=-RHLIMIT
REAL (KIND=HIGH_PRES) :: COND, SSAT, WCdum
REAL (KIND=kind_phys) :: COND, SSAT, WCdum
!
REAL,INTENT(IN) :: QW,PP,WV,TK,RHgrd
REAL WVdum,Tdum,DWV,WS,ESW
Expand Down Expand Up @@ -2367,7 +2395,7 @@ END SUBROUTINE EGCP01COLUMN_hr
! SH 0211/2002

!-----------------------------------------------------------------------
SUBROUTINE FERRIER_INIT_hr (GSMDT)
SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,THREADS)
!-----------------------------------------------------------------------
!-------------------------------------------------------------------------------
!--- SUBPROGRAM DOCUMENTATION BLOCK
Expand Down Expand Up @@ -2421,16 +2449,19 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT)
!
! VARIABLES PASSED IN
real,INTENT(IN) :: GSMDT
INTEGER, INTENT(IN) :: MYPE
INTEGER, INTENT(IN) :: MPI_COMM_COMP
INTEGER, INTENT(IN) :: THREADS
!
!-----------------------------------------------------------------------
! LOCAL VARIABLES
!-----------------------------------------------------------------------
type(ESMF_VM) :: VM
!MZ type(ESMF_VM) :: VM
REAL :: BBFR,DTPH,Thour_print,RDIS,BETA6
INTEGER :: I,J,L,K
INTEGER :: etampnew_unit1
LOGICAL :: opened
INTEGER :: IRTN,MYPE,rc,mpi_comm_comp
INTEGER :: IRTN,rc !MYPE,mpi_comm_comp
CHARACTER*80 errmess
!
!-----------------------------------------------------------------------
Expand All @@ -2443,8 +2474,8 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT)
!
!--- Read in various lookup tables
!
call ESMF_VMGetCurrent(vm=VM)
call ESMF_VMGet(vm=VM,localPet=mype,mpiCommunicator=MPI_COMM_COMP)
!MZ call ESMF_VMGetCurrent(vm=VM)
!MZ call ESMF_VMGet(vm=VM,localPet=mype,mpiCommunicator=MPI_COMM_COMP)
IF(MYPE==0)THEN
etampnew_unit1 = -1
DO i = 31,99
Expand Down
24 changes: 19 additions & 5 deletions physics/mp_fer_hires.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,11 +24,17 @@ module mp_fer_hires
!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F |
!! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F |
!! | imp_physics_fer_hires | flag_for_fer_hires_microphysics_scheme | choice of Ferrier-Aligo microphysics scheme | flag | 0 | integer | | in | F |
!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F |
!! | mpirank | mpi_rank | current MPI-rank | index | 0 | integer | | in | F |
!! | mpiroot | mpi_root | master MPI-rank | index | 0 | integer | | in | F |
!! | threads | omp_threads | number of OpenMP threads available to scheme | count | 0 | integer | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
subroutine mp_fer_hires_init(Model, imp_physics, &
imp_physics_fer_hires, errmsg, errflg)
imp_physics_fer_hires, &
mpicomm, mpirank,mpiroot, &
threads, errmsg, errflg)

USE machine, ONLY : kind_phys
USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR
Expand All @@ -38,6 +44,10 @@ subroutine mp_fer_hires_init(Model, imp_physics, &
type(GFS_control_type), intent(in) :: Model
integer, intent(in) :: imp_physics
integer, intent(in) :: imp_physics_fer_hires
integer, intent(in) :: mpicomm
integer, intent(in) :: mpirank
integer, intent(in) :: mpiroot
integer, intent(in) :: threads
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

Expand Down Expand Up @@ -75,11 +85,11 @@ subroutine mp_fer_hires_init(Model, imp_physics, &
! DT_MICRO=Model%NPRECIP*Model%dtp
DT_MICRO=Model%dtp

CALL FERRIER_INIT_HR(DT_MICRO)
CALL FERRIER_INIT_HR(DT_MICRO,mpicomm,mpirank,thread)

if (errflg /= 0 ) return

is_initialized = .true
is_initialized = .true.


end subroutine mp_fer_hires_init
Expand Down Expand Up @@ -110,19 +120,21 @@ end subroutine mp_fer_hires_init
!! | qg | graupel_mixing_ratio_updated_by_physics | moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics | kg kg-1 | 2 | real | kind_phys | inout | F |
!! | prec | nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep | total precipitation amount in each time step | m | 1 | real | kind_phys | inout | F |
!! | acprec | accumulated_lwe_thickness_of_precipitation_amount | accumulated total precipitation | m | 1 | real | kind_phys | inout | F |
!! | threads | omp_threads | number of OpenMP threads available to scheme | count | 0 | integer | | in | F |
!! | refl_10cm | radar_reflectivity_10cm | instantaneous refl_10cm | dBZ | 2 | real | kind_phys | inout | F |
!! | rhgrd | fa_threshold_relative_humidity_for_onset_of_condensation | relative humidity threshold parameter for condensation for FA scheme | none | 0 | real | kind_phys | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character| len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!!
SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT, &
SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
,SLMSK &
,PRSI,P_PHY &
,T,Q,CWM &
,TRAIN,SR &
,F_ICE,F_RAIN,F_RIMEF &
,QC,QR,QI,QS,QG &
,PREC,ACPREC &
,threads &
,refl_10cm &
,RHGRD &
,errmsg,errflg)
Expand All @@ -143,14 +155,15 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT, &
integer, intent(in ) :: ncol
integer, intent(in ) :: nlev
integer, intent(in ) :: dt
integer, intent(in ) :: threads
real(kind_phys), intent(in ) :: slmsk(1:ncol)
real(kind_phys), intent(in ) :: prsi(1:ncol,1:nlev+1)
real(kind_phys), intent(in ) :: p_phy(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: t(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: q(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: cwm(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: train(1:ncol,1:nlev)
real(kind_phys), intent(out) :: sr(1:ncol)
real(kind_phys), intent(out ) :: sr(1:ncol)
real(kind_phys), intent(inout) :: f_ice(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: f_rain(1:ncol,1:nlev)
real(kind_phys), intent(inout) :: f_rimef(1:ncol,1:nlev)
Expand Down Expand Up @@ -305,6 +318,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT, &
,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN &
,F_RIMEF_PHY=F_RIMEF &
,RAINNC=rainnc,RAINNCV=rainncv &
,threads=threads &
,IMS=IMS,IME=IME,JMS=JMS,JME=JME,LM=LM &
,D_SS=d_ss,MPRATES=mprates &
,refl_10cm=refl_10cm)
Expand Down

0 comments on commit c29c3cd

Please sign in to comment.