Skip to content

Commit

Permalink
fix omp message and pass F-A scheme
Browse files Browse the repository at this point in the history
  • Loading branch information
@mzhangw
mzhangw committed Aug 30, 2019
1 parent 4e0d9bd commit 1426c6e
Show file tree
Hide file tree
Showing 4 changed files with 55 additions and 15 deletions.
27 changes: 27 additions & 0 deletions physics/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,11 @@ end subroutine GFS_rrtmg_pre_init
!! | Cldprop | GFS_cldprop_type_instance | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_cldprop_type | | in | F |
!! | Coupling | GFS_coupling_type_instance | Fortran DDT containing FV3-GFS fields needed for coupling | DDT | 0 | GFS_coupling_type| | in | F |
!! | Radtend | GFS_radtend_type_instance | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F |
!! | f_ice | mass_fraction_of_ice_water_cloud | mass fraction of ice water cloud | frac | 2 | real | kind_phys | in | F |
!! | f_rain | mass_fraction_of_rain_water_cloud | mass fraction of rain water cloud | frac | 2 | real | kind_phys | in | F |
!! | f_rimef | mass_fraction_of_rime_factor | mass fraction of rime factor | frac | 2 | real | kind_phys | in | F |
!! | flgmin | minimum_large_ice_fraction | minimum large ice fraction in F-A mp scheme | frac | 1 | real | kind_phys | in | F |
!! | cwm | total_cloud_condensate_mixing_ratio_updated_by_physics | total cloud condensate mixing ratio (except water vapor) updated by physics | kg kg-1 | 2 | real | kind_phys | in | F |
!! | lm | number_of_vertical_layers_for_radiation_calculations | number of vertical layers for radiation calculation | count | 0 | integer | | in | F |
!! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F |
!! | lmk | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F |
Expand Down Expand Up @@ -81,6 +86,7 @@ end subroutine GFS_rrtmg_pre_init
subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Tbd, Cldprop, Coupling, &
Radtend, & ! input/output
f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only
lm, im, lmk, lmp, & ! input
kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output
tlvl, tlyr, tsfg, tsfa, qlyr, olyr, &
Expand Down Expand Up @@ -120,6 +126,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
& NSPC1
use module_radiation_clouds, only: NF_CLDS, & ! cld_init
& progcld1, progcld3, &
& progcld2, &
& progcld4, progcld5, &
& progclduni
use module_radsw_parameters, only: topfsw_type, sfcfsw_type, &
Expand All @@ -141,8 +148,16 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input

integer, intent(in) :: im, lm, lmk, lmp
integer, intent(out) :: kd, kt, kb

! F-A mp scheme only
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: cwm
real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin
real(kind=kind_phys), intent(out) :: raddt


real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz
real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl
Expand Down Expand Up @@ -773,6 +788,18 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Model%sup, Model%kdt, me, &
clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs

!MZ
!clw here is total cloud condensate
elseif (Model%imp_physics == 15) then ! F-A cloud scheme
call progcld2 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, &
cwm, & ! --- inputs:
Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, &
f_ice,f_rain,f_rimef,flgmin, & ! F-A scheme specific
im, lmk, lmp, Model%lmfshal, Model%lmfdeep2, &
clouds,cldsa,mtopa,mbota,de_lgth) ! --- outputs:



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

if (.not.Model%lgfdlmprad) then
Expand Down
11 changes: 9 additions & 2 deletions physics/module_MP_FER_HIRES.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -571,7 +571,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, &
!
!.......................................................................
!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$OMP PRIVATE(j,k,i,wc)
!$OMP PRIVATE(j,k,i, th_phy, wc, qs, qc)
!.......................................................................
DO j = jms,jme
DO k = 1,lm
Expand Down Expand Up @@ -2410,7 +2410,7 @@ END SUBROUTINE EGCP01COLUMN_hr
! SH 0211/2002

!-----------------------------------------------------------------------
SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,THREADS)
SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS)
!-----------------------------------------------------------------------
!-------------------------------------------------------------------------------
!--- SUBPROGRAM DOCUMENTATION BLOCK
Expand Down Expand Up @@ -2465,6 +2465,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,THREADS)
! VARIABLES PASSED IN
real,INTENT(IN) :: GSMDT
INTEGER, INTENT(IN) :: MYPE
INTEGER, INTENT(IN) :: MPIROOT
INTEGER, INTENT(IN) :: MPI_COMM_COMP
INTEGER, INTENT(IN) :: THREADS
!
Expand All @@ -2484,6 +2485,10 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,THREADS)
DTPH=GSMDT !-- Time step in s
!
!--- Create lookup tables for saturation vapor pressure w/r/t water & ice

!MZ
if (mype==mpiroot) write(0,*) 'F-A: Create lookup tables for saturation vapor pressure w/r/t water & ice ... '

