Skip to content

Commit

Permalink
Same stuff as previous commit, but for SW.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed May 1, 2019
1 parent cf6bd66 commit c089f10
Show file tree
Hide file tree
Showing 4 changed files with 486 additions and 227 deletions.
18 changes: 0 additions & 18 deletions physics/rrtmgp_lw_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,24 +15,6 @@ module mo_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), parameter :: &
cldmin = 1e-20_kind_phys

! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50
! and 1.80) as a function of total column water vapor. the function
! has been defined to minimize flux and cooling rate errors in these bands
! over a wide range of precipitable water values.
real (kind_phys), dimension(nbandsLW_RRTMG) :: &
a0 = (/ 1.66, 1.55, 1.58, 1.66, 1.54, 1.454, 1.89, 1.33, &
1.668, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66 /), &
a1 = (/ 0.00, 0.25, 0.22, 0.00, 0.13, 0.446, -0.10, 0.40, &
-0.006, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /), &
a2 = (/ 0.00, -12.0, -11.7, 0.00, -0.72,-0.243, 0.19,-0.062, &
0.414, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /)
real(kind_phys),parameter :: &
diffusivityLow = 1.50, & ! Minimum diffusivity angle for bands 2-3 and 5-9
diffusivityHigh = 1.80, & ! Maximum diffusivity angle for bands 2-3 and 5-9
diffusivityB1410 = 1.66 ! Diffusivity for bands 1, 4, and 10

! RRTMG LW cloud property coefficients
real(kind_phys) , dimension(58,nBandsLW_RRTMG),parameter :: &
Expand Down
24 changes: 13 additions & 11 deletions physics/rrtmgp_lw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -232,6 +232,9 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
! How are we handling cloud-optics?
rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys

! HACK. If using RRTMG cloud_optics w/ RRTMGP, we need to be able to define
if (Model%rrtmgp_cld_phys .eq. 0) rrtmgp_lw_cld_phys=1

! Filenames are set in the gfs_physics_nml (scm/src/GFS_typedefs.F90)
kdist_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_gas)
kdist_cldy_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_clouds)
Expand Down Expand Up @@ -653,17 +656,17 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
status = nf90_get_var(ncid_lw_clds,varID,pade_ssaice)
status = nf90_inq_varid(ncid_lw_clds,'pade_asyice',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_asyice)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizereg_extliq',varID)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_extliq',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_extliq)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizereg_ssaliq',varID)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_ssaliq',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_ssaliq)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizereg_asyliq',varID)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_asyliq',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_asyliq)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizereg_extice',varID)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_extice',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_extice)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizereg_ssaice',varID)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_ssaice',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_ssaice)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizereg_asyice',varID)
status = nf90_inq_varid(ncid_lw_clds,'pade_sizreg_asyice',varID)
status = nf90_get_var(ncid_lw_clds,varID,pade_sizereg_asyice)
status = nf90_inq_varid(ncid_lw_clds,'bnd_limits_wavenumber',varID)
status = nf90_get_var(ncid_lw_clds,varID,band_lims_cldy)
Expand Down Expand Up @@ -708,21 +711,22 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)

! Load tables data for RRTGMP cloud-optics
if (rrtmgp_lw_cld_phys .eq. 1) then
print*,'RRTMGP_INIT: ',shape(lut_extice)
call check_error_msg(kdist_lw_cldy%set_ice_roughness(nrghice))
call check_error_msg(kdist_lw_cldy%load(band_lims_cldy, radliq_lwr, radliq_upr, &
radliq_fac, radice_lwr, radice_upr, radice_fac, lut_extliq, lut_ssaliq, &
lut_asyliq, lut_extice, lut_ssaice, lut_asyice))
endif
if (rrtmgp_lw_cld_phys .eq. 2) then
print*,'RRTMGP_INIT: ',shape(pade_extice)
call check_error_msg(kdist_lw_cldy%set_ice_roughness(nrghice))
call check_error_msg(kdist_lw_cldy%load(band_lims_cldy, pade_extliq, &
pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice, &
pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, &
pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice))
endif

! HACK!
rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys

end subroutine rrtmgp_lw_init

! #########################################################################################
Expand Down Expand Up @@ -908,8 +912,6 @@ subroutine rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr
type(ty_fluxes_byband) :: &
fluxAllSky, & ! All-sky flux (W/m2)
fluxClrSky ! Clear-sky flux (W/m2)
! type(ty_fluxes_byband) :: &
! fluxBBAllSky ! All-sky flux (in each LW band) (W/m2)

! Initialize CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -1110,7 +1112,7 @@ subroutine rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr
if (rrtmgp_lw_cld_phys .gt. 0) then
print*,'Using RRTMGP cloud-physics'
call check_error_msg(kdist_lw_cldy%cloud_optics(ncol, nlay, nBandsLW, nrghice, &
liqmask, icemask, cld_lwp, cld_iwp, cld_ref_liq2, cld_ref_ice2, optical_props_cldy))
liqmask, icemask, cld_lwp, cld_iwp, cld_ref_liq2, cld_ref_ice2, optical_props_cldy))
end if
endif

