diff --git a/physics/GFS_rrtmgp_gas_optics.F90 b/physics/GFS_rrtmgp_gas_optics.F90 index 1054c0908..9eff6567c 100644 --- a/physics/GFS_rrtmgp_gas_optics.F90 +++ b/physics/GFS_rrtmgp_gas_optics.F90 @@ -1,5 +1,3 @@ -!> \file GFS_rrtmgp_gas_optics.f90 -!! This file contains module GFS_rrtmgp_gas_optics use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type,GFS_radtend_type @@ -7,13 +5,12 @@ module GFS_rrtmgp_gas_optics public GFS_rrtmgp_gas_optics_init,GFS_rrtmgp_gas_optics_run,GFS_rrtmgp_gas_optics_finalize contains -!! \section arg_table_GFS_rrtmgp_gas_optics_init -!! \htmlinclude GFS_rrtmgp_gas_optics.html -!! - ! ######################################################################################### ! SUBROUTINE GFS_rrtmgp_gas_optics_init() ! ######################################################################################### +!! \section arg_table_GFS_rrtmgp_gas_optics_init +!! \htmlinclude GFS_rrtmgp_gas_optics.html +!! subroutine GFS_rrtmgp_gas_optics_init(Model, Radtend, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -57,13 +54,17 @@ subroutine GFS_rrtmgp_gas_optics_init(Model, Radtend, errmsg, errflg) enddo endif end subroutine GFS_rrtmgp_gas_optics_init - ! - subroutine GFS_rrtmgp_gas_optics_run() - + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_gas_optics_run + ! ######################################################################################### + subroutine GFS_rrtmgp_gas_optics_run() end subroutine GFS_rrtmgp_gas_optics_run - ! + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_gas_optics_finalize + ! ######################################################################################### subroutine GFS_rrtmgp_gas_optics_finalize() end subroutine GFS_rrtmgp_gas_optics_finalize - ! + end module GFS_rrtmgp_gas_optics diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 769478e6d..38b9530b0 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -1,5 +1,3 @@ -!>\file GFS_rrtmgp_lw_post -!!This file contains module GFS_rrtmgp_lw_post use machine, only: kind_phys use GFS_typedefs, only: GFS_coupling_type, & @@ -20,10 +18,15 @@ module GFS_rrtmgp_lw_post public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize contains - + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_init + ! ######################################################################################### subroutine GFS_rrtmgp_lw_post_init() end subroutine GFS_rrtmgp_lw_post_init + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_run + ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_lw_post_run !! \htmlinclude GFS_rrtmgp_lw_post.html !! @@ -34,70 +37,58 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! Inputs type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT containing FV3-GFS model control parameters + Model ! Fortran DDT: FV3-GFS model control parameters type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data - type(GFS_coupling_type), intent(inout) :: & - Coupling ! Fortran DDT containing FV3-GFS fields to/from coupling with other components - type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT containing FV3-GFS radiation tendencies - type(GFS_diag_type), intent(inout) :: & - Diag ! Fortran DDT containing FV3-GFS diagnotics data + Grid ! Fortran DDT: FV3-GFS grid and interpolation related data type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore integer, intent(in) :: & - im ! Horizontal loop extent + im ! Horizontal loop extent real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & - tsfa ! Lowest model layer air temperature for radiation + tsfa ! Lowest model layer air temperature for radiation (K) real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) + p_lev ! Pressure @ model layer-interfaces (hPa) real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & - fluxlwUP_allsky, & ! LW All-sky flux (W/m2) - fluxlwDOWN_allsky, & ! LW All-sky flux (W/m2) - fluxlwUP_clrsky, & ! LW Clear-sky flux (W/m2) - fluxlwDOWN_clrsky ! LW All-sky flux (W/m2) + fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) + fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2) real(kind_phys), intent(in) :: & - raddt ! Radiation time step + raddt ! Radiation time step real(kind_phys), dimension(im,NSPC1), intent(in) :: & - aerodp ! Vertical integrated optical depth for various aerosol species + aerodp ! Vertical integrated optical depth for various aerosol species real(kind_phys), dimension(im,5), intent(in) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL + cldsa ! Fraction of clouds for low, middle, high, total and BL integer, dimension(im,3), intent(in) ::& - mbota, & ! vertical indices for low, middle and high cloud tops - mtopa ! vertical indices for low, middle and high cloud bases + mbota, & ! vertical indices for low, middle and high cloud tops + mtopa ! vertical indices for low, middle and high cloud bases real(kind_phys), dimension(im,Model%levs), intent(in) :: & - cld_frac, & ! Total cloud fraction in each layer - cldtaulw ! approx 10.mu band layer cloud optical depth + cld_frac, & ! Total cloud fraction in each layer + cldtaulw ! approx 10.mu band layer cloud optical depth real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: & - hlwc ! Longwave all-sky heating-rate (K/sec) + hlwc ! Longwave all-sky heating-rate (K/sec) ! Outputs (mandatory) character(len=*), intent(out) :: & errmsg integer, intent(out) :: & errflg -! real(kind_phys),dimension(size(Grid%xlon,1), Model%levs),intent(out) :: & -! hlwc ! Longwave all-sky heating-rate (K/sec) -! type(topflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: & -! topflx_lw ! radiation fluxes at top, components: -! ! upfxc - total sky upward flux at top (w/m2) -! ! upfx0 - clear sky upward flux at top (w/m2) -! type(sfcflw_type), dimension(size(Grid%xlon,1)), intent(inout) :: & -! sfcflx_lw ! radiation fluxes at sfc, components: -! ! upfxc - total sky upward flux at sfc (w/m2) -! ! upfx0 - clear sky upward flux at sfc (w/m2) -! ! dnfxc - total sky downward flux at sfc (w/m2) -! ! dnfx0 - clear sky downward flux at sfc (w/m2) - + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT: FV3-GFS radiation tendencies + type(GFS_diag_type), intent(inout) :: & + Diag ! Fortran DDT: FV3-GFS diagnotics data + ! Outputs (optional) real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: & - hlw0 ! Longwave clear-sky heating rate (K/sec) + hlw0 ! Longwave clear-sky heating rate (K/sec) type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+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) + 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) ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc @@ -133,17 +124,17 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! Clear-sky heating-rate (optional) if (l_clrskylw_hr) then call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, & - p_lev, & - hlw0)) + fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) + fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + hlw0)) ! OUT - Longwave clear-sky heating rate (K/sec) endif ! All-sky heating-rate (mandatory) call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_allsky, & - fluxlwDOWN_allsky, & - p_lev, & - hlwc)) + fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) + fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + hlwc)) ! OUT - Longwave all-sky heating rate (K/sec) ! Copy fluxes from RRTGMP types into model radiation types. ! Mandatory outputs @@ -235,6 +226,9 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei end subroutine GFS_rrtmgp_lw_post_run + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_finalize + ! ######################################################################################### subroutine GFS_rrtmgp_lw_post_finalize () end subroutine GFS_rrtmgp_lw_post_finalize diff --git a/physics/GFS_rrtmgp_lw_pre.F90 b/physics/GFS_rrtmgp_lw_pre.F90 index 5300b21b5..aef812246 100644 --- a/physics/GFS_rrtmgp_lw_pre.F90 +++ b/physics/GFS_rrtmgp_lw_pre.F90 @@ -1,5 +1,3 @@ -!> \file GFS_rrtmgp_lw_pre.f90 -!! This file contains module GFS_rrtmgp_lw_pre use physparam use machine, only: & @@ -25,24 +23,31 @@ module GFS_rrtmgp_lw_pre contains + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_pre_init + ! ######################################################################################### subroutine GFS_rrtmgp_lw_pre_init () end subroutine GFS_rrtmgp_lw_pre_init + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_pre_run + ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_lw_pre_run !! \htmlinclude GFS_rrtmgp_lw_pre.html !! - subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & - tv_lay, relhum, tracer, lw_gas_props, Radtend, Interstitial, aerosolslw, aerodp, errmsg, errflg) + subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & + tv_lay, relhum, tracer, lw_gas_props, Radtend, Interstitial, aerosolslw, aerodp, & + errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT containing FV3-GFS model control parameters + Model ! DDT: FV3-GFS model control parameters type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data + Grid ! DDT: FV3-GFS grid and interpolation related data type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! Fortran DDT containing FV3-GFS surface fields + Sfcprop ! DDT: FV3-GFS surface fields type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + Statein ! DDT: FV3-GFS prognostic state data in from dycore integer, intent(in) :: & ncol ! Number of horizontal grid points real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & @@ -50,19 +55,19 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, tv_lay, & ! Layer virtual-temperature relhum ! Layer relative-humidity real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & - tracer + tracer ! trace gas concentrations real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & p_lev ! Interface (level) pressure type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT containing spectral information for LW calculation + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation ! Outputs type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + Radtend ! DDT: FV3-GFS radiation tendencies type(GFS_interstitial_type), intent(inout) :: & - Interstitial + Interstitial ! DDT: FV3-GFS Interstitial arrays real(kind_phys), dimension(ncol,Model%levs,lw_gas_props%get_nband(),NF_AELW), intent(out) ::& - aerosolslw ! Aerosol radiative properties in each SW band. + aerosolslw ! Aerosol radiative properties in each SW band. real(kind_phys), dimension(ncol,NSPC1), intent(inout) :: & aerodp ! Vertical integrated optical depth for various aerosol species character(len=*), intent(out) :: & @@ -83,9 +88,10 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & - Sfcprop%zorl, Sfcprop%tsfc,Sfcprop%tsfc, Sfcprop%hprime(:,1), NCOL, & - Radtend%semis) + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & + Sfcprop%zorl, Sfcprop%tsfc,Sfcprop%tsfc, Sfcprop%hprime(:,1), NCOL, Radtend%semis) + + ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() Interstitial%sfc_emiss_byband(iBand,1:NCOL) = Radtend%semis(1:NCOL) enddo @@ -100,8 +106,9 @@ subroutine GFS_rrtmgp_lw_pre_run (Model, Grid, Sfcprop, Statein, ncol, p_lay, end subroutine GFS_rrtmgp_lw_pre_run -!> \section arg_table_GFS_rrtmgp_lw_pre_finalize Argument Table -!! + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_pre_finalize + ! ######################################################################################### subroutine GFS_rrtmgp_lw_pre_finalize () end subroutine GFS_rrtmgp_lw_pre_finalize diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index aa0d2c007..4584fe2ac 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -1,5 +1,3 @@ -!> \file GFS_rrtmgp_pre.f90 -!! This file contains module GFS_rrtmgp_pre use physparam use machine, only: & @@ -63,18 +61,18 @@ module GFS_rrtmgp_pre contains + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_init + ! ######################################################################################### !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_pre_init() - ! ######################################################################################### subroutine GFS_rrtmgp_pre_init(Model, Radtend, errmsg, errflg) ! Inputs type(GFS_control_type), intent(inout) :: & - Model ! DDT containing model control parameters - type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + Model ! DDT: FV3-GFS model control parameters + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies ! Outputs character(len=*), intent(out) :: & errmsg ! Error message @@ -113,6 +111,9 @@ subroutine GFS_rrtmgp_pre_init(Model, Radtend, errmsg, errflg) endif end subroutine GFS_rrtmgp_pre_init + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_run + ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre.html !! @@ -125,19 +126,19 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! Inputs type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT containing FV3-GFS model control parameters + Model ! DDT: FV3-GFS model control parameters type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data + Grid ! DDT: FV3-GFS grid and interpolation related data type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + Statein ! DDT: FV3-GFS prognostic state data in from dycore type(GFS_coupling_type), intent(in) :: & - Coupling ! Fortran DDT containing FV3-GFS fields to/from coupling with other components + Coupling ! DDT: FV3-GFS fields to/from coupling with other components type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + Radtend ! DDT: FV3-GFS radiation tendencies type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! Fortran DDT containing FV3-GFS surface fields + Sfcprop ! DDT: FV3-GFS surface fields type(GFS_tbd_type), intent(in) :: & - Tbd ! Fortran DDT containing FV3-GFS data not yet assigned to a defined container + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container integer, intent(in) :: & ncol ! Number of horizontal grid points @@ -154,7 +155,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, tsfg, & ! Ground temperature tsfa ! Skin temperature type(ty_gas_concs),intent(out) :: & - gas_concentrations ! RRTMGP DDT containing gas volumne mixing ratios + gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -170,17 +171,17 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, cld_rwp, & ! Cloud rain water path cld_rerain ! Cloud rain effective radius real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & - tv_lay, & ! - relhum + tv_lay, & ! Virtual temperatue at model-layers + relhum ! Relative-humidity at model-layers real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(out) :: & - tracer + tracer ! Array containing trace gases integer,dimension(ncol,3),intent(out) :: & mbota, & ! Vertical indices for cloud tops mtopa ! Vertical indices for cloud bases real(kind_phys), dimension(ncol,5), intent(out) :: & cldsa ! Fraction of clouds for low, middle, high, total and BL real(kind_phys), dimension(ncol), intent(out) :: & - de_lgth ! + de_lgth ! Decorrelation length ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay @@ -215,7 +216,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! ####################################################################################### ! Water-vapor mixing-ratio - q_lay(1:ncol,:) = max( 1.e-6, Statein%qgrs(:,:,1)) + q_lay(1:ncol,:) = max( 1.e-6, Statein%qgrs(1:NCOL,:,1)) ! Pressure at layer-interface p_lev(1:NCOL,:) = Statein%prsi(1:NCOL,:) @@ -305,9 +306,8 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! ####################################################################################### ! Cloud microphysics ! ####################################################################################### - call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, & - p_lev, tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, & - clouds, cldsa, mbota, mtopa, de_lgth) + call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev, & + tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) ! Copy output cloud fields cld_frac = clouds(:,:,1) @@ -322,28 +322,29 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, end subroutine GFS_rrtmgp_pre_run -!> \section arg_table_GFS_rrtmgp_pre_finalize Argument Table -!! + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_finalize + ! ######################################################################################### subroutine GFS_rrtmgp_pre_finalize () end subroutine GFS_rrtmgp_pre_finalize - ! ####################################################################################### + ! ######################################################################################### ! Subroutine cloud_microphysics() - ! ####################################################################################### - subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, & - p_lev, tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, & - clouds, cldsa, mbota, mtopa, de_lgth) + ! ######################################################################################### + subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev,& + tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + ! Inputs type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT containing FV3-GFS model control parameters + Model ! DDT: FV3-GFS model control parameters type(GFS_tbd_type), intent(in) :: & - Tbd ! Fortran DDT containing FV3-GFS data not yet assigned to a defined container + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data + Grid ! DDT: FV3-GFS grid and interpolation related data type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! Fortran DDT containing FV3-GFS surface fields + Sfcprop ! DDT: FV3-GFS surface fields integer, intent(in) :: & - ncol ! Number of horizontal gridpoints + ncol ! Number of horizontal gridpoints real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & tracer ! real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & @@ -359,16 +360,22 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ p_lev ! ! Outputs - real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: clouds - integer,dimension(ncol,3), intent(out) :: mbota, mtopa - real(kind_phys), dimension(ncol), intent(out) :: de_lgth - real(kind_phys), dimension(ncol, 5), intent(out) :: cldsa + real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: & + clouds ! + integer,dimension(ncol,3), intent(out) :: & + mbota, & ! + mtopa ! + real(kind_phys), dimension(ncol), intent(out) ::& + de_lgth ! + real(kind_phys), dimension(ncol, 5), intent(out) :: & + cldsa ! ! Local variables real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate integer :: i,k real(kind_phys), parameter :: xrc3 = 100. - real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, effr_i, effr_r, effr_s, cldcov + real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & + effr_i, effr_r, effr_s, cldcov ! ####################################################################################### ! Obtain cloud information for radiation calculations @@ -665,6 +672,6 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) de_lgth) ! OUT - clouds decorrelation length (km) endif ! end if_imp_physics - end subroutine cloud_microphysics + ! end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index ee3a69720..8c4b5b7fd 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -1,5 +1,3 @@ -!> \file GFS_rrtmgp_sw_pre.f90 -!! This file contains module GFS_rrtmgp_sw_pre use physparam use machine, only: & @@ -32,27 +30,33 @@ module GFS_rrtmgp_sw_pre contains + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_init + ! ######################################################################################### subroutine GFS_rrtmgp_sw_pre_init () end subroutine GFS_rrtmgp_sw_pre_init + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_run + ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run (Model, Interstitial, Grid, Sfcprop, Statein, ncol, p_lay, & - p_lev, tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, RadTend, & + subroutine GFS_rrtmgp_sw_pre_run(Model, Interstitial, Grid, Sfcprop, Statein, ncol, p_lay,& + p_lev, tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, RadTend, & Coupling, aerosolssw, aerodp, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & - Model ! Fortran DDT containing FV3-GFS model control parameters + Model ! DDT: FV3-GFS model control parameters type(GFS_Interstitial_type),intent(inout) :: & Interstitial type(GFS_grid_type), intent(in) :: & - Grid ! Fortran DDT containing FV3-GFS grid and interpolation related data + Grid ! DDT: FV3-GFS grid and interpolation related data type(GFS_sfcprop_type), intent(in) :: & - Sfcprop ! Fortran DDT containing FV3-GFS surface fields + Sfcprop ! DDT: FV3-GFS surface fields type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + Statein ! DDT: FV3-GFS prognostic state data in from dycore integer, intent(in) :: & ncol ! Number of horizontal grid points real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & @@ -62,9 +66,9 @@ subroutine GFS_rrtmgp_sw_pre_run (Model, Interstitial, Grid, Sfcprop, Statein, real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & tracer real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & - p_lev ! Interface (level) pressure + p_lev ! Pressure @ layer interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT containing spectral information for SW calculation + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation ! Outputs integer, intent(out) :: & @@ -74,11 +78,11 @@ subroutine GFS_rrtmgp_sw_pre_run (Model, Interstitial, Grid, Sfcprop, Statein, real(kind_phys), dimension(ncol), intent(out) :: & alb1d ! Surface albedo pertubation type(GFS_radtend_type), intent(inout) :: & - Radtend ! Fortran DDT containing FV3-GFS radiation tendencies + Radtend ! DDT: FV3-GFS radiation tendencies type(GFS_coupling_type), intent(inout) :: & - Coupling + Coupling ! DDT: FV3-GFS coupling arrays real(kind_phys), dimension(ncol,Model%levs,sw_gas_props%get_nband(),NF_AESW), intent(out) ::& - aerosolssw ! Aerosol radiative properties in each SW band. + aerosolssw ! Aerosol radiative properties in each SW band. real(kind_phys), dimension(ncol,NSPC1), intent(inout) :: & aerodp ! Vertical integrated optical depth for various aerosol species character(len=*), intent(out) :: & @@ -135,7 +139,7 @@ subroutine GFS_rrtmgp_sw_pre_run (Model, Interstitial, Grid, Sfcprop, Statein, ! 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, & + 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) @@ -153,9 +157,9 @@ subroutine GFS_rrtmgp_sw_pre_run (Model, Interstitial, Grid, Sfcprop, Statein, ! ####################################################################################### ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile ! ####################################################################################### - call setaer(p_lev, p_lay, Statein%prslk(1:NCOL,:), tv_lay, relhum, & - Sfcprop%slmsk, tracer, Grid%xlon, Grid%xlat, NCOL, Model%levs, Model%levs+1, & - Model%lsswr, .true., aerosolssw2, aerosolslw, aerodp) + call setaer(p_lev, p_lay, Statein%prslk(1:NCOL,:), tv_lay, relhum, Sfcprop%slmsk, tracer, & + Grid%xlon, Grid%xlat, NCOL, Model%levs, Model%levs+1, Model%lsswr, .true., & + aerosolssw2, aerosolslw, aerodp) ! Store aerosol optical properties ! SW. @@ -170,8 +174,9 @@ subroutine GFS_rrtmgp_sw_pre_run (Model, Interstitial, Grid, Sfcprop, Statein, end subroutine GFS_rrtmgp_sw_pre_run -!> \section arg_table_GFS_rrtmgp_sw_pre_finalize Argument Table -!! + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_finalize + ! ######################################################################################### subroutine GFS_rrtmgp_sw_pre_finalize () end subroutine GFS_rrtmgp_sw_pre_finalize diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 8ab4ae9e2..f235b8d02 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -403,11 +403,11 @@ subroutine rrtmgp_sw_gas_optics_run(Model, Interstitial, sw_gas_props, ncol, p_l ! Inputs type(GFS_control_type), intent(in) :: & - Model ! DDT containing model control parameters + Model ! DDT: FV3-GFS model control parameters type(GFS_Interstitial_type),intent(inout) :: & - Interstitial + Interstitial ! DDT: FV3-GFS Interstitial arrays type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! DDT containing spectral information for RRTMGP SW radiation scheme + sw_gas_props ! RRTMGP DDT: spectral information for RRTMGP SW radiation scheme integer,intent(in) :: & ncol ! Number of horizontal points real(kind_phys), dimension(ncol,model%levs), intent(in) :: & @@ -429,7 +429,7 @@ subroutine rrtmgp_sw_gas_optics_run(Model, Interstitial, sw_gas_props, ncol, p_l integer, intent(out) :: & errflg ! Error code type(ty_optical_props_2str),intent(out) :: & - sw_optical_props_clrsky ! + sw_optical_props_clrsky ! RRTMGP DDT: clear-sky shortwave optical properties, spectral (tau,ssa,g) ! Local variables integer :: ij diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index bfa94a062..ca2c0248a 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -1,5 +1,3 @@ -! ########################################################################################### -! ########################################################################################### module rrtmgp_sw_rte use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_radtend_type, GFS_statein_type, GFS_interstitial_type @@ -29,74 +27,72 @@ end subroutine rrtmgp_sw_rte_init !! \section arg_table_rrtmgp_sw_rte_run !! \htmlinclude rrtmgp_sw_rte.html !! - subroutine rrtmgp_sw_rte_run(Model, Interstitial, Radtend, Statein, ncol, sw_gas_props, p_lay, t_lay, & - p_lev, gas_concentrations, sw_optical_props_clrsky, sw_optical_props_clouds, & - sw_optical_props_aerosol, lsswr, nday, idxday, hsw0, hswb, scmpsw, & - fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, errmsg, errflg) + subroutine rrtmgp_sw_rte_run(Model, Interstitial, Radtend, Statein, ncol, sw_gas_props, & + p_lay, t_lay, p_lev, gas_concentrations, sw_optical_props_clrsky, & + sw_optical_props_clouds, sw_optical_props_aerosol, lsswr, nday, idxday, hsw0, hswb, & + scmpsw, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, & + errmsg, errflg) ! Inputs - type(GFS_control_type), intent(in) :: & + type(GFS_control_type), intent(in) :: & Model type(GFS_interstitial_type), intent(in) :: & Interstitial type(GFS_radtend_type), intent(in) :: & Radtend type(GFS_statein_type), intent(in) :: & - Statein ! Fortran DDT containing FV3-GFS prognostic state data in from dycore + Statein ! DDT: FV3-GFS prognostic state data in from dycore integer, intent(in) :: & - ncol, & ! Number of horizontal gridpoints - nday ! Number of daytime points + ncol, & ! Number of horizontal gridpoints + nday ! Number of daytime points integer, intent(in), dimension(nday) :: & - idxday ! Index array for daytime points + idxday ! Index array for daytime points real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) - t_lay ! Temperature (K) + p_lay, & ! Pressure @ model layer-centers (Pa) + t_lay ! Temperature (K) real(kind_phys), dimension(ncol,Model%levs+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) + p_lev ! Pressure @ model layer-interfaces (Pa) type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! DDT containing SW spectral information + sw_gas_props ! RRTMGP DDT: SW spectral information type(ty_optical_props_2str),intent(in) :: & sw_optical_props_clrsky, & ! RRTMGP DDT: longwave clear-sky radiative properties sw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties - sw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties - + sw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties type(ty_gas_concs),intent(in) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) logical, intent(in) :: & - lsswr ! Flag to calculate SW irradiances + lsswr ! Flag to calculate SW irradiances ! Outputs character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg real(kind_phys), dimension(ncol,Model%levs+1), intent(inout) :: & - fluxswUP_allsky, & ! All-sky flux (W/m2) - fluxswDOWN_allsky, & ! All-sky flux (W/m2) - fluxswUP_clrsky, & ! Clear-sky flux (W/m2) - fluxswDOWN_clrsky ! All-sky flux (W/m2) + fluxswUP_allsky, & ! RRTMGP upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) + fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) real(kind_phys), dimension(ncol,Model%levs), optional, intent(inout) :: & - hsw0 ! Clear-sky heating rate (K/sec) + hsw0 ! Clear-sky heating rate (K/sec) real(kind_phys), dimension(ncol,Model%levs,sw_gas_props%get_nband()), intent(inout), optional :: & - hswb ! All-sky heating rate, by band (K/sec) + hswb ! All-sky heating rate, by band (K/sec) ! Outputs (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) - ! nirbm - downward nir direct beam flux (W/m2) - ! nirdf - downward nir diffused flux (W/m2) - ! visbm - downward uv+vis direct beam flux (W/m2) - ! visdf - downward uv+vis diffused flux (W/m2) + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux (W/m2) + ! uvbf0 - clear sky downward uv-b flux (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) ! Local variables type(ty_fluxes_byband) :: & - flux_allsky, & ! All-sky flux (W/m2) - flux_clrsky ! Clear-sky flux (W/m2) + flux_allsky, & ! All-sky flux (W/m2) + flux_clrsky ! Clear-sky flux (W/m2) real(kind_phys), dimension(nday,Model%levs+1,sw_gas_props%get_nband()),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky -! real(kind_phys), dimension(nday,Model%levs+1,sw_gas_props%get_nband()),target :: & -! fluxSWBB_up_allsky, fluxSWBB_dn_allsky real(kind_phys), dimension(ncol,Model%levs) :: vmrTemp logical :: l_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 integer :: iGas,iSFC,iTOA @@ -166,41 +162,39 @@ subroutine rrtmgp_sw_rte_run(Model, Interstitial, Radtend, Statein, ncol, sw_gas flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky flux_clrsky%bnd_flux_up => fluxSW_up_clrsky flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky - ! Only calculate fluxes by-band, only when heating-rate profiles by band are requested. - !if (l_AllSky_HR_byband) then - ! flux_allsky%bnd_flux_up => fluxSWBB_up_allsky - ! flux_allsky%bnd_flux_dn => fluxSWBB_dn_allsky - !endif ! Compute clear-sky fluxes (if requested) - ! Clear-sky fluxes are gas+aerosol + ! Clear-sky fluxes (gas+aerosol) call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_aerosol_daylit%increment(sw_optical_props_clrsky_daylit)) + ! Delta-scale optical properties call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky_daylit%delta_scale()) if (l_ClrSky_HR) then call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & - sw_optical_props_clrsky_daylit, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle - Interstitial%toa_src_sw(idxday,:), & ! IN - incident solar flux at TOA - Interstitial%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) - Interstitial%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) + sw_optical_props_clrsky_daylit, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle + Interstitial%toa_src_sw(idxday,:), & ! IN - incident solar flux at TOA + Interstitial%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) + Interstitial%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) ! Store fluxes fluxswUP_clrsky(idxday,:) = sum(flux_clrsky%bnd_flux_up,dim=3) fluxswDOWN_clrsky(idxday,:) = sum(flux_clrsky%bnd_flux_dn,dim=3) endif ! Compute all-sky fluxes - call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds_daylit%delta_scale()) + ! All-sky fluxes (clear-sky + clouds) call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds_daylit%increment(sw_optical_props_clrsky_daylit)) + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds_daylit%delta_scale()) call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & - sw_optical_props_clrsky_daylit, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle - Interstitial%toa_src_sw(idxday,:), & ! IN - incident solar flux at TOA - Interstitial%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) - Interstitial%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) - flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) + sw_optical_props_clrsky_daylit, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + Radtend%coszen(idxday), & ! IN - Cosine of solar zenith angle + Interstitial%toa_src_sw(idxday,:), & ! IN - incident solar flux at TOA + Interstitial%sfc_alb_nir_dir(:,idxday), & ! IN - Shortwave surface albedo (direct) + Interstitial%sfc_alb_nir_dif(:,idxday), & ! IN - Shortwave surface albedo (diffuse) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,Model%levs,nBand) ! Store fluxes fluxswUP_allsky(idxday,:) = sum(flux_allsky%bnd_flux_up,dim=3) fluxswDOWN_allsky(idxday,:) = sum(flux_allsky%bnd_flux_dn,dim=3)