diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index 1ccff17e5..2b82d5c90 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -85,7 +85,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & clam,c0s,c1,betal,betas,evef,pgcon,asolfac,cscale, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & & rainevap,sigmain,sigmaout,omegain,omegaout,betadcu,betamcu, & - & betascu,maxMF,do_mynnedmf,sigmab_coldstart,errmsg,errflg) + & betascu,maxMF,do_mynnedmf,sigmab_coldstart,cat_adj_deep, & + & errmsg,errflg) ! use machine , only : kind_phys @@ -139,6 +140,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & evef, pgcon character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + + ! for HAFS + real(kind_phys), intent(in) :: cat_adj_deep ! !------local variables integer i, indx, jmn, k, kk, km1, n @@ -2952,7 +2956,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & umean(i) = max(umean(i), 1.) tauadv = gdx(i) / umean(i) advfac(i) = tauadv / dtconv(i) - advfac(i) = min(advfac(i), 1.) + advfac(i) = min(cat_adj_deep*advfac(i), 1.) + !advfac(i) = min(0.85*advfac(i), 1.) !shin endif enddo diff --git a/physics/CONV/SAMF/samfdeepcnv.meta b/physics/CONV/SAMF/samfdeepcnv.meta index 1fc5fdf62..079248dbe 100644 --- a/physics/CONV/SAMF/samfdeepcnv.meta +++ b/physics/CONV/SAMF/samfdeepcnv.meta @@ -762,6 +762,14 @@ type = real kind = kind_phys intent = out +[cat_adj_deep] + standard_name = Adjustment_for_convective_advection_time_for_deep + long_name = Adjustment for convective advection time for deep + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index bc69f0ebb..16bcca2f7 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -59,7 +59,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal, & & sigmain,sigmaout,omegain,omegaout,betadcu,betamcu,betascu, & - & errmsg,errflg) + & cat_adj_shal,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -100,6 +100,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & restart,progsigma,progomega character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + + ! for HAFS + real(kind_phys), intent(in) :: cat_adj_shal ! ! local variables integer i,j,indx, k, kk, km1, n @@ -1992,7 +1995,8 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & umean(i) = max(umean(i), 1.) tauadv = gdx(i) / umean(i) advfac(i) = tauadv / dtconv(i) - advfac(i) = min(advfac(i), 1.) + advfac(i) = min(cat_adj_shal*advfac(i), 1.) + !advfac(i) = min(0.85*advfac(i), 1.) !shin endif enddo c diff --git a/physics/CONV/SAMF/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta index b96a742f2..0373aaea2 100644 --- a/physics/CONV/SAMF/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -550,6 +550,14 @@ dimensions = () type = real intent = in +[cat_adj_shal] + standard_name = Adjustment_for_convective_advection_time_for_shallow + long_name = Adjustment for convective advection time for shallow + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/Thompson/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 index d78d9689c..036985e77 100644 --- a/physics/MP/Thompson/module_mp_thompson.F90 +++ b/physics/MP/Thompson/module_mp_thompson.F90 @@ -1043,7 +1043,8 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rcs, tprv_rev, tten3, qvten3, & qrten3, qsten3, qgten3, qiten3, niten3, & nrten3, ncten3, qcten3, & - pfils, pflls) + pfils, pflls, & + fs_fac_rain, fs_fac_snow) implicit none @@ -1112,6 +1113,8 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rcs, tprv_rev, tten3, qvten3, & qrten3, qsten3, qgten3, qiten3, niten3, & nrten3, ncten3, qcten3 + ! Fall speed adjustment + real(wp), INTENT (IN), optional :: fs_fac_rain, fs_fac_snow !..Local variables real(wp), dimension(kts:kte):: & @@ -1481,7 +1484,8 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & tprr_rcs1, tprv_rev1, & tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1, & - pfil1, pfll1) + pfil1, pfll1, & + fs_fac_rain, fs_fac_snow) pcp_ra(i,j) = pcp_ra(i,j) + pptrain pcp_sn(i,j) = pcp_sn(i,j) + pptsnow @@ -1901,7 +1905,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprr_rcs1, tprv_rev1, & tten1, qvten1, qrten1, qsten1, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1, & - pfil1, pfll1) + pfil1, pfll1, & + fs_fac_rain, fs_fac_snow) use mpi_f08 @@ -1937,6 +1942,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tprr_rcs1, tprv_rev1, tten1, qvten1, & qrten1, qsten1, qgten1, qiten1, niten1, & nrten1, ncten1, qcten1 + ! TC adjustment + real(wp), intent(in), optional :: fs_fac_rain, fs_fac_snow #if ( WRF_CHEM == 1 ) real(wp), dimension(kts:kte), intent(inout) :: & @@ -2031,6 +2038,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & logical :: debug_flag integer :: nu_c + real(wp) :: fallspeed_adjustment_factor !+---+ debug_flag = .false. @@ -3769,6 +3777,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & enddo if (ANY(L_qr .eqv. .true.)) then + fallspeed_adjustment_factor=1.0 + if ( present(fs_fac_rain) ) fallspeed_adjustment_factor=fs_fac_rain + do k = kte, kts, -1 vtr = 0. rhof(k) = SQRT(RHO_NOT/rho(k)) @@ -3777,7 +3788,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & lamr = (am_r*crg(3)*org2*nr(k)/rr(k))**obmr vtr = rhof(k)*av_r*crg(6)*org3 * lamr**cre(3) & *((lamr+fv_r)**(-cre(6))) - vtrk(k) = vtr + vtrk(k) = vtr*fallspeed_adjustment_factor ! First below is technically correct: ! vtr = rhof(k)*av_r*crg(5)*org2 * lamr**cre(2) & ! *((lamr+fv_r)**(-cre(5))) @@ -3785,7 +3796,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! Goal: less prominent size sorting vtr = rhof(k)*av_r*crg(7)/crg(12) * lamr**cre(12) & *((lamr+fv_r)**(-cre(7))) - vtnrk(k) = vtr + vtnrk(k) = vtr*fallspeed_adjustment_factor else vtrk(k) = vtrk(k+1) vtnrk(k) = vtnrk(k+1) @@ -3869,6 +3880,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qs .eqv. .true.)) then + fallspeed_adjustment_factor=1.0 + if ( present(fs_fac_snow) ) fallspeed_adjustment_factor=fs_fac_snow + nstep = 0 do k = kte, kts, -1 vts = 0. @@ -3886,6 +3900,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & t3_vts = Kap0*csg(1)*ils1**cse(1) t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7) vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts) + vts=vts*fallspeed_adjustment_factor if (prr_sml(k) .gt. 0.0) then ! vtsk(k) = max(vts*vts_boost(k), & ! & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) diff --git a/physics/MP/Thompson/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 index 666a8a53f..b3454c49f 100644 --- a/physics/MP/Thompson/mp_thompson.F90 +++ b/physics/MP/Thompson/mp_thompson.F90 @@ -383,6 +383,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & spp_prt_list, spp_var_list, & spp_stddev_cutoff, & cplchm, pfi_lsan, pfl_lsan, & + fs_fac_rain, fs_fac_snow, & is_initialized, errmsg, errflg) implicit none @@ -465,6 +466,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfl_lsan + ! fall speed adjustment + real(kind_phys), intent(in), optional :: fs_fac_rain, fs_fac_snow + ! Local variables ! Reduced time step if subcycling is used @@ -776,7 +780,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3, pfils=pfils, pflls=pflls) + qcten3=qcten3, pfils=pfils, pflls=pflls, & + fs_fac_rain=fs_fac_rain, fs_fac_snow=fs_fac_snow) else if (merra2_aerosol_aware) then call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, & @@ -818,7 +823,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3, pfils=pfils, pflls=pflls) + qcten3=qcten3, pfils=pfils, pflls=pflls, & + fs_fac_rain=fs_fac_rain, fs_fac_snow=fs_fac_snow) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & @@ -858,7 +864,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & tprv_rev=tprv_rev, tten3=tten3, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & - qcten3=qcten3, pfils=pfils, pflls=pflls) + qcten3=qcten3, pfils=pfils, pflls=pflls, & + fs_fac_rain=fs_fac_rain, fs_fac_snow=fs_fac_snow) end if if (errflg/=0) return diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index 09e292672..b8ff37bd4 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -943,6 +943,24 @@ dimensions = () type = logical intent = inout +[fs_fac_rain] + standard_name = multiplicative_tuning_parameter_for_rain_fall_speed + long_name = multiplicative tuning parameter for rain fall speed + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[fs_fac_snow] + standard_name = multiplicative_tuning_parameter_for_snow_fall_speed + long_name = multiplicative tuning parameter_for snow fall speed + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 index fd28b11b7..950dfaee4 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 @@ -48,7 +48,7 @@ module rrtmgp_lw_cloud_optics ! ###################################################################################### !> subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -64,9 +64,11 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag + character(len=*), intent( out) :: & errmsg !< Error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< Error code ! Local variables @@ -77,6 +79,8 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, errmsg = '' errflg = 0 + if (is_initialized) return + ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) @@ -240,6 +244,8 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, lut_exticeLW, lut_ssaiceLW, lut_asyiceLW)) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) - + + is_initialized = .true. + end subroutine rrtmgp_lw_cloud_optics_init end module rrtmgp_lw_cloud_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 index f9de18830..511d4116f 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 @@ -72,7 +72,7 @@ module rrtmgp_lw_gas_optics !> subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + active_gases_array, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -85,11 +85,13 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, integer,intent(in) :: & mpirank, & !< Current MPI rank mpiroot !< Master MPI rank - + ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag. + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Local variables @@ -102,6 +104,8 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, errmsg = '' errflg = 0 + if (is_initialized) return + ! Filenames are set in the physics_nml lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) @@ -459,7 +463,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, scaling_gas_lowerLW, scaling_gas_upperLW, scale_by_complement_lowerLW, & scale_by_complement_upperLW, kminor_start_lowerLW, kminor_start_upperLW, totplnkLW,& planck_fracLW, rayl_lowerLW, rayl_upperLW, optimal_angle_fitLW)) - + + is_initialized = .true. + end subroutine rrtmgp_lw_gas_optics_init end module rrtmgp_lw_gas_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 index 7f86c6ca3..ee295535d 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 @@ -31,7 +31,7 @@ module rrtmgp_lw_main !! subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_clouds,& active_gases_array, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & - errmsg, errflg) + is_init_gas_optics, is_init_cloud_optics, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -53,9 +53,12 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi nLay ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_init_gas_optics, & !< Initialization flag + is_init_cloud_optics !< Initialization flag + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Initialize CCPP error handling variables @@ -64,11 +67,11 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi ! RRTMGP longwave gas-optics (k-distribution) initialization call rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + active_gases_array, mpicomm, mpirank, mpiroot, is_init_gas_optics, errmsg, errflg) ! RRTMGP longwave cloud-optics initialization call rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_init_cloud_optics, errmsg, errflg) end subroutine rrtmgp_lw_main_init diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index 9c7807c59..26f2ca833 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -88,6 +88,20 @@ type = character kind = len=* intent = in +[is_init_gas_optics] + standard_name = flag_for_rrmtgp_lw_gas_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[is_init_cloud_optics] + standard_name = flag_for_rrmtgp_lw_cloud_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 index 402631b88..56c599f9c 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 @@ -45,7 +45,7 @@ module rrtmgp_sw_cloud_optics ! ###################################################################################### !> subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -60,9 +60,11 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Local variables @@ -73,6 +75,8 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, errmsg = '' errflg = 0 + if (is_initialized) return + ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) @@ -251,5 +255,7 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + is_initialized = .true. + end subroutine rrtmgp_sw_cloud_optics_init end module rrtmgp_sw_cloud_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index d5fb525f2..fb1787241 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -83,7 +83,7 @@ module rrtmgp_sw_gas_optics !! the full k-distribution data is read in, reduced by the "active gases" provided, and !! loaded into the RRTMGP DDT, ty_gas_optics_rrtmgp. subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & - active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + active_gases_array, mpicomm, mpirank, mpiroot, is_initialized, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -98,9 +98,11 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, mpiroot !< Master MPI rank ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_initialized !< Initialization flag. + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Local variables @@ -113,6 +115,8 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, errmsg = '' errflg = 0 + if (is_initialized) return + ! Filenames are set in the gfphysics_nml sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) @@ -509,6 +513,8 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, solar_quietSW, solar_facularSW, solar_sunspotSW, tsi_defaultSW, mg_defaultSW, & sb_defaultSW, rayl_lowerSW, rayl_upperSW)) + is_initialized = .true. + end subroutine rrtmgp_sw_gas_optics_init end module rrtmgp_sw_gas_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 index 4ce051fe1..b083546f3 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 @@ -31,7 +31,7 @@ module rrtmgp_sw_main !! subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_file_clouds,& active_gases_array, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & - errmsg, errflg) + is_init_gas_optics, is_init_cloud_optics, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -50,9 +50,12 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. nLay ! Outputs - character(len=*), intent(out) :: & + logical, intent(inout) :: & + is_init_gas_optics, & !< Initialization flag + is_init_cloud_optics !< Initialization flag + character(len=*), intent( out) :: & errmsg !< CCPP error message - integer, intent(out) :: & + integer, intent( out) :: & errflg !< CCPP error code ! Initialize CCPP error handling variables @@ -61,11 +64,11 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi ! RRTMGP shortwave gas-optics (k-distribution) initialization call rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, active_gases_array,& - mpicomm, mpirank, mpiroot, errmsg, errflg) + mpicomm, mpirank, mpiroot, is_init_gas_optics, errmsg, errflg) ! RRTMGP shortwave cloud-optics initialization call rrtmgp_sw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, is_init_cloud_optics, errmsg, errflg) end subroutine rrtmgp_sw_main_init diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index a0935d84c..8c382cb1e 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -87,6 +87,20 @@ type = character kind = len=* intent = in +[is_init_gas_optics] + standard_name = flag_for_rrmtgp_sw_gas_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[is_init_cloud_optics] + standard_name = flag_for_rrmtgp_sw_cloud_optics_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP