Skip to content

Commit

Permalink
Updated interface to rte-rrtmgp routines.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Feb 11, 2020
1 parent 30b5237 commit 75c479d
Show file tree
Hide file tree
Showing 10 changed files with 174 additions and 97 deletions.
140 changes: 102 additions & 38 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,9 +58,25 @@ module GFS_rrtmgp_pre
amo3 = 47.9982_kind_phys, & ! Modelular weight of ozone (g/mol)
amdw = amd/amw, & ! Molecular weight of dry air / water vapor
amdo3 = amd/amo3 ! Molecular weight of dry air / ozone

public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize


! Some common trace gas on/off flags.
! This allows for control over which trace gases are used in RRTMGP radiation scheme via
! namelist.
logical :: &
isActive_h2o = .false., & !
isActive_co2 = .false., & !
isActive_o3 = .false., & !
isActive_n2o = .false., & !
isActive_ch4 = .false., & !
isActive_o2 = .false., & !
isActive_ccl4 = .false., & !
isActive_cfc11 = .false., & !
isActive_cfc12 = .false., & !
isActive_cfc22 = .false. !
integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, &
iStr_cfc11, iStr_cfc12, iStr_cfc22

public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize
contains

! #########################################################################################
Expand All @@ -77,7 +93,7 @@ subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errfl
Radtend ! DDT: FV3-GFS radiation tendencies

! Outputs
character(len=128),dimension(Model%ngases), intent(out) :: &
character(len=*),dimension(Model%ngases), intent(out) :: &
active_gases_array ! Character array containing trace gases to include in RRTMGP
character(len=*), intent(out) :: &
errmsg ! Error message
Expand All @@ -93,27 +109,72 @@ subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errfl
errmsg = ''
errflg = 0

if (len(Model%active_gases) .eq. 0) return

! Which gases are active? Provided via physics namelist.
if (len(Model%active_gases) .gt. 0) then

! Pull out gas names from list...
! First grab indices in character array corresponding to start:end of gas name.
gasIndices(1,1)=1
count=1
do ij=1,len(Model%active_gases)
tempstr=trim(Model%active_gases(ij:ij))
if (tempstr .eq. '_') then
gasIndices(count,2)=ij-1
gasIndices(count+1,1)=ij+1
count=count+1
endif
enddo
gasIndices(Model%ngases,2)=len(trim(Model%active_gases))
! Now extract the gas names
do ij=1,Model%ngases
active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2))
enddo
endif

! Pull out gas names from list...
! First grab indices in character array corresponding to start:end of gas name.
gasIndices(1,1)=1
count=1
do ij=1,len(Model%active_gases)
tempstr=trim(Model%active_gases(ij:ij))
if (tempstr .eq. '_') then
gasIndices(count,2)=ij-1
gasIndices(count+1,1)=ij+1
count=count+1
endif
enddo
gasIndices(Model%ngases,2)=len(trim(Model%active_gases))

! Now extract the gas names
do ij=1,Model%ngases
active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2))
enddo

! Which gases are active? (This is purely for flexibility)
do ij=1,Model%ngases
if(trim(active_gases_array(ij)) .eq. 'h2o') then
isActive_h2o = .true.
istr_h2o = ij
endif
if(trim(active_gases_array(ij)) .eq. 'co2') then
isActive_co2 = .true.
istr_co2 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'o3') then
isActive_o3 = .true.
istr_o3 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'n2o') then
isActive_n2o = .true.
istr_n2o = ij
endif
if(trim(active_gases_array(ij)) .eq. 'ch4') then
isActive_ch4 = .true.
istr_ch4 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'o2') then
isActive_o2 = .true.
istr_o2 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'ccl4') then
isActive_ccl4 = .true.
istr_ccl4 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'cfc11') then
isActive_cfc11 = .true.
istr_cfc11 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'cfc12') then
isActive_cfc12 = .true.
istr_cfc12 = ij
endif
if(trim(active_gases_array(ij)) .eq. 'cfc22') then
isActive_cfc22 = .true.
istr_cfc22 = ij
endif
enddo

