diff --git a/README.md b/README.md index c1964c445..9000afccc 100644 --- a/README.md +++ b/README.md @@ -15,4 +15,6 @@ For the use of CCPP with its Single Column Model, see the [Single Column Model U For the use of CCPP with NOAA's Unified Forecast System (UFS), see the [UFS Medium-Range Application User's Guide](https://ufs-mrweather-app.readthedocs.io/en/latest/) and the [UFS Weather Model User's Guide](https://ufs-weather-model.readthedocs.io/en/latest/). +The Apache license will be in effect unless superseded by an existing license in specific files. + Questions can be directed to the [CCPP Help Desk](mailto:gmtb-help@ucar.edu). When using the CCPP with NOAA's UFS, questions can be posted in the [UFS Weather Model](https://forums.ufscommunity.org/forum/ufs-weather-model) section of the [UFS Forum](https://forums.ufscommunity.org/) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 4680f8de7..b5066637d 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -491,10 +491,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if ! CCPP/RUC only if (Model%lsm == Model%lsm_ruc) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Model%zs', Model%zs) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sh2o', Sfcprop%sh2o) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%smois', Sfcprop%smois) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tslb', Sfcprop%tslb) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zs', Sfcprop%zs) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%clw_surf', Sfcprop%clw_surf) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qwv_surf', Sfcprop%qwv_surf) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%cndm_surf', Sfcprop%cndm_surf) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 5fcc9ed84..be62e5052 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -353,18 +353,18 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, !--- determine if diagnostics buckets need to be cleared sec_zero = nint(Model%fhzero*con_hr) if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then + if (mod(Model%kdt,Model%nszero) == 0) then call Diag%rad_zero (Model) call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif else - if (mod(Model%kdt,Model%nszero) == 1) then + if (mod(Model%kdt,Model%nszero) == 0) then call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then + if (mod(Model%kdt, kdt_rad) == 0) then call Diag%rad_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 new file mode 100644 index 000000000..05b8ee79e --- /dev/null +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -0,0 +1,192 @@ +! ######################################################################################## +! +! ######################################################################################## +module GFS_rrtmgp_cloud_overlap_pre + use machine, only: kind_phys + use rrtmgp_aux, only: check_error_msg + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + + public GFS_rrtmgp_cloud_overlap_pre_init, GFS_rrtmgp_cloud_overlap_pre_run, GFS_rrtmgp_cloud_overlap_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_cloud_overlap_pre_init() + end subroutine GFS_rrtmgp_cloud_overlap_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_cloud_overlap_pre_run +!! \htmlinclude GFS_rrtmgp_cloud_overlap_pre_run.html +!! + subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWrad, & + julian, lat, p_lev, p_lay, tv_lay, con_pi, con_g, con_rd, con_epsq, dcorr_con, & + idcor, iovr, iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, & + idcor_oreopoulos, cld_frac, & + cloud_overlap_param, precip_overlap_param, de_lgth, deltaZc, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + logical, intent(in) :: & + doSWrad, & ! Call SW radiation? + doLWrad ! Call LW radiation + real(kind_phys), intent(in) :: & + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq, & ! Physical constant: Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = idcor_con) + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + cld_frac ! Total cloud fraction + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZc ! Layer thickness (from layer-centers)(km) + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1,pfac + real(kind_phys), dimension(nLev+1) :: hgtb + real(kind_phys), dimension(nLev) :: hgtc + integer :: iCol,iLay,l,iSFC,iTOA + real(kind_phys), dimension(nCol,nLev) :: deltaZ + logical :: top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (doSWrad .or. doLWrad)) return + + ! What is vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! + do iCol=1,nCol + if (top_at_1) then + ! Layer thickness (km) + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(nLev+1) = 0._kind_phys + do iLay=nLev,1,-1 + hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = nLev, 1, -1 + pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & + abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) + hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) + enddo + ! Layer thickness between centers + do iLay = nLev-1, 1, -1 + deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) + enddo + deltaZc(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) + else + do iLay=nLev,1,-1 + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(1) = 0._kind_phys + do iLay=1,nLev + hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = 1, nLev + pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & + abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) + hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) + enddo + ! Layer thickness between centers + do iLay = 2, nLev + deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) + enddo + deltaZc(iCol,1) = hgtc(1) - hgtb(1) + endif + enddo + + ! + ! Cloud decorrelation length + ! + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con + endif + + ! + ! Cloud overlap parameter + ! + if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then + call get_alpha_exp(nCol, nLev, deltaZc, de_lgth, cloud_overlap_param) + else + de_lgth(:) = 0. + cloud_overlap_param(:,:) = 0. + endif + + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 1, nLev + do iCol = 1, nCol + if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then + cloud_overlap_param(iCol,iLay) = 0._kind_phys + endif + enddo + enddo + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + + end subroutine GFS_rrtmgp_cloud_overlap_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_cloud_overlap_pre_finalize() + end subroutine GFS_rrtmgp_cloud_overlap_pre_finalize +end module GFS_rrtmgp_cloud_overlap_pre diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.meta b/physics/GFS_rrtmgp_cloud_overlap_pre.meta new file mode 100644 index 000000000..273832362 --- /dev/null +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.meta @@ -0,0 +1,265 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_cloud_overlap_pre + type = scheme + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_cloud_overlap_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + intent = in + kind = kind_phys + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_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 +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = flag for cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor] + standard_name = flag_for_decorrelation_length_method + long_name = flag for decorrelation length method used in cloud overlap method (iovr) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_con] + standard_name = flag_for_constant_decorrelation_length_method + long_name = choice of decorrelation length computation (costant) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_hogan] + standard_name = flag_for_hogan_decorrelation_length_method + long_name = choice of decorrelation length computation (hogan) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_oreopoulos] + standard_name = flag_for_oreopoulos_decorrelation_length_method + long_name = choice of decorrelation length computation (oreopoulos) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dcorr_con] + standard_name = decorreltion_length_used_by_overlap_method + long_name = decorrelation length (default) used by cloud overlap method (iovr) + units = km + dimensions = () + type = real + intent = in + kind = kind_phys + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZc] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 52e1a7b74..16844304b 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -6,17 +6,19 @@ module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys use rrtmgp_aux, only: check_error_msg use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr ! Parameters real(kind_phys), parameter :: & reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) - resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) - reice_min = 10.0, & ! Minimum ice size allowed by scheme - reice_max = 150.0, & ! Maximum ice size allowed by scheme - cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme - + resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) + reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme + reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme + ! NOTE: When using RRTMGP cloud-optics, the min/max particle size allowed are imported + ! from initialization. + public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize contains @@ -31,13 +33,11 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, doSWrad, doLWrad, effr_in, & - julian, lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & - effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, dcorr_con, idcor, iovr, & - iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, idcor_oreopoulos, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, doSWrad, doLWrad, effr_in, kdt, & + do_mynnedmf, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + effrin_cldsnow, tracer, con_g, con_rd, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & - deltaZb, errmsg, errflg) + cld_rerain, precip_frac, errmsg, errflg) implicit none ! Inputs @@ -52,28 +52,17 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld i_cldsnow, & ! Index into tracer array for cloud snow. i_cldgrpl, & ! Index into tracer array for cloud groupel. i_cldtot, & ! Index into tracer array for cloud total amount. - yearlen, & ! Length of current year (365/366) WTF? - iovr, & ! Choice of cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + kdt ! Current forecast iteration logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation - effr_in ! Provide hydrometeor radii from macrophysics? + effr_in, & ! Provide hydrometeor radii from macrophysics? + do_mynnedmf, & ! Flag to activate MYNN-EDMF + doGP_cldoptics_LUT, & ! Flag to do GP cloud-optics (LUTs) + doGP_cldoptics_PADE ! (PADE approximation) real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant(?): Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = idcor_con) - real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude + con_rd ! Physical constant: gas-constant for dry air real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) p_lay, & ! Pressure at model-layers (Pa) @@ -87,9 +76,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld tracer ! Cloud condensate amount in layer by type () ! Outputs - real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length - real(kind_phys), dimension(nCol,nLev),intent(out) :: & + real(kind_phys), dimension(nCol,nLev),intent(inout) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius @@ -99,10 +86,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param, & ! Precipitation overlap parameter - deltaZb ! Layer thickness (km) + precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -110,10 +94,8 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Local variables real(kind_phys) :: tem1,pfac - real(kind_phys), dimension(nLev+1) :: hgtb - real(kind_phys), dimension(nLev) :: hgtc real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,ncndl,iSFC,iTOA + integer :: iCol,iLay,l,ncndl real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ logical :: top_at_1 @@ -131,24 +113,10 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld return endif - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif - - ! Initialize outputs - cld_lwp(:,:) = 0.0 + ! Initialize outputs cld_reliq(:,:) = reliq_def - cld_iwp(:,:) = 0.0 cld_reice(:,:) = reice_def - cld_rwp(:,:) = 0.0 cld_rerain(:,:) = rerain_def - cld_swp(:,:) = 0.0 cld_resnow(:,:) = resnow_def ! #################################################################################### @@ -161,143 +129,58 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - ! Since we combine the snow and grapuel, define local variable for number of condensate types. - ncndl = min(4,ncnd) - - ! Set really tiny suspended particle amounts to clear - do l=1,ncndl - do iLay=1,nLev - do iCol=1,nCol - if (cld_condensate(iCol,iLay,l) < con_epsq) cld_condensate(iCol,iLay,l) = 0.0 - enddo - enddo - enddo - - ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) - - ! Precipitation fraction (Hack. For now use cloud-fraction) - precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) - - ! Condensate and effective size + ! Cloud water path (g/m2) deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay = 1, nLev do iCol = 1, nCol ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(iCol,iLay) .ge. cllimit) then - tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) - cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 - cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 - cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 - cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 - endif + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) + cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) + cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + enddo + enddo + + ! Particle size + do iLay = 1, nLev + do iCol = 1, nCol ! Use radii provided from the macrophysics if (effr_in) then cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) - else - cld_reliq(iCol,iLay) = reliq_def - cld_reice(iCol,iLay) = reice_def - cld_rerain(iCol,iLay) = rerain_def - cld_resnow(iCol,iLay) = resnow_def endif enddo enddo - - ! #################################################################################### - ! Cloud (and precipitation) overlap - ! #################################################################################### - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! - do iCol=1,nCol - if (top_at_1) then - ! Layer thickness (km) - do iLay=1,nLev - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(nLev+1) = 0._kind_phys - do iLay=nLev,1,-1 - hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = nLev, 1, -1 - pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & - abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) - hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) - enddo - ! Layer thickness between centers - do iLay = nLev-1, 1, -1 - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) - enddo - deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) - else - do iLay=nLev,1,-1 - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(1) = 0._kind_phys - do iLay=1,nLev - hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = 1, nLev - pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & - abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) - hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) - enddo - ! Layer thickness between centers - do iLay = 2, nLev - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) - enddo - deltaZb(iCol,1) = hgtc(1) - hgtb(1) - endif - enddo - ! - ! Cloud decorrelation length - ! - if (idcor == idcor_hogan) then - call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) - endif - if (idcor == idcor_oreopoulos) then - call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) - endif - if (idcor == idcor_con) then - de_lgth(:) = dcorr_con + ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from + ! 2.5 - 21.5 microns for liquid clouds, + ! 10 - 180 microns for ice-clouds + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + where(cld_reliq .lt. radliq_lwr) cld_reliq = radliq_lwr + where(cld_reliq .gt. radliq_upr) cld_reliq = radliq_upr + where(cld_reice .lt. radice_lwr) cld_reice = radice_lwr + where(cld_reice .gt. radice_upr) cld_reice = radice_upr endif - - ! - ! Cloud overlap parameter - ! - if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then - call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) - else - de_lgth(:) = 0. - cloud_overlap_param(:,:) = 0. - endif - - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then + + ! Cloud-fraction + if (do_mynnedmf .and. kdt .gt. 1) then do iLay = 1, nLev do iCol = 1, nCol - if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then - cloud_overlap_param(iCol,iLay) = 0._kind_phys + if (tracer(iCol,iLay,i_cldrain) > 1.0e-7 .OR. tracer(iCol,iLay,i_cldsnow)>1.0e-7) then + cld_frac(iCol,iLay) = tracer(iCol,iLay,i_cldtot) endif enddo enddo + else + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) endif - - ! - ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) - ! - precip_overlap_param = cloud_overlap_param + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) + end subroutine GFS_rrtmgp_gfdlmp_pre_run ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 3841afc9b..19d09cd79 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_gfdlmp_pre type = scheme - dependencies = rrtmgp_aux.F90 + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90, rrtmgp_lw_cloud_optics.F90 ######################################################################## [ccpp-arg-table] @@ -62,7 +62,39 @@ dimensions = () type = logical intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F [i_cldliq] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) @@ -146,32 +178,6 @@ type = real kind = kind_phys intent = in - optional = F -[yearlen] - standard_name = number_of_days_in_year - long_name = number of days in a year - units = days - dimensions = () - type = integer - intent = in - optional = F -[julian] - standard_name = julian_day - long_name = julian day - units = days - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - intent = in - kind = kind_phys optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa @@ -209,15 +215,6 @@ kind = kind_phys intent = in optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -236,97 +233,6 @@ kind = kind_phys intent = in optional = F -[con_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 -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = flag for cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor] - standard_name = flag_for_decorrelation_length_method - long_name = flag for decorrelation length method used in cloud overlap method (iovr) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_con] - standard_name = flag_for_constant_decorrelation_length_method - long_name = choice of decorrelation length computation (costant) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_hogan] - standard_name = flag_for_hogan_decorrelation_length_method - long_name = choice of decorrelation length computation (hogan) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_oreopoulos] - standard_name = flag_for_oreopoulos_decorrelation_length_method - long_name = choice of decorrelation length computation (oreopoulos) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[dcorr_con] - standard_name = decorreltion_length_used_by_overlap_method - long_name = decorrelation length (default) used by cloud overlap method (iovr) - units = km - dimensions = () - type = real - intent = in - kind = kind_phys - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -334,7 +240,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_lwp] standard_name = cloud_liquid_water_path @@ -343,7 +249,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud @@ -352,7 +258,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_iwp] standard_name = cloud_ice_water_path @@ -361,7 +267,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reice] standard_name = mean_effective_radius_for_ice_cloud @@ -370,7 +276,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_swp] standard_name = cloud_snow_water_path @@ -379,7 +285,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_resnow] standard_name = mean_effective_radius_for_snow_flake @@ -388,7 +294,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rwp] standard_name = cloud_rain_water_path @@ -397,7 +303,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rerain] standard_name = mean_effective_radius_for_rain_drop @@ -406,7 +312,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [precip_frac] standard_name = precipitation_fraction_by_layer @@ -415,35 +321,8 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out - optional = F -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[deltaZb] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 537ce8879..e2dbd17fa 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -27,7 +27,7 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & - sfcdlw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + sfcdlw, sfculw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -65,12 +65,13 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(out) :: & - sfcdlw, & ! Total sky sfc downward lw flux (W/m2) - tsflw ! surface air temp during lw calculation (K) - type(sfcflw_type), dimension(nCol), intent(out) :: & - sfcflw ! LW radiation fluxes at sfc - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & + sfcdlw, & ! Total sky sfc downward lw flux (W/m2) + sfculw, & ! Total sky sfc upward lw flux (W/m2) + tsflw ! surface air temp during lw calculation (K) + type(sfcflw_type), dimension(nCol), intent(inout) :: & + sfcflw ! LW radiation fluxes at sfc + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrlw ! LW all-sky heating rate type(topflw_type), dimension(nCol), intent(out) :: & topflw ! lw_fluxes_top_atmosphere @@ -80,13 +81,13 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag errflg ! Outputs (optional) - type(proflw_type), dimension(nCol, nLev+1), optional, intent(out) :: & + type(proflw_type), dimension(nCol, nLev+1), optional, intent(inout) :: & flxprf_lw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrlwc ! Longwave clear-sky heating-rate (K/sec) ! Local variables @@ -160,6 +161,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! Radiation fluxes for other physics processes sfcdlw(:) = sfcflw(:)%dnfxc + sfculw(:) = sfcflw(:)%upfxc ! ####################################################################################### ! Save LW diagnostics diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 2218bc55e..72a82421e 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -196,7 +196,16 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout + optional = F +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout optional = F [sfcflw] standard_name = lw_fluxes_sfc @@ -204,7 +213,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = sfcflw_type - intent = out + intent = inout optional = F [tsflw] standard_name = surface_midlayer_air_temperature_in_longwave_radiation @@ -213,7 +222,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [htrlw] standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step @@ -222,7 +231,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [topflw] standard_name = lw_fluxes_top_atmosphere @@ -238,7 +247,7 @@ units = W m-2 dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = proflw_type - intent = out + intent = inout optional = T [htrlwc] standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step @@ -247,7 +256,7 @@ dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys - intent = out + intent = inout optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 0e5d65f5c..73828999f 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -143,10 +143,10 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & - fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & - con_eps, con_epsm1, con_fvirt, con_epsqs, & - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & + fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,& + con_epsm1, con_fvirt, con_epsqs, lw_gas_props, & + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& gas_concentrations, errmsg, errflg) ! Inputs @@ -181,36 +181,40 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, prsi ! Pressure at model-interfaces (Pa) real(kind_phys), dimension(nCol,nLev,nTracers) :: & qgrs ! Tracer concentrations (kg/kg) + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: ! Outputs character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), intent(out) :: & + real(kind_phys), intent(inout) :: & raddt ! Radiation time-step - real(kind_phys), dimension(ncol), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & tsfg, & ! Ground temperature tsfa ! Skin temperature - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer + q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers - relhum ! Relative-humidity at model-layers - real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & + relhum, & ! Relative-humidity at model-layers + qs_lay ! Saturation vapor pressure at model-layers + real(kind_phys), dimension(nCol,nLev+1), intent(inout) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface - real(kind_phys), dimension(nCol, nLev, nTracers),intent(out) :: & + real(kind_phys), dimension(nCol, nLev, nTracers),intent(inout) :: & tracer ! Array containing trace gases - type(ty_gas_concs),intent(out) :: & + type(ty_gas_concs),intent(inout) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o - real(kind_phys) :: es, qs, tem1, tem2 - real(kind_phys), dimension(nCol,nLev) :: o3_lay, q_lay + real(kind_phys) :: es, tem1, tem2 + real(kind_phys), dimension(nCol,nLev) :: o3_lay, tem2da, tem2db real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables @@ -248,14 +252,42 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) - ! Temperature at layer-interfaces + ! Temperature at layer-interfaces if (top_at_1) then + tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) + tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1) ) + tem2db(iCol,1) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,1)) ) + tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) + enddo + ! t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) - t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + do iLay = 2, iSFC + do iCol = 1, nCol + t_lev(iCol,iLay) = t_lay(iCol,iLay) + (t_lay(iCol,iLay-1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) + enddo + enddo t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else + tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) + tem2db(1:nCol,2:iTOA) = log(p_lev(1:nCol,2:iTOA)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1)) + tem2db(iCol,1) = log(p_lev(iCol,1)) + tem2db(iCol,iTOA) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,iTOA)) ) + enddo + ! t_lev(1:NCOL,1) = tsfc(1:NCOL) - t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + do iLay = 1, iTOA-1 + do iCol = 1, nCol + t_lev(iCol,iLay+1) = t_lay(iCol,iLay) + (t_lay(iCol,iLay+1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) + enddo + enddo t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif @@ -265,8 +297,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, do iCol=1,NCOL do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs ) ) + qs_lay(iCol,iLay) = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs_lay(iCol,iLay) ) ) tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + con_fvirt*q_lay(iCol,iLay)) enddo enddo @@ -319,7 +351,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### tsfg(1:NCOL) = tsfc(1:NCOL) - tsfa(1:NCOL) = tsfc(1:NCOL) + tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)!tsfc(1:NCOL) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 7fa69c0f6..d07f9c137 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -247,6 +247,14 @@ kind = kind_phys intent = in optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step @@ -254,7 +262,7 @@ dimensions = () type = real kind = kind_phys - intent = out + intent = inout optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa @@ -263,7 +271,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa @@ -272,7 +280,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP @@ -281,7 +289,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP @@ -290,7 +298,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation @@ -299,7 +307,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsfa] standard_name = surface_air_temperature_for_radiation @@ -308,7 +316,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [tv_lay] standard_name = virtual_temperature @@ -317,7 +325,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [relhum] standard_name = relative_humidity @@ -326,8 +334,26 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout + optional = F +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg/kg + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers @@ -335,7 +361,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys - intent = out + intent = inout optional = F [gas_concentrations] standard_name = Gas_concentrations_for_RRTMGP_suite @@ -343,7 +369,7 @@ units = DDT dimensions = () type = ty_gas_concs - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 3a9871a5c..f89c2e7e7 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -77,7 +77,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky cldtausw ! approx .55mu band layer cloud optical depth ! Inputs (optional) - type(cmpfsw_type), dimension(nCol), intent(in), optional :: & + type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux at (W/m2) ! uvbf0 - clear sky downward uv-b flux at (W/m2) @@ -89,7 +89,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & nirbmdi, & ! sfc nir beam sw downward flux (W/m2) nirdfdi, & ! sfc nir diff sw downward flux (W/m2) visbmdi, & ! sfc uv+vis beam sw downward flux (W/m2) @@ -100,11 +100,11 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky visdfui, & ! sfc uv+vis diff sw upward flux (W/m2) sfcnsw, & ! total sky sfc netsw flx into ground sfcdsw ! - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrsw ! SW all-sky heating rate - type(sfcfsw_type), dimension(nCol), intent(out) :: & + type(sfcfsw_type), dimension(nCol), intent(inout) :: & sfcfsw ! sw radiation fluxes at sfc - type(topfsw_type), dimension(nCol), intent(out) :: & + type(topfsw_type), dimension(nCol), intent(inout) :: & topfsw ! sw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg @@ -112,13 +112,13 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, nLev), intent(out), optional :: & + type(profsw_type), dimension(nCol, nLev), intent(inout), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrswc ! Clear-sky heating rate (K/s) ! Local variables diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 77f7b15a6..2dc412118 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -266,7 +266,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirdfdi] standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step @@ -275,7 +275,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visbmdi] standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -284,7 +284,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visdfdi] standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -293,7 +293,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirbmui] standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step @@ -302,7 +302,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirdfui] standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step @@ -311,7 +311,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visbmui] standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -320,7 +320,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visdfui] standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -329,7 +329,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcnsw] standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step @@ -338,7 +338,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcdsw] standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step @@ -347,7 +347,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step @@ -356,7 +356,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcfsw] standard_name = sw_fluxes_sfc @@ -364,7 +364,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = sfcfsw_type - intent = out + intent = inout optional = F [topfsw] standard_name = sw_fluxes_top_atmosphere @@ -372,7 +372,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = topfsw_type - intent = out + intent = inout optional = F [htrswc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step @@ -381,7 +381,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = T [flxprf_sw] standard_name = RRTMGP_sw_fluxes @@ -389,7 +389,7 @@ units = W m-2 dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_plus_one) type = profsw_type - intent = out + intent = inout optional = T [scmpsw] standard_name = components_of_surface_downward_shortwave_fluxes @@ -397,7 +397,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = cmpfsw_type - intent = in + intent = inout optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 179c622f5..1268ed26f 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -27,12 +27,11 @@ end subroutine GFS_rrtmgp_sw_pre_init !! \htmlinclude GFS_rrtmgp_sw_pre.html !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & - lndp_prt_list, doSWrad, solhr, & - lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & - relhum, p_lev, sw_gas_props, & - nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) + lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & + tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & + sfc_wts, p_lay, tv_lay, relhum, p_lev, sw_gas_props, nday, idxday, coszen, coszdg, & + sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & + errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -58,7 +57,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ sncovr, & ! Surface snow area fraction (frac) snoalb, & ! Maximum snow albedo (frac) zorl, & ! Surface roughness length (cm) - tsfc, & ! Surface skin temperature (K) + tsfg, & ! Surface ground temperature for radiation (K) + tsfa, & ! Lowest model layer air temperature for radiation (K) hprime, & ! Standard deviation of subgrid orography (m) alvsf, & ! Mean vis albedo with strong cosz dependency (frac) alnsf, & ! Mean nir albedo with strong cosz dependency (frac) @@ -84,7 +84,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ nday ! Number of daylit points integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points - real(kind_phys), dimension(ncol), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & coszen, & ! Cosine of SZA coszdg, & ! Cosine of SZA, daytime sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo @@ -132,7 +132,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ ! #################################################################################### alb1d(:) = 0. lndp_alb = -999. - call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & + call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, lndp_alb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. @@ -148,8 +148,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ else nday = 0 idxday = 0 - coszen(1:nCol) = 0. - coszdg(1:nCol) = 0. sfc_alb_nir_dir(:,1:nCol) = 0. sfc_alb_nir_dif(:,1:nCol) = 0. sfc_alb_uvvis_dir(:,1:nCol) = 0. diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index b24ab5710..202f1667a 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -154,15 +154,24 @@ kind = kind_phys intent = in optional = F -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [hprime] standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography @@ -356,7 +365,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [coszdg] standard_name = daytime_mean_cosz_over_rad_call_period @@ -365,7 +374,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfc_alb_dif] standard_name = surface_diffused_shortwave_albedo @@ -374,7 +383,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 new file mode 100644 index 000000000..ea27f3d2b --- /dev/null +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -0,0 +1,282 @@ +! ######################################################################################## +! This module contains the interface between the THOMPSON macrophysics and the RRTMGP radiation +! schemes. Only compatable with Model%imp_physics = Model%imp_physics_thompson +! ######################################################################################## +module GFS_rrtmgp_thompsonmp_pre + use machine, only: & + kind_phys + use rrtmgp_aux, only: & + check_error_msg + use module_mp_thompson, only: & + calc_effectRad, & + Nt_c + use module_mp_thompson_make_number_concentrations, only: & + make_IceNumber, & + make_DropletNumber, & + make_RainNumber + use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr + implicit none + + ! Parameters specific to THOMPSON MP scheme. + real(kind_phys), parameter :: & + rerain_def = 1000.0 ! Default rain radius to 1000 microns + + public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_thompsonmp_pre_init() + end subroutine GFS_rrtmgp_thompsonmp_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run +!! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html +!! + subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, doLWrad, & + i_cldliq, i_cldice, i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, & + i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & + effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, cld_frac_mg, con_g, & + con_rd, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & + imfdeepcnv_gf, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, errmsg, errflg) + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + ncnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid amount. + i_cldice, & ! cloud ice amount. + i_cldrain, & ! cloud rain amount. + i_cldsnow, & ! cloud snow amount. + i_cldgrpl, & ! cloud groupel amount. + i_cldtot, & ! cloud total amount. + i_cldliq_nc, & ! cloud liquid number concentration. + i_cldice_nc, & ! cloud ice number concentration. + i_twa, & ! water friendly aerosol. + imfdeepcnv, & ! Choice of mass-flux deep convection scheme + imfdeepcnv_gf ! Flag for Grell-Freitas deep convection scheme + logical, intent(in) :: & + doSWrad, & ! Call SW radiation? + doLWrad, & ! Call LW radiation + effr_in, & ! Use cloud effective radii provided by model? + uni_cld, & ! Use provided cloud-fraction? + lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall + lmfdeep2, & ! Flag for some scale-aware mass-flux convection scheme active + ltaerosol, & ! Flag for aerosol option + do_mynnedmf, & ! Flag to activate MYNN-EDMF + doGP_cldoptics_LUT,& ! Flag to do GP cloud-optics (LUTs) + doGP_cldoptics_PADE ! (PADE approximation) + real(kind_phys), intent(in) :: & + con_g, & ! Physical constant: gravitational constant + con_rd ! Physical constant: gas-constant for dry air + + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + t_lay, & ! Temperature (K) + qs_lay, & ! Saturation vapor pressure (Pa) + q_lay, & ! water-vapor mixing ratio (kg/kg) + relhum, & ! Relative humidity + p_lay, & ! Pressure at model-layers (Pa) + cld_frac_mg ! Cloud-fraction from MG scheme. WTF????? + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! In/Outs + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac, & ! Precipitation fraction + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: alpha0, pfac, tem1, cld_mr + real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate + integer :: iCol,iLay,l + real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& + re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa + logical :: top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (doSWrad .or. doLWrad)) return + + ! Cloud condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel + tracer(1:nCol,1:nLev,i_cldgrpl) + + ! Cloud water path (g/m2) + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay = 1, nLev + do iCol = 1, nCol + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) + cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) + cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + enddo + enddo + + ! Cloud particle sizes and number concentrations... + + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re + rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) + orho = 1./rho + do iLay = 1, nLev + do iCol = 1, nCol + qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + if (ltaerosol) then + nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) + else + nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) + endif + enddo + enddo + + ! Update number concentration, consistent with sub-grid clouds + do iLay = 1, nLev + do iCol = 1, nCol + if (ltaerosol .and. qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then + nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho(iCol,iLay), nwfa(iCol,iLay)) * orho(iCol,iLay) + endif + if (qi_mp(iCol,iLay) > 1.e-12 .and. ni_mp(iCol,iLay) < 100.) then + ni_mp(iCol,iLay) = make_IceNumber(qi_mp(iCol,iLay)*rho(iCol,iLay), t_lay(iCol,iLay)) * orho(iCol,iLay) + endif + enddo + enddo + + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds + ! Call Thompson's subroutine to compute effective radii + do iCol=1,nCol + call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & + nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & + re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) + enddo + + ! Scale Thompson's effective radii from meter to micron + effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 + effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 + effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 + + ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from + ! 2.5 - 21.5 microns for liquid clouds, + ! 10 - 180 microns for ice-clouds + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr + where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr + where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr + where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + endif + + ! Update global effective radii arrays. + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = rerain_def + + ! Compute cloud-fraction. Else, use value provided + if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv + ! Cloud-fraction + if (uni_cld) then + cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + else + if( lmfshal) alpha0 = 100. ! Default (from GATE simulations) + if(.not. lmfshal) alpha0 = 2000. + ! Xu-Randall (1996) cloud-fraction + do iLay = 1, nLev + do iCol = 1, nCol + cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & + cld_condensate(iCol,iLay,4) + cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0) + enddo + enddo + endif + endif + + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) + + end subroutine GFS_rrtmgp_thompsonmp_pre_run + + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_thompsonmp_pre_finalize() + end subroutine GFS_rrtmgp_thompsonmp_pre_finalize + + ! ###################################################################################### + ! This function computes the cloud-fraction following. + ! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models + ! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 + ! + ! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P + ! + ! ###################################################################################### + function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) + + ! Inputs + real(kind_phys), intent(in) :: & + p_lay, & ! Pressure (Pa) + qs_lay, & ! Saturation vapor-pressure (Pa) + relhum, & ! Relative humidity + cld_mr, & ! Total cloud mixing ratio + alpha ! Scheme parameter (default=100) + + ! Outputs + real(kind_phys) :: cld_frac_XuRandall + + ! Locals + real(kind_phys) :: clwt, clwm, onemrh, tem1, tem2, tem3 + + ! Parameters + real(kind_phys) :: & + lambda = 0.50, & ! + P = 0.25 + + clwt = 1.0e-6 * (p_lay*0.001) + if (cld_mr > clwt) then + onemrh = max(1.e-10, 1.0 - relhum) + tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) + tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) + tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p + ! + cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) + else + cld_frac_XuRandall = 0.0 + endif + + return + end function +end module GFS_rrtmgp_thompsonmp_pre diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta new file mode 100644 index 000000000..90ec59760 --- /dev/null +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -0,0 +1,442 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_thompsonmp_pre + type = scheme + dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90, rrtmgp_lw_cloud_optics.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_thompsonmp_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[uni_cld] + standard_name = flag_for_uni_cld + long_name = flag for uni_cld + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfshal] + standard_name = flag_for_lmfshal + long_name = flag for lmfshal + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfdeep2] + standard_name = flag_for_scale_aware_mass_flux_convection + long_name = flag for some scale-aware mass-flux convection scheme active + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldrain] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldsnow] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldgrpl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldtot] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldliq_nc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice_nc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_twa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_frac_mg] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg/kg + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 551f0e600..62efa00d5 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,14 +163,14 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) implicit none ! interface variables integer, intent(in ) :: im, levs, imfshalcnv logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv - logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid, use_LW_jacobian real(kind=kind_phys), intent(in ) :: dtf, cp, hvap logical, intent(in ), dimension(im) :: flag_cice @@ -183,18 +183,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer, intent(inout), dimension(im) :: kinver real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat - real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw - - ! RRTMGP - logical, intent(in ) :: & - use_GP_jacobian ! Use RRTMGP LW Jacobian of upwelling to adjust the surface flux? - real(kind=kind_phys), intent(in ), dimension(im) :: & - skt ! Skin temperature - real(kind=kind_phys), intent(inout), dimension(im) :: & - sktp1r ! Skin temperature at previous timestep - real(kind=kind_phys), intent(in ), dimension(im,levs+1), optional :: & - fluxlwUP, & ! Upwelling LW flux (W/m2) - fluxlwUP_jac ! Jacobian of upwelling LW flux (W/m2/K) + real(kind=kind_phys), intent(inout), dimension(im) :: adjsfculw ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -211,7 +200,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer :: i, k real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn - real(kind=kind_phys), dimension(im) :: tx1, tx2, dT + real(kind=kind_phys), dimension(im) :: tx1, tx2 real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys), parameter :: qmin = 1.0e-10_kind_phys, epsln=1.0e-10_kind_phys @@ -238,60 +227,44 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo ! --- ... sfc lw fluxes used by atmospheric model are saved for output - -! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed -! --- ... and provided as inputs in this routine. - - if (use_GP_jacobian) then - ! Compute adjustment to the surface flux using Jacobian. - if(linit_mod) then - dT(:) = (skt(:) - sktp1r(:)) - adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) - else - adjsfculw(:) = 0. - linit_mod = .true. - endif - - ! Store surface temperature for next iteration - sktp1r(:) = skt(:) - else - if (frac_grid) then - do i=1,im + if (.not. use_LW_jacobian) then + if (frac_grid) then + do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) endif - enddo - else - do i=1,im + enddo + else + do i=1,im if (dry(i)) then ! all land - adjsfculw(i) = adjsfculw_lnd(i) + adjsfculw(i) = adjsfculw_lnd(i) elseif (icy(i)) then ! ice (and water) - tem = one - cice(i) - if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_wat(i) /= huge) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = ulwsfc_cice(i) - endif - else - if (wet(i) .and. adjsfculw_wat(i) /= huge) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = adjsfculw_ice(i) - endif - endif + tem = one - cice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = ulwsfc_cice(i) + endif + else + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = adjsfculw_ice(i) + endif + endif else ! all water - adjsfculw(i) = adjsfculw_wat(i) + adjsfculw(i) = adjsfculw_wat(i) endif - enddo - endif + enddo + endif endif do i=1,im diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index b27884f9a..fdf1716f1 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -601,6 +601,14 @@ kind = kind_phys intent = inout optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [adjsfculw] standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time @@ -608,7 +616,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial @@ -636,7 +644,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [dlwsfc] standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface downwelling LW flux multiplied by timestep @@ -785,51 +793,7 @@ type = real kind = kind_phys intent = in - optional = F -[use_GP_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in - optional = F -[skt] - standard_name = air_temperature_at_lowest_model_layer - long_name = air temperature at lowest model layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sktp1r] - standard_name = surface_skin_temperature_at_previous_time_step - long_name = surface skin temperature at previous time step - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 6cbf35f03..92367ef4b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -571,6 +571,7 @@ subroutine GFS_surface_composites_post_run ( snowd(i) = snowd_ice(i) !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_wat(i) qss(i) = qss_ice(i) + tsfc(i) = tsfc_ice(i) evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 22eece516..389496d07 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -42,7 +42,7 @@ end subroutine dcyc2t3_finalize ! ( solhr,slag,sdec,cdec,sinlat,coslat, ! ! xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat, ! ! tf,tsflw,sfcemis_lnd,sfcemis_ice,sfcemis_wat, ! -! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! +! sfcdsw,sfcnsw,sfcdlw,sfculw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! ! im, levs, deltim, fhswr, ! @@ -50,7 +50,7 @@ end subroutine dcyc2t3_finalize ! input/output: ! ! dtdt,dtdtc, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! @@ -76,6 +76,7 @@ end subroutine dcyc2t3_finalize ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! ! sfcdlw (im) - real, total sky sfc downward lw flux ( w/m**2 ) ! +! sfculw (im) - real, total sky sfc upward lw flux ( w/m**2 ) ! ! swh(im,levs) - real, total sky sw heating rates ( k/s ) ! ! swhc(im,levs) - real, clear sky sw heating rates ( k/s ) ! ! hlw(im,levs) - real, total sky lw heating rates ( k/s ) ! @@ -179,11 +180,12 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & + & use_LW_jacobian, sfculw, sfculw_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -210,12 +212,13 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet + logical, intent(in) :: use_LW_jacobian real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr real(kind=kind_phys), dimension(im), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & - & sfcdsw, sfcnsw + & sfcdsw, sfcnsw, sfculw, sfculw_jac real(kind=kind_phys), dimension(im), intent(in) :: & & tsfc_lnd, tsfc_ice, tsfc_wat, & @@ -234,7 +237,7 @@ subroutine dcyc2t3_run & ! --- outputs: real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd @@ -247,7 +250,7 @@ subroutine dcyc2t3_run & ! --- locals: integer :: i, k, nstp, nstl, it, istsun(im) real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & - & rstl, solang + & rstl, solang, dT ! !===> ... begin here ! @@ -291,33 +294,35 @@ subroutine dcyc2t3_run & enddo endif ! - do i = 1, im + do i = 1, im + tem1 = tf(i) / tsflw(i) + tem2 = tem1 * tem1 + adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 !> - LW time-step adjustment: + if (use_LW_Jacobian) then + ! F_adj = F_o + (dF/dT) * dT + dT = tf(i) - tsflw(i) + adjsfculw(i) = sfculw(i) + sfculw_jac(i) * dT + else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. !! compute 4th power of the ratio of \c tf in the lowest model layer over the mean value \c tsflw. - tem1 = tf(i) / tsflw(i) - tem2 = tem1 * tem1 - adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 - -!! - compute \a sfc upward LW flux from current \a sfc temperature. -! note: sfc emiss effect is not appied here, and will be dealt in other place - - if (dry(i)) then - tem2 = tsfc_lnd(i) * tsfc_lnd(i) - adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) - endif - if (icy(i)) then - tem2 = tsfc_ice(i) * tsfc_ice(i) - adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ice(i)) * adjsfcdlw(i) - endif - if (wet(i)) then - tem2 = tsfc_wat(i) * tsfc_wat(i) - adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_wat(i)) * adjsfcdlw(i) - endif + if (dry(i)) then + tem2 = tsfc_lnd(i) * tsfc_lnd(i) + adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) + endif + if (icy(i)) then + tem2 = tsfc_ice(i) * tsfc_ice(i) + adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_ice(i)) * adjsfcdlw(i) + endif + if (wet(i)) then + tem2 = tsfc_wat(i) * tsfc_wat(i) + adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_wat(i)) * adjsfcdlw(i) + endif + endif ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) ! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 6fbc7f8b6..efba0a5f5 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -105,7 +105,7 @@ type = real kind = kind_phys intent = in - optional = F + optional = F [tf] standard_name = air_temperature_at_lowest_model_layer long_name = air temperature at lowest model layer @@ -178,6 +178,15 @@ kind = kind_phys intent = in optional = F +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [swh] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate on radiation time step @@ -416,6 +425,15 @@ kind = kind_phys intent = out optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [xmu] standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave fluxes @@ -506,6 +524,23 @@ kind = kind_phys intent = out optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[sfculw_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward_at_surface + long_name = RRTMGP Jacobian upward longwave flux at surface + units = W m-2 K-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index eaa1366a8..2e68ceb12 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -1260,7 +1260,7 @@ subroutine drag_suite_run( & eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) ! Modify theta tendency - dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim/prslk(i,k) + dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim end if dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + taud_bl(i,k)*xn(i)*del(i,k) diff --git a/physics/gmtb_scm_sfc_flux_spec.F90 b/physics/gmtb_scm_sfc_flux_spec.F90 index d77e42000..22730f9f2 100644 --- a/physics/gmtb_scm_sfc_flux_spec.F90 +++ b/physics/gmtb_scm_sfc_flux_spec.F90 @@ -15,7 +15,18 @@ module gmtb_scm_sfc_flux_spec CONTAINS !******************************************************************************************* - subroutine gmtb_scm_sfc_flux_spec_init() + subroutine gmtb_scm_sfc_flux_spec_init(lheatstrg, errmsg, errflg) + + logical, intent(in) :: lheatstrg + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + if (lheatstrg) then + errmsg = 'Using specified surface fluxes is not compatible with canopy heat storage (lheatstrg) being true. Stopping.' + errflg = 1 + return + end if end subroutine gmtb_scm_sfc_flux_spec_init subroutine gmtb_scm_sfc_flux_spec_finalize() @@ -38,16 +49,17 @@ end subroutine gmtb_scm_sfc_flux_spec_finalize !! -# Calculate the surface drag coefficient for heat and moisture. !! -# Calculate the u and v wind at 10m. subroutine gmtb_scm_sfc_flux_spec_run (u1, v1, z1, t1, q1, p1, roughness_length, spec_sh_flux, spec_lh_flux, & - exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, sh_flux, lh_flux, u_star, sfc_stress, cm, ch, & + exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, sh_flux, lh_flux, sh_flux_chs, lh_flux_chs, u_star, sfc_stress, cm, ch, & fm, fh, rb, u10m, v10m, wind1, qss, t2m, q2m, errmsg, errflg) use machine, only: kind_phys - + real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman real(kind=kind_phys), intent(out) :: sh_flux(:), lh_flux(:), u_star(:), sfc_stress(:), & - cm(:), ch(:), fm(:), fh(:), rb(:), u10m(:), v10m(:), wind1(:), qss(:), t2m(:), q2m(:) + cm(:), ch(:), fm(:), fh(:), rb(:), u10m(:), v10m(:), wind1(:), qss(:), t2m(:), q2m(:), & + sh_flux_chs(:), lh_flux_chs(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -60,12 +72,14 @@ subroutine gmtb_scm_sfc_flux_spec_run (u1, v1, z1, t1, q1, p1, roughness_length, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + ! !--- set control properties (including namelist read) !calculate u_star from wind profiles (need roughness length, and wind and height at lowest model level) do i=1, size(z1) sh_flux(i) = spec_sh_flux(i) lh_flux(i) = spec_lh_flux(i) + sh_flux_chs(i) = sh_flux(i) + lh_flux_chs(i) = lh_flux(i) roughness_length_m = 0.01*roughness_length(i) diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta index 71ddff22a..1e004b7f9 100644 --- a/physics/gmtb_scm_sfc_flux_spec.meta +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -4,6 +4,36 @@ dependencies = machine.F ######################################################################## +[ccpp-arg-table] + name = gmtb_scm_sfc_flux_spec_init + type = scheme +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +################################# [ccpp-arg-table] name = gmtb_scm_sfc_flux_spec_run type = scheme @@ -178,6 +208,24 @@ kind = kind_phys intent = out optional = F +[sh_flux_chs] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[lh_flux_chs] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [u_star] standard_name = surface_friction_velocity long_name = boundary layer parameter diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index ebc5ea2ae..592b88e32 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -293,55 +293,6 @@ subroutine sgscloud_radpre_run( & endif ! timestep > 1 -!> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. - - do i =1, im - rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range -! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range - enddo - - do id = 1, 4 - tem1 = ptopc(id,2) - ptopc(id,1) - do i =1, im - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - - cldcnv = 0. - -! DH* 20200723 -! iovr == 4 or 5 requires alpha, which is computed in GFS_rrmtg_pre, -! which comes after SGSCloud_RadPre. Computing alpha here requires -! a lot more input variables and computations (dzlay etc.), and -! recomputing it in GFS_rrmtg_pre is a waste of time. Workaround: -! pass a dummy array initialized to zero to gethml for other values of iovr. - if ( iovr == 4 .or. iovr == 5 ) then - errmsg = 'Logic error in sgscloud_radpre: iovr==4 or 5 not implemented' - errflg = 1 - return - end if -!! Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options -! if ( iovr == 4 .or. iovr == 5 ) then -! call get_alpha_exp & -!! --- inputs: -! (im, nlay, dzlay, iovr, latdeg, julian, yearlen, clouds1, & -!! --- outputs: -! alpha & -! ) -! endif - alpha_dummy = 0.0 -! *DH 2020723 - -!> - Recompute the diagnostic high, mid, low, total and bl cloud fraction - call gethml & -! --- inputs: - ( plyr, ptop1, clouds1, cldcnv, dz, de_lgth, alpha_dummy, & -! --- outputs: - im, nlay, cldsa, mtopa, mbota) - - !print*,"===Finished adding subgrid clouds to the resolved-scale clouds" - !print*,"qc_save:",qc_save(1,1)," qi_save:",qi_save(1,1) - end subroutine sgscloud_radpre_run end module sgscloud_radpre diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index f45f08dd1..341c19fc2 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -3,7 +3,7 @@ module rrtmgp_lw_cloud_optics use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf @@ -17,17 +17,23 @@ module rrtmgp_lw_cloud_optics absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr ! Ice particle size lower bound for LUT interpolation contains - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_init() - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & - nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, & + mpirank, mpiroot, lw_cloud_props, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -52,13 +58,13 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ integer, intent(out) :: & errflg ! Error code - ! Variables that will be passed to cloud_optics%load() + ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr, & ! Ice particle size lower bound for LUT interpolation + !radice_lwr, & ! Ice particle size upper bound for LUT interpolation + !radice_upr, & ! Ice particle size lower bound for LUT interpolation radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & lut_extliq, & ! LUT shortwave liquid extinction coefficient @@ -264,16 +270,16 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ end subroutine rrtmgp_lw_cloud_optics_init - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_run() - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_cloud_optics_run !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, & - cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & - precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nrghice, p_lay, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) ! Inputs @@ -281,7 +287,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw doLWrad, & ! Logical flag for longwave radiation call doG_cldoptics, & ! Use legacy RRTMG cloud-optics? doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -313,10 +320,10 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - type(ty_optical_props_1scl),intent(out) :: & + type(ty_optical_props_2str),intent(inout) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - real(kind_phys), dimension(ncol,nLev), intent(out) :: & + real(kind_phys), dimension(ncol,nLev), intent(inout) :: & cldtaulw ! Approx 10.mu band layer cloud optical depth ! Local variables @@ -337,14 +344,19 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw ! Allocate space for RRTMGP DDTs containing cloud radiative properties ! Cloud optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys + lw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + ! Precipitation optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_1scl(& - ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys + lw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + ! Compute cloud-optics for RTE. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! i) RRTMGP cloud-optics. @@ -381,14 +393,14 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & cld_frac, icliq_lw, icice_lw, tau_cld, tau_precip) - endif - lw_optical_props_cloudsByBand%tau = tau_cld - lw_optical_props_precipByBand%tau = tau_precip + lw_optical_props_cloudsByBand%tau = tau_cld + lw_optical_props_precipByBand%tau = tau_precip + endif endif ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) - + end subroutine rrtmgp_lw_cloud_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 809e8abf0..c57e70a33 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -159,6 +159,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -314,14 +322,14 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [lw_optical_props_cloudsByBand] standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [lw_optical_props_precipByBand] @@ -329,7 +337,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [errmsg] diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index cfb86eb3a..902a4e20f 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,7 +1,7 @@ module rrtmgp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg @@ -12,7 +12,7 @@ module rrtmgp_lw_cloud_sampling contains ! ######################################################################################### - ! SUBROUTINE mcica_init + ! SUBROUTINE rrtmgp_lw_cloud_sampling_init() ! ######################################################################################### !! \section arg_table_rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_init.html @@ -47,12 +47,13 @@ end subroutine rrtmgp_lw_cloud_sampling_init subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & - lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & + doGP_lwscat, lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for shortwave radiation call + doLWrad, & ! Logical flag for shortwave radiation call + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical layers @@ -78,7 +79,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data - type(ty_optical_props_1scl),intent(in) :: & + type(ty_optical_props_2str),intent(in) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) @@ -87,7 +88,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - type(ty_optical_props_1scl),intent(out) :: & + type(ty_optical_props_2str),intent(out) :: & lw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (clouds) lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) @@ -96,8 +97,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables @@ -112,7 +113,9 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& - lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) + lw_optical_props_clouds%alloc_2str(nCol, nLev, lw_gas_props)) + lw_optical_props_clouds%tau(:,:,:) = 0._kind_phys + lw_optical_props_clouds%ssa(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -170,7 +173,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_lw_cloud_sampling_run_draw_samples',& - draw_samples(cldfracMCICA, & + draw_samples(cldfracMCICA, doGP_lwscat, & lw_optical_props_cloudsByBand, & lw_optical_props_clouds)) @@ -180,7 +183,9 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& - lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) + lw_optical_props_precip%alloc_2str(nCol, nLev, lw_gas_props)) + lw_optical_props_precip%tau(:,:,:) = 0._kind_phys + lw_optical_props_precip%ssa(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -230,7 +235,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_lw_precip_sampling_run_draw_samples',& - draw_samples(precipfracSAMP, & + draw_samples(precipfracSAMP, doGP_lwscat, & lw_optical_props_precipByBand, & lw_optical_props_precip)) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 54f3c63af..2438f715c 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -53,6 +53,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -198,7 +206,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = in optional = F [lw_optical_props_precipByBand] @@ -206,7 +214,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = in optional = F [lw_optical_props_clouds] @@ -214,7 +222,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [lw_optical_props_precip] @@ -222,7 +230,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [errmsg] diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 787db6bb4..f8a01b982 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -282,7 +282,7 @@ end subroutine rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& - t_lev, skt, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) + t_lev, tsfg, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -299,7 +299,7 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ p_lev, & ! Pressure @ model layer-interfaces (hPa) t_lev ! Temperature @ model levels real(kind_phys), dimension(ncol), intent(in) :: & - skt ! Surface(skin) temperature (K) + tsfg ! Surface ground temperature (K) type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) @@ -328,7 +328,7 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ p_lay, & ! IN - Pressure @ layer-centers (Pa) p_lev, & ! IN - Pressure @ layer-interfaces (Pa) t_lay, & ! IN - Temperature @ layer-centers (K) - skt, & ! IN - Skin-temperature (K) + tsfg, & ! IN - Skin-temperature (K) gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties sources, & ! OUT - RRTMGP DDT: source functions diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 92d475d24..3eab78be2 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -165,7 +165,7 @@ kind = kind_phys intent = in optional = F -[skt] +[tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index caee7308e..358e49bee 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -24,8 +24,8 @@ end subroutine rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run !! \htmlinclude rrtmgp_lw_pre_run.html !! - subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, tsfc, & - hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & + tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -39,7 +39,8 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc zorl, & ! Surface roughness length (cm) snowd, & ! water equivalent snow depth (mm) sncovr, & ! Surface snow are fraction (1) - tsfc, & ! Surface skin temperature (K) + tsfg, & ! Surface ground temperature for radiation (K) + tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: spectral information for LW calculation @@ -66,7 +67,7 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfc, tsfc, hprime, nCol, semis) + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, nCol, semis) ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 8084ecf90..1f329dd8d 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -77,15 +77,24 @@ kind = kind_phys intent = in optional = F -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [hprime] standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index dc49260f6..321214a02 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -5,7 +5,7 @@ module rrtmgp_lw_rte use mo_rte_kind, only: wl use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rte_lw, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband use mo_source_functions, only: ty_source_func_lw @@ -28,28 +28,23 @@ end subroutine rrtmgp_lw_rte_init !! \section arg_table_rrtmgp_lw_rte_run !! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p_lay, & - t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky,& + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & + nLev, p_lev, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & - fluxlwDOWN_jac, errmsg, errflg) + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, sfculw_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad, & ! Logical flag for longwave radiation call doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? - use_LW_jacobian ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nGauss_angles ! Number of angles used in Gaussian quadrature - real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) - t_lay ! Temperature (K) real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & p_lev ! Pressure @ model layer-interfaces (hPa) - real(kind_phys), dimension(ncol), intent(in) :: & - skt ! Surface(skin) temperature (K) type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: longwave spectral information real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & @@ -57,12 +52,15 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p type(ty_source_func_lw),intent(in) :: & sources ! RRTMGP DDT: longwave source functions type(ty_optical_props_1scl),intent(inout) :: & + lw_optical_props_aerosol, &! RRTMGP DDT: longwave aerosol radiative properties lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties - type(ty_optical_props_1scl),intent(in) :: & - lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties - lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_optical_props_2str),intent(inout) :: & + lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties + ! Outputs - real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & + sfculw_jac ! Jacobian of upwelling LW surface radiation (W/m2/K) + real(kind_phys), dimension(ncol,nLev+1), intent(inout) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) @@ -70,21 +68,17 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag - ! Outputs (optional) - real(kind_phys), dimension(ncol,nLev+1), intent(out), optional :: & - fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) - fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) + errflg ! CCPP error flag ! Local variables - integer :: & - iCol, iBand, iLay type(ty_fluxes_byband) :: & flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(nCol,nLev+1) :: fluxlwUP_jac,fluxlwDOWN_jac logical :: & top_at_1 + integer :: iSFC, iTOA ! Initialize CCPP error handling variables errmsg = '' @@ -94,7 +88,14 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! Vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - + if (top_at_1) then + iSFC = nLev+1 + iTOA = 1 + else + iSFC = 1 + iTOA = nLev+1 + endif + ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -106,6 +107,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) + call lw_optical_props_aerosol%finalize() ! Call RTE solver if (doLWclrsky) then @@ -128,31 +130,63 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! ! All-sky fluxes ! - ! Add cloud optics to clear-sky optics - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - ! Call RTE solver - if (use_LW_jacobian) then - ! Compute LW Jacobians - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) - flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Add clear-sky optics to cloud-optics (2-stream) + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%increment(lw_optical_props_clouds)) + call lw_optical_props_clrsky%finalize() + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + sfculw_jac = fluxlwUP_jac(:,iSFC) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + ! No scattering in LW clouds. else - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature - end if - + ! Add cloud optics to clear-sky optics (scalar) + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) + call lw_optical_props_clouds%finalize() + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + sfculw_jac = fluxlwUP_jac(:,iSFC) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + endif + ! Store fluxes fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 857ab834c..d295fa511 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -32,6 +32,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -56,15 +64,6 @@ type = integer intent = in optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure layer - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level @@ -74,24 +73,6 @@ kind = kind_phys intent = in optional = F -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[skt] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band long_name = surface emissivity in each RRTMGP LW band @@ -122,8 +103,8 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl - intent = in + type = ty_optical_props_2str + intent = inout optional = F [lw_optical_props_aerosol] standard_name = longwave_optical_properties_for_aerosols @@ -131,7 +112,7 @@ units = DDT dimensions = () type = ty_optical_props_1scl - intent = in + intent = inout optional = F [sources] standard_name = longwave_source_function @@ -148,7 +129,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_allsky] standard_name = RRTMGP_lw_flux_profile_downward_allsky @@ -157,7 +138,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwUP_clrsky] standard_name = RRTMGP_lw_flux_profile_upward_clrsky @@ -166,7 +147,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_clrsky] standard_name = RRTMGP_lw_flux_profile_downward_clrsky @@ -175,26 +156,17 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile +[sfculw_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward_at_surface + long_name = RRTMGP Jacobian upward longwave flux at surface units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = out - optional = T -[fluxlwDOWN_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward - long_name = RRTMGP Jacobian downward of longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out - optional = T + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_sampling.F90 b/physics/rrtmgp_sampling.F90 index 29a9064a2..3974da359 100644 --- a/physics/rrtmgp_sampling.F90 +++ b/physics/rrtmgp_sampling.F90 @@ -36,9 +36,10 @@ module rrtmgp_sampling ! McICA-sampled cloud optical properties ! ! ------------------------------------------------------------------------------------------------- - function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) + function draw_samples(cloud_mask,do_twostream,clouds,clouds_sampled) result(error_msg) ! Inputs logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt + logical, intent(in ) :: do_twostream ! Do two-stream? class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band ! Outputs @@ -66,8 +67,10 @@ function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) type is (ty_optical_props_2str) select type(clouds_sampled) type is (ty_optical_props_2str) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + if (do_twostream) then + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + endif class default error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" end select diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 505fe7853..f08cd7181 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -1,8 +1,8 @@ module rrtmgp_sw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_aux, only: check_error_msg @@ -18,17 +18,22 @@ module rrtmgp_sw_cloud_optics a0s = 0.0, & ! a1s = 1.5 ! real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr ! Ice particle size lower bound for LUT interpolation contains - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & - nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props,& - errmsg, errflg) + subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, & + mpirank, mpiroot, sw_cloud_props, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -53,13 +58,13 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ integer, intent(out) :: & errflg ! CCPP error code - ! Variables that will be passed to cloud_optics%load() + ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr, & ! Ice particle size lower bound for LUT interpolation + !radice_lwr, & ! Ice particle size upper bound for LUT interpolation + !radice_upr, & ! Ice particle size lower bound for LUT interpolation radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & lut_extliq, & ! LUT shortwave liquid extinction coefficient diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index ba4097e96..e74ceb4e5 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -181,7 +181,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_sw_cloud_sampling_run_draw_samples', & - draw_samples(cldfracMCICA, & + draw_samples(cldfracMCICA, .true., & sw_optical_props_cloudsByBand, & sw_optical_props_clouds)) @@ -239,7 +239,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_sw_precip_sampling_run_draw_samples', & - draw_samples(precipfracSAMP, & + draw_samples(precipfracSAMP, .true., & sw_optical_props_precipByBand, & sw_optical_props_precip)) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index fda887f3e..5c0604f86 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -244,7 +244,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, integer, intent(in) :: gwd_opt integer, intent(in), dimension(im) :: kpbl real(kind=kind_phys), intent(in), dimension(im) :: oro, oro_uf, hprime, oc, theta, sigma, gamma - real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,oa4ss,ol4ss,dx + real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,dx + real(kind=kind_phys), intent(in), dimension(im,4) :: oa4ss,ol4ss logical, intent(in) :: flag_for_gwd_generic_tend ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS real(kind=kind_phys), intent(inout), dimension(im) :: elvmax