Expand Down
29 changes: 12 additions & 17 deletions physics/rrtmgp_sw_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2063,7 +2063,7 @@ subroutine rrtmgp_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cl
cld_ref_snow ! Effective radius (snow-flake) (micron)

! Outputs
real(kind_phys),dimension(nBandsSW,ncol,nlay),intent(out) :: &
real(kind_phys),dimension(ncol,nlay,nBandsSW),intent(out) :: &
tau_cld, & ! In-cloud optical depth (1)
ssa_cld, & ! In-cloud single-scattering albedo (1)
asy_cld ! In-cloud asymmetry parameter (1)
Expand Down Expand Up @@ -2234,22 +2234,17 @@ subroutine rrtmgp_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cl
if (cld_frac(iCol,iLay) .gt. 0._kind_phys) then
do iBand = 1,nBandsSW
! Sum up radiative properties by type.
tau_cld(iBand,iCol,iLay) = tau_liq(iBand) + tau_ice(iBand) + tau_rain + tau_snow
ssa_cld(iBand,iCol,iLay) = ssa_liq(iBand) + ssa_ice(iBand) + ssa_rain(iBand) + ssa_snow(iBand)
asy_cld(iBand,iCol,iLay) = asy_liq(iBand) + asy_ice(iBand) + asy_rain(iBand) + asy_snow(iBand)
tau_cld(iCol,iLay,iBand) = tau_liq(iBand) + tau_ice(iBand) + tau_rain + tau_snow
ssa_cld(iCol,iLay,iBand) = ssa_liq(iBand) + ssa_ice(iBand) + ssa_rain(iBand) + ssa_snow(iBand)
asy_cld(iCol,iLay,iBand) = asy_liq(iBand) + asy_ice(iBand) + asy_rain(iBand) + asy_snow(iBand)
! Delta-scale
asyw = asy_cld(iband,iCol,iLay)/max(0._kind_phys, ssa_cld(iBand,iCol,iLay))
ssaw = min(1._kind_phys-0.000001, ssa_cld(iBand,iCol,iLay)/tau_cld(iBand,iCol,iLay))
asyw = asy_cld(iCol,iLay,iBand)/max(0._kind_phys, ssa_cld(iCol,iLay,iBand))
ssaw = min(1._kind_phys-0.000001, ssa_cld(iCol,iLay,iBand)/tau_cld(iCol,iLay,iBand))
za1 = asyw * asyw
za2 = ssaw * za1
tau_cld(iBand,iCol,iLay) = (1._kind_phys - za2) * tau_cld(iband,iCol,iLay)
ssa_cld(iBand,iCol,iLay) = (ssaw - za2) / (1._kind_phys - za2)
asy_cld(iBand,iCol,iLay) = (asyw - za2/ssaw)/(1-za2/ssaw)
!asy_cld(iBand,iCol,iLay) = (tau_liq(iBand)*ssa_liq(iBand)*(asycoliq(iBand)-asycoliq(iBand)**2)/&
! (1 - asycoliq(iBand)**2) + &
! tau_ice(iBand)*ssa_ice(iBand)*(asycoice(iBand)-forwice(iBand))/&
! (1 - forwice(iBand)))/&
! (tau_liq(iBand)*ssa_liq(iBand) + tau_ice(iBand)*ssa_ice(iBand))
tau_cld(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_cld(iCol,iLay,iBand)
ssa_cld(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2)
asy_cld(iCol,iLay,iBand) = (asyw - za2/ssaw)/(1-za2/ssaw)
enddo ! Loop over SW bands
endif ! END sum cloudy properties
!
Expand All @@ -2276,7 +2271,7 @@ subroutine mcica_subcol_sw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth,
cld_frac, & ! Cloud-fraction
dzlyr ! Layer thinkness (km)
! Outputs
real(kind_phys),dimension(ngpts,ncol,nlay),intent(out) :: &
logical,dimension(ncol,nlay,ngpts),intent(out) :: &
cld_frac_mcica
! Local variables
type(random_stat) :: stat
Expand Down Expand Up @@ -2406,9 +2401,9 @@ subroutine mcica_subcol_sw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth,
do n = 1, ngpts
lcloudy(n,k) = cdfunc(n,k) >= tem1
if (lcloudy(n,k)) then
cld_frac_mcica(n,icol,k) = 1._kind_phys
cld_frac_mcica(icol,k,n) = .true.
else
cld_frac_mcica(n,icol,k) = 0._kind_phys
cld_frac_mcica(icol,k,n) = .false.
endif
enddo
enddo
Expand Down
Loading

0 comments on commit c089f10

Please sign in to comment.