Skip to content

Commit

Permalink
Added metadata tables to DDT definitions.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed May 9, 2019
1 parent 232545f commit 25b2372
Show file tree
Hide file tree
Showing 4 changed files with 162 additions and 135 deletions.
64 changes: 38 additions & 26 deletions physics/GFS_rrtmgp_lw.F90
View file
Original file line number Diff line number Diff line change
@@ -1,15 +1,15 @@
! ###########################################################################################
! ###########################################################################################
module GFS_rrtmgp_lw
use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_type
use mo_gas_concentrations, only: ty_gas_concs
use mo_fluxes, only: ty_fluxes_broadband
use mo_fluxes_byband, only: ty_fluxes_byband
use mo_optical_props, only: ty_optical_props_1scl,ty_optical_props_2str
use mo_source_functions, only: ty_source_func_lw
use mo_rte_kind, only: wl
use mo_heating_rates, only: compute_heating_rate
use mo_cloud_optics, only: ty_cloud_optics
use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_type
use mo_cloud_optics, only: ty_cloud_optics_type
use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples
use machine, only: kind_phys
use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type
Expand Down Expand Up @@ -56,29 +56,31 @@ module GFS_rrtmgp_lw
! Classes used by rte+rrtmgp
!type(ty_gas_optics_rrtmgp) :: &
! kdist_lw
type(ty_cloud_optics) :: &
kdist_lw_cldy
!type(ty_cloud_optics) :: &
! kdist_lw_cldy
type(ty_gas_concs) :: &
gas_concs_lw
gas_concentrations

public GFS_rrtmgp_lw_init, GFS_rrtmgp_lw_run, GFS_rrtmgp_lw_finalize
contains
! #########################################################################################
! GFS_rrtmgp_lw_init
! #########################################################################################
!! \section arg_table_GFS_rrtmgp_lw_init Argument Table
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |-----------------|------------------------------------------|--------------------------------------------------------------------|-------|------|---------------------------|-----------|--------|----------|
!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F |
!! | mpirank | mpi_rank | current MPI rank | index | 0 | integer | | in | F |
!! | mpiroot | mpi_root | master MPI rank | index | 0 | integer | | in | F |
!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp_type | | inout | F |
!! | local_name | standard_name | long_name | units | rank | type | kind | intent | optional |
!! |--------------------|-------------------------------------------------|---------------------------------------------------------------------------|-------|------|---------------------------|-----------|--------|----------|
!! | Model | GFS_control_type_instance | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F |
!! | mpirank | mpi_rank | current MPI rank | index | 0 | integer | | in | F |
!! | mpiroot | mpi_root | master MPI rank | index | 0 | integer | | in | F |
!! | mpicomm | mpi_comm | MPI communicator | index | 0 | integer | | in | F |
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp_type | | inout | F |
!! | kdist_lw_cldy | K_distribution_file_for_cloudy_RRTMGP_LW_scheme | DDT containing spectral information for cloudy RRTMGP LW radiation scheme | DDT | 0 | ty_cloud_optics_type | | inout | F |
!!
! #########################################################################################
subroutine GFS_rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, kdist_lw, errmsg, errflg)
subroutine GFS_rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, kdist_lw, kdist_lw_cldy, &
errmsg, errflg)
use netcdf

#ifdef MPI
Expand All @@ -94,6 +96,11 @@ subroutine GFS_rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, kdist_lw, errmsg,
mpiroot ! Master MPI rank
type(ty_gas_optics_rrtmgp_type),intent(inout) :: &
kdist_lw
type(ty_cloud_optics_type),intent(inout) :: &
kdist_lw_cldy
! type(ty_gas_concs_type),intent(inout) :: &
! gas_concentrations

! Outputs
character(len=*), intent(out) :: &
errmsg ! Error message
Expand Down Expand Up @@ -500,9 +507,9 @@ subroutine GFS_rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, kdist_lw, errmsg,