end subroutine GFS_rrtmgp_pre_init

Expand All @@ -123,11 +184,11 @@ end subroutine GFS_rrtmgp_pre_init
!> \section arg_table_GFS_rrtmgp_pre_run
!! \htmlinclude GFS_rrtmgp_pre.html
!!
subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN
ncol, lw_gas_props, sec_diff_byband, & ! IN
raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp, & ! OUT
cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT
tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT
subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN
ncol, lw_gas_props, active_gases_array, & ! IN
sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT
cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT
tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT
errmsg, errflg)

! Inputs
Expand All @@ -147,8 +208,10 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
Tbd ! DDT: FV3-GFS data not yet assigned to a defined container
integer, intent(in) :: &
ncol ! Number of horizontal grid points
type(ty_gas_optics_rrtmgp),intent(in) :: &
lw_gas_props ! RRTMGP DDT: longwave spectral information
type(ty_gas_optics_rrtmgp),intent(in) :: &
lw_gas_props ! RRTMGP DDT: longwave spectral information
character(len=*),dimension(Model%ngases), intent(in) :: &
active_gases_array ! Character array containing trace gases to include in RRTMGP

! Outputs
real(kind_phys), dimension(ncol,Model%levs), intent(out) :: &
Expand Down Expand Up @@ -296,13 +359,14 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop,
vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.)
vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.)

! Populate RRTMGP DDT w/ gas-concentrations
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o2', gas_vmr(:,:,4)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('co2', gas_vmr(:,:,1)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('ch4', gas_vmr(:,:,3)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('n2o', gas_vmr(:,:,2)))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('h2o', vmr_h2o))
call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr('o3', vmr_o3))
! Initialize and opulate RRTMGP DDT w/ gas-concentrations
call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array))
if (isActive_o2) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o2), gas_vmr(:,:,4)))
if (isActive_co2) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_co2), gas_vmr(:,:,1)))
if (isActive_ch4) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_ch4), gas_vmr(:,:,3)))
if (isActive_n2o) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_n2o), gas_vmr(:,:,2)))
if (isActive_h2o) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o))
if (isActive_o3) call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3))

! #######################################################################################
! Compute diffusivity angle adjustments for each longwave band
Expand Down
11 changes: 10 additions & 1 deletion physics/GFS_rrtmgp_pre.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
units = none
dimensions = (number_of_active_gases_used_by_RRTMGP)
type = character
kind = len=128
kind = len=*
intent = out
optional = F
[errmsg]
Expand Down Expand Up @@ -120,6 +120,15 @@
type = ty_gas_optics_rrtmgp
intent = in
optional = F
[active_gases_array]
standard_name = list_of_active_gases_used_by_RRTMGP
long_name = list of active gases used by RRTMGP
units = none
dimensions = (number_of_active_gases_used_by_RRTMGP)
type = character
kind = len=*
intent = in
optional = F
[raddt]
standard_name = time_step_for_radiation
long_name = radiation time step
Expand Down
46 changes: 24 additions & 22 deletions physics/rrtmgp_lw_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d
! Local variables
integer :: dimID,varID,status,ncid
character(len=264) :: lw_cloud_props_file
integer,parameter :: max_strlen=256
integer,parameter :: max_strlen=256, nrghice_default=2
#ifdef MPI
integer :: mpierr
#endif
Expand Down Expand Up @@ -131,33 +131,35 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d
status = nf90_inquire_dimension(ncid, dimid, len=npairs)
status = nf90_close(ncid)

