Skip to content

Commit

Permalink
Cleaned up a tad.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Feb 14, 2020
1 parent 54a38d9 commit c984e90
Show file tree
Hide file tree
Showing 7 changed files with 334 additions and 347 deletions.
92 changes: 0 additions & 92 deletions physics/GFS_rrtmgp_lw_pre.F90
View file

This file was deleted.

135 changes: 0 additions & 135 deletions physics/GFS_rrtmgp_lw_pre.meta
View file

This file was deleted.

101 changes: 59 additions & 42 deletions physics/GFS_rrtmgp_sw_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,6 @@ module GFS_rrtmgp_sw_pre
use physparam
use machine, only: &
kind_phys ! Working type
use GFS_typedefs, only: &
GFS_sfcprop_type, & ! Surface fields
GFS_control_type, & ! Model control parameters
GFS_grid_type, & ! Grid and interpolation related data
GFS_coupling_type, & !
GFS_statein_type, & !
GFS_radtend_type, & ! Radiation tendencies needed in physics
GFS_interstitial_type
use module_radiation_astronomy,only: &
coszmn ! Function to compute cos(SZA)
use module_radiation_surface, only: &
Expand All @@ -35,29 +27,57 @@ end subroutine GFS_rrtmgp_sw_pre_init
!> \section arg_table_GFS_rrtmgp_sw_pre_run
!! \htmlinclude GFS_rrtmgp_sw_pre.html
!!
subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, &
tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, &
sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, &
errmsg, errflg)
subroutine GFS_rrtmgp_sw_pre_run(doLWrad, do_sfcperts, ncol, nlev, ntrac, nsfcpert, nmtvr,mpi_rank, solhr, &
pertalb, sfc_wts, xlon, coslat, sinlat, slmsk, snowd, sncovr, snoalb, zorl, coszen, coszdg, tsfc,&
hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, p_lay, p_lev, tv_lay, &
relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfalb, sfc_alb_nir_dir, sfc_alb_nir_dif, &
sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg)

! Inputs
type(GFS_control_type), intent(in) :: &
Model ! DDT: FV3-GFS model control parameters
type(GFS_grid_type), intent(in) :: &
Grid ! DDT: FV3-GFS grid and interpolation related data
type(GFS_sfcprop_type), intent(in) :: &
Sfcprop ! DDT: FV3-GFS surface fields
type(GFS_statein_type), intent(in) :: &
Statein ! DDT: FV3-GFS prognostic state data in from dycore
logical, intent(in) :: &
doLWrad , & ! Flag for longwave radiation call
do_sfcperts ! Flag for stochastic surface perturbations option