!
CALL GPVS_hr
!
Expand All @@ -2509,6 +2514,8 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,THREADS)
ENDIF
!
IF(MYPE==0)THEN
!MZ
write(0,*) 'F-A: Reading DETAMPNEW_DATA*LE data... '
OPEN(UNIT=etampnew_unit1,FILE="DETAMPNEW_DATA.expanded_rain_LE", &
& FORM="UNFORMATTED",STATUS="OLD",ERR=9061)
!
Expand Down
29 changes: 16 additions & 13 deletions physics/mp_fer_hires.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,8 +85,9 @@ subroutine mp_fer_hires_init(Model, imp_physics, &
! DT_MICRO=Model%NPRECIP*Model%dtp
DT_MICRO=Model%dtp

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

if (mpirank==mpiroot) write (0,*)'F-A: FERRIER_INIT_HR finished ...'
if (errflg /= 0 ) return

is_initialized = .true.
Expand Down Expand Up @@ -120,6 +121,8 @@ 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 |
!! | 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 |
!! | 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 |
Expand All @@ -140,7 +143,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
,F_ICE,F_RAIN,F_RIMEF &
,QC,QR,QI,QS,QG &
,PREC,ACPREC &
,threads &
,mpirank, mpiroot, threads &
,refl_10cm &
,RHGRD,dx &
,EPSQ,R_D,P608,CP,G &
Expand All @@ -163,6 +166,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
integer, intent(in ) :: nlev
real(kind_phys), intent(in ) :: dt
integer, intent(in ) :: threads
integer, intent(in) :: mpirank
integer, intent(in) :: mpiroot
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)
Expand Down Expand Up @@ -262,7 +267,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
!
!.......................................................................
!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$omp& private(i,k,ql,tl)
!$OMP private(i,k,ql,xland,tl,rr,pi_phy, th_phy,dz)
!.......................................................................
DO I=IMS,IME
!
Expand Down Expand Up @@ -304,7 +309,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
!
ENDDO !- DO I=IMS,IME
!.......................................................................
!$omp end parallel do
!$OMP end parallel do
!.......................................................................
!
!*** CALL MICROPHYSICS
Expand All @@ -322,7 +327,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
ENDDO
ENDDO
!---------------------------------------------------------------------

if (mpirank==mpiroot) write (0,*)'F-A: Calling FER_HIRES ...'
CALL FER_HIRES( &
DT=dtphs,RHgrd=RHGRD &
,DZ8W=dz,RHO_PHY=rr,P_PHY=p_phy,PI_PHY=pi_phy &
Expand All @@ -349,7 +354,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &

!.......................................................................
!$OMP PARALLEL DO SCHEDULE(dynamic) num_threads(threads) &
!$omp& private(i,k,TNEW)
!$OMP private(i,k,TNEW,TRAIN)
!.......................................................................
DO K=1,LM
DO I=IMS,IME
Expand All @@ -364,15 +369,15 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
ENDDO
ENDDO
!.......................................................................
!$omp end parallel do
!$OMP end parallel do
!.......................................................................
!
!-----------------------------------------------------------------------
!*** UPDATE PRECIPITATION
!-----------------------------------------------------------------------
!
!jaa!$omp parallel do &
!jaa!$omp& private(i,j,pcpcol)
!$OMP parallel do SCHEDULE(dynamic) num_threads(threads) &
!$OMP private(i,pcpcol,prec,acprec)
DO I=IMS,IME
PCPCOL=RAINNCV(I)*1.E-3
PREC(I)=PREC(I)+PCPCOL
Expand All @@ -382,8 +387,9 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT &
! SINCE IT IS ONLY A LOCAL ARRAY FOR NOW
!
ENDDO
!
!$OMP end parallel do
!-----------------------------------------------------------------------
if (mpirank==mpiroot) write (0,*)'F-A: mp_fer_hires_run finished ...'
!
end subroutine mp_fer_hires_run

Expand All @@ -394,6 +400,3 @@ subroutine mp_fer_hires_finalize ()
end subroutine mp_fer_hires_finalize

end module mp_fer_hires



3 changes: 3 additions & 0 deletions physics/radiation_clouds.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -262,6 +262,7 @@ module module_radiation_clouds
!!\n =8: Thompson microphysics
!!\n =6: WSM6 microphysics
!!\n =10: MG microphysics
!!\n =15: Ferrier-Aligo microphysics
!!\param me print control flag
!>\section gen_cld_init cld_init General Algorithm
!! @{
Expand Down Expand Up @@ -350,6 +351,8 @@ subroutine cld_init &
print *,' --- WSM6 cloud microphysics'
elseif (imp_physics == 10) then
print *,' --- MG cloud microphysics'
elseif (imp_physics == 15) then
print *,' --- Ferrier-Aligo cloud microphysics'
else
print *,' !!! ERROR in cloud microphysc specification!!!', &
& ' imp_physics (NP3D) =',imp_physics
Expand Down

0 comments on commit 1426c6e

Please sign in to comment.