! Initialize gas concentrations and gas optics class with data
do iGas=1,nGases
call check_error_msg(gas_concs_lw%set_vmr(active_gases(iGas), 0._kind_phys))
call check_error_msg(gas_concentrations%set_vmr(active_gases(iGas), 0._kind_phys))
enddo
call check_error_msg(kdist_lw%load(gas_concs_lw, gas_names, key_species, band2gpt, &
call check_error_msg(kdist_lw%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, &
minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, &
Expand Down Expand Up @@ -774,12 +781,13 @@ end subroutine GFS_rrtmgp_lw_init
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp_type | | in | F |
!! | kdist_lw_cldy | K_distribution_file_for_cloudy_RRTMGP_LW_scheme | DDT containing spectral information for cloudy RRTMGP LW radiation scheme | DDT | 0 | ty_cloud_optics_type | | inout | F |
!!
! #########################################################################################
subroutine GFS_rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr_n2o, & ! IN
vmr_ch4, vmr_o2, vmr_co, vmr_cfc11, vmr_cfc12, vmr_cfc22, vmr_ccl4, icseed, tau_aer, & ! IN
ssa_aer, sfc_emiss, skt, dzlyr, delpin, de_lgth, ncol, nlay, lprint, cldfrac, lslwr, & ! IN
kdist_lw, &
kdist_lw, kdist_lw_cldy, &
hlwc, topflx, sfcflx, cldtau, & ! OUT
hlw0, hlwb, flxprf, & ! OPT(out)
cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, & ! OPT(in)
Expand All @@ -799,6 +807,10 @@ subroutine GFS_rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2,
lslwr ! Flag to calculate RRTMGP LW? (1)
type(ty_gas_optics_rrtmgp_type),intent(in) :: &
kdist_lw ! DDT containing LW spectral information
type(ty_cloud_optics_type),intent(in) :: &
kdist_lw_cldy
! type(ty_gas_concs_type),intent(inout) :: &
! gas_concentrations
real(kind_phys), dimension(ncol), intent(in) :: &
sfc_emiss, & ! Surface emissivity (1)
skt, & ! Surface(skin) temperature (K)
Expand Down Expand Up @@ -1018,13 +1030,13 @@ subroutine GFS_rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2,
! #######################################################################################
! Set gas concentrations
! #######################################################################################
call gas_concs_lw%reset()
call check_error_msg(gas_concs_lw%set_vmr('o2', vmr_o2))
call check_error_msg(gas_concs_lw%set_vmr('co2', vmr_co2))
call check_error_msg(gas_concs_lw%set_vmr('ch4', vmr_ch4))
call check_error_msg(gas_concs_lw%set_vmr('n2o', vmr_n2o))
call check_error_msg(gas_concs_lw%set_vmr('h2o', vmr_h2o))
call check_error_msg(gas_concs_lw%set_vmr('o3', vmr_o3))
call gas_concentrations%reset()
call check_error_msg(gas_concentrations%set_vmr('o2', vmr_o2))
call check_error_msg(gas_concentrations%set_vmr('co2', vmr_co2))
call check_error_msg(gas_concentrations%set_vmr('ch4', vmr_ch4))
call check_error_msg(gas_concentrations%set_vmr('n2o', vmr_n2o))
call check_error_msg(gas_concentrations%set_vmr('h2o', vmr_h2o))
call check_error_msg(gas_concentrations%set_vmr('o3', vmr_o3))

! #######################################################################################
! Copy aerosol to RRTMGP DDT
Expand Down Expand Up @@ -1096,7 +1108,7 @@ subroutine GFS_rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2,
! #######################################################################################
call check_error_msg(rte_lw( &
kdist_lw, &
gas_concs_lw, &
gas_concentrations, &
p_lay(1:ncol,1:nlay), &
t_lay(1:ncol,1:nlay), &
p_lev(1:ncol,1:nlay+1), &
Expand Down
42 changes: 20 additions & 22 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,13 +77,14 @@ end subroutine GFS_rrtmgp_pre_init
!! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F |
!! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F |
!! | kdist_lw | K_distribution_file_for_RRTMGP_LW_scheme | DDT containing spectral information for RRTMGP LW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp_type | | in | F |
!! | kdist_sw | K_distribution_file_for_RRTMGP_SW_scheme | DDT containing spectral information for RRTMGP SW radiation scheme | DDT | 0 | ty_gas_optics_rrtmgp_type | | in | F |
!!
! Attention - the output arguments lm, im, lmk, lmp must not be set
! in the CCPP version - they are defined in the interstitial_create routine
! #########################################################################################
subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coupling, & ! IN
Radtend, & ! INOUT
lm, im, lmk, lmp, kdist_lw, & ! IN
lm, im, lmk, lmp, kdist_lw, kdist_sw, & ! IN
kd, kt, kb, raddt, delp, dz, plvl, plyr, tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & ! OUT
gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & ! OUT
gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113, faersw1, faersw2, faersw3, & ! OUT
Expand Down Expand Up @@ -138,14 +139,9 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup
progclduni ! Unified cloud-scheme
use surface_perturbation, only: &
cdfnor ! Routine to compute CDF (used to compute percentiles)
! RRTMGP stuff
! RRTMGP types
use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp_type
use GFS_rrtmgp_lw, only: &
nBandsLW!, & ! Number of LW bands in RRTMGP
!kdist_lw ! DDT contining LW spectral information
use GFS_rrtmgp_sw, only: &
nBandsSW, & ! Number of SW bands in RRTMGP
kdist_sw ! DDT contining SW spectral information

implicit none

! Inputs
Expand All @@ -158,7 +154,9 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup
type(GFS_cldprop_type), intent(in) :: Cldprop
type(GFS_coupling_type), intent(in) :: Coupling
integer, intent(in) :: im, lm, lmk, lmp
type(ty_gas_optics_rrtmgp_type),intent(in) :: kdist_lw
type(ty_gas_optics_rrtmgp_type),intent(in) :: &
kdist_lw, & ! RRTMGP DDT containing spectral information for LW calculation
kdist_sw ! RRTMGP DDT containing spectral information for SW calculation

! Outputs
integer, intent(out) :: kd, kt, kb
Expand All @@ -172,9 +170,9 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup
clouds6, clouds7, clouds8, clouds9
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: &
plvl, tlvl
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,nBandsSW), intent(out) :: &
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_sw%get_nband()), intent(out) :: &
faersw1, faersw2, faersw3
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,nBandsLW), intent(out) :: &
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_lw%get_nband()), intent(out) :: &
faerlw1, faerlw2, faerlw3
real(kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(out) :: &
aerodp
Expand All @@ -200,8 +198,8 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,nBandsSW,NF_AESW)::faersw
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,nBandsLW,NF_AELW)::faerlw
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_sw%get_nband(),NF_AESW)::faersw
real(kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,kdist_lw%get_nband(),NF_AELW)::faerlw