! Has the number of ice-roughnesses been provided from the namelist?
! If not provided, use all categories in file (default)
! Has the number of ice-roughnesses to use been provided from the namelist?
! If not provided, use default number of ice-roughness categories
if (nrghice .eq. 0) then
nrghice = nrghice_default
else
nrghice = nrghice_fromfile
endif
! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible.
if (nrghice .gt. nrghice_fromfile) then
errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using nrghice from file...'
nrghice = nrghice_fromfile
! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible.
if (nrghice .gt. nrghice_fromfile) then
errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.'
nrghice = nrghice_default
endif
endif

! Allocate space for arrays
if (cld_optics_scheme .eq. 1) then
allocate(lut_extliq(nSize_liq, nBand))
allocate(lut_ssaliq(nSize_liq, nBand))
allocate(lut_asyliq(nSize_liq, nBand))
allocate(lut_extice(nSize_ice, nBand, nrghice))
allocate(lut_ssaice(nSize_ice, nBand, nrghice))
allocate(lut_asyice(nSize_ice, nBand, nrghice))
allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile))
allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile))
allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile))
endif
if (cld_optics_scheme .eq. 2) then
allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext ))
allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g))
allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g))
allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice))
allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice))
allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice))
allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile))
allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile))
allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile))
allocate(pade_sizereg_extliq(nBound))
allocate(pade_sizereg_ssaliq(nBound))
allocate(pade_sizereg_asyliq(nBound))
Expand Down Expand Up @@ -304,18 +306,18 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d

! Load tables data for RRTMGP cloud-optics
if (cld_optics_scheme .eq. 1) then
call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice))
call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, &
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 (cld_optics_scheme .eq. 2) then
call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice))
call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, &
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
call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice))

end subroutine rrtmgp_lw_cloud_optics_init

! #########################################################################################
Expand Down Expand Up @@ -393,12 +395,12 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr
if (rrtmgp_cld_optics .gt. 0) then
! i) RRTMGP cloud-optics.
call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(&
ncol, & ! IN - Number of horizontal gridpoints
nLev, & ! IN - Number of vertical layers
lw_cloud_props%get_nband(), & ! IN - Number of LW bands
nrghice, & ! IN - Number of ice-roughness categories
liqmask, & ! IN - Liquid-cloud mask (1)
icemask, & ! IN - Ice-cloud mask (1)
!ncol, & ! IN - Number of horizontal gridpoints
!nLev, & ! IN - Number of vertical layers
!lw_cloud_props%get_nband(), & ! IN - Number of LW bands
!nrghice, & ! IN - Number of ice-roughness categories
!liqmask, & ! IN - Liquid-cloud mask (1)
!icemask, & ! IN - Ice-cloud mask (1)
cld_lwp, & ! IN - Cloud liquid water path (g/m2)
cld_iwp, & ! IN - Cloud ice water path (g/m2)
cld_reliq, & ! IN - Cloud liquid effective radius (microns)
Expand Down
6 changes: 2 additions & 4 deletions physics/rrtmgp_lw_gas_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp
rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties
integer, intent(in) :: &
rrtmgp_nGases ! Number of trace gases active in RRTMGP
character(len=128),dimension(rrtmgp_nGases), intent(in) :: &
character(len=*),dimension(rrtmgp_nGases), intent(in) :: &
active_gases_array ! Character array containing trace gases to include in RRTMGP
integer,intent(in) :: &
mpicomm, & ! MPI communicator
Expand Down Expand Up @@ -317,9 +317,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp
#endif

! Initialize gas concentrations and gas optics class
do iGas=1,rrtmgp_nGases
call check_error_msg('lw_gas_optics_init',gas_concentrations%set_vmr(active_gases_array(iGas), 0._kind_phys))
enddo
call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array))
call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, &
key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, &
temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, &
Expand Down
2 changes: 1 addition & 1 deletion physics/rrtmgp_lw_gas_optics.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@
units = none
dimensions = (number_of_active_gases_used_by_RRTMGP)
type = character
kind = len=128
kind = len=*
intent = in
optional = F
[mpirank]
Expand Down
Loading

0 comments on commit 75c479d

Please sign in to comment.