integer, intent(in) :: &
ncol ! Number of horizontal grid points
real(kind_phys), dimension(ncol,Model%levs),intent(in) :: &
ncol, & ! Number of horizontal grid points
nlev, & ! Number of vertical levels
ntrac, & ! Number of tracers
nsfcpert, & ! number of surface perturbations
nmtvr, & ! number of topographic variables in GWD
mpi_rank ! Current MPI-rank
real(kind_phys), intent(in) :: &
solhr ! Time after 00z at the current timestep (hours)
real(kind_phys), dimension(nsfcpert), intent(in) :: &
pertalb ! Magnitude of surface albedo perturbation
real(kind_phys), dimension(ncol,nsfcpert), intent(in) :: &
sfc_wts ! Magnitude of surface albedo perturbation
real(kind_phys), dimension(ncol), intent(in) :: &
xlon, & ! Longitude
coslat, & ! Cosine of latitude
sinlat, & ! Sine of latitude
slmsk, & ! Lank/sea mask
snowd, & ! Water equivalent snow depth (mm)
sncovr, & ! Surface snow area fraction
snoalb, & ! Maximum snow albedo
zorl, & ! Surface roughness length
tsfc, & ! Surface skin temperature (K)
alvsf, & ! Mean vis albedo with strong cosz dependency
alnsf, & ! Mean nIR albedo with strong cosz dependency
alvwf, & ! Mean vis albedo with weak cosz dependency
alnwf, & ! Mean nIR albedo with weak cosz dependency
facsf, & ! Fractional coverage with strong cosz dependency
facwf, & ! Fractional coverage with weak cosz dependency
fice, & ! Ice fraction over open water
tisfc ! Sea ice surface skin temperature
real(kind_phys), dimension(ncol,nmtvr), intent(in) :: &
hprime ! orographic metrics
real(kind_phys), dimension(ncol,nlev),intent(in) :: &
p_lay, & ! Layer pressure
tv_lay, & ! Layer virtual-temperature
relhum ! Layer relative-humidity
real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: &
tracer
real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: &
real(kind_phys), dimension(ncol, nlev, 2:ntrac),intent(in) :: &
tracer ! Chemical tracers (g/g)
real(kind_phys), dimension(ncol,nlev+1),intent(in) :: &
p_lev ! Pressure @ layer interfaces (Pa)
type(ty_gas_optics_rrtmgp),intent(in) :: &
sw_gas_props ! RRTMGP DDT: spectral information for SW calculation
Expand All @@ -68,16 +88,15 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_
integer, dimension(ncol), intent(out) :: &
idxday ! Indices for daylit points
real(kind_phys), dimension(ncol), intent(out) :: &
alb1d ! Surface albedo pertubation
coszen, & ! mean cos of zenith angle over rad call period
coszdg, & ! daytime mean cosz over rad call period
sfalb, & ! mean surface diffused SW albedo
alb1d ! Surface albedo pertubation
real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: &
sfc_alb_nir_dir, & ! Surface albedo (direct)
sfc_alb_nir_dif, & ! Surface albedo (diffuse)
sfc_alb_uvvis_dir, & ! Surface albedo (direct)
sfc_alb_uvvis_dif ! Surface albedo (diffuse)
type(GFS_radtend_type), intent(inout) :: &
Radtend ! DDT: FV3-GFS radiation tendencies
type(GFS_coupling_type), intent(inout) :: &
Coupling ! DDT: FV3-GFS coupling arrays
character(len=*), intent(out) :: &
errmsg ! Error message
integer, intent(out) :: &
Expand All @@ -91,21 +110,21 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_
errmsg = ''
errflg = 0

if (.not. Model%lsswr) return
if (.not. doLWrad) return

! #######################################################################################
! Compute cosine of zenith angle (only when SW is called)
! #######################################################################################
call coszmn (Grid%xlon, Grid%sinlat, Grid%coslat, Model%solhr, NCOL, Model%me, &
Radtend%coszen, Radtend%coszdg)
call coszmn (xlon, sinlat, coslat, solhr, NCOL, mpi_rank, &
coszen, coszdg)

! #######################################################################################
! For SW gather daylit points
! #######################################################################################
nday = 0
idxday = 0
do i = 1, NCOL
if (Radtend%coszen(i) >= 0.0001) then
if (coszen(i) >= 0.0001) then
nday = nday + 1
idxday(nday) = i
endif
Expand All @@ -117,24 +136,22 @@ subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_
! --- turn vegetation fraction pattern into percentile pattern
! #######################################################################################
alb1d(:) = 0.
if (Model%do_sfcperts) then
if (Model%pertalb(1) > 0.) then
if (do_sfcperts) then
if (pertalb(1) > 0.) then
do i=1,ncol
call cdfnor(Coupling%sfc_wts(i,5),alb1d(i))
call cdfnor(sfc_wts(i,5),alb1d(i))
enddo
endif
endif

! #######################################################################################
! Call module_radiation_surface::setalb() to setup surface albedo.
! #######################################################################################
call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, &
Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, &
Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, &
Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb)
call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime(:,1), alvsf, &
alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, pertalb, sfcalb)

! Approximate mean surface albedo from vis- and nir- diffuse values.
Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4)))
sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4)))

! Spread across all SW bands
do iBand=1,sw_gas_props%get_nband()
Expand Down
Loading

0 comments on commit c984e90

Please sign in to comment.