! Initialize CCPP error handling variables
errmsg = ''
Expand Down Expand Up @@ -468,16 +466,16 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, Tbd, Cldprop, Coup
! SW.
! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the
! band ordering was [nIR -> UV -> IR(band)]
faersw1(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,nBandsSW,1)
faersw2(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,nBandsSW,2)
faersw3(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,nBandsSW,3)
faersw1(1:IM,1:LMK,2:nBandsSW) = faersw(1:IM,1:LMK,1:nBandsSW-1,1)
faersw2(1:IM,1:LMK,2:nBandsSW) = faersw(1:IM,1:LMK,1:nBandsSW-1,2)
faersw3(1:IM,1:LMK,2:nBandsSW) = faersw(1:IM,1:LMK,1:nBandsSW-1,3)
faersw1(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,kdist_sw%get_nband(),1)
faersw2(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,kdist_sw%get_nband(),2)
faersw3(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,kdist_sw%get_nband(),3)
faersw1(1:IM,1:LMK,2:kdist_sw%get_nband()) = faersw(1:IM,1:LMK,1:kdist_sw%get_nband()-1,1)
faersw2(1:IM,1:LMK,2:kdist_sw%get_nband()) = faersw(1:IM,1:LMK,1:kdist_sw%get_nband()-1,2)
faersw3(1:IM,1:LMK,2:kdist_sw%get_nband()) = faersw(1:IM,1:LMK,1:kdist_sw%get_nband()-1,3)
! LW
faerlw1(1:IM,1:LMK,1:nBandsLW) = faerlw(1:IM,1:LMK,1:nBandsLW,1)
faerlw2(1:IM,1:LMK,1:nBandsLW) = faerlw(1:IM,1:LMK,1:nBandsLW,2)
faerlw3(1:IM,1:LMK,1:nBandsLW) = faerlw(1:IM,1:LMK,1:nBandsLW,3)
faerlw1(1:IM,1:LMK,1:kdist_lw%get_nband()) = faerlw(1:IM,1:LMK,1:kdist_lw%get_nband(),1)
faerlw2(1:IM,1:LMK,1:kdist_lw%get_nband()) = faerlw(1:IM,1:LMK,1:kdist_lw%get_nband(),2)
faerlw3(1:IM,1:LMK,1:kdist_lw%get_nband()) = faerlw(1:IM,1:LMK,1:kdist_lw%get_nband(),3)

! Obtain cloud information for radiation calculations
! (clouds,cldsa,mtopa,mbota)
Expand Down
Loading

0 comments on commit 25b2372

Please sign in to comment.