From 806dce81e840fbe4a14d70858391aa810cbca517 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 21 Sep 2017 12:11:48 -0600 Subject: [PATCH 001/114] added table for moninedmf_run; added init and finalize routines --- physics/moninedmf.f | 119 ++++++++++++++++++++++++-------------------- 1 file changed, 64 insertions(+), 55 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index bab282641..2cafe0815 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -13,62 +13,71 @@ !! \section intraphysics Intraphysics Communication !! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. + subroutine moninedmf_init() + end subroutine moninedmf_init() + + subroutine moninedmf_finalize() + end subroutine moninedmf_finalize() + !> \brief This subroutine contains all of logic for the Hybrid EDMF PBL scheme except for the calculation of the updraft properties and mass flux. !! !! The scheme works on a basic level by calculating background diffusion coefficients and updating them according to which processes are occurring in the column. The most important difference in diffusion coefficients occurs between those levels in the PBL and those above the PBL, so the PBL height calculation is of utmost importance. An initial estimate is calculated in a "predictor" step in order to calculate Monin-Obukhov similarity values and a corrector step recalculates the PBL height based on updated surface thermal characteristics. Using the PBL height and the similarity parameters, the diffusion coefficients are updated below the PBL top based on Hong and Pan (1996) \cite hong_and_pan_1996 (including counter-gradient terms). Diffusion coefficients in the free troposphere (above the PBL top) are calculated according to Louis (1979) \cite louis_1979 with updated Richardson number-dependent functions. If it is diagnosed that PBL top-down mixing is occurring according to Lock et al. (2000) \cite lock_et_al_2000 , then then diffusion coefficients are updated accordingly. Finally, for convective boundary layers (defined as when the Obukhov length exceeds a threshold), the counter-gradient terms are replaced using the mass flux scheme of Siebesma et al. (2007) \cite siebesma_et_al_2007 . In order to return time tendencies, a fully implicit solution is found using tridiagonal matrices, and time tendencies are "backed out." Before returning, the time tendency of temperature is updated to reflect heating due to TKE dissipation following Han et al. (2015) \cite han_et_al_2015 . !! -!! \param[in] ix horizontal dimension -!! \param[in] im number of used points -!! \param[in] km vertical layer dimension -!! \param[in] ntrac number of tracers -!! \param[in] ntcw cloud condensate index in the tracer array -!! \param[in,out] dv v-momentum tendency (\f$ m s^{-2} \f$) -!! \param[in,out] du u-momentum tendency (\f$ m s^{-2} \f$) -!! \param[in,out] tau temperature tendency (\f$ K s^{-1} \f$) -!! \param[in,out] rtg moisture tendency (\f$ kg kg^{-1} s^{-1} \f$) -!! \param[in] u1 u component of layer wind (\f$ m s^{-1} \f$) -!! \param[in] v1 v component of layer wind (\f$ m s^{-1} \f$) -!! \param[in] t1 layer mean temperature (\f$ K \f$) -!! \param[in] q1 layer mean tracer concentration (units?) -!! \param[in] swh total sky shortwave heating rate (\f$ K s^-1 \f$) -!! \param[in] hlw total sky longwave heating rate (\f$ K s^-1 \f$) -!! \param[in] xmu time step zenith angle adjust factor for shortwave -!! \param[in] psk Exner function at surface interface? -!! \param[in] rbsoil surface bulk Richardson number -!! \param[in] zorl surface roughness (units?) -!! \param[in] u10m 10-m u wind (\f$ m s^{-1} \f$) -!! \param[in] v10m 10-m v wind (\f$ m s^{-1} \f$) -!! \param[in] fm fm parameter from PBL scheme -!! \param[in] fh fh parameter from PBL scheme -!! \param[in] tsea ground surface temperature (K) -!! \param[in] qss surface saturation humidity (units?) -!! \param[in] heat surface sensible heat flux (units?) -!! \param[in] evap evaporation from latent heat flux (units?) -!! \param[in] stress surface wind stress? (\f$ cm*v^2\f$ in sfc_diff subroutine) (units?) -!! \param[in] spd1 surface wind speed? (units?) -!! \param[out] kpbl PBL top index -!! \param[in] prsi pressure at layer interfaces (units?) -!! \param[in] del pressure difference between level k and k+1 (units?) -!! \param[in] prsl mean layer pressure (units?) -!! \param[in] prslk Exner function at layer -!! \param[in] phii interface geopotential height (units?) -!! \param[in] phil layer geopotential height (units?) -!! \param[in] delt physics time step (s) -!! \param[in] dspheat flag for TKE dissipative heating -!! \param[out] dusfc surface u-momentum tendency (units?) -!! \param[out] dvsfc surface v-momentum tendency (units?) -!! \param[out] dtsfc surface temperature tendency (units?) -!! \param[out] dqsfc surface moisture tendency (units?) -!! \param[out] hpbl PBL top height (m) -!! \param[out] hgamt counter gradient mixing term for temperature (units?) -!! \param[out] hgamq counter gradient mixing term for moisture (units?) -!! \param[out] dkt diffusion coefficient for temperature (units?) -!! \param[in] kinver index location of temperature inversion -!! \param[in] xkzm_m background vertical diffusion coefficient for momentum (units?) -!! \param[in] xkzm_h background vertical diffusion coefficeint for heat, moisture (units?) -!! \param[in] xkzm_s sigma threshold for background momentum diffusion (units?) -!! \param[in] lprnt flag to print some output -!! \param[in] ipr index of point to print +!! \section arg_table_moninedmf_run +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|----------------------------------------------------|---------------|------|---------|-----------|--------|----------| +!! | ix | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!! | km | vertical_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | +!! | ntcw | index_for_liquid_cloud_condensate | cloud condensate index in tracer array | index | 0 | integer | | in | F | +!! | dv | tendency_of_y_wind | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | +!! | du | tendency_of_x_wind | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | +!! | tau | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | +!! | rtg | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | +!! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | +!! | v1 | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | +!! | t1 | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | +!! | q1 | tracer_concentration | layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | +!! | swh | tendency_of_air_temperature_due_to_shortwave_heating | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | +!! | hlw | tendency_of_air_temperature_due_to_longwave_heating | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | +!! | xmu | time_step_zenith_angle_adjust_factor_for_sw | time step zenith angle adjust factor for shortwave | none | 2 | real | kind_phys | in | F | +!! | psk | exner_function_at_lowest_model_interface | exner function at the surface interface | none | 1 | real | kind_phys | in | F | +!! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | +!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | +!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | +!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | +!! | fm | Monin-Obukhov_similarity_parameter_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | in | F | +!! | fh | Monin-Obukhov_similarity_parameter_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | in | F | +!! | tsea | surface_temperature | surface temperature | K | 1 | real | kind_phys | in | F | +!! | qss | saturation_specific_humidity_at_the_surface | surface saturation specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | +!! | heat | surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | +!! | evap | evaporation_from_surface_upward_latent_heat_flux | evaporation from surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | +!! | spd1 | wind_speed_at_lowest_model_level | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | +!! | kpbl | model_level_number_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | +!! | prsi | air_pressure_at_model_layer_interfaces | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | +!! | del | air_pressure_layer_difference | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | +!! | prsl | air_pressure_layer | mean layer pressure | Pa | 2 | real | kind_phys | in | F | +!! | prslk | dimensionless_exner_function | Exner function at layers | none | 2 | real | kind_phys | in | F | +!! | phii | geopotential_at_interfaces | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | +!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | +!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | +!! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | +!! | dusfc | x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dvsfc | y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dtsfc | surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | dqsfc | surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | +!! | hgamt | countergradient_mixing_term_for_temperature | countergradient mixing term for temperature | K | 1 | real | kind_phys | out | F | +!! | hgamq | countergradient_mixing_term_for_water_vapor | countergradient mixing term for water vapor | kg kg-1 | 1 | real | kind_phys | out | F | +!! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 1 | real | kind_phys | out | F | +!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | +!! | xkzm_m | atmosphere_momentum_diffusivity_background | background value of momentum diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | +!! | xkzm_h | atmosphere_heat_diffusivity_background | background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | +!! | xkzm_s | diffusivity_background_sigma_level | sigma level threshold for background diffusivity | none | 0 | real | kind_phys | in | F | +!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | +!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | !! !! \section general General Algorithm !! -# Compute preliminary variables from input arguments. @@ -86,7 +95,7 @@ !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed Detailed Algorithm !! @{ - subroutine moninedmf(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine moninedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,qss,heat,evap,stress,spd1,kpbl, & @@ -150,7 +159,7 @@ subroutine moninedmf(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & govrth(im), hrad(im), & ! & hradm(im), radmin(im), vrad(im), & & radmin(im), vrad(im), & - & zd(im), zdd(im), thlvx1(im) + & zd(im), zdd(im), thlvx1(im) ! real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & & zi(im,km+1), zl(im,km), xkzo(im,km-1), & @@ -1192,7 +1201,7 @@ subroutine moninedmf(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. !! !! Origin of subroutine unknown. - subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) + subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) cc use machine , only : kind_phys implicit none From 510c88d5eea5ef4d0b4269245c2eb3e3ca2aa1f3 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 21 Sep 2017 12:19:41 -0600 Subject: [PATCH 002/114] added module and changed names from moninedmf to edmf for simplicity --- physics/moninedmf.f | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 2cafe0815..11835a0b5 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -2,6 +2,10 @@ !! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the !! subroutine that calculates the mass flux and updraft properties. + module edmf + + contains + !> \defgroup PBL Hybrid Eddy-diffusivity Mass-flux Scheme !! @{ !! \brief The Hybrid EDMF scheme is a first-order turbulent transport scheme used for subgrid-scale vertical turbulent mixing in the PBL and above. It blends the traditional first-order approach that has been used and improved over the last several years with a more recent scheme that uses a mass-flux approach to calculate the countergradient diffusion terms. @@ -13,11 +17,11 @@ !! \section intraphysics Intraphysics Communication !! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. - subroutine moninedmf_init() - end subroutine moninedmf_init() + subroutine edmf_init () + end subroutine edmf_init - subroutine moninedmf_finalize() - end subroutine moninedmf_finalize() + subroutine edmf_finalize () + end subroutine edmf_finalize !> \brief This subroutine contains all of logic for the Hybrid EDMF PBL scheme except for the calculation of the updraft properties and mass flux. !! @@ -95,7 +99,7 @@ end subroutine moninedmf_finalize() !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed Detailed Algorithm !! @{ - subroutine moninedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,qss,heat,evap,stress,spd1,kpbl, & @@ -1309,3 +1313,4 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) return end !> @} + end module edmf From aeabd107a2572ac3769d2901344893644a6cdc07 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 21 Sep 2017 12:46:50 -0600 Subject: [PATCH 003/114] fixed subroutine name for arg_table declaration --- physics/moninedmf.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 11835a0b5..ea5c14bf7 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -27,7 +27,7 @@ end subroutine edmf_finalize !! !! The scheme works on a basic level by calculating background diffusion coefficients and updating them according to which processes are occurring in the column. The most important difference in diffusion coefficients occurs between those levels in the PBL and those above the PBL, so the PBL height calculation is of utmost importance. An initial estimate is calculated in a "predictor" step in order to calculate Monin-Obukhov similarity values and a corrector step recalculates the PBL height based on updated surface thermal characteristics. Using the PBL height and the similarity parameters, the diffusion coefficients are updated below the PBL top based on Hong and Pan (1996) \cite hong_and_pan_1996 (including counter-gradient terms). Diffusion coefficients in the free troposphere (above the PBL top) are calculated according to Louis (1979) \cite louis_1979 with updated Richardson number-dependent functions. If it is diagnosed that PBL top-down mixing is occurring according to Lock et al. (2000) \cite lock_et_al_2000 , then then diffusion coefficients are updated accordingly. Finally, for convective boundary layers (defined as when the Obukhov length exceeds a threshold), the counter-gradient terms are replaced using the mass flux scheme of Siebesma et al. (2007) \cite siebesma_et_al_2007 . In order to return time tendencies, a fully implicit solution is found using tridiagonal matrices, and time tendencies are "backed out." Before returning, the time tendency of temperature is updated to reflect heating due to TKE dissipation following Han et al. (2015) \cite han_et_al_2015 . !! -!! \section arg_table_moninedmf_run +!! \section arg_table_edmf_run !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|----------------------------------------------------|---------------|------|---------|-----------|--------|----------| !! | ix | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | From 10b460a278d3570f3c4cee9f6f50b62a8ac7efb2 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 25 Sep 2017 15:08:47 -0600 Subject: [PATCH 004/114] changed GFS_physics_driver.F90 to use the edmf module and changed the call to edmf_run --- GFS_layer/GFS_physics_driver.F90 | 45 ++++++++++++++++---------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 9b92e4764..5c2f59a64 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -4,7 +4,7 @@ module module_physics_driver use physcons, only: con_cp, con_fvirt, con_g, con_rd, & con_rv, con_hvap, con_hfus, & con_rerth, con_pi, rhc_max, dxmin,& - dxinv, pa2mb, rlapse + dxinv, pa2mb, rlapse use cs_conv, only: cs_convr use ozne_def, only: levozp, oz_coeff, oz_pres use h2o_def, only: levh2o, h2o_coeff, h2o_pres @@ -15,6 +15,7 @@ module module_physics_driver GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type + use edmf, only: edmf_run implicit none @@ -27,7 +28,7 @@ module module_physics_driver real(kind=kind_phys), parameter :: hsub = con_hvap+con_hfus real(kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) real(kind=kind_phys), parameter :: onebg = 1.0/con_g - real(kind=kind_phys), parameter :: albdf = 0.06 + real(kind=kind_phys), parameter :: albdf = 0.06 real(kind=kind_phys) tf, tcr, tcrf parameter (tf=258.16, tcr=273.16, tcrf=1.0/(tcr-tf)) @@ -422,14 +423,14 @@ subroutine GFS_physics_driver & flag_cice logical, dimension(Model%ntrac-Model%ncld+2,2) :: & - otspt + otspt !--- REAL VARIABLES real(kind=kind_phys) :: & dtf, dtp, rhbbot, rhbtop, rhpbl, frain, tem, tem1, tem2, & xcosz_loc, zsea1, zsea2, eng0, eng1, dpshc, & - !--- experimental for shoc sub-stepping - dtshoc + !--- experimental for shoc sub-stepping + dtshoc real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & ccwfac, garea, dlength, cumabs, cice, zice, tice, gflx, & @@ -460,7 +461,7 @@ subroutine GFS_physics_driver & del, rhc, dtdt, dudt, dvdt, gwdcu, gwdcv, dtdtc, rainp, & ud_mf, dd_mf, dt_mf, prnum, dkt, sigmatot, sigmafrac - !--- GFDL modification for FV3 + !--- GFDL modification for FV3 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs+1) ::& del_gz @@ -468,7 +469,7 @@ subroutine GFS_physics_driver & dqdt real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,Model%nctp) :: & - sigmai, vverti + sigmai, vverti real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,oz_coeff+5) :: & dq3dt_loc @@ -477,7 +478,7 @@ subroutine GFS_physics_driver & !--- in clw, the first two varaibles are cloud water and ice. !--- from third to ntrac are convective transportable tracers, !--- third being the ozone, when ntrac=3 (valid only with ras) - !--- Anning Cheng 9/21/2016 leave a hook here for diagnosed snow, + !--- Anning Cheng 9/21/2016 leave a hook here for diagnosed snow, !--- rain, and their number real(kind=kind_phys), allocatable :: & clw(:,:,:), qpl(:,:), qpi(:,:), ncpl(:,:), ncpi(:,:), & @@ -1012,7 +1013,7 @@ subroutine GFS_physics_driver & Model%lsm, lprnt, ipr, & ! --- input/outputs: zice, cice, tice, Sfcprop%weasd, Sfcprop%tsfc, & - Sfcprop%tprcp, stsoil, ep1d, & + Sfcprop%tprcp, stsoil, ep1d, & ! --- outputs: Sfcprop%snowd, qss, snowmt, gflx, Diag%cmm, Diag%chh, evap, & hflx) @@ -1189,7 +1190,7 @@ subroutine GFS_physics_driver & Model%xkzm_m, Model%xkzm_h, Model%xkzm_s, lprnt, ipr, me) else if (Model%hybedmf) then - call moninedmf(ix, im, levs, nvdiff, Model%ntcw, dvdt, dudt, dtdt, dqdt,& + call edmf_run (ix, im, levs, nvdiff, Model%ntcw, dvdt, dudt, dtdt, dqdt,& Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & @@ -1904,7 +1905,7 @@ subroutine GFS_physics_driver & if (Model%cnvgwd) then ! call convective gravity wave drag -! --- ... calculate maximum convective heating rate +! --- ... calculate maximum convective heating rate ! cuhr = temperature change due to deep convection cumabs(:) = 0.0 @@ -2238,7 +2239,7 @@ subroutine GFS_physics_driver & Stateout%gq0(1,1,1), clw(1,1,1), clw(1,1,2), qpi, qpl,rhc, & Model%sup, Tbd%phy_f3d(1,1,Model%ntot3d-2), & Stateout%gq0(1,1,Model%ntke), hflx, evap, prnum, & - Tbd%phy_f3d(1,1,Model%ntot3d-1), Tbd%phy_f3d(1,1,Model%ntot3d),& + Tbd%phy_f3d(1,1,Model%ntot3d-1), Tbd%phy_f3d(1,1,Model%ntot3d),& lprnt, ipr, ncpl, ncpi, kdt) if ((Model%ntlnc > 0) .and. (Model%ntinc > 0) .and. (Model%ncld >= 2)) then @@ -2428,13 +2429,13 @@ subroutine GFS_physics_driver & ncpr(:,:) = 0. ncps(:,:) = 0. Tbd%phy_f3d(:,:,1) = Tbd%phy_f3d(:,:,Model%ntot3d-2) ! clouds from shoc - else + else clw(:,:,1) = Stateout%gq0(:,:,Model%ntiw) ! ice clw(:,:,2) = Stateout%gq0(:,:,Model%ntcw) ! water - qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) - qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) - ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) - ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) + qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) + qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) + ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) + ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) Tbd%phy_f3d(:,:,1) = Tbd%phy_f3d(:,:,Model%ntot3d-2) ! clouds from shoc end if elseif ((Model%imfdeepcnv >= 0) .or. (Model%imfshalcnv > 0)) then @@ -2470,10 +2471,10 @@ subroutine GFS_physics_driver & else clw(:,:,1) = Stateout%gq0(:,:,Model%ntiw) ! ice clw(:,:,2) = Stateout%gq0(:,:,Model%ntcw) ! water - qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) - qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) - ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) - ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) + qrn(:,:) = Stateout%gq0(:,:,Model%ntrw) + qsnw(:,:) = Stateout%gq0(:,:,Model%ntsw) + ncpr(:,:) = Stateout%gq0(:,:,Model%ntrnc) + ncps(:,:) = Stateout%gq0(:,:,Model%ntsnc) Tbd%phy_f3d(:,:,1) = min(1.0, Tbd%phy_f3d(:,:,1)+cnvc(:,:)) endif endif @@ -2812,7 +2813,7 @@ subroutine moist_bud(im,ix,ix2,levs,me,kdt,grav,dtp,delp,rain, & ! endif enddo return - + end subroutine moist_bud !> @} From 1c3829e23d46d08aa09112d7ca0618c70f4636a3 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 25 Sep 2017 20:13:52 -0600 Subject: [PATCH 005/114] added edmf_ prefix to other subs in moninedmf.f; changed actual argument to edmf_run call in GFS_physics_driver to array --- GFS_layer/GFS_physics_driver.F90 | 2 +- physics/moninedmf.f | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 5c2f59a64..d675c93d0 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -1192,7 +1192,7 @@ subroutine GFS_physics_driver & if (Model%hybedmf) then call edmf_run (ix, im, levs, nvdiff, Model%ntcw, dvdt, dudt, dtdt, dqdt,& Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & - Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(1,1), & + Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(:,1), & rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & Sfcprop%ffhh, Sfcprop%tsfc, qss, hflx, evap, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & diff --git a/physics/moninedmf.f b/physics/moninedmf.f index ea5c14bf7..24381a3f1 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1047,8 +1047,8 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! solve tridiagonal problem for heat and moisture ! -!> The tridiagonal system is solved by calling the internal ::tridin subroutine. - call tridin(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) +!> The tridiagonal system is solved by calling the internal ::edmf_tridin subroutine. + call edmf_tridin(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) ! ! recover tendencies of heat and moisture @@ -1162,7 +1162,7 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! solve tridiagonal problem for momentum ! - call tridi2(im,km,al,ad,au,a1,a2,au,a1,a2) + call edmf_tridi2(im,km,al,ad,au,a1,a2,au,a1,a2) ! ! recover tendencies of momentum ! @@ -1205,7 +1205,7 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. !! !! Origin of subroutine unknown. - subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) + subroutine edmf_tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) cc use machine , only : kind_phys implicit none @@ -1248,7 +1248,7 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) !! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. !! !! Origin of subroutine unknown. - subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) + subroutine edmf_tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) cc use machine , only : kind_phys implicit none From 43c5943a61a7db8511808b8dd467e94bbe981b9a Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 25 Sep 2017 20:31:49 -0600 Subject: [PATCH 006/114] fixed line continuation character in moninedmf.f --- physics/moninedmf.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 24381a3f1..bec543bfd 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -99,7 +99,7 @@ end subroutine edmf_finalize !! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. !! \section detailed Detailed Algorithm !! @{ - subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,qss,heat,evap,stress,spd1,kpbl, & From d5be1bcd8122b8bdf145eff3855dc590a359c429 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 26 Sep 2017 08:39:43 -0600 Subject: [PATCH 007/114] Adding step ZERO_OUT_HEATING_RATES_AND_FLUXES --- GFS_layer/GFS_radiation_driver.F90 | 78 +++++++++++++++++++++++------- 1 file changed, 61 insertions(+), 17 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 6b2ee9558..8a6cf63a5 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1849,6 +1849,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: htswc, htsw0 + ! Added by PAJ: + logical, parameter :: ZERO_OUT_HEATING_RATES_AND_FLUXES = .true. + if_lsswr: if (Model%lsswr) then @@ -1866,8 +1869,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & if_nday: if (nday > 0) then - ! Compute SW heating rates - ! and fluxes. + ! Daytime: Compute SW heating rates and fluxes. if (Model%swhtr) then call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr, clouds, Tbd%icsdsw, faersw, & @@ -1925,25 +1927,33 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & else - Radtend%htrsw(:,:) = 0.0 + ! Night time: set SW heating rates and fluxes to zero + if (ZERO_OUT_HEATING_RATES_AND_FLUXES) then - Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + call Zero_out_heatflux (Radtend, Diag, scmpsw, Coupling, Grid, Model) - Coupling%nirbmdi(:) = 0.0 - Coupling%nirdfdi(:) = 0.0 - Coupling%visbmdi(:) = 0.0 - Coupling%visdfdi(:) = 0.0 + else + Radtend%htrsw(:,:) = 0.0 - Coupling%nirbmui(:) = 0.0 - Coupling%nirdfui(:) = 0.0 - Coupling%visbmui(:) = 0.0 - Coupling%visdfui(:) = 0.0 + Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 - endif + Coupling%nirbmdi(:) = 0.0 + Coupling%nirdfdi(:) = 0.0 + Coupling%visbmdi(:) = 0.0 + Coupling%visdfdi(:) = 0.0 + + Coupling%nirbmui(:) = 0.0 + Coupling%nirdfui(:) = 0.0 + Coupling%visbmui(:) = 0.0 + Coupling%visdfui(:) = 0.0 + + if (Model%swhtr) then + Radtend%swhc(:,:) = 0 + endif + + end if end if if_nday @@ -2170,6 +2180,40 @@ subroutine Organize_output (Diag, Model, Grid, Radtend, Statein, Coupling, & end subroutine Organize_output + subroutine Zero_out_heatflux (Radtend, Diag, scmpsw, Coupling, Grid, Model) + + implicit none + + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_diag_type), intent(inout) :: Diag + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw + type(GFS_control_type), intent(in) :: Model + + + Radtend%htrsw(:,:) = 0.0 + + Radtend%sfcfsw = sfcfsw_type(0.0, 0.0, 0.0, 0.0) + Diag%topfsw = topfsw_type(0.0, 0.0, 0.0) + scmpsw = cmpfsw_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0) + + Coupling%nirbmdi(:) = 0.0 + Coupling%nirdfdi(:) = 0.0 + Coupling%visbmdi(:) = 0.0 + Coupling%visdfdi(:) = 0.0 + + Coupling%nirbmui(:) = 0.0 + Coupling%nirdfui(:) = 0.0 + Coupling%visbmui(:) = 0.0 + Coupling%visdfui(:) = 0.0 + + if (Model%swhtr) then + Radtend%swhc(:,:) = 0 + endif + + end subroutine Zero_out_heatflux + ! !> @} !........................................! From 07190072c7f15c4d694d29b836f346bfac8b6550 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 26 Sep 2017 08:43:57 -0600 Subject: [PATCH 008/114] Change name sub zero heating rate and fluxes --- GFS_layer/GFS_radiation_driver.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 8a6cf63a5..9990a00f1 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1930,7 +1930,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Night time: set SW heating rates and fluxes to zero if (ZERO_OUT_HEATING_RATES_AND_FLUXES) then - call Zero_out_heatflux (Radtend, Diag, scmpsw, Coupling, Grid, Model) + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) else Radtend%htrsw(:,:) = 0.0 @@ -2180,7 +2180,7 @@ subroutine Organize_output (Diag, Model, Grid, Radtend, Statein, Coupling, & end subroutine Organize_output - subroutine Zero_out_heatflux (Radtend, Diag, scmpsw, Coupling, Grid, Model) + subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) implicit none @@ -2212,7 +2212,7 @@ subroutine Zero_out_heatflux (Radtend, Diag, scmpsw, Coupling, Grid, Model) Radtend%swhc(:,:) = 0 endif - end subroutine Zero_out_heatflux + end subroutine Zero_out_heatrate_flux ! !> @} From 43a177d8a12e56acd77c3ac944573c7fed449010 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 26 Sep 2017 09:52:47 -0600 Subject: [PATCH 009/114] Adding step SET_SURFACE_ALBEDO --- GFS_layer/GFS_radiation_driver.F90 | 56 ++++++++++++++++++++++++------ 1 file changed, 46 insertions(+), 10 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 9990a00f1..adcbd4fab 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1851,21 +1851,32 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Added by PAJ: logical, parameter :: ZERO_OUT_HEATING_RATES_AND_FLUXES = .true. + logical, parameter :: SET_SURFACE_ALBEDO = .true. if_lsswr: if (Model%lsswr) then ! Setup surface albedo for SW calculation - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, & - sfcalb) ! --- outputs - - ! Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) + if (SET_SURFACE_ALBEDO) then + call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, & + sfcalb, Radtend%sfalb) ! --- outputs + else + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, & + sfcalb) ! --- outputs + + ! Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) + end if if_nday: if (nday > 0) then @@ -2214,6 +2225,31 @@ subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) end subroutine Zero_out_heatrate_flux + + subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & + coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & + facsf, facwf, fice, tisfc, IMAX, sfcalb, sfalb) + + implicit none + + integer, intent(in) :: IMAX + real (kind = kind_phys), dimension(:), intent(in) :: slmsk, snowf, & + zorlf, coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, & + alnwf, facsf, facwf, fice, tisfc, sncovr, snoalb + + real (kind = kind_phys), dimension(IMAX, NF_ALBD), intent(out) :: sfcalb + real (kind = kind_phys), dimension(:), intent(out) :: sfalb + + + call setalb (slmsk, snowf, sncovr, snoalb, zorlf, & + coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & + facsf, facwf, fice, tisfc, IMAX, sfcalb) + + ! Approximate mean surface albedo from vis- and nir- diffuse values. + sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) + + end subroutine Set_sfc_albedo + ! !> @} !........................................! From 8090803d4c102d4a7a8cf8308cee5d9ab5f7a412 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 26 Sep 2017 13:57:47 -0600 Subject: [PATCH 010/114] Adding more steps to the if statements of do_sw_rad --- GFS_layer/GFS_radiation_driver.F90 | 164 +++++++++++++++++++++++------ 1 file changed, 133 insertions(+), 31 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index adcbd4fab..7298727a1 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1852,12 +1852,15 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Added by PAJ: logical, parameter :: ZERO_OUT_HEATING_RATES_AND_FLUXES = .true. logical, parameter :: SET_SURFACE_ALBEDO = .true. + logical, parameter :: ORGANIZE_HEATING_RATE = .true. + logical, parameter :: ORGANIZE_HEATING_RATE_CSK = .true. + logical, parameter :: SAVE_SW_OUT = .true. if_lsswr: if (Model%lsswr) then - ! Setup surface albedo for SW calculation if (SET_SURFACE_ALBEDO) then + ! Setup surface albedo for SW calculation call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & @@ -1882,6 +1885,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Daytime: Compute SW heating rates and fluxes. if (Model%swhtr) then + ! Output SW heating rate for clear skies (htsw0) call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr, clouds, Tbd%icsdsw, faersw, & sfcalb, Radtend%coszen, Model%solcon, & @@ -1889,6 +1893,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs hsw0=htsw0, fdncmp=scmpsw) ! --- optional else + ! Does not output SW heating rates for clear skies. call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr, clouds, Tbd%icsdsw, faersw, & sfcalb, Radtend%coszen, Model%solcon, & @@ -1897,44 +1902,58 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & FDNCMP=scmpsw) ! --- optional end if - do k = 1, lm - k1 = k + kd - Radtend%htrsw(:, k) = htswc(:, k1) - end do - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%htrsw (:, k) = Radtend%htrsw (:, lm) + if (ORGANIZE_HEATING_RATE) then + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) + else + do k = 1, lm + k1 = k + kd + Radtend%htrsw(:, k) = htswc(:, k1) end do + + ! Repopulate the points above levr + if (Model%levr < Model%levs) then + do k = lm, Model%levs + Radtend%htrsw (:, k) = Radtend%htrsw (:, lm) + end do + end if end if - if (Model%swhtr) then - do k = 1, lm - k1 = k + kd - Radtend%swhc(:, k) = htsw0(:, k1) - end do - - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%swhc(:, k) = Radtend%swhc(:, lm) + + if (ORGANIZE_HEATING_RATE_CSK) then + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) + else + if (Model%swhtr) then + do k = 1, lm + k1 = k + kd + Radtend%swhc(:, k) = htsw0(:, k1) end do - end if - end if + ! Repopulate the points above levr + if (Model%levr < Model%levs) then + do k = lm, Model%levs + Radtend%swhc(:, k) = Radtend%swhc(:, lm) + end do + end if + end if + end if - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - Coupling%nirbmdi(:) = scmpsw(:)%nirbm - Coupling%nirdfdi(:) = scmpsw(:)%nirdf - Coupling%visbmdi(:) = scmpsw(:)%visbm - Coupling%visdfdi(:) = scmpsw(:)%visdf - Coupling%nirbmui(:) = scmpsw(:)%nirbm * sfcalb(:, 1) - Coupling%nirdfui(:) = scmpsw(:)%nirdf * sfcalb(:, 2) - Coupling%visbmui(:) = scmpsw(:)%visbm * sfcalb(:, 3) - Coupling%visdfui(:) = scmpsw(:)%visdf * sfcalb(:, 4) + if (SAVE_SW_OUT) then + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) + else + Coupling%nirbmdi(:) = scmpsw(:)%nirbm + Coupling%nirdfdi(:) = scmpsw(:)%nirdf + Coupling%visbmdi(:) = scmpsw(:)%visbm + Coupling%visdfdi(:) = scmpsw(:)%visdf + + Coupling%nirbmui(:) = scmpsw(:)%nirbm * sfcalb(:, 1) + Coupling%nirdfui(:) = scmpsw(:)%nirdf * sfcalb(:, 2) + Coupling%visbmui(:) = scmpsw(:)%visbm * sfcalb(:, 3) + Coupling%visdfui(:) = scmpsw(:)%visdf * sfcalb(:, 4) + end if else @@ -2250,6 +2269,89 @@ subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & end subroutine Set_sfc_albedo + + subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) + + implicit none + + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(cmpfsw_type), dimension(Size (Grid%xlon, 1)), intent(in) :: scmpsw + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb + + + Coupling%nirbmdi(:) = scmpsw(:)%nirbm + Coupling%nirdfdi(:) = scmpsw(:)%nirdf + Coupling%visbmdi(:) = scmpsw(:)%visbm + Coupling%visdfdi(:) = scmpsw(:)%visdf + + Coupling%nirbmui(:) = scmpsw(:)%nirbm * sfcalb(:, 1) + Coupling%nirdfui(:) = scmpsw(:)%nirdf * sfcalb(:, 2) + Coupling%visbmui(:) = scmpsw(:)%visbm * sfcalb(:, 3) + Coupling%visdfui(:) = scmpsw(:)%visdf * sfcalb(:, 4) + + end subroutine Save_sw_fluxes + + + subroutine Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) + + implicit none + + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(in) :: htswc + integer, intent(in) :: lm, kd + + ! Local vars + integer :: k, k1 + + + do k = 1, lm + k1 = k + kd + Radtend%htrsw(:, k) = htswc(:, k1) + end do + + ! Repopulate the points above levr + if (Model%levr < Model%levs) then + do k = lm, Model%levs + Radtend%htrsw (:, k) = Radtend%htrsw (:, lm) + end do + end if + + end subroutine Save_sw_heating_rate + + + subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) + + implicit none + + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(in) :: htsw0 + integer, intent(in) :: lm, kd + + ! Local vars + integer :: k, k1 + + if (Model%swhtr) then + do k = 1, lm + k1 = k + kd + Radtend%swhc(:, k) = htsw0(:, k1) + end do + + if (Model%levr < Model%levs) then + do k = lm, Model%levs + Radtend%swhc(:, k) = Radtend%swhc(:, lm) + end do + end if + end if + + end subroutine Save_sw_heating_rate_csk + ! !> @} !........................................! From 481f39c509438ca05fe4ebecf736b8035052c008 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 07:48:11 -0600 Subject: [PATCH 011/114] Cleaning if statements in the do_sw_rad subroutine --- GFS_layer/GFS_radiation_driver.F90 | 117 ++++------------------------- 1 file changed, 14 insertions(+), 103 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 7298727a1..29e90aac7 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1849,37 +1849,17 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: htswc, htsw0 - ! Added by PAJ: - logical, parameter :: ZERO_OUT_HEATING_RATES_AND_FLUXES = .true. - logical, parameter :: SET_SURFACE_ALBEDO = .true. - logical, parameter :: ORGANIZE_HEATING_RATE = .true. - logical, parameter :: ORGANIZE_HEATING_RATE_CSK = .true. - logical, parameter :: SAVE_SW_OUT = .true. - if_lsswr: if (Model%lsswr) then - if (SET_SURFACE_ALBEDO) then - ! Setup surface albedo for SW calculation - call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, & - sfcalb, Radtend%sfalb) ! --- outputs - else - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, & - sfcalb) ! --- outputs - - ! Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) - end if + ! Setup surface albedo for SW calculation + call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, & + sfcalb, Radtend%sfalb) ! --- outputs if_nday: if (nday > 0) then @@ -1903,87 +1883,18 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & end if - if (ORGANIZE_HEATING_RATE) then - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) - else - do k = 1, lm - k1 = k + kd - Radtend%htrsw(:, k) = htswc(:, k1) - end do - - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%htrsw (:, k) = Radtend%htrsw (:, lm) - end do - end if - end if - - - if (ORGANIZE_HEATING_RATE_CSK) then - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) - else - if (Model%swhtr) then - do k = 1, lm - k1 = k + kd - Radtend%swhc(:, k) = htsw0(:, k1) - end do - - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%swhc(:, k) = Radtend%swhc(:, lm) - end do - end if - end if - end if + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) - if (SAVE_SW_OUT) then - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) - else - Coupling%nirbmdi(:) = scmpsw(:)%nirbm - Coupling%nirdfdi(:) = scmpsw(:)%nirdf - Coupling%visbmdi(:) = scmpsw(:)%visbm - Coupling%visdfdi(:) = scmpsw(:)%visdf - - Coupling%nirbmui(:) = scmpsw(:)%nirbm * sfcalb(:, 1) - Coupling%nirdfui(:) = scmpsw(:)%nirdf * sfcalb(:, 2) - Coupling%visbmui(:) = scmpsw(:)%visbm * sfcalb(:, 3) - Coupling%visdfui(:) = scmpsw(:)%visdf * sfcalb(:, 4) - end if + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) else ! Night time: set SW heating rates and fluxes to zero - if (ZERO_OUT_HEATING_RATES_AND_FLUXES) then - - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) - - else - Radtend%htrsw(:,:) = 0.0 - - Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) - - Coupling%nirbmdi(:) = 0.0 - Coupling%nirdfdi(:) = 0.0 - Coupling%visbmdi(:) = 0.0 - Coupling%visdfdi(:) = 0.0 - - Coupling%nirbmui(:) = 0.0 - Coupling%nirdfui(:) = 0.0 - Coupling%visbmui(:) = 0.0 - Coupling%visdfui(:) = 0.0 - - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 - endif - - end if + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) end if if_nday From 396b8756ad7b62671285c5eab05ce5c141fab80b Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 09:49:07 -0600 Subject: [PATCH 012/114] Further factorization of do_sw_rad subroutine --- GFS_layer/GFS_radiation_driver.F90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 29e90aac7..df98b1aec 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1898,9 +1898,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & end if if_nday - ! Radiation fluxes for other physics processes - Coupling%sfcnsw(:) = Radtend%sfcfsw(:)%dnfxc - Radtend%sfcfsw(:)%upfxc - Coupling%sfcdsw(:) = Radtend%sfcfsw(:)%dnfxc + call Save_more_sw_fluxes (Radtend, Coupling) end if if_lsswr @@ -2263,6 +2261,20 @@ subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) end subroutine Save_sw_heating_rate_csk + + subroutine Save_more_sw_fluxes (Radtend, Coupling) + + implicit none + + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_coupling_type), intent(inout) :: Coupling + + ! Radiation fluxes for other physics processes + Coupling%sfcnsw(:) = Radtend%sfcfsw(:)%dnfxc - Radtend%sfcfsw(:)%upfxc + Coupling%sfcdsw(:) = Radtend%sfcfsw(:)%dnfxc + + end subroutine Save_more_sw_fluxes + ! !> @} !........................................! From 13b08a7e333e2aa2fbccc912c5ccee4877119b26 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 09:53:42 -0600 Subject: [PATCH 013/114] Adding first versin of the swrad table --- physics/radsw_main.f | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 6897c02de..3eee97420 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -590,6 +590,36 @@ subroutine swrad & & hswc,topflx,sfcflx, & ! --- outputs & HSW0,HSWB,FLXPRF,FDNCMP & ! --- optional & ) +!! \section arg_table_swrad +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------------------|------------------------------------------------------|---------|------|-------------|-----------|--------|----------| +!! | plyr | air_pressure_layer | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | +!! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr | atmospheric constant gases | split TBD +!! | clouds | cloud profile | split TBD +!! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | +!! | aerosols | aerosol optical properties | split TBD +!! | sfcalb | Surface albedo | split TBD +!! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | +!! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | +!! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | +!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | +!! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | +!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | +!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | +!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | +!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | +!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | +!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | +!! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | + ! ==================== defination of variables ==================== ! ! ! From 76d33019381df7c8a88aa30375e9b331c8f5f0e3 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 11:00:38 -0600 Subject: [PATCH 014/114] Split gasvmr variable into arguments --- GFS_layer/GFS_radiation_driver.F90 | 16 ++++++++++++--- physics/radsw_main.f | 31 ++++++++++++++++++++++++++++-- 2 files changed, 42 insertions(+), 5 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index df98b1aec..3454a0db6 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1848,7 +1848,13 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: htswc, htsw0 - + real (kind=kind_phys), dimension(im, lmk) :: gasvmr_co2, & + gasvmr_n2o, gasvmr_ch4, gasvmr_o2 + + gasvmr_co2 = gasvmr(:, :, 1) + gasvmr_n2o = gasvmr(:, :, 2) + gasvmr_ch4 = gasvmr(:, :, 3) + gasvmr_o2 = gasvmr(:, :, 4) if_lsswr: if (Model%lsswr) then @@ -1867,7 +1873,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & if (Model%swhtr) then ! Output SW heating rate for clear skies (htsw0) call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr, clouds, Tbd%icsdsw, faersw, & + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & + gasvmr_o2, & + clouds, Tbd%icsdsw, faersw, & sfcalb, Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs @@ -1875,7 +1883,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & else ! Does not output SW heating rates for clear skies. call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr, clouds, Tbd%icsdsw, faersw, & + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & + gasvmr_o2, & + clouds, Tbd%icsdsw, faersw, & sfcalb, Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 3eee97420..ee466c638 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -583,7 +583,10 @@ module module_radsw_main ! !> @{ !----------------------------------- subroutine swrad & - & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, & ! --- inputs + & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & + & gasvmr_co2, & + & gasvmr_n2o, gasvmr_ch4, & + & gasvmr_o2, & ! --- inputs & clouds,icseed,aerosols,sfcalb, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & @@ -809,7 +812,12 @@ subroutine swrad & & plyr, tlyr, qlyr, olyr real (kind=kind_phys), dimension(npts,4), intent(in) :: sfcalb - real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: gasvmr + !real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: gasvmr + real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 + real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o + real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 + real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 + real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: clouds real (kind=kind_phys), dimension(npts,nlay,nbdsw,3),intent(in):: & & aerosols @@ -868,6 +876,25 @@ subroutine swrad & integer, dimension(nlay) :: indfor, indself, jp, jt, jt1 integer :: i, ib, ipt, j1, k, kk, laytrop, mb + + ! PAJ + real (kind=kind_phys), dimension(npts, nlay) :: gasvmr_zero + real (kind=kind_phys), dimension(npts, nlay, 9) :: gasvmr + + + ! PAJ: Inirialize some arrays + gasvmr_zero = 0.0 + + gasvmr(:, :, 1) = gasvmr_co2 + gasvmr(:, :, 2) = gasvmr_n2o + gasvmr(:, :, 3) = gasvmr_ch4 + gasvmr(:, :, 4) = gasvmr_o2 + gasvmr(:, :, 5) = gasvmr_zero + gasvmr(:, :, 6) = gasvmr_zero + gasvmr(:, :, 7) = gasvmr_zero + gasvmr(:, :, 8) = gasvmr_zero + gasvmr(:, :, 9) = gasvmr_zero + ! !===> ... begin here ! From 9f0658df30b213a2dbbc5846ca9ff43c9a851eb3 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 11:25:33 -0600 Subject: [PATCH 015/114] More elegant way to split gasvmr --- physics/radsw_main.f | 48 ++++++++++++++++++-------------------------- 1 file changed, 20 insertions(+), 28 deletions(-) diff --git a/physics/radsw_main.f b/physics/radsw_main.f index ee466c638..f1b203d8a 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -602,7 +602,10 @@ subroutine swrad & !! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | !! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | !! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | gasvmr | atmospheric constant gases | split TBD +!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! !! | clouds | cloud profile | split TBD !! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | !! | aerosols | aerosol optical properties | split TBD @@ -812,7 +815,6 @@ subroutine swrad & & plyr, tlyr, qlyr, olyr real (kind=kind_phys), dimension(npts,4), intent(in) :: sfcalb - !real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: gasvmr real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 @@ -877,24 +879,6 @@ subroutine swrad & integer :: i, ib, ipt, j1, k, kk, laytrop, mb - ! PAJ - real (kind=kind_phys), dimension(npts, nlay) :: gasvmr_zero - real (kind=kind_phys), dimension(npts, nlay, 9) :: gasvmr - - - ! PAJ: Inirialize some arrays - gasvmr_zero = 0.0 - - gasvmr(:, :, 1) = gasvmr_co2 - gasvmr(:, :, 2) = gasvmr_n2o - gasvmr(:, :, 3) = gasvmr_ch4 - gasvmr(:, :, 4) = gasvmr_o2 - gasvmr(:, :, 5) = gasvmr_zero - gasvmr(:, :, 6) = gasvmr_zero - gasvmr(:, :, 7) = gasvmr_zero - gasvmr(:, :, 8) = gasvmr_zero - gasvmr(:, :, 9) = gasvmr_zero - ! !===> ... begin here ! @@ -999,7 +983,8 @@ subroutine swrad & temcol(k) = 1.0e-12 * coldry(k) colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr(j1,kk,1)) ! co2 + !colamt(k,2) = max(temcol(k), coldry(k)*gasvmr(j1,kk,1)) ! co2 + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(j1,kk)) ! co2 colamt(k,3) = max(f_zero, coldry(k)*o3vmr(k)) ! o3 colmol(k) = coldry(k) + colamt(k,1) enddo @@ -1010,9 +995,12 @@ subroutine swrad & if (iswrgas > 0) then do k = 1, nlay kk = nlp1 - k - colamt(k,4) = max(temcol(k), coldry(k)*gasvmr(j1,kk,2)) ! n2o - colamt(k,5) = max(temcol(k), coldry(k)*gasvmr(j1,kk,3)) ! ch4 - colamt(k,6) = max(temcol(k), coldry(k)*gasvmr(j1,kk,4)) ! o2 + !colamt(k,4) = max(temcol(k), coldry(k)*gasvmr(j1,kk,2)) ! n2o + colamt(k,4) = max(temcol(k), coldry(k)*gasvmr_n2o(j1,kk)) ! n2o + ! colamt(k,5) = max(temcol(k), coldry(k)*gasvmr(j1,kk,3)) ! ch4 + colamt(k,5) = max(temcol(k), coldry(k)*gasvmr_ch4(j1,kk)) ! ch4 + ! colamt(k,6) = max(temcol(k), coldry(k)*gasvmr(j1,kk,4)) ! o2 + colamt(k,6) = max(temcol(k), coldry(k)*gasvmr_o2(j1,kk)) ! o2 ! colamt(k,7) = max(temcol(k), coldry(k)*gasvmr(j1,kk,5)) ! co - notused enddo else @@ -1083,7 +1071,8 @@ subroutine swrad & temcol(k) = 1.0e-12 * coldry(k) colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr(j1,k,1)) ! co2 + !colamt(k,2) = max(temcol(k), coldry(k)*gasvmr(j1,k,1)) ! co2 + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(j1,k)) ! co2 colamt(k,3) = max(f_zero, coldry(k)*o3vmr(k)) ! o3 colmol(k) = coldry(k) + colamt(k,1) enddo @@ -1104,9 +1093,12 @@ subroutine swrad & if (iswrgas > 0) then do k = 1, nlay - colamt(k,4) = max(temcol(k), coldry(k)*gasvmr(j1,k,2)) ! n2o - colamt(k,5) = max(temcol(k), coldry(k)*gasvmr(j1,k,3)) ! ch4 - colamt(k,6) = max(temcol(k), coldry(k)*gasvmr(j1,k,4)) ! o2 + !colamt(k,4) = max(temcol(k), coldry(k)*gasvmr(j1,k,2)) ! n2o + colamt(k,4) = max(temcol(k), coldry(k)*gasvmr_n2o(j1,k)) ! n2o + !colamt(k,5) = max(temcol(k), coldry(k)*gasvmr(j1,k,3)) ! ch4 + colamt(k,5) = max(temcol(k), coldry(k)*gasvmr_ch4(j1,k)) ! ch4 + !colamt(k,6) = max(temcol(k), coldry(k)*gasvmr(j1,k,4)) ! o2 + colamt(k,6) = max(temcol(k), coldry(k)*gasvmr_o2(j1,k)) ! o2 ! colamt(k,7) = max(temcol(k), coldry(k)*gasvmr(j1,k,5)) ! co - notused enddo else From 7d582d5618413835f89b49871a7652589bec34ad Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 12:06:17 -0600 Subject: [PATCH 016/114] Split aerosol optical properties into three arrays --- GFS_layer/GFS_radiation_driver.F90 | 14 ++++++++++++-- physics/radsw_main.f | 31 ++++++++++++++++++++---------- 2 files changed, 33 insertions(+), 12 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 3454a0db6..ac838b308 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1850,12 +1850,20 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & LTP) :: htswc, htsw0 real (kind=kind_phys), dimension(im, lmk) :: gasvmr_co2, & gasvmr_n2o, gasvmr_ch4, gasvmr_o2 + real (kind=kind_phys), dimension(im, lmk, NBDSW) :: & + aeraod, aerssa, aerasy + + ! Split some arrays gasvmr_co2 = gasvmr(:, :, 1) gasvmr_n2o = gasvmr(:, :, 2) gasvmr_ch4 = gasvmr(:, :, 3) gasvmr_o2 = gasvmr(:, :, 4) + aeraod = faersw(:, :, :, 1) + aerssa = faersw(:, :, :, 2) + aerasy = faersw(:, :, :, 3) + if_lsswr: if (Model%lsswr) then ! Setup surface albedo for SW calculation @@ -1875,7 +1883,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & - clouds, Tbd%icsdsw, faersw, & + clouds, Tbd%icsdsw, aeraod, & + aerssa, aerasy, & sfcalb, Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs @@ -1885,7 +1894,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & - clouds, Tbd%icsdsw, faersw, & + clouds, Tbd%icsdsw, aeraod, & + aerssa, aerasy, & sfcalb, Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs diff --git a/physics/radsw_main.f b/physics/radsw_main.f index f1b203d8a..7f45e16e2 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -587,7 +587,8 @@ subroutine swrad & & gasvmr_co2, & & gasvmr_n2o, gasvmr_ch4, & & gasvmr_o2, & ! --- inputs - & clouds,icseed,aerosols,sfcalb, & + & clouds,icseed, aeraod, aerssa, aerasy, & + & sfcalb, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & & hswc,topflx,sfcflx, & ! --- outputs @@ -608,7 +609,9 @@ subroutine swrad & !! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! !! | clouds | cloud profile | split TBD !! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | -!! | aerosols | aerosol optical properties | split TBD +!! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | +!! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | +!! | aerasy | aerosol_asymetry_parameter | aerosol asymetry paramter | | 3 | real | kind_phys | in | F | !! | sfcalb | Surface albedo | split TBD !! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | !! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | @@ -821,8 +824,10 @@ subroutine swrad & real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: clouds - real (kind=kind_phys), dimension(npts,nlay,nbdsw,3),intent(in):: & - & aerosols + + real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aeraod + real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerssa + real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerasy real (kind=kind_phys), intent(in) :: cosz(npts), solcon @@ -1017,9 +1022,12 @@ subroutine swrad & do k = 1, nlay kk = nlp1 - k do ib = 1, nbdsw - tauae(k,ib) = aerosols(j1,kk,ib,1) - ssaae(k,ib) = aerosols(j1,kk,ib,2) - asyae(k,ib) = aerosols(j1,kk,ib,3) + !tauae(k,ib) = aerosols(j1,kk,ib,1) + !ssaae(k,ib) = aerosols(j1,kk,ib,2) + !asyae(k,ib) = aerosols(j1,kk,ib,3) + tauae(k,ib) = aeraod(j1,kk,ib) + ssaae(k,ib) = aerssa(j1,kk,ib) + asyae(k,ib) = aerasy(j1,kk,ib) enddo enddo @@ -1114,9 +1122,12 @@ subroutine swrad & do ib = 1, nbdsw do k = 1, nlay - tauae(k,ib) = aerosols(j1,k,ib,1) - ssaae(k,ib) = aerosols(j1,k,ib,2) - asyae(k,ib) = aerosols(j1,k,ib,3) + !tauae(k,ib) = aerosols(j1,k,ib,1) + !ssaae(k,ib) = aerosols(j1,k,ib,2) + !asyae(k,ib) = aerosols(j1,k,ib,3) + tauae(k,ib) = aeraod(j1,k,ib) + ssaae(k,ib) = aerssa(j1,k,ib) + asyae(k,ib) = aerasy(j1,k,ib) enddo enddo From 901d3aadcd3a0a302e783f1b586d3d96c6ec0c80 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 13:34:42 -0600 Subject: [PATCH 017/114] Split surface albedo variable --- GFS_layer/GFS_radiation_driver.F90 | 17 +++++- physics/radsw_main.f | 86 ++++++++++++++++-------------- 2 files changed, 62 insertions(+), 41 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index ac838b308..4629d261b 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1852,6 +1852,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_n2o, gasvmr_ch4, gasvmr_o2 real (kind=kind_phys), dimension(im, lmk, NBDSW) :: & aeraod, aerssa, aerasy + real (kind=kind_phys), dimension(im) :: sfcalb_nir_dir, sfcalb_nir_dif, & + sfcalb_uvis_dir, sfcalb_uvis_dif + ! Split some arrays @@ -1864,6 +1867,12 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & aerssa = faersw(:, :, :, 2) aerasy = faersw(:, :, :, 3) + sfcalb_nir_dir = sfcalb(:, 1) + sfcalb_nir_dif = sfcalb(:, 2) + sfcalb_uvis_dir = sfcalb(:, 3) + sfcalb_uvis_dif = sfcalb(:, 4) + + if_lsswr: if (Model%lsswr) then ! Setup surface albedo for SW calculation @@ -1885,7 +1894,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_o2, & clouds, Tbd%icsdsw, aeraod, & aerssa, aerasy, & - sfcalb, Radtend%coszen, Model%solcon, & + sfcalb_nir_dir, sfcalb_nir_dif, & + sfcalb_uvis_dir, sfcalb_uvis_dif, & + Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs hsw0=htsw0, fdncmp=scmpsw) ! --- optional @@ -1896,7 +1907,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_o2, & clouds, Tbd%icsdsw, aeraod, & aerssa, aerasy, & - sfcalb, Radtend%coszen, Model%solcon, & + sfcalb_nir_dir, sfcalb_nir_dif, & + sfcalb_uvis_dir, sfcalb_uvis_dif, & + Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs FDNCMP=scmpsw) ! --- optional diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 7f45e16e2..8facefd3b 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -588,46 +588,50 @@ subroutine swrad & & gasvmr_n2o, gasvmr_ch4, & & gasvmr_o2, & ! --- inputs & clouds,icseed, aeraod, aerssa, aerasy, & - & sfcalb, & + & sfcalb_nir_dir, sfcalb_nir_dif, & + & sfcalb_uvis_dir, sfcalb_uvis_dif, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & & hswc,topflx,sfcflx, & ! --- outputs & HSW0,HSWB,FLXPRF,FDNCMP & ! --- optional & ) !! \section arg_table_swrad -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|-------------------------------------------------------|------------------------------------------------------|---------|------|-------------|-----------|--------|----------| -!! | plyr | air_pressure_layer | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | -!! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | clouds | cloud profile | split TBD -!! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | -!! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | -!! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | -!! | aerasy | aerosol_asymetry_parameter | aerosol asymetry paramter | | 3 | real | kind_phys | in | F | -!! | sfcalb | Surface albedo | split TBD -!! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | -!! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | -!! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | -!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | -!! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | -!! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | -!! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | -!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | -!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | -!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | -!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | -!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | -!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | -!! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |-----------------|--------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| +!! | plyr | air_pressure_layer | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | +!! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | clouds | cloud profile | split TBD +!! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | +!! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | +!! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | +!! | aerasy | aerosol_asymetry_parameter | aerosol asymetry paramter | | 3 | real | kind_phys | in | F | +!! | sfcalb_nir_dir | albedo_sfc_nir_dir | near infrared sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | +!! | sfcalb_nir_dif | albedo_sfc_nir_dif | near infrared sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | +!! | sfcalb_uvis_dir | albedo_sfc_uvis_dir | uv - visible sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | +!! | sfcalb_uvis_dif | albedo_sfc_uvis_dif | uv - visible sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | +!! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | +!! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | +!! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | +!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | +!! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | +!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | +!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | +!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | +!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | +!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | +!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | +!! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | ! ==================== defination of variables ==================== ! @@ -816,7 +820,11 @@ subroutine swrad & & plvl, tlvl real (kind=kind_phys), dimension(npts,nlay), intent(in) :: & & plyr, tlyr, qlyr, olyr - real (kind=kind_phys), dimension(npts,4), intent(in) :: sfcalb + + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dir & + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dif & + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dir& + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dif& real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o @@ -951,10 +959,10 @@ subroutine swrad & ssolar = s0fac * cosz(j1) !> -# Prepare surface albedo: bm,df - dir,dif; 1,2 - nir,uvv. - albbm(1) = sfcalb(j1,1) - albdf(1) = sfcalb(j1,2) - albbm(2) = sfcalb(j1,3) - albdf(2) = sfcalb(j1,4) + albbm(1) = sfcalb_nir_dir(j1) + albdf(1) = sfcalb_nir_dif(j1) + albbm(2) = sfcalb_uvis_dir(j1) + albdf(2) = sfcalb_uvis_dif(j1) !> -# Prepare atmospheric profile for use in rrtm. ! the vertical index of internal array is from surface to top From 781a73a0b965b1f04105b8d630293b7b33efc23a Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 27 Sep 2017 15:51:39 -0600 Subject: [PATCH 018/114] Splig clouds type into arrays --- GFS_layer/GFS_radiation_driver.F90 | 83 ++++++++++++++-- physics/radsw_main.f | 149 ++++++++++++++++------------- 2 files changed, 158 insertions(+), 74 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 4629d261b..deb046ade 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1854,7 +1854,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & aeraod, aerssa, aerasy real (kind=kind_phys), dimension(im) :: sfcalb_nir_dir, sfcalb_nir_dif, & sfcalb_uvis_dir, sfcalb_uvis_dif - + real (kind=kind_phys), dimension(im, lmk) :: cld_cf, cld_lwp, cld_ref_liq, & + cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & + cld_od, cld_ssa, cld_asy ! Split some arrays @@ -1872,6 +1874,24 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & sfcalb_uvis_dir = sfcalb(:, 3) sfcalb_uvis_dif = sfcalb(:, 4) + cld_cf = clouds(:,:,1) + if (ISWCLIQ > 0) then + ! use prognostic cloud method + cld_lwp = clouds(:, :, 2) + cld_ref_liq = clouds(:, :, 3) + cld_iwp = clouds(:, :, 4) + cld_ref_ice = clouds(:, :, 5) + cld_rwp = clouds(:, :, 6) + cld_ref_rain = clouds(:, :, 7) + cld_swp = clouds(:, :, 8) + cld_ref_snow = clouds(:, :, 9) + else + ! Impose cloud optical properties + cld_od = clouds(:, :, 2) + cld_ssa = clouds(:, :, 3) + cld_asy = clouds(:, :, 4) + end if + if_lsswr: if (Model%lsswr) then @@ -1889,30 +1909,75 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Daytime: Compute SW heating rates and fluxes. if (Model%swhtr) then ! Output SW heating rate for clear skies (htsw0) - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + if (ISWCLIQ > 0) then + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & + gasvmr_o2, & + Tbd%icsdsw, aeraod, & + aerssa, aerasy, & + sfcalb_nir_dir, sfcalb_nir_dif, & + sfcalb_uvis_dir, sfcalb_uvis_dif, & + Radtend%coszen, Model%solcon, & + nday, idxday, im, lmk, lmp, Model%lprnt,& + cld_cf, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs + hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs + cld_lwp=cld_lwp, & ! Optional input + cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & + cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & + cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & + cld_ref_snow=cld_ref_snow) + else + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & - clouds, Tbd%icsdsw, aeraod, & + Tbd%icsdsw, aeraod, & aerssa, aerasy, & sfcalb_nir_dir, sfcalb_nir_dif, & sfcalb_uvis_dir, sfcalb_uvis_dif, & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs - hsw0=htsw0, fdncmp=scmpsw) ! --- optional + cld_cf, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs + hsw0=htsw0, fdncmp=scmpsw, & ! Optional optputs + cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input + end if else ! Does not output SW heating rates for clear skies. - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + if (ISWCLIQ > 0) then + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & + gasvmr_o2, & + Tbd%icsdsw, aeraod, & + aerssa, aerasy, & + sfcalb_nir_dir, sfcalb_nir_dif, & + sfcalb_uvis_dir, sfcalb_uvis_dif, & + Radtend%coszen, Model%solcon, & + nday, idxday, IM, LMK, LMP, Model%lprnt,& + cld_cf, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs + FDNCMP=scmpsw, & ! --- optional outputs + cld_lwp=cld_lwp, & ! Optional input + cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & + cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & + cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & + cld_ref_snow=cld_ref_snow) + + else + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & - clouds, Tbd%icsdsw, aeraod, & + Tbd%icsdsw, aeraod, & aerssa, aerasy, & sfcalb_nir_dir, sfcalb_nir_dif, & sfcalb_uvis_dir, sfcalb_uvis_dif, & Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs - FDNCMP=scmpsw) ! --- optional + cld_cf, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs + FDNCMP=scmpsw, & ! --- optional outputs + cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input + end if end if diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 8facefd3b..a2a7c7e86 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -587,51 +587,66 @@ subroutine swrad & & gasvmr_co2, & & gasvmr_n2o, gasvmr_ch4, & & gasvmr_o2, & ! --- inputs - & clouds,icseed, aeraod, aerssa, aerasy, & + & icseed, aeraod, aerssa, aerasy, & & sfcalb_nir_dir, sfcalb_nir_dif, & & sfcalb_uvis_dir, sfcalb_uvis_dif, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & + & cld_cf, & & hswc,topflx,sfcflx, & ! --- outputs - & HSW0,HSWB,FLXPRF,FDNCMP & ! --- optional + & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od, cld_ssa, cld_asy & ) !! \section arg_table_swrad -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |-----------------|--------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| -!! | plyr | air_pressure_layer | air pressure layer | hPa | 2 | real | kind_phys | in | F | -!! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | -!! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | -!! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | clouds | cloud profile | split TBD -!! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | -!! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | -!! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | -!! | aerasy | aerosol_asymetry_parameter | aerosol asymetry paramter | | 3 | real | kind_phys | in | F | -!! | sfcalb_nir_dir | albedo_sfc_nir_dir | near infrared sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | -!! | sfcalb_nir_dif | albedo_sfc_nir_dif | near infrared sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | -!! | sfcalb_uvis_dir | albedo_sfc_uvis_dir | uv - visible sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | -!! | sfcalb_uvis_dif | albedo_sfc_uvis_dif | uv - visible sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | -!! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | -!! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | -!! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | -!! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | -!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | -!! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | -!! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | -!! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | -!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | -!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | -!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | -!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | -!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | -!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | -!! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |-----------------|-----------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| +!! | plyr | air_pressure_layer | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | +!! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | +!! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | +!! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | +!! | aerasy | aerosol_asymetry_parameter | aerosol asymetry paramter | | 3 | real | kind_phys | in | F | +!! | sfcalb_nir_dir | albedo_sfc_nir_dir | near infrared sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | +!! | sfcalb_nir_dif | albedo_sfc_nir_dif | near infrared sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | +!! | sfcalb_uvis_dir | albedo_sfc_uvis_dir | uv - visible sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | +!! | sfcalb_uvis_dif | albedo_sfc_uvis_dif | uv - visible sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | +!! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | +!! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | +!! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | +!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | +!! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | +!! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | +!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | +!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | +!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | +!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | +!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | +!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | +!! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | +!! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | +!! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | | 2 | real | kind_phys | in | T | +!! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | +!! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_liq | effective_radious_liquid_cloud_droplets | effective radious liquid cloud droplets | micron | 2 | real | kind_phys | in | T | +!! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_ice | effective_radious_ice_hydrometeor | effective radious ice hydrometeor | micron | 2 | real | kind_phys | in | T | +!! | cld_rwp | cloud_rain_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_rain | effective_radious_rain_hydrometeor | effective radious rain hydrometeor | micron | 2 | real | kind_phys | in | T | +!! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_snow | effective_radious_snow_hydrometeor | effective radious snow hydrometeor | micron | 2 | real | kind_phys | in | T | ! ==================== defination of variables ==================== ! @@ -831,7 +846,11 @@ subroutine swrad & real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 - real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: clouds + real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf + real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od, cld_ssa, cld_asy real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aeraod real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerssa @@ -1043,23 +1062,23 @@ subroutine swrad & if (iswcliq > 0) then ! use prognostic cloud method do k = 1, nlay kk = nlp1 - k - cfrac(k) = clouds(j1,kk,1) ! cloud fraction - cliqp(k) = clouds(j1,kk,2) ! cloud liq path - reliq(k) = clouds(j1,kk,3) ! liq partical effctive radius - cicep(k) = clouds(j1,kk,4) ! cloud ice path - reice(k) = clouds(j1,kk,5) ! ice partical effctive radius - cdat1(k) = clouds(j1,kk,6) ! cloud rain drop path - cdat2(k) = clouds(j1,kk,7) ! rain partical effctive radius - cdat3(k) = clouds(j1,kk,8) ! cloud snow path - cdat4(k) = clouds(j1,kk,9) ! snow partical effctive radius + cfrac(k) = cld_cf(j1,kk) ! cloud fraction + cliqp(k) = cld_lwp(j1,kk) ! cloud liq path + reliq(k) = cld_ref_liq(j1,kk) ! liq partical effctive radius + cicep(k) = cld_iwp(j1,kk) ! cloud ice path + reice(k) = cld_ref_ice(j1,kk) ! ice partical effctive radius + cdat1(k) = cld_rwp(j1,kk) ! cloud rain drop path + cdat2(k) = cld_ref_rain(j1,kk) ! rain partical effctive radius + cdat3(k) = cld_swp(j1,kk) ! cloud snow path + cdat4(k) = cld_ref_snow(j1,kk) ! snow partical effctive radius enddo else ! use diagnostic cloud method do k = 1, nlay kk = nlp1 - k - cfrac(k) = clouds(j1,kk,1) ! cloud fraction - cdat1(k) = clouds(j1,kk,2) ! cloud optical depth - cdat2(k) = clouds(j1,kk,3) ! cloud single scattering albedo - cdat3(k) = clouds(j1,kk,4) ! cloud asymmetry factor + cfrac(k) = cld_cf(j1,kk) ! cloud fraction + cdat1(k) = cld_od(j1,kk) ! cloud optical depth + cdat2(k) = cld_ssa(j1,kk) ! cloud single scattering albedo + cdat3(k) = cld_asy(j1,kk) ! cloud asymmetry factor enddo endif ! end if_iswcliq @@ -1141,22 +1160,22 @@ subroutine swrad & if (iswcliq > 0) then ! use prognostic cloud method do k = 1, nlay - cfrac(k) = clouds(j1,k,1) ! cloud fraction - cliqp(k) = clouds(j1,k,2) ! cloud liq path - reliq(k) = clouds(j1,k,3) ! liq partical effctive radius - cicep(k) = clouds(j1,k,4) ! cloud ice path - reice(k) = clouds(j1,k,5) ! ice partical effctive radius - cdat1(k) = clouds(j1,k,6) ! cloud rain drop path - cdat2(k) = clouds(j1,k,7) ! rain partical effctive radius - cdat3(k) = clouds(j1,k,8) ! cloud snow path - cdat4(k) = clouds(j1,k,9) ! snow partical effctive radius + cfrac(k) = cld_cf(j1,k) ! cloud fraction + cliqp(k) = cld_lwp(j1,k) ! cloud liq path + reliq(k) = cld_ref_liq(j1,k) ! liq partical effctive radius + cicep(k) = cld_iwp(j1,k) ! cloud ice path + reice(k) = cld_ref_ice(j1,k) ! ice partical effctive radius + cdat1(k) = cld_rwp(j1,k) ! cloud rain drop path + cdat2(k) = cld_ref_rain(j1,k) ! rain partical effctive radius + cdat3(k) = cld_swp(j1,k) ! cloud snow path + cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius enddo else ! use diagnostic cloud method do k = 1, nlay - cfrac(k) = clouds(j1,k,1) ! cloud fraction - cdat1(k) = clouds(j1,k,2) ! cloud optical depth - cdat2(k) = clouds(j1,k,3) ! cloud single scattering albedo - cdat3(k) = clouds(j1,k,4) ! cloud asymmetry factor + cfrac(k) = cld_cf(j1,k) ! cloud fraction + cdat1(k) = cld_od(j1,k) ! cloud optical depth + cdat2(k) = cld_ssa(j1,k) ! cloud single scattering albedo + cdat3(k) = cld_asy(j1,k) ! cloud asymmetry factor enddo endif ! end if_iswcliq From c7de472676a8f6ebb8fd726f180a9bd6d7b06e0a Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Thu, 28 Sep 2017 08:41:25 -0600 Subject: [PATCH 019/114] Slight change in the SW table --- physics/radsw_main.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/radsw_main.f b/physics/radsw_main.f index a2a7c7e86..e3c269220 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -602,7 +602,7 @@ subroutine swrad & !! \section arg_table_swrad !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-----------------|-----------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| -!! | plyr | air_pressure_layer | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | !! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | !! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | !! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | From 5fee42e85a95da3a627500ff78b38dc9d6e26e5f Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Thu, 28 Sep 2017 09:40:16 -0600 Subject: [PATCH 020/114] Starting with LW --- GFS_layer/GFS_radiation_driver.F90 | 10 +++- physics/radlw_main.f | 96 +++++++++++++++++++++++------- physics/radsw_main.f | 6 +- 3 files changed, 85 insertions(+), 27 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index deb046ade..6e0fb1ae3 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -2045,13 +2045,19 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Compute LW heating rates and fluxes. if (Model%lwhtr) then - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, & ! --- inputs + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & clouds, Tbd%icsdlw, faerlw, Radtend%semis, & tsfg, im, lmk, lmp, Model%lprnt, & htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs hlw0=htlw0) ! --- optional else - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, & ! --- inputs + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & clouds, Tbd%icsdlw, faerlw, Radtend%semis, & tsfg, im, lmk, lmp, Model%lprnt, & htlwc, Diag%topflw, Radtend%sfcflw) ! --- outputs diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 701505296..763e17889 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -452,13 +452,62 @@ module module_radlw_main ! !> @{ ! -------------------------------- subroutine lwrad & - & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, & ! --- inputs + & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs + & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & + & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & & clouds,icseed,aerosols,sfemis,sfgtmp, & & npts, nlay, nlp1, lprnt, & & hlwc,topflx,sfcflx, & ! --- outputs & HLW0,HLWB,FLXPRF & !! --- optional & ) +!! \section arg_table_swrad +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |-----------------|-----------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| +!! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | +!! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | +!! | tlyr | air_temperature | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | +!! | qlyr | specific_humidity | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_co | volumetric_mixing_ratio_co | volumetric mixing ratio co ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_cfc11 | volumetric_mixing_ratio_cfc11 | volumetric mixing ratio cfc11 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_cfc12 | volumetric_mixing_ratio_cfc12 | volumetric mixing ratio cfc12 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_cfc22 | volumetric_mixing_ratio_cfc22 | volumetric mixing ratio cfc22 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_ccl4 | volumetric_mixing_ratio_ccl4 | volumetric mixing ratio ccl4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | +!! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | +!! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | +!! | clouds +!! | sfemis +!! | sfgtmp +!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | +!! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | +!! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | +!! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | +!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | +!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | +!! | hlw0 | lw_heating_rate_csk | longwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | +!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | +!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | +!! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | +!! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | | 2 | real | kind_phys | in | T | +!! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | +!! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_liq | effective_radious_liquid_cloud_droplets | effective radious liquid cloud droplets | micron | 2 | real | kind_phys | in | T | +!! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_ice | effective_radious_ice_hydrometeor | effective radious ice hydrometeor | micron | 2 | real | kind_phys | in | T | +!! | cld_rwp | cloud_rain_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_rain | effective_radious_rain_hydrometeor | effective radious rain hydrometeor | micron | 2 | real | kind_phys | in | T | +!! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | +!! | cld_ref_snow | effective_radious_snow_hydrometeor | effective radious snow hydrometeor | micron | 2 | real | kind_phys | in | T | + ! ==================== defination of variables ==================== ! ! ! ! input variables: ! @@ -641,7 +690,10 @@ subroutine lwrad & real (kind=kind_phys), dimension(npts,nlay), intent(in) :: plyr, & & tlyr, qlyr, olyr - real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: gasvmr + real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2,& + & gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & + & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4 + real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: clouds real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & @@ -793,7 +845,7 @@ subroutine lwrad & temcol(k) = 1.0e-12 * coldry(k) colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr(iplon,k1,1)) ! co2 + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(iplon,k1)) ! co2 colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 enddo @@ -804,15 +856,15 @@ subroutine lwrad & if (ilwrgas > 0) then do k = 1, nlay k1 = nlp1 - k - colamt(k,4)=max(temcol(k), coldry(k)*gasvmr(iplon,k1,2)) ! n2o - colamt(k,5)=max(temcol(k), coldry(k)*gasvmr(iplon,k1,3)) ! ch4 - colamt(k,6)=max(f_zero, coldry(k)*gasvmr(iplon,k1,4)) ! o2 - colamt(k,7)=max(f_zero, coldry(k)*gasvmr(iplon,k1,5)) ! co - - wx(k,1) = max( f_zero, coldry(k)*gasvmr(iplon,k1,9) ) ! ccl4 - wx(k,2) = max( f_zero, coldry(k)*gasvmr(iplon,k1,6) ) ! cf11 - wx(k,3) = max( f_zero, coldry(k)*gasvmr(iplon,k1,7) ) ! cf12 - wx(k,4) = max( f_zero, coldry(k)*gasvmr(iplon,k1,8) ) ! cf22 + colamt(k,4)=max(temcol(k), coldry(k)*gasvmr_n2o(iplon,k1)) ! n2o + colamt(k,5)=max(temcol(k), coldry(k)*gasvmr_ch4(iplon,k1)) ! ch4 + colamt(k,6)=max(f_zero, coldry(k)*gasvmr_o2(iplon,k1)) ! o2 + colamt(k,7)=max(f_zero, coldry(k)*gasvmr_co(iplon,k1)) ! co + + wx(k,1) = max( f_zero, coldry(k)*gasvmr_ccl4(iplon,k1) ) ! ccl4 + wx(k,2) = max( f_zero, coldry(k)*gasvmr_cfc11(iplon,k1) ) ! cf11 + wx(k,3) = max( f_zero, coldry(k)*gasvmr_cfc12(iplon,k1) ) ! cf12 + wx(k,4) = max( f_zero, coldry(k)*gasvmr_cfc22(iplon,k1) ) ! cf22 enddo else do k = 1, nlay @@ -903,7 +955,7 @@ subroutine lwrad & temcol(k) = 1.0e-12 * coldry(k) colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr(iplon,k,1)) ! co2 + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(iplon,k)) ! co2 colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 enddo @@ -912,15 +964,15 @@ subroutine lwrad & if (ilwrgas > 0) then do k = 1, nlay - colamt(k,4)=max(temcol(k), coldry(k)*gasvmr(iplon,k,2)) ! n2o - colamt(k,5)=max(temcol(k), coldry(k)*gasvmr(iplon,k,3)) ! ch4 - colamt(k,6)=max(f_zero, coldry(k)*gasvmr(iplon,k,4)) ! o2 - colamt(k,7)=max(f_zero, coldry(k)*gasvmr(iplon,k,5)) ! co - - wx(k,1) = max( f_zero, coldry(k)*gasvmr(iplon,k,9) ) ! ccl4 - wx(k,2) = max( f_zero, coldry(k)*gasvmr(iplon,k,6) ) ! cf11 - wx(k,3) = max( f_zero, coldry(k)*gasvmr(iplon,k,7) ) ! cf12 - wx(k,4) = max( f_zero, coldry(k)*gasvmr(iplon,k,8) ) ! cf22 + colamt(k,4)=max(temcol(k), coldry(k)*gasvmr_n2o(iplon,k)) ! n2o + colamt(k,5)=max(temcol(k), coldry(k)*gasvmr_ch4(iplon,k)) ! ch4 + colamt(k,6)=max(f_zero, coldry(k)*gasvmr_o2(iplon,k)) ! o2 + colamt(k,7)=max(f_zero, coldry(k)*gasvmr_co(iplon,k)) ! co + + wx(k,1) = max( f_zero, coldry(k)*gasvmr_ccl4(iplon,k) ) ! ccl4 + wx(k,2) = max( f_zero, coldry(k)*gasvmr_cfc11(iplon,k) ) ! cf11 + wx(k,3) = max( f_zero, coldry(k)*gasvmr_cfc12(iplon,k) ) ! cf12 + wx(k,4) = max( f_zero, coldry(k)*gasvmr_cfc22(iplon,k) ) ! cf22 enddo else do k = 1, nlay diff --git a/physics/radsw_main.f b/physics/radsw_main.f index e3c269220..bf62f0907 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -604,10 +604,10 @@ subroutine swrad & !! |-----------------|-----------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| !! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | !! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | -!! | tlyr | air_temperature_layer | air temperature layer | K | 2 | real | kind_phys | in | F | +!! | tlyr | air_temperature | air temperature layer | K | 2 | real | kind_phys | in | F | !! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | -!! | qlyr | specific_humidity_layer | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | qlyr | specific_humidity | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | olyr | ozone_concentration | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | !! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! !! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! !! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! From ebff381e1b01314edc320a8b1e7f4b9b0628ac38 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Thu, 28 Sep 2017 11:23:07 -0600 Subject: [PATCH 021/114] Bug fix in the split of the surface albedo --- GFS_layer/GFS_radiation_driver.F90 | 23 ++++++++--------------- 1 file changed, 8 insertions(+), 15 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 6e0fb1ae3..c72d2f0ac 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1852,8 +1852,6 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_n2o, gasvmr_ch4, gasvmr_o2 real (kind=kind_phys), dimension(im, lmk, NBDSW) :: & aeraod, aerssa, aerasy - real (kind=kind_phys), dimension(im) :: sfcalb_nir_dir, sfcalb_nir_dif, & - sfcalb_uvis_dir, sfcalb_uvis_dif real (kind=kind_phys), dimension(im, lmk) :: cld_cf, cld_lwp, cld_ref_liq, & cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & cld_od, cld_ssa, cld_asy @@ -1869,11 +1867,6 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & aerssa = faersw(:, :, :, 2) aerasy = faersw(:, :, :, 3) - sfcalb_nir_dir = sfcalb(:, 1) - sfcalb_nir_dif = sfcalb(:, 2) - sfcalb_uvis_dir = sfcalb(:, 3) - sfcalb_uvis_dif = sfcalb(:, 4) - cld_cf = clouds(:,:,1) if (ISWCLIQ > 0) then ! use prognostic cloud method @@ -1915,8 +1908,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_o2, & Tbd%icsdsw, aeraod, & aerssa, aerasy, & - sfcalb_nir_dir, sfcalb_nir_dif, & - sfcalb_uvis_dir, sfcalb_uvis_dif, & + sfcalb(:, 1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& cld_cf, & @@ -1933,8 +1926,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_o2, & Tbd%icsdsw, aeraod, & aerssa, aerasy, & - sfcalb_nir_dir, sfcalb_nir_dif, & - sfcalb_uvis_dir, sfcalb_uvis_dif, & + sfcalb(:,1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& cld_cf, & @@ -1950,8 +1943,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_o2, & Tbd%icsdsw, aeraod, & aerssa, aerasy, & - sfcalb_nir_dir, sfcalb_nir_dif, & - sfcalb_uvis_dir, sfcalb_uvis_dif, & + sfcalb(:,1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& cld_cf, & @@ -1969,8 +1962,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr_o2, & Tbd%icsdsw, aeraod, & aerssa, aerasy, & - sfcalb_nir_dir, sfcalb_nir_dif, & - sfcalb_uvis_dir, sfcalb_uvis_dif, & + sfcalb(:,1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, IM, LMK, LMP, Model%lprnt,& cld_cf, & From 0baac9cff4db933a163ea733d4c484f20e8a8f98 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Thu, 28 Sep 2017 16:00:12 -0600 Subject: [PATCH 022/114] Spliting aerosols var --- GFS_layer/GFS_radiation_driver.F90 | 4 ++-- physics/radlw_main.f | 22 +++++++++++----------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index c72d2f0ac..e39198985 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -2042,7 +2042,7 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - clouds, Tbd%icsdlw, faerlw, Radtend%semis, & + clouds, Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & tsfg, im, lmk, lmp, Model%lprnt, & htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs hlw0=htlw0) ! --- optional @@ -2051,7 +2051,7 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - clouds, Tbd%icsdlw, faerlw, Radtend%semis, & + clouds, Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & tsfg, im, lmk, lmp, Model%lprnt, & htlwc, Diag%topflw, Radtend%sfcflw) ! --- outputs end if diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 763e17889..18d93d8b7 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -455,7 +455,7 @@ subroutine lwrad & & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & - & clouds,icseed,aerosols,sfemis,sfgtmp, & + & clouds,icseed,aeraod,aerssa,sfemis,sfgtmp, & & npts, nlay, nlp1, lprnt, & & hlwc,topflx,sfcflx, & ! --- outputs & HLW0,HLWB,FLXPRF & !! --- optional @@ -483,16 +483,16 @@ subroutine lwrad & !! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | !! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | !! | clouds -!! | sfemis -!! | sfgtmp +!! | sfemis | surface_emissivity | surface emissivity | | 1 | real | kind_phys | in | F | +!! | sfgtmp | surface_groud_temperature | surface ground temperature | K | 1 | real | kind_phys | in | F | !! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | !! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | !! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | !! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | !! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | !! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | -!! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | -!! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | +!! | topflx | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | kind_phys | out | F | +!! | sfcflx | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | kind_phys | out | F | !! | hlw0 | lw_heating_rate_csk | longwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | !! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | !! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | @@ -699,8 +699,8 @@ subroutine lwrad & real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & & sfgtmp - real (kind=kind_phys), dimension(npts,nlay,nbands,3),intent(in):: & - & aerosols + real (kind=kind_phys), dimension(npts,nlay,nbands),intent(in):: & + & aeraod, aerssa ! --- outputs: real (kind=kind_phys), dimension(npts,nlay), intent(out) :: hlwc @@ -885,8 +885,8 @@ subroutine lwrad & do k = 1, nlay k1 = nlp1 - k do j = 1, nbands - tauaer(j,k) = aerosols(iplon,k1,j,1) & - & * (f_one - aerosols(iplon,k1,j,2)) + tauaer(j,k) = aeraod(iplon,k1,j) & + & * (f_one - aerssa(iplon,k1,j)) enddo enddo @@ -992,8 +992,8 @@ subroutine lwrad & do j = 1, nbands do k = 1, nlay - tauaer(j,k) = aerosols(iplon,k,j,1) & - & * (f_one - aerosols(iplon,k,j,2)) + tauaer(j,k) = aeraod(iplon,k,j) & + & * (f_one - aerssa(iplon,k,j)) enddo enddo From 880acd1ab75f9af2de16568a3edc77a1a596ae4f Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 29 Sep 2017 12:19:36 -0600 Subject: [PATCH 023/114] Spliging cloud var in longwave parameterization --- GFS_layer/GFS_radiation_driver.F90 | 62 ++++++++++++++++++++++-------- physics/radlw_main.f | 61 +++++++++++++++-------------- 2 files changed, 80 insertions(+), 43 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index e39198985..60471ff77 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -2038,22 +2038,54 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Compute LW heating rates and fluxes. if (Model%lwhtr) then - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - clouds, Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - hlw0=htlw0) ! --- optional + if (ilwcliq > 0 ) then + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs + hlw0=htlw0, & ! --- optional output + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& + cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) + + else + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs + hlw0=htlw0, & ! --- optional output + cld_od=clouds(:, :, 2)) ! --- optional input + end if else - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - clouds, Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, & - htlwc, Diag%topflw, Radtend%sfcflw) ! --- outputs + if (ilwcliq > 0 ) then + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& + cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) + else + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs + cld_od=clouds(:, :, 2)) ! --- optional input + end if end if ! Save calculation results diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 18d93d8b7..ce4b6f8b9 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -455,10 +455,13 @@ subroutine lwrad & & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & - & clouds,icseed,aeraod,aerssa,sfemis,sfgtmp, & - & npts, nlay, nlp1, lprnt, & + & icseed,aeraod,aerssa,sfemis,sfgtmp, & + & npts, nlay, nlp1, lprnt, cld_cf, & & hlwc,topflx,sfcflx, & ! --- outputs - & HLW0,HLWB,FLXPRF & !! --- optional + & HLW0,HLWB,FLXPRF, & !! --- optional + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od & & ) !! \section arg_table_swrad @@ -497,8 +500,6 @@ subroutine lwrad & !! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | !! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | !! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | -!! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | | 2 | real | kind_phys | in | T | -!! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | !! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_liq | effective_radious_liquid_cloud_droplets | effective radious liquid cloud droplets | micron | 2 | real | kind_phys | in | T | !! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | @@ -694,7 +695,11 @@ subroutine lwrad & & gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4 - real (kind=kind_phys), dimension(npts,nlay,9),intent(in):: clouds + real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf + real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, cld_od + real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & & sfgtmp @@ -894,21 +899,21 @@ subroutine lwrad & if (ilwcliq > 0) then ! use prognostic cloud method do k = 1, nlay k1 = nlp1 - k - cldfrc(k)= clouds(iplon,k1,1) - clwp(k) = clouds(iplon,k1,2) - relw(k) = clouds(iplon,k1,3) - ciwp(k) = clouds(iplon,k1,4) - reiw(k) = clouds(iplon,k1,5) - cda1(k) = clouds(iplon,k1,6) - cda2(k) = clouds(iplon,k1,7) - cda3(k) = clouds(iplon,k1,8) - cda4(k) = clouds(iplon,k1,9) + cldfrc(k)= cld_cf(iplon,k1) + clwp(k) = cld_lwp(iplon,k1) + relw(k) = cld_ref_liq(iplon,k1) + ciwp(k) = cld_iwp(iplon,k1) + reiw(k) = cld_ref_ice(iplon,k1) + cda1(k) = cld_rwp(iplon,k1) + cda2(k) = cld_ref_rain(iplon,k1) + cda3(k) = cld_swp(iplon,k1) + cda4(k) = cld_ref_snow(iplon,k1) enddo else ! use diagnostic cloud method do k = 1, nlay k1 = nlp1 - k - cldfrc(k)= clouds(iplon,k1,1) - cda1(k) = clouds(iplon,k1,2) + cldfrc(k)= cld_cf(iplon,k1) + cda1(k) = cld_od(iplon,k1) enddo endif ! end if_ilwcliq @@ -999,20 +1004,20 @@ subroutine lwrad & if (ilwcliq > 0) then ! use prognostic cloud method do k = 1, nlay - cldfrc(k)= clouds(iplon,k,1) - clwp(k) = clouds(iplon,k,2) - relw(k) = clouds(iplon,k,3) - ciwp(k) = clouds(iplon,k,4) - reiw(k) = clouds(iplon,k,5) - cda1(k) = clouds(iplon,k,6) - cda2(k) = clouds(iplon,k,7) - cda3(k) = clouds(iplon,k,8) - cda4(k) = clouds(iplon,k,9) + cldfrc(k)= cld_cf(iplon,k) + clwp(k) = cld_lwp(iplon,k) + relw(k) = cld_ref_liq(iplon,k) + ciwp(k) = cld_iwp(iplon,k) + reiw(k) = cld_ref_ice(iplon,k) + cda1(k) = cld_rwp(iplon,k) + cda2(k) = cld_ref_rain(iplon,k) + cda3(k) = cld_swp(iplon,k) + cda4(k) = cld_ref_snow(iplon,k) enddo else ! use diagnostic cloud method do k = 1, nlay - cldfrc(k)= clouds(iplon,k,1) - cda1(k) = clouds(iplon,k,2) + cldfrc(k)= cld_cf(iplon,k) + cda1(k) = cld_od(iplon,k) enddo endif ! end if_ilwcliq From 9d306a30c1ffc0f59008cf9e37a32874b4a6dc3b Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 29 Sep 2017 12:38:08 -0600 Subject: [PATCH 024/114] Modifications to the SW and LW tables --- physics/radlw_main.f | 11 +++++------ physics/radsw_main.f | 10 +++++----- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/physics/radlw_main.f b/physics/radlw_main.f index ce4b6f8b9..a5cb25fad 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -485,7 +485,6 @@ subroutine lwrad & !! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | !! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | !! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | -!! | clouds !! | sfemis | surface_emissivity | surface emissivity | | 1 | real | kind_phys | in | F | !! | sfgtmp | surface_groud_temperature | surface ground temperature | K | 1 | real | kind_phys | in | F | !! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | @@ -493,13 +492,12 @@ subroutine lwrad & !! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | !! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | !! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | -!! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | +!! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | K s-1???| 2 | real | kind_phys | out | F | !! | topflx | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | kind_phys | out | F | !! | sfcflx | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | kind_phys | out | F | -!! | hlw0 | lw_heating_rate_csk | longwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | -!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | -!! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | -!! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | +!! | hlw0 | lw_heating_rate_csk | longwave clear sky heating rate | K s-1???| 2 | real | kind_phys | out | T | +!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1???| 3 | real | kind_phys | out | T | +!! | flxprf | lw_fluxes | lw fluxes total sky / csk and up / down at levels | W m-2 | 2 | proflw_type | kind_phys | out | T | !! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_liq | effective_radious_liquid_cloud_droplets | effective radious liquid cloud droplets | micron | 2 | real | kind_phys | in | T | !! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | @@ -508,6 +506,7 @@ subroutine lwrad & !! | cld_ref_rain | effective_radious_rain_hydrometeor | effective radious rain hydrometeor | micron | 2 | real | kind_phys | in | T | !! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_snow | effective_radious_snow_hydrometeor | effective radious snow hydrometeor | micron | 2 | real | kind_phys | in | T | +!! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | ! ==================== defination of variables ==================== ! ! ! diff --git a/physics/radsw_main.f b/physics/radsw_main.f index bf62f0907..3de09d8a0 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -632,13 +632,10 @@ subroutine swrad & !! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | !! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | !! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | -!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | W m-2 | 2 | real | kind_phys | out | T | -!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | W m-2 | 3 | real | kind_phys | out | T | +!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | K s-1???| 2 | real | kind_phys | out | T | +!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1???| 3 | real | kind_phys | out | T | !! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | !! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | -!! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | -!! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | | 2 | real | kind_phys | in | T | -!! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | !! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_liq | effective_radious_liquid_cloud_droplets | effective radious liquid cloud droplets | micron | 2 | real | kind_phys | in | T | !! | cld_iwp | cloud_ice_water_path | cloud ice water path | g m-2 | 2 | real | kind_phys | in | T | @@ -647,6 +644,9 @@ subroutine swrad & !! | cld_ref_rain | effective_radious_rain_hydrometeor | effective radious rain hydrometeor | micron | 2 | real | kind_phys | in | T | !! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_snow | effective_radious_snow_hydrometeor | effective radious snow hydrometeor | micron | 2 | real | kind_phys | in | T | +!! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | +!! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | | 2 | real | kind_phys | in | T | +!! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | ! ==================== defination of variables ==================== ! From ec3938d4db489c7abc718085d089e46f00cf1493 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 4 Oct 2017 17:19:07 -0600 Subject: [PATCH 025/114] argument table fixes --- physics/moninedmf.f | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index bec543bfd..c1884ef83 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -53,18 +53,18 @@ end subroutine edmf_finalize !! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | !! | fm | Monin-Obukhov_similarity_parameter_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | in | F | !! | fh | Monin-Obukhov_similarity_parameter_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | in | F | -!! | tsea | surface_temperature | surface temperature | K | 1 | real | kind_phys | in | F | +!! | tsea | surface_skin_temperature | surface temperature | K | 1 | real | kind_phys | in | F | !! | qss | saturation_specific_humidity_at_the_surface | surface saturation specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | !! | heat | surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | !! | evap | evaporation_from_surface_upward_latent_heat_flux | evaporation from surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | !! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | spd1 | wind_speed_at_lowest_model_level | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | model_level_number_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | prsi | air_pressure_at_model_layer_interfaces | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | del | air_pressure_layer_difference | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure_layer | mean layer pressure | Pa | 2 | real | kind_phys | in | F | +!! | spd1 | surface_wind_speed | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | +!! | kpbl | vertical_index_for_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | +!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | +!! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | +!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | !! | prslk | dimensionless_exner_function | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interfaces | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | +!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | !! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | !! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | !! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | @@ -1243,6 +1243,7 @@ subroutine edmf_tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) c----------------------------------------------------------------------- return end + c----------------------------------------------------------------------- !> \ingroup PBL !! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. From d8eb319620f0285697f73951e017a3be206b23d7 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 4 Oct 2017 17:25:21 -0600 Subject: [PATCH 026/114] more changes to argument table --- physics/moninedmf.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index c1884ef83..8d6e5fe40 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -35,8 +35,8 @@ end subroutine edmf_finalize !! | km | vertical_dimension | vertical layer dimension | index | 0 | integer | | in | F | !! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | !! | ntcw | index_for_liquid_cloud_condensate | cloud condensate index in tracer array | index | 0 | integer | | in | F | -!! | dv | tendency_of_y_wind | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | du | tendency_of_x_wind | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | +!! | dv | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | +!! | du | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | !! | tau | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | !! | rtg | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | !! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | @@ -58,8 +58,8 @@ end subroutine edmf_finalize !! | heat | surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | !! | evap | evaporation_from_surface_upward_latent_heat_flux | evaporation from surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | !! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | spd1 | surface_wind_speed | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_for_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | +!! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | +!! | kpbl | vertical_index_of_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | !! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | !! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | !! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | From b5be301a458376f1a94933643f99fd067cecb919 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 5 Oct 2017 12:45:25 -0600 Subject: [PATCH 027/114] changes to edmf_run argument table --- physics/moninedmf.f | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 8d6e5fe40..1dda9ecf5 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -51,12 +51,11 @@ end subroutine edmf_finalize !! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | !! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | !! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | fm | Monin-Obukhov_similarity_parameter_for_momentum | Monin-Obukhov similarity parameter for momentum | none | 1 | real | kind_phys | in | F | -!! | fh | Monin-Obukhov_similarity_parameter_for_heat | Monin-Obukhov similarity parameter for heat | none | 1 | real | kind_phys | in | F | +!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | +!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | !! | tsea | surface_skin_temperature | surface temperature | K | 1 | real | kind_phys | in | F | -!! | qss | saturation_specific_humidity_at_the_surface | surface saturation specific humidity | kg kg-1 | 1 | real | kind_phys | in | F | -!! | heat | surface_upward_sensible_heat_flux | surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | evaporation_from_surface_upward_latent_heat_flux | evaporation from surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | +!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | !! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | !! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | !! | kpbl | vertical_index_of_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | @@ -72,7 +71,7 @@ end subroutine edmf_finalize !! | dvsfc | y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | !! | dtsfc | surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | dqsfc | surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | +!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | !! | hgamt | countergradient_mixing_term_for_temperature | countergradient mixing term for temperature | K | 1 | real | kind_phys | out | F | !! | hgamq | countergradient_mixing_term_for_water_vapor | countergradient mixing term for water vapor | kg kg-1 | 1 | real | kind_phys | out | F | !! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 1 | real | kind_phys | out | F | @@ -102,7 +101,7 @@ end subroutine edmf_finalize subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & u1,v1,t1,q1,swh,hlw,xmu, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & - & tsea,qss,heat,evap,stress,spd1,kpbl, & + & tsea,heat,evap,stress,spd1,kpbl, & & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr) @@ -129,7 +128,7 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & rbsoil(im), zorl(im), & & u10m(im), v10m(im), & & fm(im), fh(im), & - & tsea(im), qss(im), & + & tsea(im), & & spd1(im), & & prsi(ix,km+1), del(ix,km), & & prsl(ix,km), prslk(ix,km), & From 079668a658d8bdb757055ecd3559ee1fce974ba9 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 31 Oct 2017 13:05:42 -0600 Subject: [PATCH 028/114] added GFS generic PBL interstitial code --- GFS_layer/GFS_physics_driver.F90 | 97 +++++++++++++++------------- makefile | 2 +- physics/GFS_PBL_generic.f90 | 106 +++++++++++++++++++++++++++++++ 3 files changed, 159 insertions(+), 46 deletions(-) create mode 100644 physics/GFS_PBL_generic.f90 diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index d675c93d0..a9fdc24ba 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -16,6 +16,8 @@ module module_physics_driver GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type use edmf, only: edmf_run + use GFS_PBL_generic, only: GFS_PBL_generic_pre, & + GFS_PBL_generic_post implicit none @@ -790,8 +792,10 @@ subroutine GFS_physics_driver & endif endif ! end if_lssav_block + call GFS_PBL_generic_pre(im, levs, kinver) + kcnv(:) = 0 - kinver(:) = levs + !kinver(:) = levs invrsn(:) = .false. tx1(:) = 0.0 tx2(:) = 10.0 @@ -1269,56 +1273,59 @@ subroutine GFS_physics_driver & Coupling%dtsfci_cpl(:) = dtsfc1(:) Coupling%dqsfci_cpl(:) = dqsfc1(:) endif -!-------------------------------------------------------lssav if loop ---------- - if (Model%lssav) then - Diag%dusfc (:) = Diag%dusfc(:) + dusfc1(:)*dtf - Diag%dvsfc (:) = Diag%dvsfc(:) + dvsfc1(:)*dtf - Diag%dtsfc (:) = Diag%dtsfc(:) + dtsfc1(:)*dtf - Diag%dqsfc (:) = Diag%dqsfc(:) + dqsfc1(:)*dtf - Diag%dusfci(:) = dusfc1(:) - Diag%dvsfci(:) = dvsfc1(:) - Diag%dtsfci(:) = dtsfc1(:) - Diag%dqsfci(:) = dqsfc1(:) -! if (lprnt) then -! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', -! & dtf,' kdt=',kdt,' lat=',lat -! endif - if (Model%ldiag3d) then - if (Model%lsidea) then - Diag%dt3dt(:,:,3) = Diag%dt3dt(:,:,3) + dtdt(:,:)*dtf - else - do k = 1, levs - do i = 1, im - tem = dtdt(i,k) - (Radtend%htrlw(i,k)+Radtend%htrsw(i,k)*xmu(i)) - Diag%dt3dt(i,k,3) = Diag%dt3dt(i,k,3) + tem*dtf - enddo - enddo - endif - Diag%du3dt(:,:,1) = Diag%du3dt(:,:,1) + dudt(:,:) * dtf - Diag%du3dt(:,:,2) = Diag%du3dt(:,:,2) - dudt(:,:) * dtf - Diag%dv3dt(:,:,1) = Diag%dv3dt(:,:,1) + dvdt(:,:) * dtf - Diag%dv3dt(:,:,2) = Diag%dv3dt(:,:,2) - dvdt(:,:) * dtf -! update dqdt_v to include moisture tendency due to vertical diffusion -! if (lgocart) then + call GFS_PBL_generic_post(Grid, Model, Radtend, dusfc1, dvsfc1, & + dtsfc1, dqsfc1, dudt, dvdt, dtdt, dqdt, xmu, Diag) +! !-------------------------------------------------------lssav if loop ---------- +! if (Model%lssav) then +! Diag%dusfc (:) = Diag%dusfc(:) + dusfc1(:)*dtf +! Diag%dvsfc (:) = Diag%dvsfc(:) + dvsfc1(:)*dtf +! Diag%dtsfc (:) = Diag%dtsfc(:) + dtsfc1(:)*dtf +! Diag%dqsfc (:) = Diag%dqsfc(:) + dqsfc1(:)*dtf +! Diag%dusfci(:) = dusfc1(:) +! Diag%dvsfci(:) = dvsfc1(:) +! Diag%dtsfci(:) = dtsfc1(:) +! Diag%dqsfci(:) = dqsfc1(:) +! ! if (lprnt) then +! ! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', +! ! & dtf,' kdt=',kdt,' lat=',lat +! ! endif +! +! if (Model%ldiag3d) then +! if (Model%lsidea) then +! Diag%dt3dt(:,:,3) = Diag%dt3dt(:,:,3) + dtdt(:,:)*dtf +! else +! do k = 1, levs +! do i = 1, im +! tem = dtdt(i,k) - (Radtend%htrlw(i,k)+Radtend%htrsw(i,k)*xmu(i)) +! Diag%dt3dt(i,k,3) = Diag%dt3dt(i,k,3) + tem*dtf +! enddo +! enddo +! endif +! Diag%du3dt(:,:,1) = Diag%du3dt(:,:,1) + dudt(:,:) * dtf +! Diag%du3dt(:,:,2) = Diag%du3dt(:,:,2) - dudt(:,:) * dtf +! Diag%dv3dt(:,:,1) = Diag%dv3dt(:,:,1) + dvdt(:,:) * dtf +! Diag%dv3dt(:,:,2) = Diag%dv3dt(:,:,2) - dvdt(:,:) * dtf +! ! update dqdt_v to include moisture tendency due to vertical diffusion +! ! if (lgocart) then +! ! do k = 1, levs +! ! do i = 1, im +! ! dqdt_v(i,k) = dqdt(i,k,1) * dtf +! ! enddo +! ! enddo +! ! endif ! do k = 1, levs ! do i = 1, im -! dqdt_v(i,k) = dqdt(i,k,1) * dtf +! tem = dqdt(i,k,1) * dtf +! Diag%dq3dt(i,k,1) = Diag%dq3dt(i,k,1) + tem ! enddo ! enddo +! if (Model%ntoz > 0) then +! Diag%dq3dt(:,:,5) = Diag%dq3dt(:,:,5) + dqdt(i,k,Model%ntoz) * dtf +! endif ! endif - do k = 1, levs - do i = 1, im - tem = dqdt(i,k,1) * dtf - Diag%dq3dt(i,k,1) = Diag%dq3dt(i,k,1) + tem - enddo - enddo - if (Model%ntoz > 0) then - Diag%dq3dt(:,:,5) = Diag%dq3dt(:,:,5) + dqdt(i,k,Model%ntoz) * dtf - endif - endif - - endif ! end if_lssav +! +! endif ! end if_lssav !-------------------------------------------------------lssav if loop ---------- ! ! Orographic gravity wave drag parameterization diff --git a/makefile b/makefile index 95c891e1b..44c094835 100644 --- a/makefile +++ b/makefile @@ -120,6 +120,7 @@ SRCS_f90 = \ ./physics/gcm_shoc.f90 \ ./physics/gcycle.f90 \ ./physics/get_prs_fv3.f90 \ + ./physics/GFS_PBL_generic.f90 \ ./physics/h2ointerp.f90 \ ./physics/m_micro_driver.f90 \ ./physics/module_nst_model.f90 \ @@ -186,4 +187,3 @@ include ./depend ifneq (clean,$(findstring clean,$(MAKECMDGOALS))) -include depend endif - diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 new file mode 100644 index 000000000..dc400afea --- /dev/null +++ b/physics/GFS_PBL_generic.f90 @@ -0,0 +1,106 @@ +!> \file GFS_PBL_generic.f90 +!! Contains code related to PBL schemes to be used within the GFS physics suite. + + module GFS_PBL_generic + + contains + +!! \section arg_table_GFS_PBL_generic_pre +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|----------------------------------------------------|---------------|------|---------|-----------|--------|----------| +!! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!! | levs | vertical_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | +!! + subroutine GFS_PBL_generic_pre (im, levs, kinver) + + integer , intent(in) :: im, levs + integer, dimension(im), intent(inout) :: kinver + + kinver(:) = levs + + end subroutine GFS_PBL_generic_pre + +!! \section arg_table_GFS_PBL_generic_post +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies needed in physics | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | +!! | dusfc1 | instantaneous_surface_x_momentum_flux | surface momentum flux in the x-direction valid for current call | Pa | 1 | real | kind_phys | in | F | +!! | dvsfc1 | instantaneous_surface_y_momentum_flux | surface momentum flux in the y-direction valid for current call | Pa | 1 | real | kind_phys | in | F | +!! | dtsfc1 | surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfc1 | surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | +!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | +!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | +!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | +!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | +!! | xmu | time_step_zenith_angle_adjust_factor_for_sw | time step zenith angle adjust factor for shortwave | none | 2 | real | kind_phys | in | F | +!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | in | F | +!! + subroutine GFS_PBL_generic_post (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc1, dqsfc1, & + dudt, dvdt, dtdt, dqdt, xmu, Diag) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_diag_type, GFS_radtend_type, GFS_model_type, GFS_grid_type + + type(GFS_grid_type), intent(in) :: Grid + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_control_type), intent(in) :: Model + type(GFS_diag_type), intent(inout) :: Diag + + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: dusfc1, dvsfc1, dtsfc1, dqsfc1, xmu + real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levs), intent(in) :: dudt, dvdt, dtdt + real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levs, Model%ntrac), intent(in) :: dqdt + + integer :: i, k + real(kind=kind_phys) :: tem + + if (Model%lssav) then + Diag%dusfc (:) = Diag%dusfc(:) + dusfc1(:)*Model%dtf + Diag%dvsfc (:) = Diag%dvsfc(:) + dvsfc1(:)*Model%dtf + Diag%dtsfc (:) = Diag%dtsfc(:) + dtsfc1(:)*Model%dtf + Diag%dqsfc (:) = Diag%dqsfc(:) + dqsfc1(:)*Model%dtf + Diag%dusfci(:) = dusfc1(:) + Diag%dvsfci(:) = dvsfc1(:) + Diag%dtsfci(:) = dtsfc1(:) + Diag%dqsfci(:) = dqsfc1(:) + ! if (lprnt) then + ! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', + ! & dtf,' kdt=',kdt,' lat=',lat + ! endif + + if (Model%ldiag3d) then + do k = 1, Model%levs + do i = 1, size(Grid%xlon,1) + tem = dtdt(i,k) - (Radtend%htrlw(i,k)+Radtend%htrsw(i,k)*xmu(i)) + Diag%dt3dt(i,k,3) = Diag%dt3dt(i,k,3) + tem*Model%dtf + enddo + enddo + Diag%du3dt(:,:,1) = Diag%du3dt(:,:,1) + dudt(:,:) * Model%dtf + Diag%du3dt(:,:,2) = Diag%du3dt(:,:,2) - dudt(:,:) * Model%dtf + Diag%dv3dt(:,:,1) = Diag%dv3dt(:,:,1) + dvdt(:,:) * Model%dtf + Diag%dv3dt(:,:,2) = Diag%dv3dt(:,:,2) - dvdt(:,:) * Model%dtf + ! update dqdt_v to include moisture tendency due to vertical diffusion + ! if (lgocart) then + ! do k = 1, levs + ! do i = 1, im + ! dqdt_v(i,k) = dqdt(i,k,1) * dtf + ! enddo + ! enddo + ! endif + do k = 1, Model%levs + do i = 1, size(Grid%xlon,1) + tem = dqdt(i,k,1) * Model%dtf + Diag%dq3dt(i,k,1) = Diag%dq3dt(i,k,1) + tem + enddo + enddo + if (Model%ntoz > 0) then + Diag%dq3dt(:,:,5) = Diag%dq3dt(:,:,5) + dqdt(i,k,Model%ntoz) * Model%dtf + endif + endif + + endif ! end if_lssav + end subroutine GFS_PBL_generic_post + + end module From b2e307569ac19287cd072949a733b1b0121f205e Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 3 Nov 2017 15:30:27 -0600 Subject: [PATCH 029/114] saving changes due to GFS_PBL_generic interstitial --- GFS_layer/GFS_physics_driver.F90 | 6 +++--- physics/GFS_PBL_generic.f90 | 34 +++++++++++++++++++++++++------- 2 files changed, 30 insertions(+), 10 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index a9fdc24ba..3e8bddea3 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -792,7 +792,7 @@ subroutine GFS_physics_driver & endif endif ! end if_lssav_block - call GFS_PBL_generic_pre(im, levs, kinver) + call GFS_PBL_generic_pre (im, levs, kinver) kcnv(:) = 0 !kinver(:) = levs @@ -1198,7 +1198,7 @@ subroutine GFS_physics_driver & Statein%ugrs, Statein%vgrs, Statein%tgrs, Statein%qgrs, & Radtend%htrsw, Radtend%htrlw, xmu, Statein%prsik(:,1), & rb, Sfcprop%zorl, Diag%u10m, Diag%v10m, Sfcprop%ffmm, & - Sfcprop%ffhh, Sfcprop%tsfc, qss, hflx, evap, stress, & + Sfcprop%ffhh, Sfcprop%tsfc, hflx, evap, stress, & wind, kpbl, Statein%prsi, del, Statein%prsl, & Statein%prslk, Statein%phii, Statein%phil, dtp, & Model%dspheat, dusfc1, dvsfc1, dtsfc1, dqsfc1, Diag%hpbl,& @@ -1274,7 +1274,7 @@ subroutine GFS_physics_driver & Coupling%dqsfci_cpl(:) = dqsfc1(:) endif - call GFS_PBL_generic_post(Grid, Model, Radtend, dusfc1, dvsfc1, & + call GFS_PBL_generic_post (Grid, Model, Radtend, dusfc1, dvsfc1, & dtsfc1, dqsfc1, dudt, dvdt, dtdt, dqdt, xmu, Diag) ! !-------------------------------------------------------lssav if loop ---------- ! if (Model%lssav) then diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 index dc400afea..c982e280e 100644 --- a/physics/GFS_PBL_generic.f90 +++ b/physics/GFS_PBL_generic.f90 @@ -1,27 +1,47 @@ !> \file GFS_PBL_generic.f90 !! Contains code related to PBL schemes to be used within the GFS physics suite. - module GFS_PBL_generic + module GFS_PBL_generic_pre contains -!! \section arg_table_GFS_PBL_generic_pre + subroutine GFS_PBL_generic_pre_init () + end subroutine GFS_PBL_generic_pre_init + + subroutine GFS_PBL_generic_pre_finalize() + subroutine GFS_PBL_generic_pre_finalize + +!> \section arg_table_GFS_PBL_generic_pre_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|----------------------------------------------------|---------------|------|---------|-----------|--------|----------| !! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | !! | levs | vertical_dimension | vertical layer dimension | index | 0 | integer | | in | F | !! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | !! - subroutine GFS_PBL_generic_pre (im, levs, kinver) + subroutine GFS_PBL_generic_pre_run (im, levs, kinver) integer , intent(in) :: im, levs integer, dimension(im), intent(inout) :: kinver kinver(:) = levs - end subroutine GFS_PBL_generic_pre + end subroutine GFS_PBL_generic_pre_run + + end module + + module GFS_PBL_generic_post + + contains + + subroutine GFS_PBL_generic_post_init () + end subroutine GFS_PBL_generic_post_init + + subroutine GFS_PBL_generic_post_finalize () + end subroutine GFS_PBL_generic_post_finalize + + -!! \section arg_table_GFS_PBL_generic_post +!> \section arg_table_GFS_PBL_generic_post_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | @@ -38,7 +58,7 @@ end subroutine GFS_PBL_generic_pre !! | xmu | time_step_zenith_angle_adjust_factor_for_sw | time step zenith angle adjust factor for shortwave | none | 2 | real | kind_phys | in | F | !! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | in | F | !! - subroutine GFS_PBL_generic_post (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc1, dqsfc1, & + subroutine GFS_PBL_generic_post_run (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc1, dqsfc1, & dudt, dvdt, dtdt, dqdt, xmu, Diag) use machine, only: kind_phys @@ -101,6 +121,6 @@ subroutine GFS_PBL_generic_post (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc1, d endif endif ! end if_lssav - end subroutine GFS_PBL_generic_post + end subroutine GFS_PBL_generic_post_run end module From 7c8035850f826744f1f3992159731e0335e19e2b Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Mon, 6 Nov 2017 14:55:55 -0700 Subject: [PATCH 030/114] Impro SW and LW tables --- physics/radlw_main.f | 30 +++++++++++++++--------------- physics/radsw_main.f | 16 ++++++++-------- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/physics/radlw_main.f b/physics/radlw_main.f index a5cb25fad..11e028d1c 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -472,31 +472,31 @@ subroutine lwrad & !! | tlyr | air_temperature | air temperature layer | K | 2 | real | kind_phys | in | F | !! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | !! | qlyr | specific_humidity | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | olyr | ozone_concentration_layer | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_co | volumetric_mixing_ratio_co | volumetric mixing ratio co ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_cfc11 | volumetric_mixing_ratio_cfc11 | volumetric mixing ratio cfc11 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_cfc12 | volumetric_mixing_ratio_cfc12 | volumetric mixing ratio cfc12 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_cfc22 | volumetric_mixing_ratio_cfc22 | volumetric mixing ratio cfc22 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_ccl4 | volumetric_mixing_ratio_ccl4 | volumetric mixing ratio ccl4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | olyr | ozone_concentration | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_co | volumetric_mixing_ratio_co | volumetric mixing ratio co | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_cfc11 | volumetric_mixing_ratio_cfc11 | volumetric mixing ratio cfc11 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_cfc12 | volumetric_mixing_ratio_cfc12 | volumetric mixing ratio cfc12 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_cfc22 | volumetric_mixing_ratio_cfc22 | volumetric mixing ratio cfc22 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_ccl4 | volumetric_mixing_ratio_ccl4 | volumetric mixing ratio ccl4 | gm gm-1 | 2 | real | kind_phys | in | F | !! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | !! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | !! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | -!! | sfemis | surface_emissivity | surface emissivity | | 1 | real | kind_phys | in | F | +!! | sfemis | surface_longwave_emissivity | surface emissivity | | 1 | real | kind_phys | in | F | !! | sfgtmp | surface_groud_temperature | surface ground temperature | K | 1 | real | kind_phys | in | F | -!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | npts | horizontal_loop_extent | horizontal dimension | index | 0 | integer | | in | F | !! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | !! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | !! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | !! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | -!! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | K s-1???| 2 | real | kind_phys | out | F | +!! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | K s-1 | 2 | real | kind_phys | out | F | !! | topflx | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | kind_phys | out | F | !! | sfcflx | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | kind_phys | out | F | -!! | hlw0 | lw_heating_rate_csk | longwave clear sky heating rate | K s-1???| 2 | real | kind_phys | out | T | -!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1???| 3 | real | kind_phys | out | T | +!! | hlw0 | lw_heating_rate_csk | longwave clear sky heating rate | K s-1 | 2 | real | kind_phys | out | T | +!! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | out | T | !! | flxprf | lw_fluxes | lw fluxes total sky / csk and up / down at levels | W m-2 | 2 | proflw_type | kind_phys | out | T | !! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_liq | effective_radious_liquid_cloud_droplets | effective radious liquid cloud droplets | micron | 2 | real | kind_phys | in | T | diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 3de09d8a0..c29cd0645 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -608,10 +608,10 @@ subroutine swrad & !! | tlvl | air_temperature_level | air temperature level | K | 2 | real | kind_phys | in | F | !! | qlyr | specific_humidity | specific humidity layer | gm gm-1 | 2 | real | kind_phys | in | F | !! | olyr | ozone_concentration | ozone concentration layer | gm gm-1 | 2 | real | kind_phys | in | F | -!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! -!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 ! gm gm-1 ! 2 ! real ! kind_phys ! in ! F ! +!! | gasvmr_co2 | volumetric_mixing_ratio_co2 | volumetric mixing ratio co2 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_n2o | volumetric_mixing_ratio_n2o | volumetric mixing ratio no2 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_ch4 | volumetric_mixing_ratio_ch4 | volumetric mixing ratio ch4 | gm gm-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_o2 | volumetric_mixing_ratio_o2 | volumetric mixing ratio o2 | gm gm-1 | 2 | real | kind_phys | in | F | !! | icseed | seed_random_numbers | seed for random number generation | | 2 | integer | | in | F | !! | aeraod | aerosol_optical_depth | aerosol optical depth | | 3 | real | kind_phys | in | F | !! | aerssa | aerosol_single_scattering_albedo | aerosol sngle scattering albedo | | 3 | real | kind_phys | in | F | @@ -624,16 +624,16 @@ subroutine swrad & !! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | !! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | !! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | -!! | npts | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | npts | horizontal_loop_extent | horizontal dimension | index | 0 | integer | | in | F | !! | nlay | vertical_layer_dimension | vertical layer dimension | index | 0 | integer | | in | F | !! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | !! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | !! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | -!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1???| 2 | real | kind_phys | out | F | +!! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1 | 2 | real | kind_phys | out | F | !! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | !! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | -!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | K s-1???| 2 | real | kind_phys | out | T | -!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1???| 3 | real | kind_phys | out | T | +!! | hsw0 | sw_heating_rate_csk | shortwave clear sky heating rate | K s-1 | 2 | real | kind_phys | out | T | +!! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | out | T | !! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | kind_phys | out | T | !! | fdncmp | sw_fluxes_down_components_sfc | componenets of the downward sw fluxes at the surface | W m-2 | 1 | cmpfsw_type | kind_phys | out | T | !! | cld_lwp | cloud_liquid_water_path | cloud liquid water path | g m-2 | 2 | real | kind_phys | in | T | From 9339c68b57eeb8e3fe25e0ea53dc5cf69726bddc Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 7 Nov 2017 12:42:46 -0700 Subject: [PATCH 031/114] Reducing the SW radiation to just one call --- GFS_layer/GFS_radiation_driver.F90 | 110 ++++++++++++++--------------- 1 file changed, 55 insertions(+), 55 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 60471ff77..8bc92f235 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1900,9 +1900,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & if_nday: if (nday > 0) then ! Daytime: Compute SW heating rates and fluxes. - if (Model%swhtr) then - ! Output SW heating rate for clear skies (htsw0) - if (ISWCLIQ > 0) then +! if (Model%swhtr) then +! ! Output SW heating rate for clear skies (htsw0) +! if (ISWCLIQ > 0) then call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & @@ -1920,58 +1920,58 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & cld_ref_snow=cld_ref_snow) - else - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & - gasvmr_o2, & - Tbd%icsdsw, aeraod, & - aerssa, aerasy, & - sfcalb(:,1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4), & - Radtend%coszen, Model%solcon, & - nday, idxday, im, lmk, lmp, Model%lprnt,& - cld_cf, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs - hsw0=htsw0, fdncmp=scmpsw, & ! Optional optputs - cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input - end if - else - ! Does not output SW heating rates for clear skies. - if (ISWCLIQ > 0) then - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & - gasvmr_o2, & - Tbd%icsdsw, aeraod, & - aerssa, aerasy, & - sfcalb(:,1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4), & - Radtend%coszen, Model%solcon, & - nday, idxday, IM, LMK, LMP, Model%lprnt,& - cld_cf, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs - FDNCMP=scmpsw, & ! --- optional outputs - cld_lwp=cld_lwp, & ! Optional input - cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & - cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & - cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & - cld_ref_snow=cld_ref_snow) - - else - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & - gasvmr_o2, & - Tbd%icsdsw, aeraod, & - aerssa, aerasy, & - sfcalb(:,1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4), & - Radtend%coszen, Model%solcon, & - nday, idxday, IM, LMK, LMP, Model%lprnt,& - cld_cf, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs - FDNCMP=scmpsw, & ! --- optional outputs - cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input - end if - end if +! else +! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs +! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & +! gasvmr_o2, & +! Tbd%icsdsw, aeraod, & +! aerssa, aerasy, & +! sfcalb(:,1), sfcalb(:,2), & +! sfcalb(:,3), sfcalb(:,4), & +! Radtend%coszen, Model%solcon, & +! nday, idxday, im, lmk, lmp, Model%lprnt,& +! cld_cf, & +! htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs +! hsw0=htsw0, fdncmp=scmpsw, & ! Optional optputs +! cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input +! end if +! else +! ! Does not output SW heating rates for clear skies. +! if (ISWCLIQ > 0) then +! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs +! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & +! gasvmr_o2, & +! Tbd%icsdsw, aeraod, & +! aerssa, aerasy, & +! sfcalb(:,1), sfcalb(:,2), & +! sfcalb(:,3), sfcalb(:,4), & +! Radtend%coszen, Model%solcon, & +! nday, idxday, IM, LMK, LMP, Model%lprnt,& +! cld_cf, & +! htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs +! FDNCMP=scmpsw, & ! --- optional outputs +! cld_lwp=cld_lwp, & ! Optional input +! cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & +! cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & +! cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & +! cld_ref_snow=cld_ref_snow) +! +! else +! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs +! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & +! gasvmr_o2, & +! Tbd%icsdsw, aeraod, & +! aerssa, aerasy, & +! sfcalb(:,1), sfcalb(:,2), & +! sfcalb(:,3), sfcalb(:,4), & +! Radtend%coszen, Model%solcon, & +! nday, idxday, IM, LMK, LMP, Model%lprnt,& +! cld_cf, & +! htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs +! FDNCMP=scmpsw, & ! --- optional outputs +! cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input +! end if +! end if call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) From c33d187b6cdf01744a2ab0f2849a306fac05189c Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 7 Nov 2017 13:08:47 -0700 Subject: [PATCH 032/114] Remove nday if from SW call --- GFS_layer/GFS_radiation_driver.F90 | 104 ++++++++--------------------- physics/radsw_main.f | 1 + 2 files changed, 27 insertions(+), 78 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 8bc92f235..9e8b6ccb9 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1897,12 +1897,8 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & Sfcprop%tisfc, im, & sfcalb, Radtend%sfalb) ! --- outputs - if_nday: if (nday > 0) then +! if_nday: if (nday > 0) then - ! Daytime: Compute SW heating rates and fluxes. -! if (Model%swhtr) then -! ! Output SW heating rate for clear skies (htsw0) -! if (ISWCLIQ > 0) then call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & @@ -1912,7 +1908,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& - cld_cf, & + cld_cf, & htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs cld_lwp=cld_lwp, & ! Optional input @@ -1920,59 +1916,6 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & cld_ref_snow=cld_ref_snow) -! else -! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs -! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & -! gasvmr_o2, & -! Tbd%icsdsw, aeraod, & -! aerssa, aerasy, & -! sfcalb(:,1), sfcalb(:,2), & -! sfcalb(:,3), sfcalb(:,4), & -! Radtend%coszen, Model%solcon, & -! nday, idxday, im, lmk, lmp, Model%lprnt,& -! cld_cf, & -! htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs -! hsw0=htsw0, fdncmp=scmpsw, & ! Optional optputs -! cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input -! end if -! else -! ! Does not output SW heating rates for clear skies. -! if (ISWCLIQ > 0) then -! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs -! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & -! gasvmr_o2, & -! Tbd%icsdsw, aeraod, & -! aerssa, aerasy, & -! sfcalb(:,1), sfcalb(:,2), & -! sfcalb(:,3), sfcalb(:,4), & -! Radtend%coszen, Model%solcon, & -! nday, idxday, IM, LMK, LMP, Model%lprnt,& -! cld_cf, & -! htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs -! FDNCMP=scmpsw, & ! --- optional outputs -! cld_lwp=cld_lwp, & ! Optional input -! cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & -! cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & -! cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & -! cld_ref_snow=cld_ref_snow) -! -! else -! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs -! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & -! gasvmr_o2, & -! Tbd%icsdsw, aeraod, & -! aerssa, aerasy, & -! sfcalb(:,1), sfcalb(:,2), & -! sfcalb(:,3), sfcalb(:,4), & -! Radtend%coszen, Model%solcon, & -! nday, idxday, IM, LMK, LMP, Model%lprnt,& -! cld_cf, & -! htswc, Diag%topfsw, Radtend%sfcfsw, & ! --- outputs -! FDNCMP=scmpsw, & ! --- optional outputs -! cld_od=cld_od, cld_ssa=cld_ssa, cld_asy=cld_asy) ! Optional input -! end if -! end if - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) @@ -1982,12 +1925,12 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Save two spectral bands' surface downward and upward fluxes for output. call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) - else +! else ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday) - end if if_nday +! end if if_nday call Save_more_sw_fluxes (Radtend, Coupling) @@ -2248,7 +2191,7 @@ subroutine Organize_output (Diag, Model, Grid, Radtend, Statein, Coupling, & end subroutine Organize_output - subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) + subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday) implicit none @@ -2258,27 +2201,32 @@ subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model) type(GFS_grid_type), intent(in) :: Grid type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw type(GFS_control_type), intent(in) :: Model + integer, intent(in) :: nday - Radtend%htrsw(:,:) = 0.0 + if (nday > 0) then + return + else + Radtend%htrsw(:,:) = 0.0 - Radtend%sfcfsw = sfcfsw_type(0.0, 0.0, 0.0, 0.0) - Diag%topfsw = topfsw_type(0.0, 0.0, 0.0) - scmpsw = cmpfsw_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0) + Radtend%sfcfsw = sfcfsw_type(0.0, 0.0, 0.0, 0.0) + Diag%topfsw = topfsw_type(0.0, 0.0, 0.0) + scmpsw = cmpfsw_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0) - Coupling%nirbmdi(:) = 0.0 - Coupling%nirdfdi(:) = 0.0 - Coupling%visbmdi(:) = 0.0 - Coupling%visdfdi(:) = 0.0 + Coupling%nirbmdi(:) = 0.0 + Coupling%nirdfdi(:) = 0.0 + Coupling%visbmdi(:) = 0.0 + Coupling%visdfdi(:) = 0.0 - Coupling%nirbmui(:) = 0.0 - Coupling%nirdfui(:) = 0.0 - Coupling%visbmui(:) = 0.0 - Coupling%visdfui(:) = 0.0 + Coupling%nirbmui(:) = 0.0 + Coupling%nirdfui(:) = 0.0 + Coupling%visbmui(:) = 0.0 + Coupling%visdfui(:) = 0.0 - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 - endif + if (Model%swhtr) then + Radtend%swhc(:,:) = 0 + endif + end if end subroutine Zero_out_heatrate_flux diff --git a/physics/radsw_main.f b/physics/radsw_main.f index c29cd0645..c1c6c6bee 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -914,6 +914,7 @@ subroutine swrad & ! !===> ... begin here ! + if (nday <= 0) return lhswb = present ( hswb ) lhsw0 = present ( hsw0 ) From f4f7bc6920afd6bd1cacba8ad584ceb84e051ba8 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 7 Nov 2017 13:54:26 -0700 Subject: [PATCH 033/114] Removing lsswr if from SW --- GFS_layer/GFS_radiation_driver.F90 | 60 ++++++++++++++++++------------ physics/radsw_main.f | 6 ++- 2 files changed, 40 insertions(+), 26 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 9e8b6ccb9..f42c56083 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1886,7 +1886,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & end if - if_lsswr: if (Model%lsswr) then +! if_lsswr: if (Model%lsswr) then ! Setup surface albedo for SW calculation call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: @@ -1894,11 +1894,9 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, & + Sfcprop%tisfc, im, Model%lsswr, & sfcalb, Radtend%sfalb) ! --- outputs -! if_nday: if (nday > 0) then - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & gasvmr_o2, & @@ -1908,7 +1906,7 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& - cld_cf, & + cld_cf, Model%lsswr, & htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs cld_lwp=cld_lwp, & ! Optional input @@ -1917,24 +1915,20 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & cld_ref_snow=cld_ref_snow) - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) - - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) - - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) -! else + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, Model%lsswr) - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday) + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) -! end if if_nday + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, Model%lsswr) - call Save_more_sw_fluxes (Radtend, Coupling) + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) - end if if_lsswr +! end if if_lsswr end subroutine Do_sw_rad @@ -2191,7 +2185,7 @@ subroutine Organize_output (Diag, Model, Grid, Radtend, Statein, Coupling, & end subroutine Organize_output - subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday) + subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, lsswr) implicit none @@ -2202,7 +2196,9 @@ subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw type(GFS_control_type), intent(in) :: Model integer, intent(in) :: nday + logical, intent(in) :: lsswr + if (.not. lsswr) return if (nday > 0) then return @@ -2233,7 +2229,7 @@ end subroutine Zero_out_heatrate_flux subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & - facsf, facwf, fice, tisfc, IMAX, sfcalb, sfalb) + facsf, facwf, fice, tisfc, IMAX, lsswr, sfcalb, sfalb) implicit none @@ -2241,10 +2237,12 @@ subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & real (kind = kind_phys), dimension(:), intent(in) :: slmsk, snowf, & zorlf, coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, & alnwf, facsf, facwf, fice, tisfc, sncovr, snoalb + logical, intent(in) :: lsswr real (kind = kind_phys), dimension(IMAX, NF_ALBD), intent(out) :: sfcalb real (kind = kind_phys), dimension(:), intent(out) :: sfalb + if (.not. lsswr) return call setalb (slmsk, snowf, sncovr, snoalb, zorlf, & coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & @@ -2256,7 +2254,7 @@ subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & end subroutine Set_sfc_albedo - subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) + subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, lsswr) implicit none @@ -2264,8 +2262,11 @@ subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) type(GFS_grid_type), intent(in) :: Grid type(cmpfsw_type), dimension(Size (Grid%xlon, 1)), intent(in) :: scmpsw real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb + logical, intent(in) :: lsswr + if (.not. lsswr) return + Coupling%nirbmdi(:) = scmpsw(:)%nirbm Coupling%nirdfdi(:) = scmpsw(:)%nirdf Coupling%visbmdi(:) = scmpsw(:)%visbm @@ -2279,7 +2280,7 @@ subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb) end subroutine Save_sw_fluxes - subroutine Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) + subroutine Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, lsswr) implicit none @@ -2289,11 +2290,14 @@ subroutine Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP), intent(in) :: htswc integer, intent(in) :: lm, kd + logical, intent(in) :: lsswr ! Local vars integer :: k, k1 + if (.not. lsswr) return + do k = 1, lm k1 = k + kd Radtend%htrsw(:, k) = htswc(:, k1) @@ -2309,7 +2313,7 @@ subroutine Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd) end subroutine Save_sw_heating_rate - subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) + subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, lsswr) implicit none @@ -2319,10 +2323,14 @@ subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP), intent(in) :: htsw0 integer, intent(in) :: lm, kd + logical, intent(in) :: lsswr ! Local vars integer :: k, k1 + + if (.not. lsswr) return + if (Model%swhtr) then do k = 1, lm k1 = k + kd @@ -2339,12 +2347,16 @@ subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd) end subroutine Save_sw_heating_rate_csk - subroutine Save_more_sw_fluxes (Radtend, Coupling) + subroutine Save_more_sw_fluxes (Radtend, Coupling, lsswr) implicit none type(GFS_radtend_type), intent(in) :: Radtend type(GFS_coupling_type), intent(inout) :: Coupling + logical, intent(in) :: lsswr + + + if (.not. lsswr) return ! Radiation fluxes for other physics processes Coupling%sfcnsw(:) = Radtend%sfcfsw(:)%dnfxc - Radtend%sfcfsw(:)%upfxc diff --git a/physics/radsw_main.f b/physics/radsw_main.f index c1c6c6bee..b348618f8 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -592,7 +592,7 @@ subroutine swrad & & sfcalb_uvis_dir, sfcalb_uvis_dif, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & - & cld_cf, & + & cld_cf, lsswr, & & hswc,topflx,sfcflx, & ! --- outputs & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & @@ -629,6 +629,7 @@ subroutine swrad & !! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | !! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | !! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | +!! | lsswr | flag_to_calc_sw | logical flag to calculate SW irradiances | logical | 0 | logical | | in | F | !! | hswc | sw_heating_rate_total_sky | shortwave total sky heating rate | k s-1 | 2 | real | kind_phys | out | F | !! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | kind_phys | out | F | !! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | kind_phys | out | F | @@ -829,7 +830,7 @@ subroutine swrad & integer, dimension(:), intent(in) :: idxday, icseed - logical, intent(in) :: lprnt + logical, intent(in) :: lprnt, lsswr real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: & & plvl, tlvl @@ -914,6 +915,7 @@ subroutine swrad & ! !===> ... begin here ! + if (.not. lsswr) return if (nday <= 0) return lhswb = present ( hswb ) From 93ef60761de77593fbbdf4a484b312438f228bf2 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 7 Nov 2017 19:55:03 -0700 Subject: [PATCH 034/114] uses existing arrays in the call to SW --- GFS_layer/GFS_radiation_driver.F90 | 101 +++++++++++++++-------------- 1 file changed, 53 insertions(+), 48 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index f42c56083..7e2c136d5 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1848,45 +1848,42 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: htswc, htsw0 - real (kind=kind_phys), dimension(im, lmk) :: gasvmr_co2, & - gasvmr_n2o, gasvmr_ch4, gasvmr_o2 - real (kind=kind_phys), dimension(im, lmk, NBDSW) :: & - aeraod, aerssa, aerasy - real (kind=kind_phys), dimension(im, lmk) :: cld_cf, cld_lwp, cld_ref_liq, & - cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - cld_od, cld_ssa, cld_asy +! real (kind=kind_phys), dimension(im, lmk) :: gasvmr_co2, & +! gasvmr_n2o, gasvmr_ch4, gasvmr_o2 +! real (kind=kind_phys), dimension(im, lmk, NBDSW) :: & +! aeraod, aerssa, aerasy +! real (kind=kind_phys), dimension(im, lmk) :: cld_cf, cld_lwp, cld_ref_liq, & +! cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & +! cld_od, cld_ssa, cld_asy - ! Split some arrays - gasvmr_co2 = gasvmr(:, :, 1) - gasvmr_n2o = gasvmr(:, :, 2) - gasvmr_ch4 = gasvmr(:, :, 3) - gasvmr_o2 = gasvmr(:, :, 4) - - aeraod = faersw(:, :, :, 1) - aerssa = faersw(:, :, :, 2) - aerasy = faersw(:, :, :, 3) - - cld_cf = clouds(:,:,1) - if (ISWCLIQ > 0) then - ! use prognostic cloud method - cld_lwp = clouds(:, :, 2) - cld_ref_liq = clouds(:, :, 3) - cld_iwp = clouds(:, :, 4) - cld_ref_ice = clouds(:, :, 5) - cld_rwp = clouds(:, :, 6) - cld_ref_rain = clouds(:, :, 7) - cld_swp = clouds(:, :, 8) - cld_ref_snow = clouds(:, :, 9) - else - ! Impose cloud optical properties - cld_od = clouds(:, :, 2) - cld_ssa = clouds(:, :, 3) - cld_asy = clouds(:, :, 4) - end if - - -! if_lsswr: if (Model%lsswr) then +! ! Split some arrays +! gasvmr_co2 = gasvmr(:, :, 1) +! gasvmr_n2o = gasvmr(:, :, 2) +! gasvmr_ch4 = gasvmr(:, :, 3) +! gasvmr_o2 = gasvmr(:, :, 4) + +! aeraod = faersw(:, :, :, 1) +! aerssa = faersw(:, :, :, 2) +! aerasy = faersw(:, :, :, 3) + +! cld_cf = clouds(:,:,1) +! if (ISWCLIQ > 0) then +! ! use prognostic cloud method +! cld_lwp = clouds(:, :, 2) +! cld_ref_liq = clouds(:, :, 3) +! cld_iwp = clouds(:, :, 4) +! cld_ref_ice = clouds(:, :, 5) +! cld_rwp = clouds(:, :, 6) +! cld_ref_rain = clouds(:, :, 7) +! cld_swp = clouds(:, :, 8) +! cld_ref_snow = clouds(:, :, 9) +! else +! ! Impose cloud optical properties +! cld_od = clouds(:, :, 2) +! cld_ssa = clouds(:, :, 3) +! cld_asy = clouds(:, :, 4) +! end if ! Setup surface albedo for SW calculation call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: @@ -1898,22 +1895,31 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & sfcalb, Radtend%sfalb) ! --- outputs call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & - gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & - gasvmr_o2, & - Tbd%icsdsw, aeraod, & - aerssa, aerasy, & +! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & +! gasvmr_o2, & + gasvmr(:, :, 4), & +! Tbd%icsdsw, aeraod, & + Tbd%icsdsw, faersw(:, :, :, 1), & + faersw(:, :, :, 2), faersw(:, :, :, 3), & sfcalb(:, 1), sfcalb(:,2), & sfcalb(:,3), sfcalb(:,4), & Radtend%coszen, Model%solcon, & nday, idxday, im, lmk, lmp, Model%lprnt,& - cld_cf, Model%lsswr, & +! cld_cf, Model%lsswr, & + clouds(:,:,1), Model%lsswr, & htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs - cld_lwp=cld_lwp, & ! Optional input - cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & - cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & - cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & - cld_ref_snow=cld_ref_snow) +! cld_lwp=cld_lwp, & ! Optional input + cld_lwp=clouds(:, :, 2), & ! Optional input +! cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & + cld_ref_liq=clouds(:, :, 3), cld_iwp=clouds(:, :, 4), & +! cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & + cld_ref_ice=clouds(:, :, 5), cld_rwp=clouds(:, :, 6), & +! cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & + cld_ref_rain=clouds(:, :, 7), cld_swp=clouds(:, :, 8), & +! cld_ref_snow=cld_ref_snow) + cld_ref_snow=clouds(:, :, 9)) call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) @@ -1928,7 +1934,6 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) -! end if if_lsswr end subroutine Do_sw_rad From c94882f1406d8e1b5bcbc7df30c0712f8242c3bc Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 7 Nov 2017 20:47:11 -0700 Subject: [PATCH 035/114] Do not call Do_sw sub --- GFS_layer/GFS_radiation_driver.F90 | 88 ++++++++++++++++-------------- 1 file changed, 46 insertions(+), 42 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 7e2c136d5..e6606d659 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1184,7 +1184,8 @@ subroutine GFS_radiation_driver & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1) :: aerodp real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP) :: plyr, tlyr, qlyr, olyr, rhly, tvly, qstl, prslk1, deltaq + LTP) :: plyr, tlyr, qlyr, olyr, rhly, tvly, qstl, prslk1, deltaq, & + htswc, htsw0 real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & 1 + LTP) :: plvl, tlvl real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & @@ -1265,10 +1266,50 @@ subroutine GFS_radiation_driver & ! Start SW radiation calculations - call Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & - Coupling, im, lm, kd, lmk, lmp, tsfg, tsfa, nday, idxday, & - plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faersw, & - scmpsw) + ! Setup surface albedo for SW calculation + call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, Model%lsswr, & + sfcalb, Radtend%sfalb) ! --- outputs + + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), & + Tbd%icsdsw, faersw(:, :, :, 1), & + faersw(:, :, :, 2), faersw(:, :, :, 3), & + sfcalb(:, 1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4), & + Radtend%coszen, Model%solcon, & + nday, idxday, im, lmk, lmp, Model%lprnt,& + clouds(:,:,1), Model%lsswr, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs + hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs + cld_lwp=clouds(:, :, 2), & ! Optional input + cld_ref_liq=clouds(:, :, 3), cld_iwp=clouds(:, :, 4), & + cld_ref_ice=clouds(:, :, 5), cld_rwp=clouds(:, :, 6), & + cld_ref_rain=clouds(:, :, 7), cld_swp=clouds(:, :, 8), & + cld_ref_snow=clouds(:, :, 9)) + + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) + + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, Model%lsswr) + + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, Model%lsswr) + + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + +! call Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & +! Coupling, im, lm, kd, lmk, lmp, tsfg, tsfa, nday, idxday, & +! plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faersw, & +! scmpsw) ! Start LW radiation calculations @@ -1848,42 +1889,6 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: htswc, htsw0 -! real (kind=kind_phys), dimension(im, lmk) :: gasvmr_co2, & -! gasvmr_n2o, gasvmr_ch4, gasvmr_o2 -! real (kind=kind_phys), dimension(im, lmk, NBDSW) :: & -! aeraod, aerssa, aerasy -! real (kind=kind_phys), dimension(im, lmk) :: cld_cf, cld_lwp, cld_ref_liq, & -! cld_iwp, cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & -! cld_od, cld_ssa, cld_asy - - -! ! Split some arrays -! gasvmr_co2 = gasvmr(:, :, 1) -! gasvmr_n2o = gasvmr(:, :, 2) -! gasvmr_ch4 = gasvmr(:, :, 3) -! gasvmr_o2 = gasvmr(:, :, 4) - -! aeraod = faersw(:, :, :, 1) -! aerssa = faersw(:, :, :, 2) -! aerasy = faersw(:, :, :, 3) - -! cld_cf = clouds(:,:,1) -! if (ISWCLIQ > 0) then -! ! use prognostic cloud method -! cld_lwp = clouds(:, :, 2) -! cld_ref_liq = clouds(:, :, 3) -! cld_iwp = clouds(:, :, 4) -! cld_ref_ice = clouds(:, :, 5) -! cld_rwp = clouds(:, :, 6) -! cld_ref_rain = clouds(:, :, 7) -! cld_swp = clouds(:, :, 8) -! cld_ref_snow = clouds(:, :, 9) -! else -! ! Impose cloud optical properties -! cld_od = clouds(:, :, 2) -! cld_ssa = clouds(:, :, 3) -! cld_asy = clouds(:, :, 4) -! end if ! Setup surface albedo for SW calculation call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: @@ -1934,7 +1939,6 @@ subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) - end subroutine Do_sw_rad From 7c960346b77c3a2b9c7fac29cb8e4604e7dc982e Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Tue, 7 Nov 2017 21:28:22 -0700 Subject: [PATCH 036/114] Clean a bit the radiation driver --- GFS_layer/GFS_radiation_driver.F90 | 61 +++++++++++++----------------- 1 file changed, 26 insertions(+), 35 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index e6606d659..bf7e30f75 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1268,50 +1268,41 @@ subroutine GFS_radiation_driver & ! Start SW radiation calculations ! Setup surface albedo for SW calculation call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, Model%lsswr, & - sfcalb, Radtend%sfalb) ! --- outputs - - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), & - Tbd%icsdsw, faersw(:, :, :, 1), & - faersw(:, :, :, 2), faersw(:, :, :, 3), & - sfcalb(:, 1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4), & - Radtend%coszen, Model%solcon, & - nday, idxday, im, lmk, lmp, Model%lprnt,& - clouds(:,:,1), Model%lsswr, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs - hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs - cld_lwp=clouds(:, :, 2), & ! Optional input - cld_ref_liq=clouds(:, :, 3), cld_iwp=clouds(:, :, 4), & - cld_ref_ice=clouds(:, :, 5), cld_rwp=clouds(:, :, 6), & - cld_ref_rain=clouds(:, :, 7), cld_swp=clouds(:, :, 8), & - cld_ref_snow=clouds(:, :, 9)) - - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) - - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, Model%lsswr) + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & + Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & + Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, Model%lsswr, & + sfcalb, Radtend%sfalb) ! --- outputs + + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: + gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & + Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & + faersw(:, :, :, 3), sfcalb(:, 1), sfcalb(:,2), sfcalb(:,3), & + sfcalb(:,4), Radtend%coszen, Model%solcon, nday, idxday, im,& + lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs + hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! Optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & + cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) + + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + Model%lsswr) + + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + kd, Model%lsswr) ! Surface down and up spectral component fluxes ! Save two spectral bands' surface downward and upward fluxes for output. call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, Model%lsswr) + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + Grid, Model, nday, Model%lsswr) call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) -! call Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & -! Coupling, im, lm, kd, lmk, lmp, tsfg, tsfa, nday, idxday, & -! plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faersw, & -! scmpsw) - - ! Start LW radiation calculations call Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & Coupling, tsfg, tsfa, im, lmk, lmp, lm, kd, plyr, plvl, & From 75a274546e330cbbcb383c3b7f3f11eeeb244518 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 8 Nov 2017 08:35:01 -0700 Subject: [PATCH 037/114] Only one call to the LW parameterization --- GFS_layer/GFS_radiation_driver.F90 | 243 ++++++++++++++--------------- 1 file changed, 117 insertions(+), 126 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index bf7e30f75..786b6235c 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1844,93 +1844,84 @@ subroutine Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & end subroutine Get_cloud_info - subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & - Coupling, im, lm, kd, lmk, lmp, tsfg, tsfa, nday, idxday, & - plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faersw, & - scmpsw) - - implicit none - - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_tbd_type), intent(in) :: Tbd - type(GFS_diag_type), intent(inout) :: Diag - type(GFS_coupling_type), intent(inout) :: Coupling - - integer, intent(in) :: im, lm, kd, lmk, lmp, nday - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfg, tsfa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: plyr, tlyr, qlyr, olyr - integer, dimension(Size (Grid%xlon, 1)), intent(in) :: idxday - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_VGAS), intent(in) :: gasvmr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(in) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NBDSW, NF_AESW), intent(in)::faersw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(in) :: plvl, tlvl - - type (cmpfsw_type), dimension(size(Grid%xlon, 1)), intent(out) :: scmpsw - - ! Local vars - integer :: k, k1 - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP) :: htswc, htsw0 - - ! Setup surface albedo for SW calculation - call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, Model%lsswr, & - sfcalb, Radtend%sfalb) ! --- outputs - - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & -! gasvmr_co2, gasvmr_n2o, gasvmr_ch4, & - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & -! gasvmr_o2, & - gasvmr(:, :, 4), & -! Tbd%icsdsw, aeraod, & - Tbd%icsdsw, faersw(:, :, :, 1), & - faersw(:, :, :, 2), faersw(:, :, :, 3), & - sfcalb(:, 1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4), & - Radtend%coszen, Model%solcon, & - nday, idxday, im, lmk, lmp, Model%lprnt,& -! cld_cf, Model%lsswr, & - clouds(:,:,1), Model%lsswr, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs - hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs -! cld_lwp=cld_lwp, & ! Optional input - cld_lwp=clouds(:, :, 2), & ! Optional input -! cld_ref_liq=cld_ref_liq, cld_iwp=cld_iwp, & - cld_ref_liq=clouds(:, :, 3), cld_iwp=clouds(:, :, 4), & -! cld_ref_ice=cld_ref_ice, cld_rwp=cld_rwp, & - cld_ref_ice=clouds(:, :, 5), cld_rwp=clouds(:, :, 6), & -! cld_ref_rain=cld_ref_rain, cld_swp=cld_swp, & - cld_ref_rain=clouds(:, :, 7), cld_swp=clouds(:, :, 8), & -! cld_ref_snow=cld_ref_snow) - cld_ref_snow=clouds(:, :, 9)) - - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) - - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, Model%lsswr) - - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) - - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, Model%lsswr) - - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) - - end subroutine Do_sw_rad +! subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & +! Coupling, im, lm, kd, lmk, lmp, tsfg, tsfa, nday, idxday, & +! plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faersw, & +! scmpsw) +! +! implicit none +! +! type(GFS_control_type), intent(in) :: Model +! type(GFS_grid_type), intent(in) :: Grid +! type(GFS_sfcprop_type), intent(in) :: Sfcprop +! type(GFS_radtend_type), intent(inout) :: Radtend +! type(GFS_tbd_type), intent(in) :: Tbd +! type(GFS_diag_type), intent(inout) :: Diag +! type(GFS_coupling_type), intent(inout) :: Coupling +! +! integer, intent(in) :: im, lm, kd, lmk, lmp, nday +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfg, tsfa +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP), intent(in) :: plyr, tlyr, qlyr, olyr +! integer, dimension(Size (Grid%xlon, 1)), intent(in) :: idxday +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NF_VGAS), intent(in) :: gasvmr +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NF_CLDS), intent(in) :: clouds +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NBDSW, NF_AESW), intent(in)::faersw +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! 1 + LTP), intent(in) :: plvl, tlvl +! +! type (cmpfsw_type), dimension(size(Grid%xlon, 1)), intent(out) :: scmpsw +! +! ! Local vars +! integer :: k, k1 +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP) :: htswc, htsw0 +! +! ! Setup surface albedo for SW calculation +! call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: +! Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& +! tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & +! Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & +! Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & +! Sfcprop%tisfc, im, Model%lsswr, & +! sfcalb, Radtend%sfalb) ! --- outputs +! +! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & +! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & +! gasvmr(:, :, 4), & +! Tbd%icsdsw, faersw(:, :, :, 1), & +! faersw(:, :, :, 2), faersw(:, :, :, 3), & +! sfcalb(:, 1), sfcalb(:,2), & +! sfcalb(:,3), sfcalb(:,4), & +! Radtend%coszen, Model%solcon, & +! nday, idxday, im, lmk, lmp, Model%lprnt,& +! clouds(:,:,1), Model%lsswr, & +! htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs +! hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs +! cld_lwp=clouds(:, :, 2), & ! Optional input +! cld_ref_liq=clouds(:, :, 3), cld_iwp=clouds(:, :, 4), & +! cld_ref_ice=clouds(:, :, 5), cld_rwp=clouds(:, :, 6), & +! cld_ref_rain=clouds(:, :, 7), cld_swp=clouds(:, :, 8), & +! cld_ref_snow=clouds(:, :, 9)) +! +! call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) +! +! call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, Model%lsswr) +! +! ! Surface down and up spectral component fluxes +! ! Save two spectral bands' surface downward and upward fluxes for output. +! call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) +! +! ! Night time: set SW heating rates and fluxes to zero +! call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, Model%lsswr) +! +! call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) +! +! end subroutine Do_sw_rad subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & @@ -1974,8 +1965,8 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & Radtend%semis) ! --- outputs ! Compute LW heating rates and fluxes. - if (Model%lwhtr) then - if (ilwcliq > 0 ) then +! if (Model%lwhtr) then +! if (ilwcliq > 0 ) then call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & @@ -1989,41 +1980,41 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - else - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - hlw0=htlw0, & ! --- optional output - cld_od=clouds(:, :, 2)) ! --- optional input - end if - else - if (ilwcliq > 0 ) then - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& - cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - else - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - cld_od=clouds(:, :, 2)) ! --- optional input - end if - end if +! else +! call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs +! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & +! gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & +! gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & +! Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & +! tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & +! htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs +! hlw0=htlw0, & ! --- optional output +! cld_od=clouds(:, :, 2)) ! --- optional input +! end if +! else +! if (ilwcliq > 0 ) then +! call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs +! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & +! gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & +! gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & +! Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & +! tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & +! htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs +! cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input +! cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & +! cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& +! cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) +! else +! call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs +! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & +! gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & +! gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & +! Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & +! tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & +! htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs +! cld_od=clouds(:, :, 2)) ! --- optional input +! end if +! end if ! Save calculation results ! Save surface air temp for diurnal adjustment at model t-steps @@ -2041,7 +2032,7 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & end do end if - if (Model%lwhtr) then +! if (Model%lwhtr) then do k = 1, lm k1 = k + kd Radtend%lwhc(:, k) = htlw0(:, k1) @@ -2053,7 +2044,7 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & Radtend%lwhc(:, k) = Radtend%lwhc(:, lm) end do end if - end if +! end if ! Radiation fluxes for other physics processes From 1367d902215dd9bf5275388f7a636a4ebf2f4e28 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Wed, 8 Nov 2017 09:55:11 -0700 Subject: [PATCH 038/114] Adding a subroutine to post LW --- GFS_layer/GFS_radiation_driver.F90 | 109 +++++++++++++++++++++-------- 1 file changed, 81 insertions(+), 28 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 786b6235c..e20239810 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -2018,37 +2018,39 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Save calculation results ! Save surface air temp for diurnal adjustment at model t-steps - Radtend%tsflw (:) = tsfa(:) + call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - do k = 1, lm - k1 = k + kd - Radtend%htrlw(:,k) = htlwc(:, k1) - end do - - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%htrlw (:, k) = Radtend%htrlw (:, lm) - end do - end if +! Radtend%tsflw (:) = tsfa(:) -! if (Model%lwhtr) then - do k = 1, lm - k1 = k + kd - Radtend%lwhc(:, k) = htlw0(:, k1) - end do - - ! --- repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%lwhc(:, k) = Radtend%lwhc(:, lm) - end do - end if +! do k = 1, lm +! k1 = k + kd +! Radtend%htrlw(:,k) = htlwc(:, k1) +! end do +! +! ! Repopulate the points above levr +! if (Model%levr < Model%levs) then +! do k = lm, Model%levs +! Radtend%htrlw (:, k) = Radtend%htrlw (:, lm) +! end do ! end if - - - ! Radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc +! +!! if (Model%lwhtr) then +! do k = 1, lm +! k1 = k + kd +! Radtend%lwhc(:, k) = htlw0(:, k1) +! end do +! +! ! --- repopulate the points above levr +! if (Model%levr < Model%levs) then +! do k = lm, Model%levs +! Radtend%lwhc(:, k) = Radtend%lwhc(:, lm) +! end do +! end if +!! end if +! +! +! ! Radiation fluxes for other physics processes +! Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc end if if_lslwr @@ -2355,6 +2357,57 @@ subroutine Save_more_sw_fluxes (Radtend, Coupling, lsswr) end subroutine Save_more_sw_fluxes + + subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) + + implicit none + + integer, intent(in) :: lm, kd + type(GFS_grid_type), intent(in) :: Grid + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_control_type), intent(in) :: Model + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(in) :: htlw0, htlwc + real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfa + + ! Local vars + integer :: k, k1 + + + Radtend%tsflw (:) = tsfa(:) + + do k = 1, lm + k1 = k + kd + Radtend%htrlw(:,k) = htlwc(:, k1) + end do + + ! Repopulate the points above levr + if (Model%levr < Model%levs) then + do k = lm, Model%levs + Radtend%htrlw (:, k) = Radtend%htrlw (:, lm) + end do + end if + + do k = 1, lm + k1 = k + kd + Radtend%lwhc(:, k) = htlw0(:, k1) + end do + + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = lm, Model%levs + Radtend%lwhc(:, k) = Radtend%lwhc(:, lm) + end do + end if + + + ! Radiation fluxes for other physics processes + Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc + + end subroutine Post_lw + + ! !> @} !........................................! From 41fd8e8157d904f121f8d5bd0bccc579bb6285f1 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 14:40:56 -0700 Subject: [PATCH 039/114] longname changes --- physics/GFS_PBL_generic.f90 | 4 ++-- physics/moninedmf.f | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 index c982e280e..f3792a970 100644 --- a/physics/GFS_PBL_generic.f90 +++ b/physics/GFS_PBL_generic.f90 @@ -49,8 +49,8 @@ end subroutine GFS_PBL_generic_post_finalize !! | Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies needed in physics | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | !! | dusfc1 | instantaneous_surface_x_momentum_flux | surface momentum flux in the x-direction valid for current call | Pa | 1 | real | kind_phys | in | F | !! | dvsfc1 | instantaneous_surface_y_momentum_flux | surface momentum flux in the y-direction valid for current call | Pa | 1 | real | kind_phys | in | F | -!! | dtsfc1 | surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | -!! | dqsfc1 | surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | +!! | dtsfc1 | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfc1 | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | !! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | !! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | !! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | diff --git a/physics/moninedmf.f b/physics/moninedmf.f index d5a0800aa..6eebdefd5 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -58,7 +58,7 @@ end subroutine edmf_finalize !! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | !! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | !! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_of_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | +!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | !! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | !! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | !! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | @@ -67,10 +67,10 @@ end subroutine edmf_finalize !! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | !! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | !! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | -!! | dusfc | x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | dusfc | instantaneous_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dvsfc | instantaneous_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | !! | hgamt | countergradient_mixing_term_for_temperature | countergradient mixing term for temperature | K | 1 | real | kind_phys | out | F | !! | hgamq | countergradient_mixing_term_for_water_vapor | countergradient mixing term for water vapor | kg kg-1 | 1 | real | kind_phys | out | F | From 693b4462ff0ff795591bb0491c9565c0ed830851 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 16:25:05 -0700 Subject: [PATCH 040/114] changed GFS_physics_driver.F90 for module changes in GFS_PBL_generic.f90 --- GFS_layer/GFS_physics_driver.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 3e8bddea3..65f7d2284 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -16,8 +16,8 @@ module module_physics_driver GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type use edmf, only: edmf_run - use GFS_PBL_generic, only: GFS_PBL_generic_pre, & - GFS_PBL_generic_post + use GFS_PBL_generic_pre, only: GFS_PBL_generic_pre_run + use GFS_PBL_generic_post, only: GFS_PBL_generic_post_run implicit none @@ -792,7 +792,7 @@ subroutine GFS_physics_driver & endif endif ! end if_lssav_block - call GFS_PBL_generic_pre (im, levs, kinver) + call GFS_PBL_generic_pre_run (im, levs, kinver) kcnv(:) = 0 !kinver(:) = levs @@ -1274,7 +1274,7 @@ subroutine GFS_physics_driver & Coupling%dqsfci_cpl(:) = dqsfc1(:) endif - call GFS_PBL_generic_post (Grid, Model, Radtend, dusfc1, dvsfc1, & + call GFS_PBL_generic_post_run (Grid, Model, Radtend, dusfc1, dvsfc1, & dtsfc1, dqsfc1, dudt, dvdt, dtdt, dqdt, xmu, Diag) ! !-------------------------------------------------------lssav if loop ---------- ! if (Model%lssav) then From 96e2adb2a2aad4c93e3eb26bd9827c806d4dae80 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 16:59:41 -0700 Subject: [PATCH 041/114] fixing compilation errors in GFS_PBL_generic.f90 --- physics/GFS_PBL_generic.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 index f3792a970..88e583b63 100644 --- a/physics/GFS_PBL_generic.f90 +++ b/physics/GFS_PBL_generic.f90 @@ -9,7 +9,7 @@ subroutine GFS_PBL_generic_pre_init () end subroutine GFS_PBL_generic_pre_init subroutine GFS_PBL_generic_pre_finalize() - subroutine GFS_PBL_generic_pre_finalize + end subroutine GFS_PBL_generic_pre_finalize !> \section arg_table_GFS_PBL_generic_pre_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | From 6ac3349149da748cc8f06ecd5a1bb73d98c0e233 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 17:20:29 -0700 Subject: [PATCH 042/114] fixing compilation errors in GFS_PBL_generic.f90 --- physics/GFS_PBL_generic.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 index 88e583b63..51435c28d 100644 --- a/physics/GFS_PBL_generic.f90 +++ b/physics/GFS_PBL_generic.f90 @@ -62,7 +62,7 @@ subroutine GFS_PBL_generic_post_run (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc dudt, dvdt, dtdt, dqdt, xmu, Diag) use machine, only: kind_phys - use GFS_typedefs, only: GFS_diag_type, GFS_radtend_type, GFS_model_type, GFS_grid_type + use GFS_typedefs, only: GFS_diag_type, GFS_radtend_type, GFS_control_type, GFS_grid_type type(GFS_grid_type), intent(in) :: Grid type(GFS_radtend_type), intent(in) :: Radtend From 0ee96b8787e471bb4b30556b6a3b3c3d4108e3a0 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 18:53:16 -0700 Subject: [PATCH 043/114] put tridiagonal solver subroutines in their own file, tridi.f; modified makefile to compile this file; other PBL schemes used tridin and tridi2 in moninedmf.f, so these subroutines don't really belong in EDMF module --- makefile | 1 + physics/moninedmf.f | 212 ++++++++++++++++++++++---------------------- physics/tridi.f | 105 ++++++++++++++++++++++ 3 files changed, 212 insertions(+), 106 deletions(-) create mode 100644 physics/tridi.f diff --git a/makefile b/makefile index 44c094835..7d390e201 100644 --- a/makefile +++ b/makefile @@ -111,6 +111,7 @@ SRCS_f = \ ./physics/shalcv_fixdp.f \ ./physics/shalcv_opr.f \ ./physics/tracer_const_h.f \ + ./physics/tridi.f \ ./physics/tridi2t3.f SRCS_f90 = \ diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 6eebdefd5..81ac9dc56 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -1047,7 +1047,7 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! solve tridiagonal problem for heat and moisture ! !> The tridiagonal system is solved by calling the internal ::edmf_tridin subroutine. - call edmf_tridin(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) + call tridin(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) ! ! recover tendencies of heat and moisture @@ -1161,7 +1161,7 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! solve tridiagonal problem for momentum ! - call edmf_tridi2(im,km,al,ad,au,a1,a2,au,a1,a2) + call tridi2(im,km,al,ad,au,a1,a2,au,a1,a2) ! ! recover tendencies of momentum ! @@ -1204,113 +1204,113 @@ subroutine edmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. !! !! Origin of subroutine unknown. - subroutine edmf_tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) -cc - use machine , only : kind_phys - implicit none - integer k,n,l,i - real(kind=kind_phys) fk -cc - real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & - & au(l,n-1),a1(l,n),a2(l,n) -c----------------------------------------------------------------------- - do i=1,l - fk = 1./cm(i,1) - au(i,1) = fk*cu(i,1) - a1(i,1) = fk*r1(i,1) - a2(i,1) = fk*r2(i,1) - enddo - do k=2,n-1 - do i=1,l - fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fk*cu(i,k) - a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) - a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) - enddo - enddo - do i=1,l - fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) - a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) - enddo - do k=n-1,1,-1 - do i=1,l - a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) - a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) - enddo - enddo -c----------------------------------------------------------------------- - return - end - -c----------------------------------------------------------------------- +C subroutine edmf_tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) +c +C use machine , only : kind_phys +C implicit none +C integer k,n,l,i +C real(kind=kind_phys) fk +c +C real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & +C & au(l,n-1),a1(l,n),a2(l,n) +C----------------------------------------------------------------------- +C do i=1,l +C fk = 1./cm(i,1) +C au(i,1) = fk*cu(i,1) +C a1(i,1) = fk*r1(i,1) +C a2(i,1) = fk*r2(i,1) +C enddo +C do k=2,n-1 +C do i=1,l +C fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) +C au(i,k) = fk*cu(i,k) +C a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) +C a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) +C enddo +C enddo +C do i=1,l +C fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) +C a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) +C a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) +C enddo +C do k=n-1,1,-1 +C do i=1,l +C a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) +C a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) +C enddo +C enddo +C----------------------------------------------------------------------- +C return +C end +C +C----------------------------------------------------------------------- !> \ingroup HEDMF !! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. !! !! Origin of subroutine unknown. - subroutine edmf_tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) -cc - use machine , only : kind_phys - implicit none - integer is,k,kk,n,nt,l,i - real(kind=kind_phys) fk(l) -cc - real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & - & r1(l,n), r2(l,n*nt), & - & au(l,n-1), a1(l,n), a2(l,n*nt), & - & fkk(l,2:n-1) -c----------------------------------------------------------------------- - do i=1,l - fk(i) = 1./cm(i,1) - au(i,1) = fk(i)*cu(i,1) - a1(i,1) = fk(i)*r1(i,1) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - a2(i,1+is) = fk(i) * r2(i,1+is) - enddo - enddo - do k=2,n-1 - do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fkk(i,k)*cu(i,k) - a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=2,n-1 - do i=1,l - a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) - enddo - enddo - enddo - do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) - enddo - enddo - do k=n-1,1,-1 - do i=1,l - a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=n-1,1,-1 - do i=1,l - a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) - enddo - enddo - enddo -c----------------------------------------------------------------------- - return - end +C subroutine edmf_tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) +c +C use machine , only : kind_phys +C implicit none +C integer is,k,kk,n,nt,l,i +C real(kind=kind_phys) fk(l) +c +C real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & +C & r1(l,n), r2(l,n*nt), & +C & au(l,n-1), a1(l,n), a2(l,n*nt), & +C & fkk(l,2:n-1) +C----------------------------------------------------------------------- +C do i=1,l +C fk(i) = 1./cm(i,1) +C au(i,1) = fk(i)*cu(i,1) +C a1(i,1) = fk(i)*r1(i,1) +C enddo +C do k = 1, nt +C is = (k-1) * n +C do i = 1, l +C a2(i,1+is) = fk(i) * r2(i,1+is) +C enddo +C enddo +C do k=2,n-1 +C do i=1,l +C fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) +C au(i,k) = fkk(i,k)*cu(i,k) +C a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) +C enddo +C enddo +C do kk = 1, nt +C is = (kk-1) * n +C do k=2,n-1 +C do i=1,l +C a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) +C enddo +C enddo +C enddo +C do i=1,l +C fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) +C a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) +C enddo +C do k = 1, nt +C is = (k-1) * n +C do i = 1, l +C a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) +C enddo +C enddo +C do k=n-1,1,-1 +C do i=1,l +C a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) +C enddo +C enddo +C do kk = 1, nt +C is = (kk-1) * n +C do k=n-1,1,-1 +C do i=1,l +C a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) +C enddo +C enddo +C enddo +C----------------------------------------------------------------------- +C return +C end !> @} end module edmf diff --git a/physics/tridi.f b/physics/tridi.f new file mode 100644 index 000000000..ca53cbc9b --- /dev/null +++ b/physics/tridi.f @@ -0,0 +1,105 @@ + subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer k,n,l,i + real(kind=kind_phys) fk +cc + real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & + & au(l,n-1),a1(l,n),a2(l,n) +c----------------------------------------------------------------------- + do i=1,l + fk = 1./cm(i,1) + au(i,1) = fk*cu(i,1) + a1(i,1) = fk*r1(i,1) + a2(i,1) = fk*r2(i,1) + enddo + do k=2,n-1 + do i=1,l + fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fk*cu(i,k) + a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) + a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) + enddo + enddo + do i=1,l + fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) + a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) + a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) + enddo + enddo +c----------------------------------------------------------------------- + return + end + +c----------------------------------------------------------------------- + + subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +cc + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & r1(l,n), r2(l,n*nt), & + & au(l,n-1), a1(l,n), a2(l,n*nt), & + & fkk(l,2:n-1) +c----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + a1(i,1) = fk(i)*r1(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,1+is) = fk(i) * r2(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) + enddo + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) + enddo + enddo + enddo +c----------------------------------------------------------------------- + return + end From c893141f9e5920739b67bba057fc9f5ecf11d306 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 19:00:35 -0700 Subject: [PATCH 044/114] fixing columns in tridi.f for compilation --- physics/tridi.f | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/tridi.f b/physics/tridi.f index ca53cbc9b..a8f29f928 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -5,9 +5,9 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) integer k,n,l,i real(kind=kind_phys) fk cc - real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & - & au(l,n-1),a1(l,n),a2(l,n) -c----------------------------------------------------------------------- + real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n),& + & au(l,n-1),a1(l,n),a2(l,n) +c---------------------------------------------------------------------- do i=1,l fk = 1./cm(i,1) au(i,1) = fk*cu(i,1) @@ -47,9 +47,9 @@ subroutine tridin(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) real(kind=kind_phys) fk(l) cc real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & - & r1(l,n), r2(l,n*nt), & - & au(l,n-1), a1(l,n), a2(l,n*nt), & - & fkk(l,2:n-1) + & r1(l,n), r2(l,n*nt), & + & au(l,n-1), a1(l,n), a2(l,n*nt), & + & fkk(l,2:n-1) c----------------------------------------------------------------------- do i=1,l fk(i) = 1./cm(i,1) From 4c7200685d08f7a2abbc9ebf520cee346e04ce32 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 13 Nov 2017 19:07:10 -0700 Subject: [PATCH 045/114] fixed column in tridi.f --- physics/tridi.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/tridi.f b/physics/tridi.f index a8f29f928..dbf03e62b 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -5,7 +5,7 @@ subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) integer k,n,l,i real(kind=kind_phys) fk cc - real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n),& + real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & & au(l,n-1),a1(l,n),a2(l,n) c---------------------------------------------------------------------- do i=1,l From e729c2300852b4a37f05eeec2c1abd8bd26f7d4c Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 14:52:11 -0700 Subject: [PATCH 046/114] longname fix in moninedmf.f --- physics/moninedmf.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 81ac9dc56..e16362a7f 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -67,8 +67,8 @@ end subroutine edmf_finalize !! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | !! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | !! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | -!! | dusfc | instantaneous_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | !! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | !! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | From 2ef4c22c64784bb00d43be426c9573a16a84adb5 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 14:58:31 -0700 Subject: [PATCH 047/114] Added code necessary for the generic deep convection interstitial schemes - created GFS_DCNV_generic.f90 with modules for pre and post - moved code from GFS_physics_driver.f90 to this file - call the new subroutines from GFS_physics_driver.f90 - edited makefile to compile new file - edits to sasasdeep_run table in mfdeepcnv.f - NOT TESTED YET (committing to test on Theia) --- GFS_layer/GFS_physics_driver.F90 | 66 +++++++++-------- makefile | 1 + physics/GFS_DCNV_generic.f90 | 118 +++++++++++++++++++++++++++++++ 3 files changed, 157 insertions(+), 28 deletions(-) create mode 100644 physics/GFS_DCNV_generic.f90 diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 65f7d2284..d8bbb38e9 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -18,6 +18,9 @@ module module_physics_driver use edmf, only: edmf_run use GFS_PBL_generic_pre, only: GFS_PBL_generic_pre_run use GFS_PBL_generic_post, only: GFS_PBL_generic_post_run +! use sasas_deep, only: sasasdeep_run + use GFS_DCNV_generic_pre, only: GFS_DCNV_generic_pre_run + use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run implicit none @@ -463,6 +466,9 @@ subroutine GFS_physics_driver & del, rhc, dtdt, dudt, dvdt, gwdcu, gwdcv, dtdtc, rainp, & ud_mf, dd_mf, dt_mf, prnum, dkt, sigmatot, sigmafrac + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs) :: & + initial_u, initial_v, initial_t, initial_qv + !--- GFDL modification for FV3 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs+1) ::& del_gz @@ -1501,17 +1507,19 @@ subroutine GFS_physics_driver & ! &,' lat=',lat,' kdt=',kdt,' me=',me ! if (lprnt) write(7000,*)' bef convection gv0=',gv0(ipr,:) - if (Model%ldiag3d) then - dtdt(:,:) = Stateout%gt0(:,:) - dudt(:,:) = Stateout%gu0(:,:) - dvdt(:,:) = Stateout%gv0(:,:) - elseif (Model%cnvgwd) then - dtdt(:,:) = Stateout%gt0(:,:) - endif ! end if_ldiag3d/cnvgwd + ! if (Model%ldiag3d) then + ! dtdt(:,:) = Stateout%gt0(:,:) + ! dudt(:,:) = Stateout%gu0(:,:) + ! dvdt(:,:) = Stateout%gv0(:,:) + ! elseif (Model%cnvgwd) then + ! dtdt(:,:) = Stateout%gt0(:,:) + ! endif ! end if_ldiag3d/cnvgwd + ! + ! if (Model%ldiag3d .or. Model%lgocart) then + ! dqdt(:,:,1) = Stateout%gq0(:,:,1) + ! endif ! end if_ldiag3d/lgocart - if (Model%ldiag3d .or. Model%lgocart) then - dqdt(:,:,1) = Stateout%gq0(:,:,1) - endif ! end if_ldiag3d/lgocart + call GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, intial_qv) #ifdef GFS_HYDRO call get_phi(im, ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & @@ -1864,26 +1872,28 @@ subroutine GFS_physics_driver & ! write(0,*)' aftcnvgq1=',(gq0(ipr,k,ntcw),k=1,levs) ! endif ! - do i = 1, im - Diag%rainc(:) = frain * rain1(:) - enddo +! do i = 1, im +! Diag%rainc(:) = frain * rain1(:) +! enddo +! ! +! if (Model%lssav) then +! Diag%cldwrk (:) = Diag%cldwrk (:) + cld1d(:) * dtf +! Diag%cnvprcp(:) = Diag%cnvprcp(:) + Diag%rainc(:) ! - if (Model%lssav) then - Diag%cldwrk (:) = Diag%cldwrk (:) + cld1d(:) * dtf - Diag%cnvprcp(:) = Diag%cnvprcp(:) + Diag%rainc(:) - - if (Model%ldiag3d) then - Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:)-dtdt(:,:)) * frain - Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain - Diag%du3dt(:,:,3) = Diag%du3dt(:,:,3) + (Stateout%gu0(:,:)-dudt(:,:)) * frain - Diag%dv3dt(:,:,3) = Diag%dv3dt(:,:,3) + (Stateout%gv0(:,:)-dvdt(:,:)) * frain - - Diag%upd_mf(:,:) = Diag%upd_mf(:,:) + ud_mf(:,:) * (con_g*frain) - Diag%dwn_mf(:,:) = Diag%dwn_mf(:,:) + dd_mf(:,:) * (con_g*frain) - Diag%det_mf(:,:) = Diag%det_mf(:,:) + dt_mf(:,:) * (con_g*frain) - endif ! if (ldiag3d) +! if (Model%ldiag3d) then +! Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:)-dtdt(:,:)) * frain +! Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain +! Diag%du3dt(:,:,3) = Diag%du3dt(:,:,3) + (Stateout%gu0(:,:)-dudt(:,:)) * frain +! Diag%dv3dt(:,:,3) = Diag%dv3dt(:,:,3) + (Stateout%gv0(:,:)-dvdt(:,:)) * frain +! +! Diag%upd_mf(:,:) = Diag%upd_mf(:,:) + ud_mf(:,:) * (con_g*frain) +! Diag%dwn_mf(:,:) = Diag%dwn_mf(:,:) + dd_mf(:,:) * (con_g*frain) +! Diag%det_mf(:,:) = Diag%det_mf(:,:) + dt_mf(:,:) * (con_g*frain) +! endif ! if (ldiag3d) +! +! endif ! end if_lssav - endif ! end if_lssav + call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, intial_v, intial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) ! ! update dqdt_v to include moisture tendency due to deep convection if (Model%lgocart) then diff --git a/makefile b/makefile index 7d390e201..5ebbce687 100644 --- a/makefile +++ b/makefile @@ -121,6 +121,7 @@ SRCS_f90 = \ ./physics/gcm_shoc.f90 \ ./physics/gcycle.f90 \ ./physics/get_prs_fv3.f90 \ + ./physics/GFS_DCNV_generic.f90 \ ./physics/GFS_PBL_generic.f90 \ ./physics/h2ointerp.f90 \ ./physics/m_micro_driver.f90 \ diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 new file mode 100644 index 000000000..7a5b1fae9 --- /dev/null +++ b/physics/GFS_DCNV_generic.f90 @@ -0,0 +1,118 @@ +!> \file GFS_DCNV_generic.f90 +!! Contains code related to deep convective schemes to be used within the GFS physics suite. + + module GFS_DCNV_generic_pre + + contains + + subroutine GFS_DCNV_generic_pre_init () + end subroutine GFS_DCNV_generic_pre_init + + subroutine GFS_DCNV_generic_pre_finalize() + end subroutine GFS_DCNV_generic_pre_finalize + +!> \section arg_table_GFS_DCNV_generic_pre_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | initial_u | x_wind_initial | x-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | inout | F | +!! | initial_v | y_wind_initial | y-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | inout | F | +!! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | +!! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | +!! + subroutine GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, intial_qv) + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_stateout_type, GFS_grid_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_grid_type), intent(in) :: Grid + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(inout) :: initial_u, initial_v, intial_t, intial_qv + + if (Model%ldiag3d) then + initial_t(:,:) = Stateout%gt0(:,:) + initial_u(:,:) = Stateout%gu0(:,:) + initial_v(:,:) = Stateout%gv0(:,:) + elseif (Model%cnvgwd) then + initial_t(:,:) = Stateout%gt0(:,:) + endif ! end if_ldiag3d/cnvgwd + + if (Model%ldiag3d .or. Model%lgocart) then + initial_qv(:,:) = Stateout%gq0(:,:,1) + endif ! end if_ldiag3d/lgocart + + end subroutine GFS_DCNV_generic_pre_run + + end module + + module GFS_DCNV_generic_post + + contains + + subroutine GFS_DCNV_generic_post_init () + end subroutine GFS_DCNV_generic_post_init + + subroutine GFS_DCNV_generic_post_finalize () + end subroutine GFS_DCNV_generic_post_finalize + +!> \section arg_table_GFS_PBL_generic_post_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-----------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | +!! | rain1 | instantaneous_rainfall_amount | instantaneous rainfall amount | m | 1 | real | kind_phys | in | F | +!! | cld1d | cloud_work_function | cloud work function | m2 s-2 | 1 | real | kind_phys | in | F | +!! | initial_u | x_wind_initial | x-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | in | F | +!! | initial_v | y_wind_initial | y-wind before entering a physics scheme | m s-1 | 2 | real | kind_phys | in | F | +!! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | +!! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | +!! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! + subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, intial_v, intial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type + use physcons, only: con_g + + type(GFS_grid_type), intent(in) :: Grid + type(GFS_control_type), intent(in) :: Model + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_diag_type), intent(inout) :: Diag + + real(kind=kind_phys), intent(in) :: frain + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: rain1, cld1d + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: initial_u, initial_v, intial_t, intial_qv + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: ud_mf, dd_mf, dt_mf + + integer :: i + + + do i = 1, size(Grid%xlon,1) + Diag%rainc(:) = frain * rain1(:) + enddo + ! + if (Model%lssav) then + Diag%cldwrk (:) = Diag%cldwrk (:) + cld1d(:) * Model%dtf + Diag%cnvprcp(:) = Diag%cnvprcp(:) + Diag%rainc(:) + + if (Model%ldiag3d) then + Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain + Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain + Diag%du3dt(:,:,3) = Diag%du3dt(:,:,3) + (Stateout%gu0(:,:)-initial_u(:,:)) * frain + Diag%dv3dt(:,:,3) = Diag%dv3dt(:,:,3) + (Stateout%gv0(:,:)-initial_v(:,:)) * frain + + Diag%upd_mf(:,:) = Diag%upd_mf(:,:) + ud_mf(:,:) * (con_g*frain) + Diag%dwn_mf(:,:) = Diag%dwn_mf(:,:) + dd_mf(:,:) * (con_g*frain) + Diag%det_mf(:,:) = Diag%det_mf(:,:) + dt_mf(:,:) * (con_g*frain) + endif ! if (ldiag3d) + + endif ! end if_lssav + end subroutine GFS_DCNV_generic_post_run + + end module From 215e3977a090718fd7a9402c9394962b8d15ba0b Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 15:06:43 -0700 Subject: [PATCH 048/114] typo fixes to GFS_DCNV_generic.f90 found when compiling --- physics/GFS_DCNV_generic.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 index 7a5b1fae9..65389c741 100644 --- a/physics/GFS_DCNV_generic.f90 +++ b/physics/GFS_DCNV_generic.f90 @@ -22,14 +22,14 @@ end subroutine GFS_DCNV_generic_pre_finalize !! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | !! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | !! - subroutine GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, intial_qv) + subroutine GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, initial_qv) use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_stateout_type, GFS_grid_type type(GFS_control_type), intent(in) :: Model type(GFS_stateout_type), intent(in) :: Stateout type(GFS_grid_type), intent(in) :: Grid - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(inout) :: initial_u, initial_v, intial_t, intial_qv + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(inout) :: initial_u, initial_v, initial_t, initial_qv if (Model%ldiag3d) then initial_t(:,:) = Stateout%gt0(:,:) @@ -74,7 +74,7 @@ end subroutine GFS_DCNV_generic_post_finalize !! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | !! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | !! - subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, intial_v, intial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) + subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) use machine, only: kind_phys use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type @@ -87,7 +87,7 @@ subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d real(kind=kind_phys), intent(in) :: frain real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: rain1, cld1d - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: initial_u, initial_v, intial_t, intial_qv + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: initial_u, initial_v, initial_t, initial_qv real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: ud_mf, dd_mf, dt_mf integer :: i From e0290016c99587415d905ba5e76435fd43f13cb0 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 15:10:23 -0700 Subject: [PATCH 049/114] fixed typo in GFS_physics_driver.F90 found when compiling --- GFS_layer/GFS_physics_driver.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index d8bbb38e9..073300c51 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -1519,7 +1519,7 @@ subroutine GFS_physics_driver & ! dqdt(:,:,1) = Stateout%gq0(:,:,1) ! endif ! end if_ldiag3d/lgocart - call GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, intial_qv) + call GFS_DCNV_generic_pre_run (Model, Stateout, Grid, initial_u, initial_v, initial_t, initial_qv) #ifdef GFS_HYDRO call get_phi(im, ix, levs, ntrac, Stateout%gt0, Stateout%gq0, & @@ -1893,7 +1893,7 @@ subroutine GFS_physics_driver & ! ! endif ! end if_lssav - call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, intial_v, intial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) + call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) ! ! update dqdt_v to include moisture tendency due to deep convection if (Model%lgocart) then From d7e16bab8091fcf6067c67a5b1d6bcd9beb186a2 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 15:56:53 -0700 Subject: [PATCH 050/114] found some more lines in GFS_physics_driver.F90 that belong in DCNV_generic_post --- GFS_layer/GFS_physics_driver.F90 | 18 +++++++++--------- physics/GFS_DCNV_generic.f90 | 22 ++++++++++++++++++---- 2 files changed, 27 insertions(+), 13 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 073300c51..1f8db1231 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -1904,15 +1904,15 @@ subroutine GFS_physics_driver & Coupling%cnvqci (:,:) = Coupling%cnvqci (:,:) + (clw(:,:,1)+clw(:,:,2))*frain endif ! if (lgocart) ! - if ((Model%npdf3d == 3) .and. (Model%num_p3d == 4)) then - num2 = Model%num_p3d + 2 - num3 = num2 + 1 - Tbd%phy_f3d(:,:,num2) = cnvw(:,:) - Tbd%phy_f3d(:,:,num3) = cnvc(:,:) - elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then - num2 = Model%num_p3d + 1 - Tbd%phy_f3d(:,:,num2) = cnvw(:,:) - endif + ! if ((Model%npdf3d == 3) .and. (Model%num_p3d == 4)) then + ! num2 = Model%num_p3d + 2 + ! num3 = num2 + 1 + ! Tbd%phy_f3d(:,:,num2) = cnvw(:,:) + ! Tbd%phy_f3d(:,:,num3) = cnvc(:,:) + ! elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then + ! num2 = Model%num_p3d + 1 + ! Tbd%phy_f3d(:,:,num2) = cnvw(:,:) + ! endif ! if (lprnt) write(7000,*)' bef cnvgwd gu0=',gu0(ipr,:) ! &,' lat=',lat,' kdt=',kdt,' me=',me diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 index 65389c741..27e020290 100644 --- a/physics/GFS_DCNV_generic.f90 +++ b/physics/GFS_DCNV_generic.f90 @@ -72,9 +72,11 @@ end subroutine GFS_DCNV_generic_post_finalize !! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | !! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | !! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | -!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_typedefs%GFS_tbd_type | | inout | F | !! - subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) + subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, & + ud_mf, dd_mf, dt_mf, cnvw, cnvc, Diag, Tbd) use machine, only: kind_phys use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type @@ -84,14 +86,15 @@ subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d type(GFS_control_type), intent(in) :: Model type(GFS_stateout_type), intent(in) :: Stateout type(GFS_diag_type), intent(inout) :: Diag + type(GFS_tbd_type), intent(inout) :: Tbd real(kind=kind_phys), intent(in) :: frain real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: rain1, cld1d real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: initial_u, initial_v, initial_t, initial_qv real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: ud_mf, dd_mf, dt_mf + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: cnvw, cnvc - integer :: i - + integer :: i, num2, num3 do i = 1, size(Grid%xlon,1) Diag%rainc(:) = frain * rain1(:) @@ -113,6 +116,17 @@ subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d endif ! if (ldiag3d) endif ! end if_lssav + + if ((Model%npdf3d == 3) .and. (Model%num_p3d == 4)) then + num2 = Model%num_p3d + 2 + num3 = num2 + 1 + Tbd%phy_f3d(:,:,num2) = cnvw(:,:) + Tbd%phy_f3d(:,:,num3) = cnvc(:,:) + elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then + num2 = Model%num_p3d + 1 + Tbd%phy_f3d(:,:,num2) = cnvw(:,:) + endif + end subroutine GFS_DCNV_generic_post_run end module From 67f98a3285e7e1520034a5be2b1d52611b38e5cc Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 16:09:14 -0700 Subject: [PATCH 051/114] propogated change from dudt, dvdt, dtdt, dqdt to initial_u, ... after the call to GFS_DCNV_generic_pre_run to try to fix B4B error introduced in commit e029001 --- GFS_layer/GFS_physics_driver.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 1f8db1231..70646a8e8 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -1897,7 +1897,7 @@ subroutine GFS_physics_driver & ! ! update dqdt_v to include moisture tendency due to deep convection if (Model%lgocart) then - Coupling%dqdti (:,:) = (Stateout%gq0(:,:,1) - dqdt(:,:,1)) * frain + Coupling%dqdti (:,:) = (Stateout%gq0(:,:,1) - initial_qv(:,:)) * frain Coupling%upd_mfi(:,:) = Coupling%upd_mfi(:,:) + ud_mf(:,:) * frain Coupling%dwn_mfi(:,:) = Coupling%dwn_mfi(:,:) + dd_mf(:,:) * frain Coupling%det_mfi(:,:) = Coupling%det_mfi(:,:) + dt_mf(:,:) * frain @@ -1930,7 +1930,7 @@ subroutine GFS_physics_driver & do k = 1, levs do i = 1, im if (k >= kbot(i) .and. k <= ktop(i)) then - cumabs(i) = cumabs(i) + (Stateout%gt0(i,k)-dtdt(i,k)) * del(i,k) + cumabs(i) = cumabs(i) + (Stateout%gt0(i,k)-initial_t(i,k)) * del(i,k) work3(i) = work3(i) + del(i,k) endif enddo @@ -2088,10 +2088,10 @@ subroutine GFS_physics_driver & !----------------Convective gravity wave drag parameterization over -------- if (Model%ldiag3d) then - dtdt(:,:) = Stateout%gt0(:,:) + initial_t(:,:) = Stateout%gt0(:,:) endif if (Model%ldiag3d .or. Model%lgocart) then - dqdt(:,:,1) = Stateout%gq0(:,:,1) + initial_qv(:,:) = Stateout%gq0(:,:,1) endif ! write(0,*)' before do_shoc shal clstp=',clstp,' kdt=',kdt, @@ -2188,14 +2188,14 @@ subroutine GFS_physics_driver & if (Model%lgocart) then do k = 1, levs do i = 1, im - tem = (Stateout%gq0(i,k,1)-dqdt(i,k,1)) * frain + tem = (Stateout%gq0(i,k,1)-initial_qv(i,k)) * frain Coupling%dqdti(i,k) = Coupling%dqdti(i,k) + tem enddo enddo endif if (Model%ldiag3d) then - Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + (Stateout%gt0(:,:)-dtdt(:,:)) * frain - Diag%dq3dt(:,:,3) = Diag%dq3dt(:,:,3) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain + Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain + Diag%dq3dt(:,:,3) = Diag%dq3dt(:,:,3) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain endif endif ! end if_lssav ! @@ -2342,15 +2342,15 @@ subroutine GFS_physics_driver & ! enddo ! endif if (Model%ldiag3d) then - Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:) -dtdt(:,:) ) * frain - Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain + Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + (Stateout%gt0(:,:) -initial_t(:,:) ) * frain + Diag%dq3dt(:,:,2) = Diag%dq3dt(:,:,2) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain endif endif endif ! moist convective adjustment over ! if (Model%ldiag3d .or. Model%do_aw) then - dtdt(:,:) = Stateout%gt0(:,:) - dqdt(:,:,1) = Stateout%gq0(:,:,1) + initial_t(:,:) = Stateout%gt0(:,:) + initial_qv(:,:) = Stateout%gq0(:,:,1) do n=Model%ntcw,Model%ntcw+Model%ncld-1 dqdt(:,:,n) = Stateout%gq0(:,:,n) enddo @@ -2558,8 +2558,8 @@ subroutine GFS_physics_driver & do k = 1,levs do i = 1,im tem1 = sigmafrac(i,k) - Stateout%gt0(i,k) = Stateout%gt0(i,k) - tem1 * (Stateout%gt0(i,k)-dtdt(i,k)) - tem2 = tem1 * (Stateout%gq0(i,k,1)-dqdt(i,k,1)) + Stateout%gt0(i,k) = Stateout%gt0(i,k) - tem1 * (Stateout%gt0(i,k)-initial_t(i,k)) + tem2 = tem1 * (Stateout%gq0(i,k,1)-initial_qv(i,k)) Stateout%gq0(i,k,1) = Stateout%gq0(i,k,1) - tem2 temrain1(i) = temrain1(i) - (Statein%prsi(i,k)-Statein%prsi(i,k+1)) & * tem2 * onebg @@ -2613,8 +2613,8 @@ subroutine GFS_physics_driver & Diag%totprcp(:) = Diag%totprcp(:) + Diag%rain(:) if (Model%ldiag3d) then - Diag%dt3dt(:,:,6) = Diag%dt3dt(:,:,6) + (Stateout%gt0(:,:)-dtdt(:,:)) * frain - Diag%dq3dt(:,:,4) = Diag%dq3dt(:,:,4) + (Stateout%gq0(:,:,1)-dqdt(:,:,1)) * frain + Diag%dt3dt(:,:,6) = Diag%dt3dt(:,:,6) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain + Diag%dq3dt(:,:,4) = Diag%dq3dt(:,:,4) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain endif endif From c743938cbf9810b259392c7010c1aa1448f750c6 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 16:14:16 -0700 Subject: [PATCH 052/114] added GFS_tbd_type in use statement --- physics/GFS_DCNV_generic.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 index 27e020290..56646d691 100644 --- a/physics/GFS_DCNV_generic.f90 +++ b/physics/GFS_DCNV_generic.f90 @@ -79,7 +79,7 @@ subroutine GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d ud_mf, dd_mf, dt_mf, cnvw, cnvc, Diag, Tbd) use machine, only: kind_phys - use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type + use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type, GFS_tbd_type use physcons, only: con_g type(GFS_grid_type), intent(in) :: Grid From 97ec943cad8f5b6fd92c042bce3650d5521e226d Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 16:16:26 -0700 Subject: [PATCH 053/114] added Tbd to call to GFS_DCNV_generic_post_run in GFS_physics_driver.F90 --- GFS_layer/GFS_physics_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 70646a8e8..390cf3f67 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -1893,7 +1893,7 @@ subroutine GFS_physics_driver & ! ! endif ! end if_lssav - call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag) + call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag, Tbd) ! ! update dqdt_v to include moisture tendency due to deep convection if (Model%lgocart) then From fd942aca64969d5da61247e8d427e2076091cc2d Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Wed, 15 Nov 2017 16:19:19 -0700 Subject: [PATCH 054/114] fixed call to GFS_DCNV_generic_post_run again --- GFS_layer/GFS_physics_driver.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 390cf3f67..ca5a68f6e 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -1893,7 +1893,8 @@ subroutine GFS_physics_driver & ! ! endif ! end if_lssav - call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, Diag, Tbd) + call GFS_DCNV_generic_post_run (Grid, Model, Stateout, frain, rain1, cld1d, & + initial_u, initial_v, initial_t, initial_qv, ud_mf, dd_mf, dt_mf, cnvw, cnvc, Diag, Tbd) ! ! update dqdt_v to include moisture tendency due to deep convection if (Model%lgocart) then From beba967413ddb884a0fa57aed6783f443a76da19 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 16 Nov 2017 11:45:54 -0700 Subject: [PATCH 055/114] added first GFS_suite_interstitial subroutine (not compiled yet) --- GFS_layer/GFS_physics_driver.F90 | 50 +++++++++++++----------- makefile | 1 + physics/GFS_DCNV_generic.f90 | 2 +- physics/GFS_suite_interstitial.f90 | 62 ++++++++++++++++++++++++++++++ 4 files changed, 91 insertions(+), 24 deletions(-) create mode 100644 physics/GFS_suite_interstitial.f90 diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index ca5a68f6e..61e5a73ed 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -21,6 +21,7 @@ module module_physics_driver ! use sasas_deep, only: sasasdeep_run use GFS_DCNV_generic_pre, only: GFS_DCNV_generic_pre_run use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run + use GFS_suite_interstitial_1, only: GFS_suite_interstitial_1_run implicit none @@ -525,25 +526,26 @@ subroutine GFS_physics_driver & ! ! --- ... figure out number of extra tracers ! - tottracer = 0 ! no convective transport of tracers - if (Model%trans_trac .or. Model%cscnv) then - if (Model%ntcw > 0) then - if (Model%ntoz < Model%ntcw) then - trc_shft = Model%ntcw + Model%ncld - 1 - else - trc_shft = Model%ntoz - endif - elseif (Model%ntoz > 0) then - trc_shft = Model%ntoz - else - trc_shft = 1 - endif + ! tottracer = 0 ! no convective transport of tracers + ! if (Model%trans_trac .or. Model%cscnv) then + ! if (Model%ntcw > 0) then + ! if (Model%ntoz < Model%ntcw) then + ! trc_shft = Model%ntcw + Model%ncld - 1 + ! else + ! trc_shft = Model%ntoz + ! endif + ! elseif (Model%ntoz > 0) then + ! trc_shft = Model%ntoz + ! else + ! trc_shft = 1 + ! endif + ! + ! tracers = Model%ntrac - trc_shft + ! tottracer = tracers + ! if (Model%ntoz > 0) tottracer = tottracer + 1 ! ozone is added separately + ! endif + ! if (Model%ntke > 0) ntk = Model%ntke - trc_shft + 3 - tracers = Model%ntrac - trc_shft - tottracer = tracers - if (Model%ntoz > 0) tottracer = tottracer + 1 ! ozone is added separately - endif - if (Model%ntke > 0) ntk = Model%ntke - trc_shft + 3 ! if (lprnt) write(0,*)' trans_trac=',trans_trac,' tottracer=', & ! write(0,*)' trans_trac=',trans_trac,' tottracer=', & @@ -551,12 +553,14 @@ subroutine GFS_physics_driver & ! &, ntrac-ncld+2,' clstp=',clstp,' kdt=',kdt ! &,' ntk=',ntk,' lat=',lat - skip_macro = .false. + ! skip_macro = .false. + ! + ! allocate ( clw(ix,levs,tottracer+2) ) + ! if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0) then + ! allocate (cnvc(ix,levs), cnvw(ix,levs)) + ! endif - allocate ( clw(ix,levs,tottracer+2) ) - if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0) then - allocate (cnvc(ix,levs), cnvw(ix,levs)) - endif + call GFS_suite_interstitial_1_run (Model, Grid, tottracer, trc_shft, tracers, ntk, skip_macro, clw, cnvc, cnvw) ! ! --- set initial quantities for stochastic physics deltas if (Model%do_sppt) then diff --git a/makefile b/makefile index 5ebbce687..6d475771e 100644 --- a/makefile +++ b/makefile @@ -123,6 +123,7 @@ SRCS_f90 = \ ./physics/get_prs_fv3.f90 \ ./physics/GFS_DCNV_generic.f90 \ ./physics/GFS_PBL_generic.f90 \ + ./physics/GFS_suite_interstitial.f90 \ ./physics/h2ointerp.f90 \ ./physics/m_micro_driver.f90 \ ./physics/module_nst_model.f90 \ diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 index 56646d691..6f8bf0813 100644 --- a/physics/GFS_DCNV_generic.f90 +++ b/physics/GFS_DCNV_generic.f90 @@ -57,7 +57,7 @@ end subroutine GFS_DCNV_generic_post_init subroutine GFS_DCNV_generic_post_finalize () end subroutine GFS_DCNV_generic_post_finalize -!> \section arg_table_GFS_PBL_generic_post_run Argument Table +!> \section arg_table_GFS_DCNV_generic_post_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|-----------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 new file mode 100644 index 000000000..0009e843c --- /dev/null +++ b/physics/GFS_suite_interstitial.f90 @@ -0,0 +1,62 @@ +!> \file GFS_suite_interstitial.f90 +!! Contains code related to more than one scheme in the GFS physics suite. + + module GFS_suite_interstitial_1 + + contains + + subroutine GFS_suite_interstitial_1_init () + end subroutine GFS_suite_interstitial_1_init + + subroutine GFS_suite_interstitial_1_finalize() + end subroutine GFS_suite_interstitial_1_finalize + +!> \section arg_table_GFS_suite_interstitial_1_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | tottracer | number_of_total_tracers | total number of tracers | count | 0 | integer | | out | F | +!! | trc_shft | start_index_of_other_tracers | beginning index of the non-water tracer species | index | 0 | integer | | out | F | +!! | tracers | number_of_water_tracers | number of water-related tracers | index | 0 | integer | | out | F | +!! | ntk | index_of_TKE | index of TKE in the tracer array | index | 0 | integer | | out | F | +!! + subroutine GFS_suite_interstitial_1_run (Model, Grid, tottracer, trc_shft, tracers, ntk, skip_macro, clw, cnvc, cnvw) + + use GFS_typedefs, only: GFS_control_type, GFS_grid_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + integer, intent(out) :: tottracer, trc_shft, tracers, ntk + logical, dimension(size(Grid%xlon,1)), intent(out) :: skip_macro + real(kind=kind_phys), allocatable, intent(out) :: clw(:,:,:), cnvc(:,:), cnvw(:,:) + + tottracer = 0 ! no convective transport of tracers + if (Model%trans_trac .or. Model%cscnv) then + if (Model%ntcw > 0) then + if (Model%ntoz < Model%ntcw) then + trc_shft = Model%ntcw + Model%ncld - 1 + else + trc_shft = Model%ntoz + endif + elseif (Model%ntoz > 0) then + trc_shft = Model%ntoz + else + trc_shft = 1 + endif + + tracers = Model%ntrac - trc_shft + tottracer = tracers + if (Model%ntoz > 0) tottracer = tottracer + 1 ! ozone is added separately + endif + if (Model%ntke > 0) ntk = Model%ntke - trc_shft + 3 + + skip_macro = .false. + + allocate ( clw(size(Grid%xlon,1),Model%levs,tottracer+2) ) + if (Model%imfdeepcnv >= 0 .or. Model%imfshalcnv > 0) then + allocate (cnvc(size(Grid%xlon,1),Model%levs), cnvw(size(Grid%xlon,1),Model%levs)) + endif + + end subroutine GFS_suite_interstitial_1_run + + end module From 5d2eec2f752a013a9509773f1a7851c54848912b Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 16 Nov 2017 11:49:54 -0700 Subject: [PATCH 056/114] added use statement for kind_phys --- physics/GFS_suite_interstitial.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 0009e843c..74d7069a0 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -22,6 +22,7 @@ end subroutine GFS_suite_interstitial_1_finalize !! subroutine GFS_suite_interstitial_1_run (Model, Grid, tottracer, trc_shft, tracers, ntk, skip_macro, clw, cnvc, cnvw) + use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_grid_type type(GFS_control_type), intent(in) :: Model From 6d3d47d155c7f2624448350f0e8847359b1bccd4 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 16 Nov 2017 12:09:03 -0700 Subject: [PATCH 057/114] table updates --- physics/GFS_DCNV_generic.f90 | 2 ++ physics/GFS_suite_interstitial.f90 | 5 +++++ 2 files changed, 7 insertions(+) diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 index 6f8bf0813..b3614888a 100644 --- a/physics/GFS_DCNV_generic.f90 +++ b/physics/GFS_DCNV_generic.f90 @@ -72,6 +72,8 @@ end subroutine GFS_DCNV_generic_post_finalize !! | ud_mf | instantaneous_atmosphere_updraft_convective_mass_flux | (updraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | !! | dd_mf | instantaneous_atmosphere_downdraft_convective_mass_flux | (downdraft mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | !! | dt_mf | instantaneous_atmosphere_detrainment_convective_mass_flux | (detrainment mass flux) * delt | kg m-2 | 2 | real | kind_phys | in | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | +!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | !! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | !! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 0 | GFS_typedefs%GFS_tbd_type | | inout | F | !! diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 74d7069a0..32807ccc9 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -15,10 +15,15 @@ end subroutine GFS_suite_interstitial_1_finalize !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | !! | tottracer | number_of_total_tracers | total number of tracers | count | 0 | integer | | out | F | !! | trc_shft | start_index_of_other_tracers | beginning index of the non-water tracer species | index | 0 | integer | | out | F | !! | tracers | number_of_water_tracers | number of water-related tracers | index | 0 | integer | | out | F | !! | ntk | index_of_TKE | index of TKE in the tracer array | index | 0 | integer | | out | F | +!! | skip_macro | flag_skip_macro | flag to skip cloud macrophysics in Morrison scheme | flag | 1 | logical | | out | F | +!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | out | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | +!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | !! subroutine GFS_suite_interstitial_1_run (Model, Grid, tottracer, trc_shft, tracers, ntk, skip_macro, clw, cnvc, cnvw) From 460b42178ab5effe6a8dda3df6f670c9a205ec0a Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 17 Nov 2017 08:04:41 -0700 Subject: [PATCH 058/114] Removing if in LW --- GFS_layer/GFS_radiation_driver.F90 | 80 +++--------------------------- physics/radiation_surface.f | 6 ++- physics/radlw_main.f | 5 +- 3 files changed, 15 insertions(+), 76 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index e20239810..a3d1771f8 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1957,22 +1957,21 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & LTP) :: htlw0, htlwc - if_lslwr: if (Model%lslwr) then +! if_lslwr: if (Model%lslwr) then ! Setup surface emissivity for LW radiation. call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, & + tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & Radtend%semis) ! --- outputs ! Compute LW heating rates and fluxes. -! if (Model%lwhtr) then -! if (ilwcliq > 0 ) then call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + Model%lslwr, & htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs hlw0=htlw0, & ! --- optional output cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input @@ -1980,79 +1979,10 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) -! else -! call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs -! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & -! gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & -! gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & -! Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & -! tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & -! htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs -! hlw0=htlw0, & ! --- optional output -! cld_od=clouds(:, :, 2)) ! --- optional input -! end if -! else -! if (ilwcliq > 0 ) then -! call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs -! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & -! gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & -! gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & -! Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & -! tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & -! htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs -! cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input -! cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & -! cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& -! cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) -! else -! call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs -! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & -! gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & -! gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & -! Tbd%icsdlw, faerlw(:,:,:,1),faerlw(:,:,:,2), Radtend%semis, & -! tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & -! htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs -! cld_od=clouds(:, :, 2)) ! --- optional input -! end if -! end if - ! Save calculation results - ! Save surface air temp for diurnal adjustment at model t-steps call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) -! Radtend%tsflw (:) = tsfa(:) - -! do k = 1, lm -! k1 = k + kd -! Radtend%htrlw(:,k) = htlwc(:, k1) -! end do -! -! ! Repopulate the points above levr -! if (Model%levr < Model%levs) then -! do k = lm, Model%levs -! Radtend%htrlw (:, k) = Radtend%htrlw (:, lm) -! end do -! end if -! -!! if (Model%lwhtr) then -! do k = 1, lm -! k1 = k + kd -! Radtend%lwhc(:, k) = htlw0(:, k1) -! end do -! -! ! --- repopulate the points above levr -! if (Model%levr < Model%levs) then -! do k = lm, Model%levs -! Radtend%lwhc(:, k) = Radtend%lwhc(:, lm) -! end do -! end if -!! end if -! -! -! ! Radiation fluxes for other physics processes -! Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - - end if if_lslwr +! end if if_lslwr end subroutine Do_lw_rad @@ -2375,6 +2305,8 @@ subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) integer :: k, k1 + if (.not. Model%lslwr) return + Radtend%tsflw (:) = tsfa(:) do k = 1, lm diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 12006c585..7910ba59b 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -639,7 +639,7 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( xlon,xlat,slmsk,snowf,sncovr,zorlf,tsknf,tairf,hprif, & ! --- inputs: - & IMAX, & + & IMAX, lslwr, & & sfcemis & ! --- outputs: & ) @@ -689,6 +689,7 @@ subroutine setemis & real (kind=kind_phys), dimension(:), intent(in) :: & & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif + logical, intent(in) :: lslwr ! --- outputs real (kind=kind_phys), dimension(:), intent(out) :: sfcemis @@ -709,6 +710,9 @@ subroutine setemis & ! !===> ... begin here ! + + if (.not. lslwr) return + !> -# Set sfcemis default to 1.0 or by surface type and condition. if ( iemslw == 0 ) then ! sfc emiss default to 1.0 diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 11e028d1c..819cd1b1e 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -456,7 +456,7 @@ subroutine lwrad & & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & & icseed,aeraod,aerssa,sfemis,sfgtmp, & - & npts, nlay, nlp1, lprnt, cld_cf, & + & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & & hlwc,topflx,sfcflx, & ! --- outputs & HLW0,HLWB,FLXPRF, & !! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & @@ -492,6 +492,7 @@ subroutine lwrad & !! | nlp1 | vertical_level_dimension | vertical level dimension | index | 0 | integer | | in | F | !! | lprnt | flag_to_print | logical flag to print | logical | 0 | logical | | in | F | !! | cld_cf | horizontal_cloud_fraction | horizontal cloud fraction | | 2 | real | kind_phys | in | F | +!! | lslwr | flag_to_calc_lw | logical flag to calculate LW irradiances | logical | 0 | logical | | in | F | !! | hlwc | lw_heating_rate_total_sky | longwave total sky heating rate | K s-1 | 2 | real | kind_phys | out | F | !! | topflx | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | kind_phys | out | F | !! | sfcflx | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | kind_phys | out | F | @@ -719,6 +720,7 @@ subroutine lwrad & & intent(out) :: hlw0 type (proflw_type), dimension(npts,nlp1), optional, & & intent(out) :: flxprf + logical, intent(in) :: lslwr ! --- locals: real (kind=kind_phys), dimension(0:nlp1) :: cldfrc @@ -765,6 +767,7 @@ subroutine lwrad & ! !===> ... begin here ! + if (.not. lslwr) return ! --- ... initialization From e65a5eb37eeea70c79d26baf30f864a1aa2d961f Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 17 Nov 2017 10:09:56 -0700 Subject: [PATCH 059/114] Do not call Do_lw --- GFS_layer/GFS_radiation_driver.F90 | 44 ++++++++++++++++++++++++++---- 1 file changed, 38 insertions(+), 6 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index a3d1771f8..8e0e8e189 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1185,7 +1185,7 @@ subroutine GFS_radiation_driver & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: plyr, tlyr, qlyr, olyr, rhly, tvly, qstl, prslk1, deltaq, & - htswc, htsw0 + htswc, htsw0, htlw0, htlwc real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & 1 + LTP) :: plvl, tlvl real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & @@ -1267,6 +1267,7 @@ subroutine GFS_radiation_driver & ! Start SW radiation calculations ! Setup surface albedo for SW calculation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & @@ -1304,9 +1305,42 @@ subroutine GFS_radiation_driver & call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) ! Start LW radiation calculations - call Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & - Coupling, tsfg, tsfa, im, lmk, lmp, lm, kd, plyr, plvl, & - tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faerlw) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! call Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & +! Coupling, tsfg, tsfa, im, lmk, lmp, lm, kd, plyr, plvl, & +! tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faerlw) + +! ! Local vars +! integer :: k, k1 +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP) :: htlw0, htlwc + + + ! Setup surface emissivity for LW radiation. + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & + Radtend%semis) ! --- outputs + + ! Compute LW heating rates and fluxes. + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + Model%lslwr, & + htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs + hlw0=htlw0, & ! --- optional output + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& + cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) + + ! Save calculation results + call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 ! Collect the fluxr data for wrtsfc @@ -1957,7 +1991,6 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & LTP) :: htlw0, htlwc -! if_lslwr: if (Model%lslwr) then ! Setup surface emissivity for LW radiation. call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & @@ -1982,7 +2015,6 @@ subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & ! Save calculation results call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) -! end if if_lslwr end subroutine Do_lw_rad From 0d42b0ffdded90ec737fc557946685ab7513d600 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 17 Nov 2017 10:26:40 -0700 Subject: [PATCH 060/114] Re-order subs in the radiation driver --- GFS_layer/GFS_radiation_driver.F90 | 119 +++++++++++++++++------------ 1 file changed, 69 insertions(+), 50 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 8e0e8e189..cdfff66b9 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1264,63 +1264,60 @@ subroutine GFS_radiation_driver & deltaq, plvl, plyr, tlyr, qlyr, tvly, & rhly, qstl, clouds, cldsa, mtopa, mbota) + ! Setup surface albedo for SW calculation + call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & + Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & + Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, Model%lsswr, & + sfcalb, Radtend%sfalb) ! --- outputs - ! Start SW radiation calculations - ! Setup surface albedo for SW calculation -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & - Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & - Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, Model%lsswr, & - sfcalb, Radtend%sfalb) ! --- outputs - - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: - gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & - Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & - faersw(:, :, :, 3), sfcalb(:, 1), sfcalb(:,2), sfcalb(:,3), & - sfcalb(:,4), Radtend%coszen, Model%solcon, nday, idxday, im,& - lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs - hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! Optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & - cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - Model%lsswr) - - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - kd, Model%lsswr) - - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + ! Setup surface emissivity for LW radiation. + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & + Radtend%semis) ! --- outputs - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - Grid, Model, nday, Model%lsswr) + call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: + gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & + Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & + faersw(:, :, :, 3), sfcalb(:, 1), sfcalb(:,2), sfcalb(:,3), & + sfcalb(:,4), Radtend%coszen, Model%solcon, nday, idxday, im,& + lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & + htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs + hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! Optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & + cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + ! Start SW radiation calculations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & +! Model%lsswr) +! +! call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & +! kd, Model%lsswr) +! +! ! Surface down and up spectral component fluxes +! ! Save two spectral bands' surface downward and upward fluxes for output. +! call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) +! +! ! Night time: set SW heating rates and fluxes to zero +! call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & +! Grid, Model, nday, Model%lsswr) +! +! call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) +! ! Start LW radiation calculations !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! call Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & -! Coupling, tsfg, tsfa, im, lmk, lmp, lm, kd, plyr, plvl, & -! tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faerlw) - -! ! Local vars -! integer :: k, k1 -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP) :: htlw0, htlwc - - ! Setup surface emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - Radtend%semis) ! --- outputs +! ! Setup surface emissivity for LW radiation. +! call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs +! Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & +! tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & +! Radtend%semis) ! --- outputs ! Compute LW heating rates and fluxes. call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs @@ -1342,6 +1339,28 @@ subroutine GFS_radiation_driver & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! post SW + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + Model%lsswr) + + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + kd, Model%lsswr) + + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + Grid, Model, nday, Model%lsswr) + + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + + ! Start LW radiation calculations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Collect the fluxr data for wrtsfc call Organize_output (Diag, Model, Grid, Radtend, Statein, & From 5af18c01ce46fb353903d1891ab69b358dac6ab9 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 17 Nov 2017 10:31:58 -0700 Subject: [PATCH 061/114] Clean radiation driver --- GFS_layer/GFS_radiation_driver.F90 | 104 ++++++++++------------------- 1 file changed, 37 insertions(+), 67 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index cdfff66b9..c9332ced8 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1264,6 +1264,7 @@ subroutine GFS_radiation_driver & deltaq, plvl, plyr, tlyr, qlyr, tvly, & rhly, qstl, clouds, cldsa, mtopa, mbota) + ! Setup surface albedo for SW calculation call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & @@ -1272,12 +1273,15 @@ subroutine GFS_radiation_driver & Sfcprop%tisfc, im, Model%lsswr, & sfcalb, Radtend%sfalb) ! --- outputs - ! Setup surface emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - Radtend%semis) ! --- outputs + ! Setup surface emissivity for LW radiation. + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & + Radtend%semis) ! --- outputs + + + ! Calculate SW heating and fluxes call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & @@ -1291,75 +1295,41 @@ subroutine GFS_radiation_driver & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - ! Start SW radiation calculations -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & -! Model%lsswr) -! -! call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & -! kd, Model%lsswr) -! -! ! Surface down and up spectral component fluxes -! ! Save two spectral bands' surface downward and upward fluxes for output. -! call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) -! -! ! Night time: set SW heating rates and fluxes to zero -! call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & -! Grid, Model, nday, Model%lsswr) -! -! call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) -! - ! Start LW radiation calculations -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! ! Setup surface emissivity for LW radiation. -! call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs -! Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & -! tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & -! Radtend%semis) ! --- outputs - - ! Compute LW heating rates and fluxes. - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & - Model%lslwr, & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - hlw0=htlw0, & ! --- optional output - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& - cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - - ! Save calculation results - call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1 - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! post SW - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - Model%lsswr) + ! Calculate LW heating rates and fluxes. + call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + Model%lslwr, & + htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs + hlw0=htlw0, & ! --- optional output + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& + cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - kd, Model%lsswr) + ! Save LW results + call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + ! post SW + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + Model%lsswr) - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - Grid, Model, nday, Model%lsswr) + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + kd, Model%lsswr) - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) - ! Start LW radiation calculations -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + Grid, Model, nday, Model%lsswr) + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) ! Collect the fluxr data for wrtsfc From c618a996ed7be7355bf3f4a0b1bdc894de436f25 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 10:49:11 -0700 Subject: [PATCH 062/114] changes to longname table in DCNV_generic and start on GFS_suite_interstitial_2 --- physics/GFS_DCNV_generic.f90 | 1 + physics/GFS_suite_interstitial.f90 | 51 ++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+) diff --git a/physics/GFS_DCNV_generic.f90 b/physics/GFS_DCNV_generic.f90 index b3614888a..5891cbb78 100644 --- a/physics/GFS_DCNV_generic.f90 +++ b/physics/GFS_DCNV_generic.f90 @@ -62,6 +62,7 @@ end subroutine GFS_DCNV_generic_post_finalize !! |----------------|-----------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | !! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | !! | rain1 | instantaneous_rainfall_amount | instantaneous rainfall amount | m | 1 | real | kind_phys | in | F | !! | cld1d | cloud_work_function | cloud work function | m2 s-2 | 1 | real | kind_phys | in | F | diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 32807ccc9..a9f61fd12 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -66,3 +66,54 @@ subroutine GFS_suite_interstitial_1_run (Model, Grid, tottracer, trc_shft, trace end subroutine GFS_suite_interstitial_1_run end module + + module GFS_suite_interstitial_2 + + contains + + subroutine GFS_suite_interstitial_2_init () + end subroutine GFS_suite_interstitial_2_init + + subroutine GFS_suite_interstitial_2_finalize() + end subroutine GFS_suite_interstitial_2_finalize + +!> \section arg_table_GFS_suite_interstitial_2_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! + subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, garea, dudt, dvdt, dtdt, dtdtc, dqdt) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_grid_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + + real(kind=kind_phys), intent(out) :: rhbbot, rhpbl, rhbtop + + integer i + + rhbbot = Model%crtrh(1) + rhpbl = Model%crtrh(2) + rhbtop = Model%crtrh(3) + + frain = Model%dtf / Model%dtp + + do i = 1, size(Grid%xlon,1) + islmsk(i) = nint(Sfcprop%slmsk(i)) + work1(i) = (log(Grid%area(i)) - dxmin) * dxinv + work1(i) = max(0.0, min(1.0,work1(i))) + work2(i) = 1.0 - work1(i) + Diag%psurf(i) = Statein%pgr(i) + garea(i) = Grid%area(i) + end do + + dudt(:,:) = 0. + dvdt(:,:) = 0. + dtdt(:,:) = 0. + dtdtc(:,:) = 0. + dqdt(:,:,:) = 0. + + end subroutine GFS_suite_interstitial_2_run + + end module From e1b121f96655e5f9a090c045f5e18a69e04a0c74 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 12:57:42 -0700 Subject: [PATCH 063/114] GFS_suite_interstitial_2 ready to compile/test --- GFS_layer/GFS_physics_driver.F90 | 35 +++++++++++++++++------------- physics/GFS_suite_interstitial.f90 | 14 +++++++++--- 2 files changed, 31 insertions(+), 18 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 61e5a73ed..f83ba0d8f 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -22,6 +22,7 @@ module module_physics_driver use GFS_DCNV_generic_pre, only: GFS_DCNV_generic_pre_run use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run use GFS_suite_interstitial_1, only: GFS_suite_interstitial_1_run + use GFS_suite_interstitial_2, only: GFS_suite_interstitial_2_run implicit none @@ -605,18 +606,22 @@ subroutine GFS_physics_driver & call get_prs_fv3 (ix, levs, ntrac, Statein%phii, Statein%prsi, & Statein%tgrs, Statein%qgrs, del, del_gz) #endif + + call GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, & + Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, garea, & + dudt, dvdt, dtdt, dtdtc, dqdt ) ! - rhbbot = Model%crtrh(1) - rhpbl = Model%crtrh(2) - rhbtop = Model%crtrh(3) + ! rhbbot = Model%crtrh(1) + ! rhpbl = Model%crtrh(2) + ! rhbtop = Model%crtrh(3) ! ! --- ... frain=factor for centered difference scheme correction of rain amount. - frain = dtf / dtp + ! frain = dtf / dtp do i = 1, im sigmaf(i) = max( Sfcprop%vfrac(i),0.01 ) - islmsk(i) = nint(Sfcprop%slmsk(i)) + ! islmsk(i) = nint(Sfcprop%slmsk(i)) if (islmsk(i) == 2) then if (Model%isot == 1) then @@ -642,17 +647,17 @@ subroutine GFS_physics_driver & ! !GFDL work1(i) = (log(coslat(i) / (nlons(i)*latr)) - dxmin) * dxinv ! work1(i) = (log(Grid%dx(i)) - dxmin) * dxinv - work1(i) = (log(Grid%area(i)) - dxmin) * dxinv - work1(i) = max(0.0, min(1.0,work1(i))) - work2(i) = 1.0 - work1(i) - Diag%psurf(i) = Statein%pgr(i) + ! work1(i) = (log(Grid%area(i)) - dxmin) * dxinv + ! work1(i) = max(0.0, min(1.0,work1(i))) + ! work2(i) = 1.0 - work1(i) + ! Diag%psurf(i) = Statein%pgr(i) work3(i) = Statein%prsik(i,1) / Statein%prslk(i,1) !GFDL tem1 = con_rerth * (con_pi+con_pi)*coslat(i)/nlons(i) !GFDL tem2 = con_rerth * con_pi / latr !GFDL garea(i) = tem1 * tem2 tem1 = Grid%dx(i) tem2 = Grid%dx(i) - garea(i) = Grid%area(i) + ! garea(i) = Grid%area(i) dlength(i) = sqrt( tem1*tem1+tem2*tem2 ) cldf(i) = Model%cgwf(1)*work1(i) + Model%cgwf(2)*work2(i) wcbmax(i) = Model%cs_parm(1)*work1(i) + Model%cs_parm(2)*work2(i) @@ -679,11 +684,11 @@ subroutine GFS_physics_driver & smsoil(:,:) = Sfcprop%smc(:,:) stsoil(:,:) = Sfcprop%stc(:,:) slsoil(:,:) = Sfcprop%slc(:,:) !! clu: slc -> slsoil - dudt(:,:) = 0. - dvdt(:,:) = 0. - dtdt(:,:) = 0. - dtdtc(:,:) = 0. - dqdt(:,:,:) = 0. + ! dudt(:,:) = 0. + ! dvdt(:,:) = 0. + ! dtdt(:,:) = 0. + ! dtdtc(:,:) = 0. + ! dqdt(:,:,:) = 0. ! --- ... initialize dtdt with heating rate from dcyc2 diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index a9f61fd12..020890349 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -84,12 +84,20 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, garea, dudt, dvdt, dtdt, dtdtc, dqdt) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_grid_type + use use physcons, only: dxmin, dxinv + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, GFS_sfcprop_type, GFS_statein_type, GFS_diag_type type(GFS_control_type), intent(in) :: Model type(GFS_grid_type), intent(in) :: Grid - - real(kind=kind_phys), intent(out) :: rhbbot, rhpbl, rhbtop + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_statein_type), intent(in) :: Statein + type(GFS_diag_type), intent(inout) :: Diag + + real(kind=kind_phys), intent(out) :: rhbbot, rhpbl, rhbtop, frain + integer, dimension(size(Grid%xlon,1)), intent(out) :: islmsk + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: work1, work2, garea + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(out) :: dudt, dvdt, dtdt, dtdtc + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,Model%ntrac), intent(out) :: dqdt integer i From f30d707a1cc751a9e4ecebdaad5dfe91a3bf36ff Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 13:02:05 -0700 Subject: [PATCH 064/114] fixed typo in GFS_suite_interstitial.f90 --- physics/GFS_suite_interstitial.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 020890349..3d9625a71 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -84,7 +84,7 @@ end subroutine GFS_suite_interstitial_2_finalize subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, garea, dudt, dvdt, dtdt, dtdtc, dqdt) use machine, only: kind_phys - use use physcons, only: dxmin, dxinv + use physcons, only: dxmin, dxinv use GFS_typedefs, only: GFS_control_type, GFS_grid_type, GFS_sfcprop_type, GFS_statein_type, GFS_diag_type type(GFS_control_type), intent(in) :: Model From 6b377a7dccdba237a7e42fae8ba2a21f2239b505 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 14:44:34 -0700 Subject: [PATCH 065/114] commit of uncompiled/untested GFS_suite_interstitial_3 --- GFS_layer/GFS_physics_driver.F90 | 97 +++++++++++------------ physics/GFS_suite_interstitial.f90 | 120 +++++++++++++++++++++++++++-- 2 files changed, 163 insertions(+), 54 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index f83ba0d8f..f9f3e036c 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -608,7 +608,7 @@ subroutine GFS_physics_driver & #endif call GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, & - Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, garea, & + Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, & dudt, dvdt, dtdt, dtdtc, dqdt ) ! ! rhbbot = Model%crtrh(1) @@ -657,7 +657,7 @@ subroutine GFS_physics_driver & !GFDL garea(i) = tem1 * tem2 tem1 = Grid%dx(i) tem2 = Grid%dx(i) - ! garea(i) = Grid%area(i) + garea(i) = Grid%area(i) dlength(i) = sqrt( tem1*tem1+tem2*tem2 ) cldf(i) = Model%cgwf(1)*work1(i) + Model%cgwf(2)*work2(i) wcbmax(i) = Model%cs_parm(1)*work1(i) + Model%cs_parm(2)*work2(i) @@ -764,52 +764,53 @@ subroutine GFS_physics_driver & gabsbdlw(:) = Radtend%semis(:) * adjsfcdlw(:) - if (Model%lssav) then ! --- ... accumulate/save output variables - -! --- ... sunshine duration time is defined as the length of time (in mdl output -! interval) that solar radiation falling on a plane perpendicular to the -! direction of the sun >= 120 w/m2 - - do i = 1, im - if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg - tem1 = adjsfcdsw(i) / xcosz(i) - if ( tem1 >= 120.0 ) then - Diag%suntim(i) = Diag%suntim(i) + dtf - endif - endif - enddo - -! --- ... sfc lw fluxes used by atmospheric model are saved for output - - if (Model%cplflx) then - do i = 1, im - if (flag_cice(i)) adjsfculw(i) = ulwsfc_cice(i) - enddo - endif - Diag%dlwsfc(:) = Diag%dlwsfc(:) + adjsfcdlw(:)*dtf - Diag%ulwsfc(:) = Diag%ulwsfc(:) + adjsfculw(:)*dtf - Diag%psmean(:) = Diag%psmean(:) + Statein%pgr(:)*dtf ! mean surface pressure - - if (Model%ldiag3d) then - if (Model%lsidea) then - Diag%dt3dt(:,:,1) = Diag%dt3dt(:,:,1) + Radtend%lwhd(:,:,1)*dtf - Diag%dt3dt(:,:,2) = Diag%dt3dt(:,:,2) + Radtend%lwhd(:,:,2)*dtf - Diag%dt3dt(:,:,3) = Diag%dt3dt(:,:,3) + Radtend%lwhd(:,:,3)*dtf - Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + Radtend%lwhd(:,:,4)*dtf - Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + Radtend%lwhd(:,:,5)*dtf - Diag%dt3dt(:,:,6) = Diag%dt3dt(:,:,6) + Radtend%lwhd(:,:,6)*dtf - else - do k = 1, levs - Diag%dt3dt(:,k,1) = Diag%dt3dt(:,k,1) + Radtend%htrlw(:,k)*dtf - Diag%dt3dt(:,k,2) = Diag%dt3dt(:,k,2) + Radtend%htrsw(:,k)*dtf*xmu(:) - enddo - endif - endif - endif ! end if_lssav_block - +! if (Model%lssav) then ! --- ... accumulate/save output variables +! +! ! --- ... sunshine duration time is defined as the length of time (in mdl output +! ! interval) that solar radiation falling on a plane perpendicular to the +! ! direction of the sun >= 120 w/m2 +! +! do i = 1, im +! if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg +! tem1 = adjsfcdsw(i) / xcosz(i) +! if ( tem1 >= 120.0 ) then +! Diag%suntim(i) = Diag%suntim(i) + dtf +! endif +! endif +! enddo +! +! ! --- ... sfc lw fluxes used by atmospheric model are saved for output +! +! if (Model%cplflx) then +! do i = 1, im +! if (flag_cice(i)) adjsfculw(i) = ulwsfc_cice(i) +! enddo +! endif +! Diag%dlwsfc(:) = Diag%dlwsfc(:) + adjsfcdlw(:)*dtf +! Diag%ulwsfc(:) = Diag%ulwsfc(:) + adjsfculw(:)*dtf +! Diag%psmean(:) = Diag%psmean(:) + Statein%pgr(:)*dtf ! mean surface pressure +! +! if (Model%ldiag3d) then +! if (Model%lsidea) then +! Diag%dt3dt(:,:,1) = Diag%dt3dt(:,:,1) + Radtend%lwhd(:,:,1)*dtf +! Diag%dt3dt(:,:,2) = Diag%dt3dt(:,:,2) + Radtend%lwhd(:,:,2)*dtf +! Diag%dt3dt(:,:,3) = Diag%dt3dt(:,:,3) + Radtend%lwhd(:,:,3)*dtf +! Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + Radtend%lwhd(:,:,4)*dtf +! Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + Radtend%lwhd(:,:,5)*dtf +! Diag%dt3dt(:,:,6) = Diag%dt3dt(:,:,6) + Radtend%lwhd(:,:,6)*dtf +! else +! do k = 1, levs +! Diag%dt3dt(:,k,1) = Diag%dt3dt(:,k,1) + Radtend%htrlw(:,k)*dtf +! Diag%dt3dt(:,k,2) = Diag%dt3dt(:,k,2) + Radtend%htrsw(:,k)*dtf*xmu(:) +! enddo +! endif +! endif +! endif ! end if_lssav_block + call GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, & + adjsfcdsw, adjsfcdlw, adjsfculw, xmu, kcnv, hflx, evap, Diag) call GFS_PBL_generic_pre_run (im, levs, kinver) - kcnv(:) = 0 + !kcnv(:) = 0 !kinver(:) = levs invrsn(:) = .false. tx1(:) = 0.0 @@ -866,8 +867,8 @@ subroutine GFS_physics_driver & drain(:) = 0.0 ep1d(:) = 0.0 runof(:) = 0.0 - hflx(:) = 0.0 - evap(:) = 0.0 + !hflx(:) = 0.0 + !evap(:) = 0.0 evbs(:) = 0.0 evcw(:) = 0.0 trans(:) = 0.0 diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 3d9625a71..cfdbf511a 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -78,10 +78,27 @@ subroutine GFS_suite_interstitial_2_finalize() end subroutine GFS_suite_interstitial_2_finalize !> \section arg_table_GFS_suite_interstitial_2_run Argument Table -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | +!! | Statein | FV3-GFS_Statein_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_statein_type | | in | F | +!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | rhbbot | critical_relative_humidity_at_surface | critical relative humidity at the surface | frac | 0 | real | kind_phys | out | F | +!! | rhpbl | critical_relative_humidity_at_PBL_top | critical relative humidity at the PBL top | frac | 0 | real | kind_phys | out | F | +!! | rhbtop | critical_relative_humidity_at_top_of_atmosphere | critical relative humidity at the top of atmosphere | frac | 0 | real | kind_phys | out | F | +!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | out | F | +!! | islmsk | sea_land_ice_mask | landmask: sea/land/ice=0/1/2 | flag | 1 | integer | | out | F | +!! | work1 | grid_related_coefficient | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | out | F | +!! | work2 | grid_related_coefficient_complement | complement to work1 | none | 1 | real | kind_phys | out | F | +!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | out | F | +!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | out | F | +!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | out | F | +!! | dtdtc | tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky | clear sky radiative (shortwave + longwave) heating rate at current time | K s-1 | 2 | real | kind_phys | out | F | +!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | out | F | !! - subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, garea, dudt, dvdt, dtdt, dtdtc, dqdt) + subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rhbbot, rhpbl, rhbtop, frain, islmsk, work1, work2, dudt, dvdt, dtdt, dtdtc, dqdt) use machine, only: kind_phys use physcons, only: dxmin, dxinv @@ -95,11 +112,11 @@ subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rh real(kind=kind_phys), intent(out) :: rhbbot, rhpbl, rhbtop, frain integer, dimension(size(Grid%xlon,1)), intent(out) :: islmsk - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: work1, work2, garea + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: work1, work2 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(out) :: dudt, dvdt, dtdt, dtdtc real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs,Model%ntrac), intent(out) :: dqdt - integer i + integer :: i rhbbot = Model%crtrh(1) rhpbl = Model%crtrh(2) @@ -113,7 +130,6 @@ subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rh work1(i) = max(0.0, min(1.0,work1(i))) work2(i) = 1.0 - work1(i) Diag%psurf(i) = Statein%pgr(i) - garea(i) = Grid%area(i) end do dudt(:,:) = 0. @@ -125,3 +141,95 @@ subroutine GFS_suite_interstitial_2_run (Model, Grid, Sfcprop, Statein, Diag, rh end subroutine GFS_suite_interstitial_2_run end module + + module GFS_suite_interstitial_3 + + contains + + subroutine GFS_suite_interstitial_3_init () + end subroutine GFS_suite_interstitial_3_init + + subroutine GFS_suite_interstitial_3_finalize() + end subroutine GFS_suite_interstitial_3_finalize + +!> \section arg_table_GFS_suite_interstitial_3_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | tottracer | number_of_total_tracers | total number of tracers | count | 0 | integer | | out | F | +!! | trc_shft | start_index_of_other_tracers | beginning index of the non-water tracer species | index | 0 | integer | | out | F | +!! | tracers | number_of_water_tracers | number of water-related tracers | index | 0 | integer | | out | F | +!! | ntk | index_of_TKE | index of TKE in the tracer array | index | 0 | integer | | out | F | +!! | skip_macro | flag_skip_macro | flag to skip cloud macrophysics in Morrison scheme | flag | 1 | logical | | out | F | +!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | out | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | +!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | +!! + subroutine GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, adjsfcdsw, adjsfcdlw, adjsfculw, xmu, kcnv, hflx, evap, Diag) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, GFS_statein_type, GFS_radtend_type, GFS_diag_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + type(GFS_statein_type), intent(in) :: Statein + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(inout) :: Diag + + integer, dimension(size(Grid%xlon,1)), intent(out) :: kcnv + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: xcosz, adjsfcdsw, adjsfcdlw, adjsfculw, xmu + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: hflx, evap + + real(kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) + + integer :: i + + real(kind=kind_phys) :: tem1 + + if (Model%lssav) then ! --- ... accumulate/save output variables + + ! --- ... sunshine duration time is defined as the length of time (in mdl output + ! interval) that solar radiation falling on a plane perpendicular to the + ! direction of the sun >= 120 w/m2 + + do i = 1, size(Grid%xlon,1) + if ( xcosz(i) >= czmin ) then ! zenth angle > 89.994 deg + tem1 = adjsfcdsw(i) / xcosz(i) + if ( tem1 >= 120.0 ) then + Diag%suntim(i) = Diag%suntim(i) + Model%dtf + endif + endif + enddo + + ! --- ... sfc lw fluxes used by atmospheric model are saved for output + + Diag%dlwsfc(:) = Diag%dlwsfc(:) + adjsfcdlw(:)*Model%dtf + Diag%ulwsfc(:) = Diag%ulwsfc(:) + adjsfculw(:)*Model%dtf + Diag%psmean(:) = Diag%psmean(:) + Statein%pgr(:)*Model%dtf ! mean surface pressure + + if (Model%ldiag3d) then + if (Model%lsidea) then + Diag%dt3dt(:,:,1) = Diag%dt3dt(:,:,1) + Radtend%lwhd(:,:,1)*Model%dtf + Diag%dt3dt(:,:,2) = Diag%dt3dt(:,:,2) + Radtend%lwhd(:,:,2)*Model%dtf + Diag%dt3dt(:,:,3) = Diag%dt3dt(:,:,3) + Radtend%lwhd(:,:,3)*Model%dtf + Diag%dt3dt(:,:,4) = Diag%dt3dt(:,:,4) + Radtend%lwhd(:,:,4)*Model%dtf + Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + Radtend%lwhd(:,:,5)*Model%dtf + Diag%dt3dt(:,:,6) = Diag%dt3dt(:,:,6) + Radtend%lwhd(:,:,6)*Model%dtf + else + do k = 1, Model%levs + Diag%dt3dt(:,k,1) = Diag%dt3dt(:,k,1) + Radtend%htrlw(:,k)*Model%dtf + Diag%dt3dt(:,k,2) = Diag%dt3dt(:,k,2) + Radtend%htrsw(:,k)*Model%dtf*xmu(:) + enddo + endif + endif + endif ! end if_lssav_block + + kcnv(:) = 0 + + hflx(:) = 0.0 + evap(:) = 0.0 + + end subroutine GFS_suite_interstitial_3_run + +end module From da922399cf74a111f684326a7cf6171dbfc44bab Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 15:00:04 -0700 Subject: [PATCH 066/114] added use GFS_suite_interstitial_3 to driver --- GFS_layer/GFS_physics_driver.F90 | 3 ++- physics/GFS_suite_interstitial.f90 | 31 ++++++++++++++++-------------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index f9f3e036c..36e0c7c21 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -23,6 +23,7 @@ module module_physics_driver use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run use GFS_suite_interstitial_1, only: GFS_suite_interstitial_1_run use GFS_suite_interstitial_2, only: GFS_suite_interstitial_2_run + use GFS_suite_interstitial_3, only: GFS_suite_interstitial_3_run implicit none @@ -807,7 +808,7 @@ subroutine GFS_physics_driver & ! endif ! endif ! end if_lssav_block call GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, & - adjsfcdsw, adjsfcdlw, adjsfculw, xmu, kcnv, hflx, evap, Diag) + adjsfcdsw, adjsfcdlw, adjsfculw, xmu, Diag, kcnv, hflx, evap) call GFS_PBL_generic_pre_run (im, levs, kinver) !kcnv(:) = 0 diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index cfdbf511a..284a03183 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -153,20 +153,23 @@ subroutine GFS_suite_interstitial_3_finalize() end subroutine GFS_suite_interstitial_3_finalize !> \section arg_table_GFS_suite_interstitial_3_run Argument Table -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| -!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | -!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | -!! | tottracer | number_of_total_tracers | total number of tracers | count | 0 | integer | | out | F | -!! | trc_shft | start_index_of_other_tracers | beginning index of the non-water tracer species | index | 0 | integer | | out | F | -!! | tracers | number_of_water_tracers | number of water-related tracers | index | 0 | integer | | out | F | -!! | ntk | index_of_TKE | index of TKE in the tracer array | index | 0 | integer | | out | F | -!! | skip_macro | flag_skip_macro | flag to skip cloud macrophysics in Morrison scheme | flag | 1 | logical | | out | F | -!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | out | F | -!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Statein | FV3-GFS_Statein_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_statein_type | | in | F | +!! | Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies needed in physics | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | +!! | xcosz | instantaneous_cosine_of_zenith_angle | cosine of zenith angle at current time | none | 1 | real | kind_phys | in | F | +!! | adjsfcdsw | surface_downwelling_shortwave_flux | surface downwelling shortwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | +!! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | +!! | adjsfculw | surface_upwelling_longwave_flux | surface upwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | +!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave fluxes | none | 1 | real | kind_phys | in | F | +!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | kcnv | flag_deep_convection | flag indicating whether convection occurs in column (0 or 1) | index | 1 | integer | | out | F | +!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | out | F | +!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | out | F | !! - subroutine GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, adjsfcdsw, adjsfcdlw, adjsfculw, xmu, kcnv, hflx, evap, Diag) + subroutine GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, adjsfcdsw, adjsfcdlw, adjsfculw, xmu, Diag, kcnv, hflx, evap) use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type, GFS_grid_type, GFS_statein_type, GFS_radtend_type, GFS_diag_type @@ -178,7 +181,7 @@ subroutine GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, a type(GFS_diag_type), intent(inout) :: Diag integer, dimension(size(Grid%xlon,1)), intent(out) :: kcnv - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: xcosz, adjsfcdsw, adjsfcdlw, adjsfculw, xmu + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: xcosz, adjsfcdsw, adjsfcdlw, adjsfculw, xmu real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: hflx, evap real(kind=kind_phys), parameter :: czmin = 0.0001 ! cos(89.994) From 0af598076f2116db61f611d5f2aefec767d5fb72 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 17 Nov 2017 15:15:49 -0700 Subject: [PATCH 067/114] Adding pre and post radiation subs --- GFS_layer/GFS_radiation_driver.F90 | 446 +++++++++++++---------------- 1 file changed, 203 insertions(+), 243 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index c9332ced8..b595fa399 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1202,83 +1202,13 @@ subroutine GFS_radiation_driver & type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw - ! Set commonly used integers - call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) - - - !Set local /level/layer indexes corresponding - ! to in/out variables - call Set_local_int (lmk, lm, lmp, kd, kt, & - kb, lla, llb, lya, lyb, lp1, raddt, Model) - - - ! Setup surface ground temperature and - ! ground/air skin temperature if required. - call Set_sfc_vars (IM, tskn, tsfg, Sfcprop, Grid) - - - ! Prepare atmospheric profiles. - ! Convert pressure unit from pa to mb - call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & - prslk1, rhly, qstl, Model, Grid) - - - ! Recast remaining all tracers (except sphum) - ! forcing them all to be positive - call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & - qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & - lla, lya, lyb) - - - ! Get layer ozone mass mixing ratio - call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) - - - ! Compute cosine of zenith angle. - call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & - im, me, Radtend%coszen, Radtend%coszdg) - - - ! Set up non-prognostic gas volume mixing ratioes - call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) - - - ! Get temperature at layer interface, and layer moisture. - call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & - im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) - - - ! Check for daytime points for SW radiation. - call Find_daytime (im, Radtend, Grid, nday, idxday) - - - ! Setup aerosols - call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & - tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & - Model%lslwr, faersw,faerlw,aerodp) - - - ! Obtain cloud information - call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & - Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & - deltaq, plvl, plyr, tlyr, qlyr, tvly, & - rhly, qstl, clouds, cldsa, mtopa, mbota) - - - ! Setup surface albedo for SW calculation - call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & - Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & - Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, Model%lsswr, & - sfcalb, Radtend%sfalb) ! --- outputs - - - ! Setup surface emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - Radtend%semis) ! --- outputs + call Pre_radiation (Model, Grid, lm, me, im, ntrac, & + lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & + tskn, tsfg, Sfcprop, Statein, plvl, plyr, & + tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & + gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & + faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & + mtopa, mbota, sfcalb) ! Calculate SW heating and fluxes @@ -1311,31 +1241,10 @@ subroutine GFS_radiation_driver & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - ! Save LW results - call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - - ! post SW - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - Model%lsswr) - - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - kd, Model%lsswr) - - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) - - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - Grid, Model, nday, Model%lsswr) - - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) - - - ! Collect the fluxr data for wrtsfc - call Organize_output (Diag, Model, Grid, Radtend, Statein, & - Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & - mtopa, mbota, clouds, aerodp) + call Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & + Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & + nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & + clouds, aerodp) end subroutine GFS_radiation_driver @@ -1867,147 +1776,6 @@ subroutine Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & end subroutine Get_cloud_info -! subroutine Do_sw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & -! Coupling, im, lm, kd, lmk, lmp, tsfg, tsfa, nday, idxday, & -! plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr, clouds, faersw, & -! scmpsw) -! -! implicit none -! -! type(GFS_control_type), intent(in) :: Model -! type(GFS_grid_type), intent(in) :: Grid -! type(GFS_sfcprop_type), intent(in) :: Sfcprop -! type(GFS_radtend_type), intent(inout) :: Radtend -! type(GFS_tbd_type), intent(in) :: Tbd -! type(GFS_diag_type), intent(inout) :: Diag -! type(GFS_coupling_type), intent(inout) :: Coupling -! -! integer, intent(in) :: im, lm, kd, lmk, lmp, nday -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfg, tsfa -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP), intent(in) :: plyr, tlyr, qlyr, olyr -! integer, dimension(Size (Grid%xlon, 1)), intent(in) :: idxday -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NF_VGAS), intent(in) :: gasvmr -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NF_CLDS), intent(in) :: clouds -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NBDSW, NF_AESW), intent(in)::faersw -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! 1 + LTP), intent(in) :: plvl, tlvl -! -! type (cmpfsw_type), dimension(size(Grid%xlon, 1)), intent(out) :: scmpsw -! -! ! Local vars -! integer :: k, k1 -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP) :: htswc, htsw0 -! -! ! Setup surface albedo for SW calculation -! call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: -! Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& -! tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & -! Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & -! Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & -! Sfcprop%tisfc, im, Model%lsswr, & -! sfcalb, Radtend%sfalb) ! --- outputs -! -! call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & -! gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & -! gasvmr(:, :, 4), & -! Tbd%icsdsw, faersw(:, :, :, 1), & -! faersw(:, :, :, 2), faersw(:, :, :, 3), & -! sfcalb(:, 1), sfcalb(:,2), & -! sfcalb(:,3), sfcalb(:,4), & -! Radtend%coszen, Model%solcon, & -! nday, idxday, im, lmk, lmp, Model%lprnt,& -! clouds(:,:,1), Model%lsswr, & -! htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs -! hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs -! cld_lwp=clouds(:, :, 2), & ! Optional input -! cld_ref_liq=clouds(:, :, 3), cld_iwp=clouds(:, :, 4), & -! cld_ref_ice=clouds(:, :, 5), cld_rwp=clouds(:, :, 6), & -! cld_ref_rain=clouds(:, :, 7), cld_swp=clouds(:, :, 8), & -! cld_ref_snow=clouds(:, :, 9)) -! -! call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, Model%lsswr) -! -! call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, Model%lsswr) -! -! ! Surface down and up spectral component fluxes -! ! Save two spectral bands' surface downward and upward fluxes for output. -! call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) -! -! ! Night time: set SW heating rates and fluxes to zero -! call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, Model%lsswr) -! -! call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) -! -! end subroutine Do_sw_rad - - - subroutine Do_lw_rad (Model, Grid, Sfcprop, Radtend, Tbd, Diag, & - Coupling, tsfg, tsfa, im, lmk, lmp, lm, kd, plyr, plvl, tlyr, & - tlvl, qlyr, olyr, gasvmr, clouds, faerlw) - - implicit none - - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_tbd_type), intent(in) :: Tbd - type(GFS_diag_type), intent(inout) :: Diag - type(GFS_coupling_type), intent(inout) :: Coupling - - integer, intent(in) :: im, lmk, lmp, kd, lm - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: plyr, tlyr, qlyr, olyr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfg, tsfa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(in) :: plvl, tlvl - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_VGAS), intent(in) :: gasvmr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(in) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NBDLW, NF_AELW), intent(in)::faerlw - - ! Local vars - integer :: k, k1 - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP) :: htlw0, htlwc - - - ! Setup surface emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - Radtend%semis) ! --- outputs - - ! Compute LW heating rates and fluxes. - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & - Model%lslwr, & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - hlw0=htlw0, & ! --- optional output - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& - cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) - - ! Save calculation results - call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - - - end subroutine Do_lw_rad - - !> - For time averaged output quantities (including total-sky and !! clear-sky SW and LW fluxes at TOA and surface; conventional !! 3-domain cloud amount, cloud top and base pressure, and cloud top @@ -2361,6 +2129,198 @@ subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) end subroutine Post_lw + subroutine Pre_radiation (Model, Grid, lm, me, im, ntrac, & + lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & + tskn, tsfg, Sfcprop, Statein, plvl, plyr, & + tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & + gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & + faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & + mtopa, mbota, sfcalb) + + + implicit none + + integer, intent(inout) :: me, lm, im, lp1, ntrac + integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_statein_type), intent(in) :: Statein + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + + integer, intent(out) :: nday + integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday + real(kind=kind_phys), intent(out) :: raddt + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn + real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + 1 + LTP), intent(inout) :: plvl + real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & + LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl + real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, 2:Model%ntrac), intent(inout) :: tracer1 + real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(inout) :: olyr + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, NF_VGAS), intent(inout) :: gasvmr + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + 1 + LTP), intent(inout) :: tlvl + real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(inout) :: tsfa + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(inout) :: qlyr, tvly + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, NBDSW, NF_AESW), intent(inout) :: faersw + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, NBDLW, NF_AELW), intent(inout) :: faerlw + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(inout) :: aerodp + real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & + LTP), intent(out) :: deltaq + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, NF_CLDS), intent(inout) :: clouds + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa + integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa + real (kind = kind_phys), dimension(im, NF_ALBD), intent(out) :: sfcalb + + + ! Set commonly used integers + call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) + + !Set local /level/layer indexes corresponding + ! to in/out variables + call Set_local_int (lmk, lm, lmp, kd, kt, & + kb, lla, llb, lya, lyb, lp1, raddt, Model) + + + ! Setup surface ground temperature and + ! ground/air skin temperature if required. + call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) + + + ! Prepare atmospheric profiles. + ! Convert pressure unit from pa to mb + call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & + prslk1, rhly, qstl, Model, Grid) + + + ! Recast remaining all tracers (except sphum) + ! forcing them all to be positive + call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & + qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & + lla, lya, lyb) + + + ! Get layer ozone mass mixing ratio + call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) + + + ! Compute cosine of zenith angle. + call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & + im, me, Radtend%coszen, Radtend%coszdg) + + + ! Set up non-prognostic gas volume mixing ratioes + call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) + + + ! Get temperature at layer interface, and layer moisture. + call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & + im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) + + + ! Check for daytime points for SW radiation. + call Find_daytime (im, Radtend, Grid, nday, idxday) + + + ! Setup aerosols + call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & + tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & + Model%lslwr, faersw,faerlw,aerodp) + + + ! Obtain cloud information + call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & + Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & + deltaq, plvl, plyr, tlyr, qlyr, tvly, & + rhly, qstl, clouds, cldsa, mtopa, mbota) + + + ! Setup surface albedo for SW calculation + call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & + Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & + Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, im, Model%lsswr, & + sfcalb, Radtend%sfalb) ! --- outputs + + + ! Setup surface emissivity for LW radiation. + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & + Radtend%semis) ! --- outputs + + + end subroutine Pre_radiation + + subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & + Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & + nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & + clouds, aerodp) + + implicit none + + integer, intent(in) :: lm, kd, im, kt, kb + type(GFS_grid_type), intent(in) :: Grid + type(GFS_control_type), intent(in) :: Model + type(GFS_statein_type), intent(in) :: Statein + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_diag_type), intent(inout) :: Diag + + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(in) :: htlw0, htlwc, htswc, htsw0 + real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfa + type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb + integer, intent(in) :: nday + real(kind = kind_phys), intent(in) :: raddt + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(in) :: cldsa + integer, dimension(size(Grid%xlon, 1), 3), intent(in) :: mbota, mtopa + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, NF_CLDS), intent(in) :: clouds + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(in) :: aerodp + + + ! Save LW results + call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) + + ! post SW + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + Model%lsswr) + + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + kd, Model%lsswr) + + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + Grid, Model, nday, Model%lsswr) + + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + + + ! Collect the fluxr data for wrtsfc + call Organize_output (Diag, Model, Grid, Radtend, Statein, & + Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & + mtopa, mbota, clouds, aerodp) + + end subroutine Post_radiation + + ! !> @} !........................................! From f43067f2b34a17f2f4a5477b077a1eacd9dcb079 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 15:24:35 -0700 Subject: [PATCH 068/114] added GFS_suite_update_stateout --- GFS_layer/GFS_physics_driver.F90 | 19 +++++++------ physics/GFS_suite_interstitial.f90 | 43 ++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 8 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 36e0c7c21..9236343ed 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -24,6 +24,7 @@ module module_physics_driver use GFS_suite_interstitial_1, only: GFS_suite_interstitial_1_run use GFS_suite_interstitial_2, only: GFS_suite_interstitial_2_run use GFS_suite_interstitial_3, only: GFS_suite_interstitial_3_run + use GFS_suite_update_stateout, only: GFS_suite_update_stateout_run implicit none @@ -1085,10 +1086,10 @@ subroutine GFS_physics_driver & Diag%uswsfci(:) = adjsfcdsw(:) - adjsfcnsw(:) Diag%dswsfci(:) = adjsfcdsw(:) Diag%gfluxi(:) = gflx(:) - Diag%t1(:) = Statein%tgrs(:,1) - Diag%q1(:) = Statein%qgrs(:,1,1) - Diag%u1(:) = Statein%ugrs(:,1) - Diag%v1(:) = Statein%vgrs(:,1) + ! Diag%t1(:) = Statein%tgrs(:,1) + ! Diag%q1(:) = Statein%qgrs(:,1,1) + ! Diag%u1(:) = Statein%ugrs(:,1) + ! Diag%v1(:) = Statein%vgrs(:,1) ! --- ... update near surface fields @@ -1428,10 +1429,12 @@ subroutine GFS_physics_driver & ! write(0,*)' dtdt=',(dtdt(ipr,ik),k=1,10) ! endif - Stateout%gt0(:,:) = Statein%tgrs(:,:) + dtdt(:,:) * dtp - Stateout%gu0(:,:) = Statein%ugrs(:,:) + dudt(:,:) * dtp - Stateout%gv0(:,:) = Statein%vgrs(:,:) + dvdt(:,:) * dtp - Stateout%gq0(:,:,:) = Statein%qgrs(:,:,:) + dqdt(:,:,:) * dtp + ! Stateout%gt0(:,:) = Statein%tgrs(:,:) + dtdt(:,:) * dtp + ! Stateout%gu0(:,:) = Statein%ugrs(:,:) + dudt(:,:) * dtp + ! Stateout%gv0(:,:) = Statein%vgrs(:,:) + dvdt(:,:) * dtp + ! Stateout%gq0(:,:,:) = Statein%qgrs(:,:,:) + dqdt(:,:,:) * dtp + + call GFS_suite_update_stateout_run (Statein, Model, Grid, dudt, dvdt, dtdt, dqdt, Stateout) ! if (lprnt) then ! write(7000,*)' ugrs=',ugrs(ipr,:) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 284a03183..41afb730e 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -233,6 +233,49 @@ subroutine GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, a hflx(:) = 0.0 evap(:) = 0.0 + Diag%t1(:) = Statein%tgrs(:,1) + Diag%q1(:) = Statein%qgrs(:,1,1) + Diag%u1(:) = Statein%ugrs(:,1) + Diag%v1(:) = Statein%vgrs(:,1) + end subroutine GFS_suite_interstitial_3_run + module GFS_suite_update_stateout + + contains + + subroutine GFS_suite_update_stateout_init () + end subroutine GFS_suite_update_stateout_init + + subroutine GFS_suite_update_stateout_finalize() + end subroutine GFS_suite_update_stateout_finalize + +!> \section arg_table_GFS_suite_update_stateout_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | +!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | +!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | +!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | +!! + subroutine GFS_suite_update_stateout_run (Statein, Model, Grid, dudt, dvdt, dtdt, dqdt, Stateout) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, GFS_grid_type, GFS_stateout_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_statein_type), intent(in) :: Statein + type(GFS_grid_type), intent(in) :: Grid + type(GFS_stateout_type), intent(inout) :: Stateout + + real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levs), intent(in) :: dudt, dvdt, dtdt + real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levs, Model%ntrac), intent(in) :: dqdt + + Stateout%gt0(:,:) = Statein%tgrs(:,:) + dtdt(:,:) * Model%dtp + Stateout%gu0(:,:) = Statein%ugrs(:,:) + dudt(:,:) * Model%dtp + Stateout%gv0(:,:) = Statein%vgrs(:,:) + dvdt(:,:) * Model%dtp + Stateout%gq0(:,:,:) = Statein%qgrs(:,:,:) + dqdt(:,:,:) * Model%dtp + + end subroutine GFS_suite_update_stateout_run + end module From 8f02530d787d9c222bc98a50897586be08619f3c Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 15:30:49 -0700 Subject: [PATCH 069/114] table for GFS_suite_update_stateout --- physics/GFS_suite_interstitial.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 41afb730e..e0b34bce0 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -251,12 +251,16 @@ subroutine GFS_suite_update_stateout_finalize() end subroutine GFS_suite_update_stateout_finalize !> \section arg_table_GFS_suite_update_stateout_run Argument Table -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Statein | FV3-GFS_Statein_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_statein_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | !! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | !! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | !! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | !! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | +!! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | inout | F | !! subroutine GFS_suite_update_stateout_run (Statein, Model, Grid, dudt, dvdt, dtdt, dqdt, Stateout) From cf6ce384e18a03d6ea4e43e87528330fd6f52a77 Mon Sep 17 00:00:00 2001 From: "Pedro A. Jimenez" Date: Fri, 17 Nov 2017 15:33:19 -0700 Subject: [PATCH 070/114] Moving SW and LW tables --- GFS_layer/GFS_radiation_driver.F90 | 36 +++++++++++----------- physics/radlw_main.f | 35 +++++++++++---------- physics/radsw_main.f | 49 +++++++++++++++++------------- 3 files changed, 65 insertions(+), 55 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index b595fa399..413b8a5f1 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -2292,31 +2292,31 @@ subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(in) :: aerodp - ! Save LW results - call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) + ! Save LW results + call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - ! post SW - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - Model%lsswr) + ! post SW + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + Model%lsswr) - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - kd, Model%lsswr) + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + kd, Model%lsswr) - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - Grid, Model, nday, Model%lsswr) + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + Grid, Model, nday, Model%lsswr) - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) - ! Collect the fluxr data for wrtsfc - call Organize_output (Diag, Model, Grid, Radtend, Statein, & - Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & - mtopa, mbota, clouds, aerodp) + ! Collect the fluxr data for wrtsfc + call Organize_output (Diag, Model, Grid, Radtend, Statein, & + Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & + mtopa, mbota, clouds, aerodp) end subroutine Post_radiation diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 819cd1b1e..43ff6dc5d 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -448,25 +448,10 @@ module module_radlw_main ! !!\n upfxc - total sky upward flux !!\n dnfx0 - clear sky downward flux !!\n upfx0 - clear sky upward flux -!> \section gen_lwrad General Algorithm -!> @{ -! -------------------------------- - subroutine lwrad & - & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs - & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & - & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & - & icseed,aeraod,aerssa,sfemis,sfgtmp, & - & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & - & hlwc,topflx,sfcflx, & ! --- outputs - & HLW0,HLWB,FLXPRF, & !! --- optional - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od & - & ) !! \section arg_table_swrad !! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| +!! |-----------------|-----------------------------------------|--------------------------------------------------------|---------|------|-------------|-----------|--------|----------| !! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | !! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | !! | tlyr | air_temperature | air temperature layer | K | 2 | real | kind_phys | in | F | @@ -509,6 +494,24 @@ subroutine lwrad & !! | cld_ref_snow | effective_radious_snow_hydrometeor | effective radious snow hydrometeor | micron | 2 | real | kind_phys | in | T | !! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | + +!> \section gen_lwrad General Algorithm +!> @{ +! -------------------------------- + subroutine lwrad & + & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs + & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & + & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & + & icseed,aeraod,aerssa,sfemis,sfgtmp, & + & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & + & hlwc,topflx,sfcflx, & ! --- outputs + & HLW0,HLWB,FLXPRF, & !! --- optional + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od & + & ) + + ! ==================== defination of variables ==================== ! ! ! ! input variables: ! diff --git a/physics/radsw_main.f b/physics/radsw_main.f index b348618f8..334dc9822 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -579,29 +579,12 @@ module module_radsw_main ! !!\n nirdf - downward surface nir diffused flux !!\n visbm - downward surface uv+vis direct beam flux !!\n visdf - downward surface uv+vis diffused flux -!> \section General_swrad General Algorithm -!> @{ -!----------------------------------- - subroutine swrad & - & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & - & gasvmr_co2, & - & gasvmr_n2o, gasvmr_ch4, & - & gasvmr_o2, & ! --- inputs - & icseed, aeraod, aerssa, aerasy, & - & sfcalb_nir_dir, sfcalb_nir_dif, & - & sfcalb_uvis_dir, sfcalb_uvis_dif, & - & cosz,solcon,NDAY,idxday, & - & npts, nlay, nlp1, lprnt, & - & cld_cf, lsswr, & - & hswc,topflx,sfcflx, & ! --- outputs - & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy - & ) + + + !! \section arg_table_swrad !! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |-----------------|-----------------------------------------|------------------------------------------------------=-|---------|------|-------------|-----------|--------|----------| +!! |-----------------|-----------------------------------------|--------------------------------------------------------|---------|------|-------------|-----------|--------|----------| !! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | !! | plvl | air_pressure_level | air pressure level | hPa | 2 | real | kind_phys | in | F | !! | tlyr | air_temperature | air temperature layer | K | 2 | real | kind_phys | in | F | @@ -650,6 +633,30 @@ subroutine swrad & !! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | + + + +!> \section General_swrad General Algorithm +!> @{ +!----------------------------------- + subroutine swrad & + & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & + & gasvmr_co2, & + & gasvmr_n2o, gasvmr_ch4, & + & gasvmr_o2, & ! --- inputs + & icseed, aeraod, aerssa, aerasy, & + & sfcalb_nir_dir, sfcalb_nir_dif, & + & sfcalb_uvis_dir, sfcalb_uvis_dif, & + & cosz,solcon,NDAY,idxday, & + & npts, nlay, nlp1, lprnt, & + & cld_cf, lsswr, & + & hswc,topflx,sfcflx, & ! --- outputs + & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od, cld_ssa, cld_asy + & ) + ! ==================== defination of variables ==================== ! ! ! ! input variables: ! From 8d64353cd340a62bdde1e81680e5fb68743921a6 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 16:23:07 -0700 Subject: [PATCH 071/114] added GFS_suite_interstitial_4 --- GFS_layer/GFS_physics_driver.F90 | 30 ++++++++------- physics/GFS_suite_interstitial.f90 | 62 ++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 14 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 9236343ed..018a027d7 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -25,6 +25,7 @@ module module_physics_driver use GFS_suite_interstitial_2, only: GFS_suite_interstitial_2_run use GFS_suite_interstitial_3, only: GFS_suite_interstitial_3_run use GFS_suite_update_stateout, only: GFS_suite_update_stateout_run + use GFS_suite_interstitial_4, only: GFS_suite_interstitial_4_run implicit none @@ -1550,13 +1551,14 @@ subroutine GFS_physics_driver & ! print *,' phii2=',phii(ipr,k=1,levs) ! print *,' phil2=',phil(ipr,:) ! endif - - clw(:,:,1) = 0.0 - clw(:,:,2) = -999.9 - if ((Model%imfdeepcnv >= 0) .or. (Model%imfshalcnv > 0)) then - cnvc(:,:) = 0.0 - cnvw(:,:) = 0.0 - endif + call GFS_suite_interstitial_4_run (Model, Grid, Statein, rhbbot, & + rhbtop, work1, work2, clw, cnvc, cnvw, ktop, kbot, rhc) + ! clw(:,:,1) = 0.0 + ! clw(:,:,2) = -999.9 + ! if ((Model%imfdeepcnv >= 0) .or. (Model%imfshalcnv > 0)) then + ! cnvc(:,:) = 0.0 + ! cnvw(:,:) = 0.0 + ! endif ! write(0,*)' before cnv clstp=',clstp,' kdt=',kdt,' lat=',lat @@ -1586,13 +1588,13 @@ subroutine GFS_physics_driver & ! -------------------------------------------- if (Model%ntcw > 0) then - do k=1,levs - do i=1,im - tem = rhbbot - (rhbbot-rhbtop) * (1.0-Statein%prslk(i,k)) - tem = rhc_max * work1(i) + tem * work2(i) - rhc(i,k) = max(0.0, min(1.0,tem)) - enddo - enddo + ! do k=1,levs + ! do i=1,im + ! tem = rhbbot - (rhbbot-rhbtop) * (1.0-Statein%prslk(i,k)) + ! tem = rhc_max * work1(i) + tem * work2(i) + ! rhc(i,k) = max(0.0, min(1.0,tem)) + ! enddo + ! enddo if (Model%ncld == 2) then clw(:,:,1) = Stateout%gq0(:,:,Model%ntiw) ! ice clw(:,:,2) = Stateout%gq0(:,:,Model%ntcw) ! water diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index e0b34bce0..71b14055a 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -240,6 +240,8 @@ subroutine GFS_suite_interstitial_3_run (Model, Grid, Statein, Radtend, xcosz, a end subroutine GFS_suite_interstitial_3_run + end module + module GFS_suite_update_stateout contains @@ -283,3 +285,63 @@ subroutine GFS_suite_update_stateout_run (Statein, Model, Grid, dudt, dvdt, dtdt end subroutine GFS_suite_update_stateout_run end module + +module GFS_suite_interstitial_4 + +contains + +subroutine GFS_suite_interstitial_4_init () +end subroutine GFS_suite_interstitial_4_init + +subroutine GFS_suite_interstitial_4_finalize() +end subroutine GFS_suite_interstitial_4_finalize + +!> \section arg_table_GFS_suite_interstitial_4_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | out | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | +!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | +!! +subroutine GFS_suite_interstitial_4_run (Model, Grid, Statein, rhbbot, rhbtop, work1, work2, clw, cnvc, cnvw, ktop, kbot, rhc) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, GFS_statein_type + use physcons, only: rhc_max + + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + type(GFS_statein_type), intent(in) :: Statein + + real(kind=kind_phys), intent(in) :: rhbbot, rhbtop + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: work1, work2 + real(kind=kind_phys), intent(inout) :: clw(:,:,:), cnvc(:,:), cnvw(:,:) + integer, dimension(size(Grid%xlon,1)), intent(inout) :: ktop, kbot + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(out) :: rhc + + integer :: i,k + real(kind=kind_phys) :: tem + + clw(:,:,1) = 0.0 + clw(:,:,2) = -999.9 + if ((Model%imfdeepcnv >= 0) .or. (Model%imfshalcnv > 0)) then + cnvc(:,:) = 0.0 + cnvw(:,:) = 0.0 + endif + + ktop(:) = 1 + kbot(:) = Model%levs + + if (Model%ntcw > 0) then + do k=1,Model%levs + do i=1, size(Grid%xlon,1) + tem = rhbbot - (rhbbot-rhbtop) * (1.0-Statein%prslk(i,k)) + tem = rhc_max * work1(i) + tem * work2(i) + rhc(i,k) = max(0.0, min(1.0,tem)) + enddo + enddo + endif + +end subroutine GFS_suite_interstitial_4_run + +end module From d3cd2b16c95eb0dce3c887e836d03894b03780e2 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 16:32:48 -0700 Subject: [PATCH 072/114] table for GFS_suite_interstitial_4 --- physics/GFS_suite_interstitial.f90 | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 71b14055a..4ed87b522 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -297,11 +297,21 @@ subroutine GFS_suite_interstitial_4_finalize() end subroutine GFS_suite_interstitial_4_finalize !> \section arg_table_GFS_suite_interstitial_4_run Argument Table -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| -!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | out | F | -!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | -!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Statein | FV3-GFS_Statein_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_statein_type | | in | F | +!! | rhbbot | critical_relative_humidity_at_surface | critical relative humidity at the surface | frac | 0 | real | kind_phys | in | F | +!! | rhbtop | critical_relative_humidity_at_top_of_atmosphere | critical relative humidity at the top of atmosphere | frac | 0 | real | kind_phys | in | F | +!! | work1 | grid_related_coefficient | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | +!! | work2 | grid_related_coefficient_complement | complement to work1 | none | 1 | real | kind_phys | in | F | +!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | +!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | inout | F | +!! | ktop | vertical_index_at_cloud_top | vertical index at cloud top | index | 1 | integer | | inout | F | +!! | kbot | vertical_index_at_cloud_base | vertical index at cloud base | index | 1 | integer | | inout | F | +!! | rhc | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | out | F | !! subroutine GFS_suite_interstitial_4_run (Model, Grid, Statein, rhbbot, rhbtop, work1, work2, clw, cnvc, cnvw, ktop, kbot, rhc) From 228216e8439bd8cc5b2f046eaf028682cf9d3258 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 17:19:56 -0700 Subject: [PATCH 073/114] added GFS_suite_interstitial_5 --- GFS_layer/GFS_physics_driver.F90 | 8 +++++--- physics/GFS_suite_interstitial.f90 | 29 +++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index 018a027d7..d015f4c0e 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -26,6 +26,7 @@ module module_physics_driver use GFS_suite_interstitial_3, only: GFS_suite_interstitial_3_run use GFS_suite_update_stateout, only: GFS_suite_update_stateout_run use GFS_suite_interstitial_4, only: GFS_suite_interstitial_4_run + use GFS_suite_interstitial_5, only: GFS_suite_interstitial_5_run implicit none @@ -2773,12 +2774,13 @@ subroutine GFS_physics_driver & enddo endif - deallocate (clw) + call GFS_suite_interstitial_5_run (clw, cnvc, cnvw) + !deallocate (clw) if (Model%do_shoc) then deallocate (qpl, qpi, ncpl, ncpi) endif - if (allocated(cnvc)) deallocate(cnvc) - if (allocated(cnvw)) deallocate(cnvw) + ! if (allocated(cnvc)) deallocate(cnvc) + ! if (allocated(cnvw)) deallocate(cnvw) ! deallocate (fscav, fswtr) ! diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index 4ed87b522..db7a784b5 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -354,4 +354,33 @@ subroutine GFS_suite_interstitial_4_run (Model, Grid, Statein, rhbbot, rhbtop, w end subroutine GFS_suite_interstitial_4_run +module GFS_suite_interstitial_5 + +contains + +subroutine GFS_suite_interstitial_5_init () +end subroutine GFS_suite_interstitial_5_init + +subroutine GFS_suite_interstitial_5_finalize() +end subroutine GFS_suite_interstitial_5_finalize + +!> \section arg_table_GFS_suite_interstitial_5_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | +!! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | inout | F | +!! +subroutine GFS_suite_interstitial_5_run (clw, cnvc, cnvw) + + use machine, only: kind_phys + + real(kind=kind_phys), intent(inout) :: clw(:,:,:), cnvc(:,:), cnvw(:,:) + + deallocate (clw) + if (allocated(cnvc)) deallocate(cnvc) + if (allocated(cnvw)) deallocate(cnvw) + +end subroutine GFS_suite_interstitial_5_run + end module From 26d5f269c9066b321f43e5ce979a91ddc83a6553 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 17:23:00 -0700 Subject: [PATCH 074/114] fixed end module statement --- physics/GFS_suite_interstitial.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index db7a784b5..a92103e4e 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -354,6 +354,8 @@ subroutine GFS_suite_interstitial_4_run (Model, Grid, Statein, rhbbot, rhbtop, w end subroutine GFS_suite_interstitial_4_run +end module GFS_suite_interstitial_4 + module GFS_suite_interstitial_5 contains From 51560a114003666763194976ea55575728608a4b Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 17:29:43 -0700 Subject: [PATCH 075/114] added allocatable to arrays in deallocation subroutine --- physics/GFS_suite_interstitial.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index a92103e4e..d1b797cf1 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -377,7 +377,7 @@ subroutine GFS_suite_interstitial_5_run (clw, cnvc, cnvw) use machine, only: kind_phys - real(kind=kind_phys), intent(inout) :: clw(:,:,:), cnvc(:,:), cnvw(:,:) + real(kind=kind_phys), allocatable, intent(inout) :: clw(:,:,:), cnvc(:,:), cnvw(:,:) deallocate (clw) if (allocated(cnvc)) deallocate(cnvc) From cb76d9548c1adf42266b6303314f98ce78b75944 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 20:15:42 -0700 Subject: [PATCH 076/114] added _run to subroutines and fixed table formatting --- GFS_layer/GFS_radiation_driver.F90 | 30 +++---- physics/radlw_main.f | 123 ++++++++++++++--------------- physics/radsw_main.f | 16 ++-- 3 files changed, 82 insertions(+), 87 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 413b8a5f1..5b842c72d 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -326,11 +326,11 @@ module module_radiation_driver ! use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type,cmpfsw_type,NBDSW - use module_radsw_main, only: rswinit, swrad + use module_radsw_main, only: rswinit, swrad_run use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW - use module_radlw_main, only: rlwinit, lwrad + use module_radlw_main, only: rlwinit, lwrad_run use GFS_typedefs, only: GFS_statein_type, & GFS_stateout_type, & GFS_sfcprop_type, & @@ -1018,7 +1018,7 @@ subroutine GFS_radiation_driver & type(GFS_cldprop_type), intent(in) :: Cldprop type(GFS_radtend_type), intent(inout) :: Radtend type(GFS_diag_type), intent(inout) :: Diag - + ! ================= subprogram documentation block ================ ! ! ! @@ -1212,13 +1212,13 @@ subroutine GFS_radiation_driver & ! Calculate SW heating and fluxes - call swrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: + call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & faersw(:, :, :, 3), sfcalb(:, 1), sfcalb(:,2), sfcalb(:,3), & sfcalb(:,4), Radtend%coszen, Model%solcon, nday, idxday, im,& lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs + htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! Optional input cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & @@ -1227,7 +1227,7 @@ subroutine GFS_radiation_driver & ! Calculate LW heating rates and fluxes. - call lwrad (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs + call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & @@ -1278,7 +1278,7 @@ subroutine Set_local_int (lmk, lm, lmp, kd, kt, & integer, intent(in) :: lm, lp1 type(GFS_control_type), intent(in) :: Model real(kind=kind_phys), intent(out) :: raddt - + ! PAJ: LTP is a global parameter lmk = lm + LTP ! num of local layers @@ -1386,12 +1386,12 @@ subroutine Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & end subroutine Prep_profiles - subroutine Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, & + subroutine Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, & rhly, qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, & llb, lla, lya, lyb) implicit none - + type(GFS_statein_type), intent(in) :: Statein type(GFS_grid_type), intent(in) :: Grid type(GFS_control_type), intent(in) :: Model @@ -1410,7 +1410,7 @@ subroutine Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, & do j = 2, ntrac - do k = 1, lm + do k = 1, lm k1 = k + kd tracer1(:, k1, j) = Max (0.0, Statein%qgrs(:, k, j)) end do @@ -1683,7 +1683,7 @@ subroutine Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & ! it is to enhance cloudiness due to suspended convec cloud water ! for zhao/moorthi's (icmphys=1) & ! ferrier's (icmphys=2) microphysics schemes - ! + ! if (Model%shoc_cld) then ! all but MG microphys @@ -1806,7 +1806,7 @@ subroutine Organize_output (Diag, Model, Grid, Radtend, Statein, Coupling, & ! Local vars integer :: i, j, k1, k, itop, ibtc - real(kind = kind_phys) :: tem0d + real(kind = kind_phys) :: tem0d if_lssav: if (Model%lssav) then @@ -2092,7 +2092,7 @@ subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) ! Local vars integer :: k, k1 - + if (.not. Model%lslwr) return @@ -2190,9 +2190,9 @@ subroutine Pre_radiation (Model, Grid, lm, me, im, ntrac, & ! to in/out variables call Set_local_int (lmk, lm, lmp, kd, kt, & kb, lla, llb, lya, lyb, lp1, raddt, Model) - - ! Setup surface ground temperature and + + ! Setup surface ground temperature and ! ground/air skin temperature if required. call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 43ff6dc5d..345c117d8 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -110,7 +110,7 @@ ! ! ! ! ! a rapid radiative transfer model ! -! for the longwave region ! +! for the longwave region ! ! for application to general circulation models ! ! ! ! ! @@ -228,7 +228,7 @@ ! apr 2012, b. ferrier and y. hou -- added conversion factor to fu's! ! cloud-snow optical property scheme. ! ! nov 2012, yu-tai hou -- modified control parameters thru ! -! module 'physparam'. ! +! module 'physparam'. ! ! ! !!!!! ============================================================== !!!!! !!!!! end descriptions !!!!! @@ -258,13 +258,13 @@ !! module 'module_radlw_main' and many of them are not directly !! accessable from places outside the module. !! -!!\author Eli J. Mlawer, emlawer@aer.com -!!\author Jennifer S. Delamere, jdelamer@aer.com -!!\author Michael J. Iacono, miacono@aer.com +!!\author Eli J. Mlawer, emlawer@aer.com +!!\author Jennifer S. Delamere, jdelamer@aer.com +!!\author Michael J. Iacono, miacono@aer.com !!\author Shepard A. Clough !!\version NCEP LW v5.1 Nov 2012 -RRTMG-LW v4.82 -!! -!! The authors wish to acknowledge the contributions of the +!! +!! The authors wish to acknowledge the contributions of the !! following people: Steven J. Taubman, Karen Cady-Pereira, !! Patrick D. Brown, Ronald E. Farren, Luke Chen, Robert Bergstrom. !! @@ -382,7 +382,7 @@ module module_radlw_main ! ! --- public accessable subprograms - public lwrad, rlwinit + public lwrad_run, rlwinit ! ================ @@ -394,8 +394,8 @@ module module_radlw_main ! !!\param plvl model interface pressure in mb !!\param tlyr model layer mean temperature in K !!\param tlvl model interface temperature in K -!!\param qlyr layer specific humidity in gm/gm -!!\param olyr layer ozone concentration in gm/gm +!!\param qlyr layer specific humidity in gm/gm +!!\param olyr layer ozone concentration in gm/gm !!\param gasvmr atmospheric gases amount: !!\n (:,:,1) - co2 volume mixing ratio !!\n (:,:,2) - n2o volume mixing ratio @@ -423,7 +423,7 @@ module module_radlw_main ! !!\n (:,:,3) - layer cloud single scattering albedo !!\n (:,:,4) - layer cloud asymmetry factor !!\param icseed auxiliary special cloud related array. -!!\param aerosols aerosol optical properties +!!\param aerosols aerosol optical properties !!\n (:,:,:,1) - optical depth !!\n (:,:,:,2) - single scattering albedo !!\n (:,:,:,3) - asymmetry parameter @@ -449,7 +449,7 @@ module module_radlw_main ! !!\n dnfx0 - clear sky downward flux !!\n upfx0 - clear sky upward flux -!! \section arg_table_swrad +!! \section arg_table_lwrad_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-----------------|-----------------------------------------|--------------------------------------------------------|---------|------|-------------|-----------|--------|----------| !! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | @@ -493,12 +493,11 @@ module module_radlw_main ! !! | cld_swp | cloud_snow_water_path | cloud snow water path | g m-2 | 2 | real | kind_phys | in | T | !! | cld_ref_snow | effective_radious_snow_hydrometeor | effective radious snow hydrometeor | micron | 2 | real | kind_phys | in | T | !! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | - - +!! !> \section gen_lwrad General Algorithm !> @{ ! -------------------------------- - subroutine lwrad & + subroutine lwrad_run & & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & @@ -777,7 +776,7 @@ subroutine lwrad & lhlwb = present ( hlwb ) lhlw0 = present ( hlw0 ) lflxprf= present ( flxprf ) - + colamt(:,:) = f_zero @@ -800,7 +799,7 @@ subroutine lwrad & ! endif ! --- ... loop over horizontal npts profiles - + lab_do_iplon : do iplon = 1, npts !> -# Read surface emissivity. @@ -1152,7 +1151,7 @@ subroutine lwrad & ! print *,'indfor',indfor ! endif -!> -# Call taumol() to calculte the gaseous optical depths and Plank +!> -# Call taumol() to calculte the gaseous optical depths and Plank !! fractions for each longwave spectral band. call taumol & @@ -1308,7 +1307,7 @@ subroutine lwrad & enddo lab_do_iplon !................................... - end subroutine lwrad + end subroutine lwrad_run !----------------------------------- !> @} @@ -2031,18 +2030,18 @@ end subroutine mcica_subcol !!\param rfrate ref ratios of binary species param !!\n (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o, !! 4-h2o/ch4,5-n2o/co2,6-o3/co2 -!!\n (:,:,n)n=1,2: the rates of ref press at +!!\n (:,:,n)n=1,2: the rates of ref press at !! the 2 sides of the layer !!\param facij factors multiply the reference ks, i,j=0/1 for !! lower/higher of the 2 appropriate temperatures !! and altitudes. !!\param selffac scale factor for w. v. self-continuum equals !! (w. v. density)/(atmospheric density at 296k and 1013 mb) -!!\param selffrac factor for temperature interpolation of +!!\param selffrac factor for temperature interpolation of !! reference w. v. self-continuum data !!\param indself index of lower ref temp for selffac !!\param forfac scale factor for w. v. foreign-continuum -!!\param forfrac factor for temperature interpolation of +!!\param forfrac factor for temperature interpolation of !! reference w.v. foreign-continuum data !!\param indfor index of lower ref temp for forfac !!\param minorfrac factor for minor gases @@ -2313,7 +2312,7 @@ end subroutine setcoef !! randomly overlaping in a vertical column. !!\brief Original Code Description: this program calculates the upward !! fluxes, downward fluxes, and heating rates for an arbitrary clear or -!! cloudy atmosphere. The input to this program is the atmospheric +!! cloudy atmosphere. The input to this program is the atmospheric !! profile, all Planck function information, and the cloud fraction by !! layer. A variable diffusivity angle (secdif) is used for the angle !! integration. Bands 2-3 and 5-9 use a value for secdif that varies @@ -2647,7 +2646,7 @@ subroutine rtrn & enddo ! end do_ig_loop -!> -# Process longwave output from band for total and clear streams. +!> -# Process longwave output from band for total and clear streams. !! Calculate upward, downward, and net flux. flxfac = wtdiff * fluxfac @@ -2703,7 +2702,7 @@ end subroutine rtrn !> This subroutine computes the upward/downward radiative fluxes, and -!! heating rates for both clear or cloudy atmosphere. Clouds are +!! heating rates for both clear or cloudy atmosphere. Clouds are !! assumed as in maximum-randomly overlaping in a vertical column. !!\param semiss lw surface emissivity !!\param delp layer pressure thickness (mb) @@ -3691,13 +3690,13 @@ end subroutine rtrnmc !> This subroutine contains optical depths developed for the rapid !! radiative transfer model. !!\brief This file contains the subroutines taugbn (where n goes from -!! 1 to 16). taugbn calculates the optical depths and planck fractions +!! 1 to 16). taugbn calculates the optical depths and planck fractions !! per g-value and layer for band n. -!!\param laytrop tropopause layer index (unitless) layer at +!!\param laytrop tropopause layer index (unitless) layer at !! which switch is made for key species !!\param pavel layer pressures (mb) !!\param coldry column amount for dry air \f$(mol/cm^2)\f$ -!!\param colamt column amounts of h2o, co2, o3, n2o, ch4,o2, +!!\param colamt column amounts of h2o, co2, o3, n2o, ch4,o2, !! co \f$(mol/cm^2)\f$ !!\param colbrd column amount of broadening gases !!\param wx cross-section amounts \f$(mol/cm^2)\f$ @@ -3708,7 +3707,7 @@ end subroutine rtrnmc !!\n (:,:,n)n=1,2: the rates of ref press at the 2 !! sides of the layer !!\param facij factors multiply the reference ks, i,j of 0/1 -!! for lower/higher of the 2 appropriate +!! for lower/higher of the 2 appropriate !! temperatures and altitudes !!\param jp index of lower reference pressure !!\param jt, jt1 indices of lower reference temperatures for @@ -3917,7 +3916,7 @@ subroutine taumol & ! ================= !> band 1: 10-350 cm-1 (low key - h2o; low minor - n2); -!! (high key - h2o; high minor - n2) +!! (high key - h2o; high minor - n2) ! ---------------------------------- subroutine taugb01 ! .................................. @@ -3976,7 +3975,7 @@ subroutine taugb01 tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taun2 = scalen2 * (ka_mn2(ig,indm) + minorfrac(k) & & * (ka_mn2(ig,indmp) - ka_mn2(ig,indm))) @@ -4007,7 +4006,7 @@ subroutine taugb01 do ig = 1, ng01 taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taun2 = scalen2 * (kb_mn2(ig,indm) + minorfrac(k) & & * (kb_mn2(ig,indmp) - kb_mn2(ig,indm))) @@ -4062,7 +4061,7 @@ subroutine taugb02 tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taug(ns02+ig,k) = corradj * (colamt(k,1) & & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & @@ -4086,7 +4085,7 @@ subroutine taugb02 do ig = 1, ng02 taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taug(ns02+ig,k) = colamt(k,1) & & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & @@ -4149,7 +4148,7 @@ subroutine taugb03 specparm = colamt(k,1) / speccomb specmult = 8.0 * min(specparm, oneminus) js = 1 + int(specmult) - fs = mod(specmult, f_one) + fs = mod(specmult, f_one) ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(3) + js speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) @@ -4382,7 +4381,7 @@ subroutine taugb03 do ig = 1, ng03 taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) n2om1 = kb_mn2o(ig,jmn2o,indm) + fmn2o & & * (kb_mn2o(ig,jmn2op,indm) - kb_mn2o(ig,jmn2o,indm)) n2om2 = kb_mn2o(ig,jmn2o,indmp) + fmn2o & @@ -4398,7 +4397,7 @@ subroutine taugb03 & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) taug(ns03+ig,k) = tau_major + tau_major1 & - & + taufor + adjcoln2o*absn2o + & + taufor + adjcoln2o*absn2o fracs(ns03+ig,k) = fracrefb(ig,jpl) + fpl & & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) @@ -4557,7 +4556,7 @@ subroutine taugb04 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) tau_major = speccomb & & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & @@ -4653,8 +4652,8 @@ subroutine taugb04 end subroutine taugb04 ! ---------------------------------- -!> Band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) -!! (high key - o3,co2) +!> Band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) +!! (high key - o3,co2) ! ---------------------------------- subroutine taugb05 ! .................................. @@ -4666,7 +4665,7 @@ subroutine taugb05 use module_radlw_kgb05 -! --- locals: +! --- locals: integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & & id000, id010, id100, id110, id200, id210, jmo3, jmo3p, & & id001, id011, id101, id111, id201, id211, jpl, jplp, & @@ -4916,7 +4915,7 @@ subroutine taugb05 end subroutine taugb05 ! ---------------------------------- -!> Band 6: 820-980 cm-1 (low key - h2o; low minor - co2) +!> Band 6: 820-980 cm-1 (low key - h2o; low minor - co2) !! (high key - none; high minor - cfc11, cfc12) ! ---------------------------------- subroutine taugb06 @@ -4929,7 +4928,7 @@ subroutine taugb06 use module_radlw_kgb06 -! --- locals: +! --- locals: integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & & indm, indmp, ig @@ -5191,7 +5190,7 @@ subroutine taugb07 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 & & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm)) co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 & @@ -5264,8 +5263,8 @@ subroutine taugb07 end subroutine taugb07 ! ---------------------------------- -!> Band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) -!! (high key - o3; high minor - co2, n2o) +!> Band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) +!! (high key - o3; high minor - co2, n2o) ! ---------------------------------- subroutine taugb08 ! .................................. @@ -5390,7 +5389,7 @@ end subroutine taugb08 ! ---------------------------------- !> Band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) -!! (high key - ch4; high minor - n2o) +!! (high key - ch4; high minor - n2o) ! ---------------------------------- subroutine taugb09 ! .................................. @@ -5576,7 +5575,7 @@ subroutine taugb09 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o & & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm)) n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o & @@ -5591,7 +5590,7 @@ subroutine taugb09 & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor + adjcoln2o*absn2o + & + tauself + taufor + adjcoln2o*absn2o fracs(ns09+ig,k) = fracrefa(ig,jpl) + fpl & & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) @@ -5675,7 +5674,7 @@ subroutine taugb10 tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taug(ns10+ig,k) = colamt(k,1) & & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & @@ -5714,8 +5713,8 @@ subroutine taugb10 end subroutine taugb10 ! ---------------------------------- -!> Band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) -!! (high key - h2o; high minor - o2) +!> Band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) +!! (high key - h2o; high minor - o2) ! ---------------------------------- subroutine taugb11 ! .................................. @@ -5790,7 +5789,7 @@ subroutine taugb11 do ig = 1, ng11 taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) tauo2 = scaleo2 * (kb_mo2(ig,indm) + minorfrac(k) & & * (kb_mo2(ig,indmp) - kb_mo2(ig,indm))) @@ -5962,7 +5961,7 @@ subroutine taugb12 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taug(ns12+ig,k) = speccomb & & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & @@ -6191,7 +6190,7 @@ subroutine taugb13 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 & & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm)) co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 & @@ -6239,7 +6238,7 @@ subroutine taugb13 end subroutine taugb13 ! ---------------------------------- -!> Band 14: 2250-2380 cm-1 (low - co2; high - co2) +!> Band 14: 2250-2380 cm-1 (low - co2; high - co2) ! ---------------------------------- subroutine taugb14 ! .................................. @@ -6275,7 +6274,7 @@ subroutine taugb14 tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taug(ns14+ig,k) = colamt(k,2) & & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & @@ -6308,8 +6307,8 @@ subroutine taugb14 end subroutine taugb14 ! ---------------------------------- -!> Band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) -!! (high - nothing) +!> Band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) +!! (high - nothing) ! ---------------------------------- subroutine taugb15 ! .................................. @@ -6387,7 +6386,7 @@ subroutine taugb15 indmp = indm + 1 jplp = jpl + 1 jmn2p = jmn2 + 1 - + if (specparm < 0.125 .and. specparm1 < 0.125) then p0 = fs - f_one @@ -6483,7 +6482,7 @@ subroutine taugb15 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) n2m1 = ka_mn2(ig,jmn2,indm) + fmn2 & & * (ka_mn2(ig,jmn2p,indm) - ka_mn2(ig,jmn2,indm)) n2m2 = ka_mn2(ig,jmn2,indmp) + fmn2 & @@ -6673,7 +6672,7 @@ subroutine taugb16 tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & & * (selfref(ig,indsp) - selfref(ig,inds))) taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) + & * (forref(ig,indfp) - forref(ig,indf))) taug(ns16+ig,k) = speccomb & & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 334dc9822..d6f0c4705 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -504,7 +504,7 @@ module module_radsw_main ! ! --- public accessable subprograms - public swrad, rswinit + public swrad_run, rswinit ! ================= @@ -582,7 +582,7 @@ module module_radsw_main ! -!! \section arg_table_swrad +!! \section arg_table_swrad_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-----------------|-----------------------------------------|--------------------------------------------------------|---------|------|-------------|-----------|--------|----------| !! | plyr | air_pressure | air pressure layer | hPa | 2 | real | kind_phys | in | F | @@ -631,15 +631,11 @@ module module_radsw_main ! !! | cld_od | cloud_optical_depth | cloud optical depth | | 2 | real | kind_phys | in | T | !! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | | 2 | real | kind_phys | in | T | !! | cld_asy | cloud_asymetry_parameter | cloud asymetry parameter | | 2 | real | kind_phys | in | T | - - - - - +!! !> \section General_swrad General Algorithm !> @{ !----------------------------------- - subroutine swrad & + subroutine swrad_run & & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & & gasvmr_co2, & & gasvmr_n2o, gasvmr_ch4, & @@ -854,7 +850,7 @@ subroutine swrad & real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 - real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf + real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & @@ -1459,7 +1455,7 @@ subroutine swrad & return !................................... - end subroutine swrad + end subroutine swrad_run !----------------------------------- !> @} From e02e98a1844e0fd57ce4d6f1003f5a69a80ed197 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 20:32:11 -0700 Subject: [PATCH 077/114] longname updates --- physics/GFS_PBL_generic.f90 | 2 +- physics/GFS_suite_interstitial.f90 | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 index 51435c28d..5faa7e831 100644 --- a/physics/GFS_PBL_generic.f90 +++ b/physics/GFS_PBL_generic.f90 @@ -56,7 +56,7 @@ end subroutine GFS_PBL_generic_post_finalize !! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | !! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | !! | xmu | time_step_zenith_angle_adjust_factor_for_sw | time step zenith angle adjust factor for shortwave | none | 2 | real | kind_phys | in | F | -!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | in | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | in | F | !! subroutine GFS_PBL_generic_post_run (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc1, dqsfc1, & dudt, dvdt, dtdt, dqdt, xmu, Diag) diff --git a/physics/GFS_suite_interstitial.f90 b/physics/GFS_suite_interstitial.f90 index d1b797cf1..d5c5ed67d 100644 --- a/physics/GFS_suite_interstitial.f90 +++ b/physics/GFS_suite_interstitial.f90 @@ -22,8 +22,8 @@ end subroutine GFS_suite_interstitial_1_finalize !! | ntk | index_of_TKE | index of TKE in the tracer array | index | 0 | integer | | out | F | !! | skip_macro | flag_skip_macro | flag to skip cloud macrophysics in Morrison scheme | flag | 1 | logical | | out | F | !! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | out | F | -!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | !! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | out | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | out | F | !! subroutine GFS_suite_interstitial_1_run (Model, Grid, tottracer, trc_shft, tracers, ntk, skip_macro, clw, cnvc, cnvw) @@ -84,7 +84,7 @@ end subroutine GFS_suite_interstitial_2_finalize !! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | !! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | !! | Statein | FV3-GFS_Statein_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_statein_type | | in | F | -!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | !! | rhbbot | critical_relative_humidity_at_surface | critical relative humidity at the surface | frac | 0 | real | kind_phys | out | F | !! | rhpbl | critical_relative_humidity_at_PBL_top | critical relative humidity at the PBL top | frac | 0 | real | kind_phys | out | F | !! | rhbtop | critical_relative_humidity_at_top_of_atmosphere | critical relative humidity at the top of atmosphere | frac | 0 | real | kind_phys | out | F | @@ -164,7 +164,7 @@ end subroutine GFS_suite_interstitial_3_finalize !! | adjsfcdlw | surface_downwelling_longwave_flux | surface downwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | !! | adjsfculw | surface_upwelling_longwave_flux | surface upwelling longwave flux at current time | W m-2 | 1 | real | kind_phys | in | F | !! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave fluxes | none | 1 | real | kind_phys | in | F | -!! | Diag | FV3-GFS_diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | !! | kcnv | flag_deep_convection | flag indicating whether convection occurs in column (0 or 1) | index | 1 | integer | | out | F | !! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | out | F | !! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | out | F | @@ -307,8 +307,8 @@ end subroutine GFS_suite_interstitial_4_finalize !! | work1 | grid_related_coefficient | grid size related coefficient used in scale-sensitive schemes | none | 1 | real | kind_phys | in | F | !! | work2 | grid_related_coefficient_complement | complement to work1 | none | 1 | real | kind_phys | in | F | !! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | !! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | inout | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | !! | ktop | vertical_index_at_cloud_top | vertical index at cloud top | index | 1 | integer | | inout | F | !! | kbot | vertical_index_at_cloud_base | vertical index at cloud base | index | 1 | integer | | inout | F | !! | rhc | critical_relative_humidity | critical relative humidity | frac | 2 | real | kind_phys | out | F | @@ -370,8 +370,8 @@ end subroutine GFS_suite_interstitial_5_finalize !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | -!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | !! | cnvc | convective_cloud_cover | convective cloud cover | frac | 2 | real | kind_phys | inout | F | +!! | cnvw | convective_cloud_water_specific_humidity | convective cloud water specific humidity | kg kg-1 | 2 | real | kind_phys | inout | F | !! subroutine GFS_suite_interstitial_5_run (clw, cnvc, cnvw) From 1d960a0dc85af5263e21ceb736886282ecdf0fd5 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 20:35:14 -0700 Subject: [PATCH 078/114] swrad longname fix --- physics/radsw_main.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/radsw_main.f b/physics/radsw_main.f index d6f0c4705..8a4d58d46 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -603,7 +603,7 @@ module module_radsw_main ! !! | sfcalb_nir_dif | albedo_sfc_nir_dif | near infrared sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | !! | sfcalb_uvis_dir | albedo_sfc_uvis_dir | uv - visible sw albedo for surface direct irradiance | | 1 | real | kind_phys | in | F | !! | sfcalb_uvis_dif | albedo_sfc_uvis_dif | uv - visible sw albedo for surface diffuse irradiance | | 1 | real | kind_phys | in | F | -!! | cosz | cosine_zenit_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | +!! | cosz | cosine_of_zenith_angle | cosine of the solar zenit angle | | 1 | real | kind_phys | in | F | !! | solcon | solar_constant | solar constant | W m-2 | 0 | real | kind_phys | in | F | !! | nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | in | F | !! | idxday | daytime_points | daytime points | | 1 | integer | | in | F | From 36ef5b425fc7272492bf9afbe22e32fc86ac327d Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Fri, 17 Nov 2017 20:52:10 -0700 Subject: [PATCH 079/114] longname table updates --- physics/GFS_PBL_generic.f90 | 30 +++++----- physics/moninedmf.f | 106 ++++++++++++++++++------------------ 2 files changed, 68 insertions(+), 68 deletions(-) diff --git a/physics/GFS_PBL_generic.f90 b/physics/GFS_PBL_generic.f90 index 5faa7e831..de15fd0a4 100644 --- a/physics/GFS_PBL_generic.f90 +++ b/physics/GFS_PBL_generic.f90 @@ -42,21 +42,21 @@ end subroutine GFS_PBL_generic_post_finalize !> \section arg_table_GFS_PBL_generic_post_run Argument Table -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| -!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | -!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | -!! | Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies needed in physics | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | -!! | dusfc1 | instantaneous_surface_x_momentum_flux | surface momentum flux in the x-direction valid for current call | Pa | 1 | real | kind_phys | in | F | -!! | dvsfc1 | instantaneous_surface_y_momentum_flux | surface momentum flux in the y-direction valid for current call | Pa | 1 | real | kind_phys | in | F | -!! | dtsfc1 | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | -!! | dqsfc1 | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | -!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | -!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | -!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | -!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | -!! | xmu | time_step_zenith_angle_adjust_factor_for_sw | time step zenith angle adjust factor for shortwave | none | 2 | real | kind_phys | in | F | -!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | in | F | +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies needed in physics | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | +!! | dusfc1 | instantaneous_surface_x_momentum_flux | surface momentum flux in the x-direction valid for current call | Pa | 1 | real | kind_phys | in | F | +!! | dvsfc1 | instantaneous_surface_y_momentum_flux | surface momentum flux in the y-direction valid for current call | Pa | 1 | real | kind_phys | in | F | +!! | dtsfc1 | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | +!! | dqsfc1 | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux valid for current call | W m-2 | 1 | real | kind_phys | in | F | +!! | dudt | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | in | F | +!! | dvdt | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | in | F | +!! | dtdt | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | in | F | +!! | dqdt | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | in | F | +!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave fluxes | none | 2 | real | kind_phys | in | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | in | F | !! subroutine GFS_PBL_generic_post_run (Grid, Model, Radtend, dusfc1, dvsfc1, dtsfc1, dqsfc1, & dudt, dvdt, dtdt, dqdt, xmu, Diag) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index e16362a7f..cd8f15fdb 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -28,59 +28,59 @@ end subroutine edmf_finalize !! The scheme works on a basic level by calculating background diffusion coefficients and updating them according to which processes are occurring in the column. The most important difference in diffusion coefficients occurs between those levels in the PBL and those above the PBL, so the PBL height calculation is of utmost importance. An initial estimate is calculated in a "predictor" step in order to calculate Monin-Obukhov similarity values and a corrector step recalculates the PBL height based on updated surface thermal characteristics. Using the PBL height and the similarity parameters, the diffusion coefficients are updated below the PBL top based on Hong and Pan (1996) \cite hong_and_pan_1996 (including counter-gradient terms). Diffusion coefficients in the free troposphere (above the PBL top) are calculated according to Louis (1979) \cite louis_1979 with updated Richardson number-dependent functions. If it is diagnosed that PBL top-down mixing is occurring according to Lock et al. (2000) \cite lock_et_al_2000 , then then diffusion coefficients are updated accordingly. Finally, for convective boundary layers (defined as when the Obukhov length exceeds a threshold), the counter-gradient terms are replaced using the mass flux scheme of Siebesma et al. (2007) \cite siebesma_et_al_2007 . In order to return time tendencies, a fully implicit solution is found using tridiagonal matrices, and time tendencies are "backed out." Before returning, the time tendency of temperature is updated to reflect heating due to TKE dissipation following Han et al. (2015) \cite han_et_al_2015 . !! !! \section arg_table_edmf_run -!! | local var name | longname | description | units | rank | type | kind | intent | optional | -!! |----------------|--------------------------------------------------------|----------------------------------------------------|---------------|------|---------|-----------|--------|----------| -!! | ix | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | -!! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | -!! | km | vertical_dimension | vertical layer dimension | index | 0 | integer | | in | F | -!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | -!! | ntcw | index_for_liquid_cloud_condensate | cloud condensate index in tracer array | index | 0 | integer | | in | F | -!! | dv | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | du | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | -!! | tau | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | -!! | rtg | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | -!! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | v1 | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | -!! | t1 | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | -!! | q1 | tracer_concentration | layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | -!! | swh | tendency_of_air_temperature_due_to_shortwave_heating | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | hlw | tendency_of_air_temperature_due_to_longwave_heating | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | time_step_zenith_angle_adjust_factor_for_sw | time step zenith angle adjust factor for shortwave | none | 2 | real | kind_phys | in | F | -!! | psk | exner_function_at_lowest_model_interface | exner function at the surface interface | none | 1 | real | kind_phys | in | F | -!! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | -!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | -!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | -!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | -!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | -!! | tsea | surface_skin_temperature | surface temperature | K | 1 | real | kind_phys | in | F | -!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | -!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | -!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | -!! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | -!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | -!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | -!! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | -!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | -!! | prslk | dimensionless_exner_function | Exner function at layers | none | 2 | real | kind_phys | in | F | -!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | -!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | -!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | -!! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | -!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | -!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | -!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | -!! | hgamt | countergradient_mixing_term_for_temperature | countergradient mixing term for temperature | K | 1 | real | kind_phys | out | F | -!! | hgamq | countergradient_mixing_term_for_water_vapor | countergradient mixing term for water vapor | kg kg-1 | 1 | real | kind_phys | out | F | -!! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 1 | real | kind_phys | out | F | -!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | -!! | xkzm_m | atmosphere_momentum_diffusivity_background | background value of momentum diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_h | atmosphere_heat_diffusivity_background | background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | -!! | xkzm_s | diffusivity_background_sigma_level | sigma level threshold for background diffusivity | none | 0 | real | kind_phys | in | F | -!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | -!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------------|----------------------------------------------------|---------------|------|---------|-----------|--------|----------| +!! | ix | horizontal_dimension | horizontal dimension | index | 0 | integer | | in | F | +!! | im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!! | km | vertical_dimension | vertical layer dimension | index | 0 | integer | | in | F | +!! | ntrac | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | +!! | ntcw | index_for_liquid_cloud_condensate | cloud condensate index in tracer array | index | 0 | integer | | in | F | +!! | dv | tendency_of_y_wind_due_to_model_physics | updated tendency of the y wind | m s-2 | 2 | real | kind_phys | inout | F | +!! | du | tendency_of_x_wind_due_to_model_physics | updated tendency of the x wind | m s-2 | 2 | real | kind_phys | inout | F | +!! | tau | tendency_of_air_temperature_due_to_model_physics | updated tendency of the temperature | K s-1 | 2 | real | kind_phys | inout | F | +!! | rtg | tendency_of_tracers_due_to_model_physics | updated tendency of the tracers | kg kg-1 s-1 | 3 | real | kind_phys | inout | F | +!! | u1 | x_wind | x component of layer wind | m s-1 | 2 | real | kind_phys | in | F | +!! | v1 | y_wind | y component of layer wind | m s-1 | 2 | real | kind_phys | in | F | +!! | t1 | air_temperature | layer mean air temperature | K | 2 | real | kind_phys | in | F | +!! | q1 | tracer_concentration | layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | +!! | swh | tendency_of_air_temperature_due_to_shortwave_heating | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | +!! | hlw | tendency_of_air_temperature_due_to_longwave_heating | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | +!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 2 | real | kind_phys | in | F | +!! | psk | exner_function_at_lowest_model_interface | exner function at the surface interface | none | 1 | real | kind_phys | in | F | +!! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | +!! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | +!! | u10m | x_wind_at_10m | x component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | +!! | v10m | y_wind_at_10m | y component of wind at 10 m | m s-1 | 1 | real | kind_phys | in | F | +!! | fm | Monin-Obukhov_similarity_function_for_momentum | Monin-Obukhov similarity function for momentum | none | 1 | real | kind_phys | in | F | +!! | fh | Monin-Obukhov_similarity_function_for_heat | Monin-Obukhov similarity function for heat | none | 1 | real | kind_phys | in | F | +!! | tsea | surface_skin_temperature | surface temperature | K | 1 | real | kind_phys | in | F | +!! | heat | kinematic_surface_upward_sensible_heat_flux | kinematic surface upward sensible heat flux | K m s-1 | 1 | real | kind_phys | in | F | +!! | evap | kinematic_surface_upward_latent_heat_flux | kinematic surface upward latent heat flux | kg kg-1 m s-1 | 1 | real | kind_phys | in | F | +!! | stress | surface_wind_stress | surface wind stress | m2 s-2 | 1 | real | kind_phys | in | F | +!! | spd1 | wind_speed_at_lowest_model_layer | wind speed at lowest model level | m s-1 | 1 | real | kind_phys | in | F | +!! | kpbl | vertical_index_at_top_of_atmosphere_boundary_layer | PBL top model level index | index | 1 | integer | | out | F | +!! | prsi | air_pressure_at_interface | air pressure at model layer interfaces | Pa | 2 | real | kind_phys | in | F | +!! | del | air_pressure_difference_between_midlayers | pres(k) - pres(k+1) | Pa | 2 | real | kind_phys | in | F | +!! | prsl | air_pressure | mean layer pressure | Pa | 2 | real | kind_phys | in | F | +!! | prslk | dimensionless_exner_function | Exner function at layers | none | 2 | real | kind_phys | in | F | +!! | phii | geopotential_at_interface | geopotential at model layer interfaces | m2 s-2 | 2 | real | kind_phys | in | F | +!! | phil | geopotential | geopotential at model layer centers | m2 s-2 | 2 | real | kind_phys | in | F | +!! | delt | time_step_for_physics | time step for physics | s | 0 | real | kind_phys | in | F | +!! | dspheat | flag_TKE_dissipation_heating | flag for using TKE dissipation heating | flag | 0 | logical | | in | F | +!! | dusfc | instantaneous_surface_x_momentum_flux | x momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dvsfc | instantaneous_surface_y_momentum_flux | y momentum flux | Pa | 1 | real | kind_phys | out | F | +!! | dtsfc | instantaneous_surface_upward_sensible_heat_flux | surface upward sensible heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | dqsfc | instantaneous_surface_upward_latent_heat_flux | surface upward latent heat flux | W m-2 | 1 | real | kind_phys | out | F | +!! | hpbl | atmosphere_boundary_layer_thickness | PBL thickness | m | 1 | real | kind_phys | out | F | +!! | hgamt | countergradient_mixing_term_for_temperature | countergradient mixing term for temperature | K | 1 | real | kind_phys | out | F | +!! | hgamq | countergradient_mixing_term_for_water_vapor | countergradient mixing term for water vapor | kg kg-1 | 1 | real | kind_phys | out | F | +!! | dkt | atmosphere_heat_diffusivity | diffusivity for heat | m2 s-1 | 1 | real | kind_phys | out | F | +!! | kinver | index_of_highest_temperature_inversion | index of highest temperature inversion | index | 1 | integer | | in | F | +!! | xkzm_m | atmosphere_momentum_diffusivity_background | background value of momentum diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | +!! | xkzm_h | atmosphere_heat_diffusivity_background | background value of heat diffusivity | m2 s-1 | 0 | real | kind_phys | in | F | +!! | xkzm_s | diffusivity_background_sigma_level | sigma level threshold for background diffusivity | none | 0 | real | kind_phys | in | F | +!! | lprnt | flag_print | flag for printing diagnostics to output | flag | 0 | logical | | in | F | +!! | ipr | horizontal_index_of_printed_column | horizontal index of printed column | index | 0 | integer | | in | F | !! !! \section general General Algorithm !! -# Compute preliminary variables from input arguments. From 2cd977d4d03f03aa29f85d7d6fc9655af5efa166 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 28 Nov 2017 21:05:41 -0700 Subject: [PATCH 080/114] added GFS_SCNV_generic_pre,post --- GFS_layer/GFS_physics_driver.F90 | 60 ++++++++++--------- makefile | 1 + physics/GFS_SCNV_generic.f90 | 99 ++++++++++++++++++++++++++++++++ 3 files changed, 133 insertions(+), 27 deletions(-) create mode 100644 physics/GFS_SCNV_generic.f90 diff --git a/GFS_layer/GFS_physics_driver.F90 b/GFS_layer/GFS_physics_driver.F90 index d015f4c0e..ea6b51a73 100644 --- a/GFS_layer/GFS_physics_driver.F90 +++ b/GFS_layer/GFS_physics_driver.F90 @@ -21,6 +21,8 @@ module module_physics_driver ! use sasas_deep, only: sasasdeep_run use GFS_DCNV_generic_pre, only: GFS_DCNV_generic_pre_run use GFS_DCNV_generic_post, only: GFS_DCNV_generic_post_run + use GFS_SCNV_generic_pre, only: GFS_SCNV_generic_pre_run + use GFS_SCNV_generic_post, only: GFS_SCNV_generic_post_run use GFS_suite_interstitial_1, only: GFS_suite_interstitial_1_run use GFS_suite_interstitial_2, only: GFS_suite_interstitial_2_run use GFS_suite_interstitial_3, only: GFS_suite_interstitial_3_run @@ -2105,12 +2107,14 @@ subroutine GFS_physics_driver & ! &,' lat=',lat,' kdt=',kdt,' me=',me !----------------Convective gravity wave drag parameterization over -------- - if (Model%ldiag3d) then - initial_t(:,:) = Stateout%gt0(:,:) - endif - if (Model%ldiag3d .or. Model%lgocart) then - initial_qv(:,:) = Stateout%gq0(:,:,1) - endif + ! if (Model%ldiag3d) then + ! initial_t(:,:) = Stateout%gt0(:,:) + ! endif + ! if (Model%ldiag3d .or. Model%lgocart) then + ! initial_qv(:,:) = Stateout%gq0(:,:,1) + ! endif + + call GFS_SCNV_generic_pre_run (Model, Stateout, Grid, initial_t, initial_qv) ! write(0,*)' before do_shoc shal clstp=',clstp,' kdt=',kdt, ! & ' lat=',lat @@ -2201,27 +2205,29 @@ subroutine GFS_physics_driver & endif ! end if_imfshalcnv endif ! end if_shal_cnv - if (Model%lssav) then -! update dqdt_v to include moisture tendency due to shallow convection - if (Model%lgocart) then - do k = 1, levs - do i = 1, im - tem = (Stateout%gq0(i,k,1)-initial_qv(i,k)) * frain - Coupling%dqdti(i,k) = Coupling%dqdti(i,k) + tem - enddo - enddo - endif - if (Model%ldiag3d) then - Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain - Diag%dq3dt(:,:,3) = Diag%dq3dt(:,:,3) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain - endif - endif ! end if_lssav -! - do k = 1, levs - do i = 1, im - if (clw(i,k,2) <= -999.0) clw(i,k,2) = 0.0 - enddo - enddo +! if (Model%lssav) then +! ! update dqdt_v to include moisture tendency due to shallow convection +! if (Model%lgocart) then +! do k = 1, levs +! do i = 1, im +! tem = (Stateout%gq0(i,k,1)-initial_qv(i,k)) * frain +! Coupling%dqdti(i,k) = Coupling%dqdti(i,k) + tem +! enddo +! enddo +! endif +! if (Model%ldiag3d) then +! Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain +! Diag%dq3dt(:,:,3) = Diag%dq3dt(:,:,3) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain +! endif +! endif ! end if_lssav +! ! +! do k = 1, levs +! do i = 1, im +! if (clw(i,k,2) <= -999.0) clw(i,k,2) = 0.0 +! enddo +! enddo + + call GFS_SCNV_generic_post_run (Model, Stateout, Grid, initial_t, initial_qv, frain, Diag, clw) ! if (lprnt) then ! write(0,*)' prsl=',prsl(ipr,:) diff --git a/makefile b/makefile index db63831ef..afeaa4f7a 100644 --- a/makefile +++ b/makefile @@ -122,6 +122,7 @@ SRCS_f90 = \ ./physics/gcycle.f90 \ ./physics/get_prs_fv3.f90 \ ./physics/GFS_DCNV_generic.f90 \ + ./physics/GFS_SCNV_generic.f90 \ ./physics/GFS_PBL_generic.f90 \ ./physics/GFS_suite_interstitial.f90 \ ./physics/h2ointerp.f90 \ diff --git a/physics/GFS_SCNV_generic.f90 b/physics/GFS_SCNV_generic.f90 new file mode 100644 index 000000000..9f909f5d0 --- /dev/null +++ b/physics/GFS_SCNV_generic.f90 @@ -0,0 +1,99 @@ +!> \file GFS_SCNV_generic.f90 +!! Contains code related to shallow convective schemes to be used within the GFS physics suite. + + module GFS_SCNV_generic_pre + + contains + + subroutine GFS_SCNV_generic_pre_init () + end subroutine GFS_SCNV_generic_pre_init + + subroutine GFS_SCNV_generic_pre_finalize() + end subroutine GFS_SCNV_generic_pre_finalize + +!> \section arg_table_GFS_SCNV_generic_pre_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | inout | F | +!! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | inout | F | +!! + subroutine GFS_SCNV_generic_pre_run (Model, Stateout, Grid, initial_t, initial_qv) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_stateout_type, GFS_grid_type + + type(GFS_control_type), intent(in) :: Model + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_grid_type), intent(in) :: Grid + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(inout) :: initial_t, initial_qv + + if (Model%ldiag3d) then + initial_t(:,:) = Stateout%gt0(:,:) + endif + if (Model%ldiag3d .or. Model%lgocart) then + initial_qv(:,:) = Stateout%gq0(:,:,1) + endif + + end subroutine GFS_SCNV_generic_pre_run + + end module + + module GFS_SCNV_generic_post + + contains + + subroutine GFS_SCNV_generic_post_init () + end subroutine GFS_SCNV_generic_post_init + + subroutine GFS_SCNV_generic_post_finalize () + end subroutine GFS_SCNV_generic_post_finalize + +!> \section arg_table_GFS_SCNV_generic_post_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-----------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | +!! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | +!! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!! | clw | convective_transportable_tracers | array to contain cloud water and other convective trans. tracers | kg kg-1 | 3 | real | kind_phys | inout | F | +!! + subroutine GFS_SCNV_generic_post_run (Model, Stateout, Grid, initial_t, initial_qv, frain, Diag, clw) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_grid_type, GFS_control_type, GFS_stateout_type, GFS_diag_type + + type(GFS_grid_type), intent(in) :: Grid + type(GFS_control_type), intent(in) :: Model + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_diag_type), intent(inout) :: Diag + + + real(kind=kind_phys), intent(in) :: frain + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levs), intent(in) :: initial_t, initial_qv + + real(kind=kind_phys), intent(inout) :: clw(:,:,:) + + integer :: i, k + + if (Model%lssav) then + if (Model%ldiag3d) then + Diag%dt3dt(:,:,5) = Diag%dt3dt(:,:,5) + (Stateout%gt0(:,:)-initial_t(:,:)) * frain + Diag%dq3dt(:,:,3) = Diag%dq3dt(:,:,3) + (Stateout%gq0(:,:,1)-initial_qv(:,:)) * frain + endif + endif ! end if_lssav +! + do k = 1, Model%levs + do i = 1, size(Grid%xlon,1) + if (clw(i,k,2) <= -999.0) clw(i,k,2) = 0.0 + enddo + enddo + + end subroutine GFS_SCNV_generic_post_run + + end module From 293dbc79ad55ad673102aa346c8e623273f63cf2 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 28 Nov 2017 22:25:37 -0700 Subject: [PATCH 081/114] add GFS_RRTMG_pre.f90 code, and got B4B. --- GFS_layer/GFS_radiation_driver.F90 | 26 +- makefile | 1 + physics/GFS_RRTMG_pre.f90 | 687 +++++++++++++++++++++++++++++ 3 files changed, 701 insertions(+), 13 deletions(-) create mode 100644 physics/GFS_RRTMG_pre.f90 diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 5b842c72d..d8e3c9160 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -327,6 +327,7 @@ module module_radiation_driver ! use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type,cmpfsw_type,NBDSW use module_radsw_main, only: rswinit, swrad_run + use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW @@ -1006,6 +1007,8 @@ subroutine GFS_radiation_driver & (Model, Statein, Stateout, Sfcprop, Coupling, Grid, Tbd, & Cldprop, Radtend, Diag) +! use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run + implicit none type(GFS_control_type), intent(in) :: Model @@ -1186,23 +1189,19 @@ subroutine GFS_radiation_driver & real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & LTP) :: plyr, tlyr, qlyr, olyr, rhly, tvly, qstl, prslk1, deltaq, & htswc, htsw0, htlw0, htlwc - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP) :: plvl, tlvl - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, 2:Model%ntrac) :: tracer1 - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_VGAS) :: gasvmr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NBDSW, NF_AESW) :: faersw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NBDLW, NF_AELW) :: faerlw + real(kind = kind_phys), dimension(Size(Grid%xlon, 1), Model%levr+1+LTP) :: plvl, tlvl + + real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, 2:Model%ntrac) :: tracer1 + real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NF_CLDS) :: clouds + real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NF_VGAS) :: gasvmr + + real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NBDSW, NF_AESW) :: faersw + real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NBDLW, NF_AELW) :: faerlw type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw - call Pre_radiation (Model, Grid, lm, me, im, ntrac, & + call GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & tskn, tsfg, Sfcprop, Statein, plvl, plyr, & tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & @@ -1226,6 +1225,7 @@ subroutine GFS_radiation_driver & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) +!zhang: move setemis here ! Calculate LW heating rates and fluxes. call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & diff --git a/makefile b/makefile index 95c891e1b..e4d6992da 100644 --- a/makefile +++ b/makefile @@ -115,6 +115,7 @@ SRCS_f = \ SRCS_f90 = \ ./physics/calpreciptype.f90 \ + ./physics/GFS_RRTMG_pre.f90 \ ./physics/cs_conv.f90 \ ./physics/funcphys.f90 \ ./physics/gcm_shoc.f90 \ diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 new file mode 100644 index 000000000..cc76eb5e4 --- /dev/null +++ b/physics/GFS_RRTMG_pre.f90 @@ -0,0 +1,687 @@ +!> \file GFS_RRTMG_pre.f90 +!! This file contains + module GFS_RRTMG_pre + + public GFS_RRTMG_pre_run + + contains + +!> \defgroup GFS_RRTMG_pre GFS RRTMG Scheme Pre +!! @{ +!!\section arg_table_GFS_RRTMG_pre_init Argument Table +!! + subroutine GFS_RRTMG_pre_init + end subroutine GFS_RRTMG_pre_init + +!!\section arg_table_GFS_RRTMG_pre_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|----------------------------------- -----------|----------------------------------------------------------------------|-------------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| lm +!!| me +!!| im +!!| ntrac +!!| lmk + subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & + lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & + tskn, tsfg, Sfcprop, Statein, plvl, plyr, & + tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & + gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & + faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & + mtopa, mbota, sfcalb) + + + +!zhang implicit none + use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_stateout_type, & + GFS_sfcprop_type, & + GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_tbd_type, & + GFS_cldprop_type, & + GFS_radtend_type, & + GFS_diag_type + use physparam + use physcons, only: eps => con_eps, & + & epsm1 => con_epsm1, & + & fvirt => con_fvirt & + &, rocp => con_rocp + use funcphys, only: fpvs + + use module_radiation_astronomy,only: sol_init, sol_update, coszmn + use module_radiation_gases, only: NF_VGAS, getgases, getozn, & + & gas_init, gas_update + use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & + & aer_init, aer_update, & + & NSPC1 + use module_radiation_surface, only: NF_ALBD, sfc_init, setalb, & + & setemis + use module_radiation_clouds, only: NF_CLDS, cld_init, & + & progcld1, progcld2,progcld3,& + & progclduni, diagcld1 + + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & + & profsw_type,cmpfsw_type,NBDSW +!zhang use module_radsw_main, only: rswinit, swrad + + use module_radlw_parameters, only: topflw_type, sfcflw_type, & + & proflw_type, NBDLW +!zhang use module_radlw_main, only: rlwinit, lwrad + + + implicit none + !integer, intent(inout) :: me, lm, im, lp1, ntrac + !integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_statein_type), intent(in) :: Statein + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + + !integer, intent(out) :: nday + !integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday + !real(kind=kind_phys), intent(out) :: raddt + !real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn + !real(kind=kind_phys), dimension(Size(Grid%xlon, 1), Model%levr+1+LTP), intent(inout) :: plvl + !real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr+LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl + !real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! LTP, 2:Model%ntrac), intent(inout) :: tracer1 + !real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! LTP), intent(inout) :: olyr + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! LTP, NF_VGAS), intent(inout) :: gasvmr + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! 1 + LTP), intent(inout) :: tlvl + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1)) :: tsfa,tem1d + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr+LTP), intent(inout) :: qlyr, tvly + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! LTP, NBDSW, NF_AESW), intent(inout) :: faersw + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! LTP, NBDLW, NF_AELW), intent(inout) :: faerlw + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(inout) :: aerodp + !real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & + ! LTP), intent(out) :: deltaq + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + ! LTP, NF_CLDS), intent(inout) :: clouds + !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa + !integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa + !real (kind = kind_phys), dimension(im, NF_ALBD), intent(out) :: sfcalb + !real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + ! htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & + ! qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & + ! tem2db, cldcov, deltaq, cnvc, cnvw + + +! --- version tag and last revision date + character(40), parameter :: & + & VTAGRAD='NCEP-Radiation_driver v5.2 Jan 2013 ' +! & VTAGRAD='NCEP-Radiation_driver v5.1 Nov 2012 ' +! & VTAGRAD='NCEP-Radiation_driver v5.0 Aug 2012 ' + +!>\name Constant values + +!> lower limit of saturation vapor pressure (=1.0e-10) + real (kind=kind_phys) :: QMIN +!> lower limit of specific humidity (=1.0e-7) + real (kind=kind_phys) :: QME5 +!> lower limit of specific humidity (=1.0e-7) + real (kind=kind_phys) :: QME6 +!> EPSQ=1.0e-12 + real (kind=kind_phys) :: EPSQ +! parameter (QMIN=1.0e-10, QME5=1.0e-5, QME6=1.0e-6, EPSQ=1.0e-12) + parameter (QMIN=1.0e-10, QME5=1.0e-7, QME6=1.0e-7, EPSQ=1.0e-12) +! parameter (QMIN=1.0e-10, QME5=1.0e-20, QME6=1.0e-20, EPSQ=1.0e-12) + +!> lower limit of toa pressure value in mb + real, parameter :: prsmin = 1.0e-6 + +!> control flag for LW surface temperature at air/ground interface +!! (default=0, the value will be set in subroutine radinit) + integer :: itsfc =0 + +!> new data input control variables (set/reset in subroutines +!radinit/radupdate): + integer :: month0=0, iyear0=0, monthd=0 + +!> control flag for the first time of reading climatological ozone data +!! (set/reset in subroutines radinit/radupdate, it is used only if the +!! control parameter ioznflg=0) + logical :: loz1st =.true. + +!> optional extra top layer on top of low ceiling models +!!\n LTP=0: no extra top layer + integer, parameter :: LTP = 0 ! no extra top layer +! integer, parameter :: LTP = 1 ! add an extra top layer + +!> control flag for extra top layer + logical, parameter :: lextop = (LTP > 0) + +! +! --- local variables: (horizontal dimensioned by IM) + !--- INTEGER VARIABLES + integer :: me, im, lm, nfxr, ntrac + integer :: i, j, k, k1, lv, itop, ibtc, nday, LP1, LMK, LMP, kd, & + lla, llb, lya, lyb, kt, kb + integer, dimension(size(Grid%xlon,1)) :: idxday + integer, dimension(size(Grid%xlon,1),3) :: mbota, mtopa + + !--- REAL VARIABLES + real(kind=kind_phys) :: raddt, es, qs, delt, tem0d + + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + tsfa, cvt1, cvb1, tem1d, tsfg, tskn + + real(kind=kind_phys), dimension(size(Grid%xlon,1),5) :: cldsa + real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1) :: aerodp + real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & + qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & + tem2db, cldcov, deltaq, cnvc, cnvw + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP) :: plvl, tlvl + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr + + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw + + !--- TYPED VARIABLES + type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw + + + + !pedro Set commonly used integers + !pedro call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) + +! +!===> ... begin here +! + !--- set commonly used integers + me = Model%me + LM = Model%levr + IM = size(Grid%xlon,1) + NFXR = Model%nfxr + NTRAC = Model%ntrac ! tracers in grrad strip off sphum - start tracer1(2:NTRAC) + + LP1 = LM + 1 ! num of in/out levels + + + !pedro Set local /level/layer indexes corresponding + !pedro to in/out variables + !pedro call Set_local_int (lmk, lm, lmp, kd, kt, & + !pedro kb, lla, llb, lya, lyb, lp1, raddt, Model) + +! --- ... set local /level/layer indexes corresponding to in/out +! variables + + LMK = LM + LTP ! num of local layers + LMP = LMK + 1 ! num of local levels + + if ( lextop ) then + if ( ivflip == 1 ) then ! vertical from sfc upward + kd = 0 ! index diff between in/out and local + kt = 1 ! index diff between lyr and upper bound + kb = 0 ! index diff between lyr and lower bound + lla = LMK ! local index at the 2nd level from top + llb = LMP ! local index at toa level + lya = LM ! local index for the 2nd layer from top + lyb = LP1 ! local index for the top layer + else ! vertical from toa downward + kd = 1 ! index diff between in/out and local + kt = 0 ! index diff between lyr and upper bound + kb = 1 ! index diff between lyr and lower bound + lla = 2 ! local index at the 2nd level from top + llb = 1 ! local index at toa level + lya = 2 ! local index for the 2nd layer from top + lyb = 1 ! local index for the top layer + endif ! end if_ivflip_block + else + kd = 0 + if ( ivflip == 1 ) then ! vertical from sfc upward + kt = 1 ! index diff between lyr and upper bound + kb = 0 ! index diff between lyr and lower bound + else ! vertical from toa downward + kt = 0 ! index diff between lyr and upper bound + kb = 1 ! index diff between lyr and lower bound + endif ! end if_ivflip_block + endif ! end if_lextop_block + + raddt = min(Model%fhswr, Model%fhlwr) +! print *,' in grrad : raddt=',raddt + + !pedro Setup surface ground temperature and + !pedro ground/air skin temperature if required. + !pedro call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) + +!> -# Setup surface ground temperature and ground/air skin temperature +!! if required. + + if ( itsfc == 0 ) then ! use same sfc skin-air/ground temp + do i = 1, IM + tskn(i) = Sfcprop%tsfc(i) + tsfg(i) = Sfcprop%tsfc(i) + enddo + else ! use diff sfc skin-air/ground temp + do i = 1, IM + tskn(i) = Sfcprop%tsfc(i) + tsfg(i) = Sfcprop%tsfc(i) + enddo + endif + + + + !pedro Prepare atmospheric profiles. + !pedro Convert pressure unit from pa to mb + !pedro call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & + ! prslk1, rhly, qstl, Model, Grid) + +!> -# Prepare atmospheric profiles for radiation input. +! +! convert pressure unit from pa to mb + do k = 1, LM + k1 = k + kd + do i = 1, IM + plvl(i,k1) = 0.01 * Statein%prsi(i,k) ! pa to mb (hpa) + plyr(i,k1) = 0.01 * Statein%prsl(i,k) ! pa to mb (hpa) + tlyr(i,k1) = Statein%tgrs(i,k) + prslk1(i,k1) = Statein%prslk(i,k) + +!> - Compute relative humidity. +! es = min( Statein%prsl(i,k), 0.001 * fpvs( Statein%tgrs(i,k) ) ) ! fpvs in pa + es = min( Statein%prsl(i,k), fpvs( Statein%tgrs(i,k) ) ) ! fpvs and prsl in pa + qs = max( QMIN, eps * es / (Statein%prsl(i,k) + epsm1*es) ) + rhly(i,k1) = max( 0.0, min( 1.0, max(QMIN, Statein%qgrs(i,k,1))/qs ) ) + qstl(i,k1) = qs + enddo + enddo + + + + !pedro Recast remaining all tracers (except sphum) + !pedro forcing them all to be positive + !pedro call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & + ! qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & + ! lla, lya, lyb) + + !--- recast remaining all tracers (except sphum) forcing them all + !to be positive + do j = 2, NTRAC + do k = 1, LM + k1 = k + kd + tracer1(:,k1,j) = max(0.0,Statein%qgrs(:,k,j)) + enddo + enddo + + do i = 1, IM + plvl(i,LP1+kd) = 0.01 * Statein%prsi(i,LP1) ! pa to mb (hpa) + enddo + + if ( lextop ) then ! values for extra top layer + do i = 1, IM + plvl(i,llb) = prsmin + if ( plvl(i,lla) <= prsmin ) plvl(i,lla) = 2.0*prsmin + plyr(i,lyb) = 0.5 * plvl(i,lla) + tlyr(i,lyb) = tlyr(i,lya) + prslk1(i,lyb) = (plyr(i,lyb)*0.00001) ** rocp ! plyr in Pa + rhly(i,lyb) = rhly(i,lya) + qstl(i,lyb) = qstl(i,lya) + enddo + +! --- note: may need to take care the top layer amount + tracer1(:,lyb,:) = tracer1(:,lya,:) + endif + + + !pedro Get layer ozone mass mixing ratio + !pedro call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) + +!> - Get layer ozone mass mixing ratio (if use ozone climatology data, +!! call getozn()). + + if (Model%ntoz > 0) then ! interactive ozone generation + olyr(:,:) = max( QMIN, tracer1(:,1:LMK,Model%ntoz) ) + else ! climatological ozone + call getozn (prslk1, Grid%xlat, IM, LMK, & ! --- inputs + olyr) ! --- outputs + endif ! end_if_ntoz + + + + !pedro Compute cosine of zenith angle. + !pedro call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & + !pedor im, me, Radtend%coszen, Radtend%coszdg) +!> - Call coszmn(), to compute cosine of zenith angle. + call coszmn (Grid%xlon,Grid%sinlat, & ! --- inputs + Grid%coslat,Model%solhr, IM, me, & + Radtend%coszen, Radtend%coszdg) ! --- outputs + + + !pedro Set up non-prognostic gas volume mixing ratioes + !pedro call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) + +!> - Call getgases(), to set up non-prognostic gas volume mixing +!! ratioes (gasvmr). +! - gasvmr(:,:,1) - co2 volume mixing ratio +! - gasvmr(:,:,2) - n2o volume mixing ratio +! - gasvmr(:,:,3) - ch4 volume mixing ratio +! - gasvmr(:,:,4) - o2 volume mixing ratio +! - gasvmr(:,:,5) - co volume mixing ratio +! - gasvmr(:,:,6) - cf11 volume mixing ratio +! - gasvmr(:,:,7) - cf12 volume mixing ratio +! - gasvmr(:,:,8) - cf22 volume mixing ratio +! - gasvmr(:,:,9) - ccl4 volume mixing ratio + +! --- ... set up non-prognostic gas volume mixing ratioes + + call getgases (plvl, Grid%xlon, Grid%xlat, IM, LMK, & ! --- inputs + gasvmr) ! --- outputs + + + + !pedro Get temperature at layer interface, and layer moisture. + !pedro call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & + !pedro im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) + +!> - Get temperature at layer interface, and layer moisture. + do k = 2, LMK + do i = 1, IM + tem2da(i,k) = log( plyr(i,k) ) + tem2db(i,k) = log( plvl(i,k) ) + enddo + enddo + + if (ivflip == 0) then ! input data from toa to sfc + do i = 1, IM + tem1d (i) = QME6 + tem2da(i,1) = log( plyr(i,1) ) + tem2db(i,1) = 1.0 + tsfa (i) = tlyr(i,LMK) ! sfc layer air temp + tlvl(i,1) = tlyr(i,1) + tlvl(i,LMP) = tskn(i) + enddo + + do k = 1, LM + k1 = k + kd + do i = 1, IM + qlyr(i,k1) = max( tem1d(i), Statein%qgrs(i,k,1) ) + tem1d(i) = min( QME5, qlyr(i,k1) ) + tvly(i,k1) = Statein%tgrs(i,k) * (1.0 + fvirt*qlyr(i,k1)) ! virtual T (K) + enddo + enddo + + if ( lextop ) then + do i = 1, IM + qlyr(i,lyb) = qlyr(i,lya) + tvly(i,lyb) = tvly(i,lya) + enddo + endif + + do k = 2, LMK + do i = 1, IM + tlvl(i,k) = tlyr(i,k) + (tlyr(i,k-1) - tlyr(i,k)) & + & * (tem2db(i,k) - tem2da(i,k)) & + & / (tem2da(i,k-1) - tem2da(i,k)) + enddo + enddo + + else ! input data from sfc to toa + + do i = 1, IM + tem1d (i) = QME6 + tem2da(i,1) = log( plyr(i,1) ) + tem2db(i,1) = log( plvl(i,1) ) + tsfa (i) = tlyr(i,1) ! sfc layer air temp + tlvl(i,1) = tskn(i) + tlvl(i,LMP) = tlyr(i,LMK) + enddo + + do k = LM, 1, -1 + do i = 1, IM + qlyr(i,k) = max( tem1d(i), Statein%qgrs(i,k,1) ) + tem1d(i) = min( QME5, qlyr(i,k) ) + tvly(i,k) = Statein%tgrs(i,k) * (1.0 + fvirt*qlyr(i,k)) ! virtual T (K) + enddo + enddo + + if ( lextop ) then + do i = 1, IM + qlyr(i,lyb) = qlyr(i,lya) + tvly(i,lyb) = tvly(i,lya) + enddo + endif + + do k = 1, LMK-1 + do i = 1, IM + tlvl(i,k+1) = tlyr(i,k) + (tlyr(i,k+1) - tlyr(i,k)) & + & * (tem2db(i,k+1) - tem2da(i,k)) & + & / (tem2da(i,k+1) - tem2da(i,k)) + enddo + enddo + + endif ! end_if_ivflip + + !pedro Check for daytime points for SW radiation. + !pedro call Find_daytime (im, Radtend, Grid, nday, idxday) + +!> - Check for daytime points for SW radiation. + + nday = 0 + do i = 1, IM + if (Radtend%coszen(i) >= 0.0001) then + nday = nday + 1 + idxday(nday) = i + endif + enddo + + !pedro Setup aerosols + !pedro call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & + !pedro tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & + !pedro Model%lslwr, faersw,faerlw,aerodp) + +!> - Call module_radiation_aerosols::setaer(),to setup aerosols +!! property profile for radiation. + +!check print *,' in grrad : calling setaer ' + + call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & ! --- inputs + tracer1, Grid%xlon, Grid%xlat, IM, LMK, LMP, & + Model%lsswr,Model%lslwr, & + faersw,faerlw,aerodp) ! --- outputs + + + + !pedro Obtain cloud information + !pedro call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & + !pedro Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & + !pedro deltaq, plvl, plyr, tlyr, qlyr, tvly, & + !pedro rhly, qstl, clouds, cldsa, mtopa, mbota) + +!> - Obtain cloud information for radiation calculations +!! (clouds,cldsa,mtopa,mbota) +!!\n for prognostic cloud: +!! - For Zhao/Moorthi's prognostic cloud scheme, +!! call module_radiation_clouds::progcld1() +!! - For Zhao/Moorthi's prognostic cloud+pdfcld, +!! call module_radiation_clouds::progcld3() +!! call module_radiation_clouds::progclduni() for unified cloud and ncld=2 +!> - If cloud condensate is not computed (ntcw=0), using the legacy +!! cloud scheme, compute cloud information based on Slingo's +!! diagnostic cloud scheme (call module_radiation_clouds::diagcld1()) + +! --- ... obtain cloud information for radiation calculations + + if (Model%ntcw > 0) then ! prognostic cloud scheme + if (Model%uni_cld .and. Model%ncld >= 2) then + clw(:,:) = tracer1(:,1:LMK,Model%ntcw) ! cloud water amount + ciw(:,:) = 0.0 + do j = 2, Model%ncld + ciw(:,:) = ciw(:,:) + tracer1(:,1:LMK,Model%ntcw+j-1) ! cloud ice amount + enddo + + do k = 1, LMK + do i = 1, IM + if ( clw(i,k) < EPSQ ) clw(i,k) = 0.0 + if ( ciw(i,k) < EPSQ ) ciw(i,k) = 0.0 + enddo + enddo + else + clw(:,:) = 0.0 + do j = 1, Model%ncld + clw(:,:) = clw(:,:) + tracer1(:,1:LMK,Model%ntcw+j-1) ! cloud condensate amount + enddo + + do k = 1, LMK + do i = 1, IM + if ( clw(i,k) < EPSQ ) clw(i,k) = 0.0 + enddo + enddo + endif +! +! --- add suspended convective cloud water to grid-scale cloud water +! only for cloud fraction & radiation computation +! it is to enhance cloudiness due to suspended convec cloud water +! for zhao/moorthi's (icmphys=1) & +! ferrier's (icmphys=2) microphysics schemes +! + if (Model%shoc_cld) then ! all but MG microphys + cldcov(:,1:LM) = Tbd%phy_f3d(:,1:LM,Model%ntot3d-2) + elseif (Model%ncld == 2) then ! MG microphys (icmphys = 1) + cldcov(:,1:LM) = Tbd%phy_f3d(:,1:LM,1) + else ! neither of the other two cases + cldcov = 0 + endif + + if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then ! icmphys = 3 + deltaq(:,1:LM) = Tbd%phy_f3d(:,1:LM,5) + cnvw (:,1:LM) = Tbd%phy_f3d(:,1:LM,6) + cnvc (:,1:LM) = Tbd%phy_f3d(:,1:LM,7) + elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then ! icmphys = 1 + deltaq(:,1:LM) = 0. + cnvw (:,1:LM) = Tbd%phy_f3d(:,1:LM,Model%num_p3d+1) + cnvc (:,1:LM) = 0. + else ! icmphys = 1 (ncld=2) + deltaq = 0.0 + cnvw = 0.0 + cnvc = 0.0 + endif + + if (lextop) then + cldcov(:,lyb) = cldcov(:,lya) + deltaq(:,lyb) = deltaq(:,lya) + cnvw (:,lyb) = cnvw (:,lya) + cnvc (:,lyb) = cnvc (:,lya) + endif + + if (icmphys == 1) then + clw(:,1:LMK) = clw(:,1:LMK) + cnvw(:,1:LMK) + endif +! + + if (icmphys == 1) then ! zhao/moorthi's prognostic cloud scheme + ! or unified cloud and/or with MG microphysics + + if (Model%uni_cld .and. Model%ncld >= 2) then + call progclduni (plyr, plvl, tlyr, tvly, clw, ciw, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk, & + IM, LMK, LMP, cldcov(:,1:LMK), & + clouds, cldsa, mtopa, mbota) ! --- outputs + else + call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, & ! --- inputs + rhly, clw, Grid%xlat,Grid%xlon, & + Sfcprop%slmsk, IM, LMK, LMP, & + Model%uni_cld, Model%lmfshal, & + Model%lmfdeep2, cldcov(:,1:LMK), & + clouds, cldsa, mtopa, mbota) ! --- outputs + endif + + elseif(icmphys == 3) then ! zhao/moorthi's prognostic cloud+pdfcld + + call progcld3 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly,& ! --- inputs + clw, cnvw, cnvc, Grid%xlat, Grid%xlon, & + Sfcprop%slmsk,im, lmk, lmp, deltaq, & + Model%sup, Model%kdt, me, & + clouds, cldsa, mtopa, mbota) ! --- outputs + + endif ! end if_icmphys + + else ! diagnostic cloud scheme + + cvt1(:) = 0.01 * Cldprop%cvt(:) + cvb1(:) = 0.01 * Cldprop%cvb(:) + + do k = 1, LM + k1 = k + kd + vvel(:,k1) = 0.01 * Statein%vvl(:,k) + enddo + if (lextop) then + vvel(:,lyb) = vvel(:,lya) + endif + +! --- compute diagnostic cloud related quantities + + call diagcld1 (plyr, plvl, tlyr, rhly, vvel, Cldprop%cv, & ! --- inputs + cvt1, cvb1, Grid%xlat, Grid%xlon, & + Sfcprop%slmsk, IM, LMK, LMP, & + clouds, cldsa, mtopa, mbota) ! --- outputs + + endif ! end_if_ntcw + + !pedro Setup surface albedo for SW calculation + !pedro call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + !pedro Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & + !pedro Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & + !pedro Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + !pedro Sfcprop%tisfc, im, Model%lsswr, & + !pedro sfcalb, Radtend%sfalb) ! --- outputs + +! --- ... start radiation calculations +! remember to set heating rate unit to k/sec! +!> -# Start SW radiation calculations + if (Model%lsswr) then + +!> - Call module_radiation_surface::setalb() to setup surface albedo. +!! for SW radiation. + + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + sfcalb) ! --- outputs + +!> -# Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + + + endif ! Model%lsswr + + !zhang: should called before + !pedro Setup surface emissivity for LW radiation. + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & + Radtend%semis) ! --- outputs + + + end subroutine GFS_RRTMG_pre_run + +!!\section arg_table_GFS_RRTMG_pre_finalize Argument Table +!! + subroutine GFS_RRTMG_pre_finalize + end subroutine GFS_RRTMG_pre_finalize + +!! @} + end module GFS_RRTMG_pre + + From 4172e151e062c49b1aa212e1de32e8389bc1fd70 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 4 Dec 2017 14:47:02 -0700 Subject: [PATCH 082/114] fixed some standard name conflicts in GFS_SCNV_generic --- physics/GFS_SCNV_generic.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_SCNV_generic.f90 b/physics/GFS_SCNV_generic.f90 index 9f909f5d0..f504d892e 100644 --- a/physics/GFS_SCNV_generic.f90 +++ b/physics/GFS_SCNV_generic.f90 @@ -55,8 +55,8 @@ end subroutine GFS_SCNV_generic_post_finalize !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|-----------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | -!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | !! | Stateout | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state to return to dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | !! | initial_t | air_temperature_initial | air temperature before entering a physics scheme | K | 2 | real | kind_phys | in | F | !! | initial_qv | water_vapor_specific_humidity_initial | water vapor specific humidity before entering a physics scheme | kg kg-1 | 2 | real | kind_phys | in | F | !! | frain | dynamics_to_physics_timestep_ratio | ratio of dynamics timestep to physics timestep | none | 0 | real | kind_phys | in | F | From 4d1954e3b65c49fc2555f719a4b0080fc7c8bc58 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Mon, 4 Dec 2017 16:58:07 -0700 Subject: [PATCH 083/114] table is done in physics/GFS_RRTMG_pre.f90 --- GFS_layer/GFS_radiation_driver.F90 | 755 +++++------------------------ physics/GFS_RRTMG_pre.f90 | 252 +++++----- 2 files changed, 240 insertions(+), 767 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index d8e3c9160..a89ad918f 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1007,7 +1007,6 @@ subroutine GFS_radiation_driver & (Model, Statein, Stateout, Sfcprop, Coupling, Grid, Tbd, & Cldprop, Radtend, Diag) -! use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run implicit none @@ -1201,13 +1200,20 @@ subroutine GFS_radiation_driver & type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw - call GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & - lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & - tskn, tsfg, Sfcprop, Statein, plvl, plyr, & - tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & - gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & - faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & - mtopa, mbota, sfcalb) + call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input + Tbd, Cldprop, Radtend, & + lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output + tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & + gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & + gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & + gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10), & + faersw(:,:,1), faersw(:,:,2), faersw(:,:,3), & + faerlw(:,:,1), faerlw(:,:,2), faerlw(:,:,3), aerodp, & + clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & + clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & + clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & + cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), & + sfcalb(:,4)) ! Calculate SW heating and fluxes @@ -1225,7 +1231,7 @@ subroutine GFS_radiation_driver & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) -!zhang: move setemis here +!CCPP todo list: move setemis here ! Calculate LW heating rates and fluxes. call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & @@ -1249,531 +1255,6 @@ subroutine GFS_radiation_driver & end subroutine GFS_radiation_driver - ! Subroutines added by PAJ - - subroutine Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) - - implicit none - - integer, intent(inout) :: me, lm, im, lp1, ntrac - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - - me = Model%me - lm = Model%levr - im = Size (Grid%xlon, 1) - ntrac = Model%ntrac - ! num of in/out levels - lp1 = lm + 1 - - end subroutine Set_common_int - - - subroutine Set_local_int (lmk, lm, lmp, kd, kt, & - kb, lla, llb, lya, lyb, lp1, raddt, Model) - - implicit none - - integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb - integer, intent(in) :: lm, lp1 - type(GFS_control_type), intent(in) :: Model - real(kind=kind_phys), intent(out) :: raddt - - - ! PAJ: LTP is a global parameter - lmk = lm + LTP ! num of local layers - lmp = lmk + 1 ! num of local levels - - ! PAJ: lextop is a global variable - if (lextop) then - if (ivflip == 1) then ! vertical from sfc upward - kd = 0 ! index diff between in/out and local - kt = 1 ! index diff between lyr and upper bound - kb = 0 ! index diff between lyr and lower bound - lla = lmk ! local index at the 2nd level from top - llb = lmp ! local index at toa level - lya = lm ! local index for the 2nd layer from top - lyb = lp1 ! local index for the top layer - else ! vertical from toa downward - kd = 1 ! index diff between in/out and local - kt = 0 ! index diff between lyr and upper bound - kb = 1 ! index diff between lyr and lower bound - lla = 2 ! local index at the 2nd level from top - llb = 1 ! local index at toa level - lya = 2 ! local index for the 2nd layer from top - lyb = 1 ! local index for the top layer - endif ! end if_ivflip_block - else - kd = 0 - if (ivflip == 1) then ! vertical from sfc upward - kt = 1 ! index diff between lyr and upper bound - kb = 0 ! index diff between lyr and lower bound - else ! vertical from toa downward - kt = 0 ! index diff between lyr and upper bound - kb = 1 ! index diff between lyr and lower bound - endif ! end if_ivflip_block - endif ! end if_lextop_block - - raddt = min(Model%fhswr, Model%fhlwr) - - end subroutine Set_local_int - - - subroutine Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) - - implicit none - - integer, intent(in) :: im - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_grid_type), intent(in) :: Grid - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn - - ! Local vars - integer :: i - - - ! itsfc is a global var - if (itsfc == 0) then ! use same sfc skin-air/ground temp - do i = 1, im - tskn(i) = Sfcprop%tsfc(i) - tsfg(i) = Sfcprop%tsfc(i) - enddo - else ! use diff sfc skin-air/ground temp - do i = 1, im - tskn(i) = Sfcprop%tsfc(i) - tsfg(i) = Sfcprop%tsfc(i) - enddo - endif - - end subroutine Set_sfc_vars - - - subroutine Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & - prslk1, rhly, qstl, Model, Grid) - - implicit none - - integer, intent(in) :: lm, kd, im - type(GFS_statein_type), intent(in) :: Statein - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - - real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(out) :: plvl - real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(out) :: prslk1, plyr, tlyr, qstl, rhly - - ! Local vars - integer :: k, k1, i - real(kind = kind_phys) :: es, qs - - do k = 1, lm - k1 = k + kd - do i = 1, im - plvl(i, k1) = 0.01 * Statein%prsi(i, k) ! pa to mb (hpa) - plyr(i, k1) = 0.01 * Statein%prsl(i, k) ! pa to mb (hpa) - tlyr(i, k1) = Statein%tgrs(i, k) - prslk1(i, k1) = Statein%prslk(i, k) - - ! Compute relative humidity. - es = Min (Statein%prsl(i,k), fpvs (Statein%tgrs(i, k))) ! fpvs and prsl in pa - qs = Max (QMIN, EPS * es / (Statein%prsl(i,k) + EPSM1 * es)) - rhly(i, k1) = max (0.0, min (1.0, max(QMIN, Statein%qgrs(i, k, 1)) / qs)) - qstl(i, k1) = qs - end do - end do - - end subroutine Prep_profiles - - - subroutine Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, & - rhly, qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, & - llb, lla, lya, lyb) - - implicit none - - type(GFS_statein_type), intent(in) :: Statein - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - - integer, intent(in) :: ntrac, lm, im, kd, lp1, lla, llb, lya, lyb - - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, 2:Model%ntrac), intent(inout) :: tracer1 - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(inout) :: plvl - real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl - - ! Local vars - integer :: i, j, k, k1 - - - do j = 2, ntrac - do k = 1, lm - k1 = k + kd - tracer1(:, k1, j) = Max (0.0, Statein%qgrs(:, k, j)) - end do - end do - - do i = 1, im - plvl(i, lp1 + kd) = 0.01 * Statein%prsi(i, lp1) ! pa to mb (hpa) - enddo - - ! PAJ: lextop is a global variable - if (lextop) then ! values for extra top layer - do i = 1, im - plvl(i, llb) = PRSMIN - if (plvl(i, lla) <= PRSMIN) plvl(i, lla) = 2.0 * PRSMIN - plyr(i, lyb) = 0.5 * plvl(i, lla) - tlyr(i, lyb) = tlyr(i, lya) - prslk1(i, lyb) = (plyr(i, lyb) * 0.00001) ** ROCP ! plyr in Pa - rhly(i, lyb) = rhly(i, lya) - qstl(i, lyb) = qstl(i, lya) - enddo - - ! note: may need to take care the top layer amount - tracer1(:,lyb,:) = tracer1(:,lya,:) - endif - - end subroutine Recast_tracers - - - subroutine Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) - - implicit none - - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, 2:Model%ntrac), intent(in) :: tracer1 - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: prslk1 - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(inout) :: olyr - - integer, intent(in) :: im, lmk - - - if (Model%ntoz > 0) then - ! interactive ozone generation - olyr(:,:) = Max (QMIN, tracer1(:, 1:lmk, Model%ntoz)) - else - ! climatological ozone - call getozn (prslk1, Grid%xlat, im, lmk, olyr) - endif - - end subroutine Prep_ozone - - - subroutine Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, im, lya, lyb, plyr, tlyr, & - tlvl, plvl, tsfa, tskn, tvly, qlyr) - - implicit none - - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_statein_type), intent(in) :: Statein - - integer, intent(in) :: lmk, lm, im, lya, lyb, lmp, kd - - real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: plyr, tlyr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(in) :: plvl - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(inout) :: tlvl - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(inout) :: tsfa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(inout) :: tskn - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(inout) :: qlyr, tvly - - ! Local vars - integer :: i, k, k1 - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP) :: tem2da, tem2db - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)) :: tem1d - - - do k = 2, lmk - do i = 1, im - tem2da(i, k) = Log (plyr(i, k)) - tem2db(i, k) = Log (plvl(i, k)) - enddo - enddo - - if_ivlflip: if (ivflip == 0) then - ! input data from toa to sfc - do i = 1, im - ! QME6 is a global parameter - tem1d(i) = QME6 - tem2da(i, 1) = Log (plyr(i, 1)) - tem2db(i, 1) = 1.0 - tsfa(i) = tlyr(i, lmk) ! sfc layer air temp - tlvl(i, 1) = tlyr(i, 1) - tlvl(i, lmp) = tskn(i) - end do - - do k = 1, lm - k1 = k + kd - do i = 1, im - qlyr(i, k1) = Max (tem1d(i), Statein%qgrs(i, k, 1)) - tem1d(i) = Min (QME5, qlyr(i,k1)) - ! virtual T (K) - tvly(i, k1) = Statein%tgrs(i, k) * (1.0 + FVIRT * & - qlyr(i, k1)) - end do - end do - - if (lextop) then - do i = 1, im - qlyr(i, lyb) = qlyr(i, lya) - tvly(i, lyb) = tvly(i, lya) - end do - end if - - do k = 2, lmk - do i = 1, im - tlvl(i, k) = tlyr(i, k) + (tlyr(i, k - 1) - tlyr(i, k)) & - * (tem2db(i, k) - tem2da(i, k)) / (tem2da(i, k - 1) - & - tem2da(i, k)) - end do - end do - - else - - ! input data from sfc to toa - do i = 1, im - tem1d(i) = QME6 - tem2da(i, 1) = Log (plyr(i, 1)) - tem2db(i, 1) = Log (plvl(i, 1)) - ! sfc layer air temp - tsfa(i) = tlyr(i, 1) - tlvl(i, 1) = tskn(i) - tlvl(i, lmp) = tlyr(i, lmk) - end do - - do k = lm, 1, -1 - do i = 1, im - qlyr(i, k) = Max (tem1d(i), Statein%qgrs(i, k, 1)) - tem1d(i) = Min (QME5, qlyr(i, k)) - ! virtual T (K) - tvly(i, k) = Statein%tgrs(i, k) * (1.0 + FVIRT * & - qlyr(i, k)) - end do - end do - - if (lextop) then - do i = 1, im - qlyr(i, lyb) = qlyr(i, lya) - tvly(i, lyb) = tvly(i, lya) - end do - end if - - do k = 1, lmk - 1 - do i = 1, im - tlvl(i, k + 1) = tlyr(i, k) + (tlyr(i, k + 1) - tlyr(i, k)) & - * (tem2db(i, k + 1) - tem2da(i, k)) / (tem2da(i, k + 1) - & - tem2da(i,k)) - end do - end do - - end if if_ivlflip - - end subroutine Prep_t_and_moist - - - subroutine Find_daytime (im, Radtend, Grid, nday, idxday) - - implicit none - - type(GFS_radtend_type), intent(in) :: Radtend - type(GFS_grid_type), intent(in) :: Grid - integer, intent(in) :: im - - integer, intent(out) :: nday - integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday - - ! Local vars - integer :: i - - nday = 0 - do i = 1, im - if (Radtend%coszen(i) >= 0.0001) then - nday = nday + 1 - idxday(nday) = i - end if - end do - - end subroutine Find_daytime - - - subroutine Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & - Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & - deltaq, plvl, plyr, tlyr, qlyr, tvly, & - rhly, qstl, clouds, cldsa, mtopa, mbota) - - implicit none - - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_tbd_type), intent(in) :: Tbd - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_cldprop_type), intent(in) :: Cldprop - type(GFS_statein_type), intent(in) :: Statein - - integer, intent(in) :: lmk, lm, lya, lyb, lmp, im, me, kd - - real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(out) :: deltaq - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(inout) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa - integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa - - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(in) :: plvl - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, 2:Model%ntrac), intent(in) :: tracer1 - real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: plyr, tlyr, tvly, qlyr, qstl, rhly - - ! Local vars - integer :: i, j, k, k1 - real(kind = kind_phys), dimension(size(Grid%xlon, 1)) :: cvt1, cvb1 - real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP) :: vvel, clw, ciw, cldcov, cnvc, cnvw - - - if (Model%ntcw > 0) then - ! prognostic cloud scheme - if (Model%uni_cld .and. Model%ncld >= 2) then - ! cloud water amount - clw(:,:) = tracer1(:, 1:lmk, Model%ntcw) - ! cloud ice amount - ciw(:,:) = 0.0 - do j = 2, Model%ncld - ciw(:, :) = ciw(:, :) + tracer1(:, 1:lmk, Model%ntcw + j - 1) - end do - - do k = 1, lmk - do i = 1, im - if (clw(i, k) < EPSQ) clw(i, k) = 0.0 - if (ciw(i, k) < EPSQ) ciw(i, k) = 0.0 - end do - end do - else - ! cloud condensate amount - clw(:, :) = 0.0 - do j = 1, Model%ncld - clw(:, :) = clw(:, :) + tracer1(:, 1:lmk, Model%ntcw + j - 1) - end do - - do k = 1, lmk - do i = 1, im - if (clw(i, k) < EPSQ ) clw(i, k) = 0.0 - end do - end do - endif - - ! - ! --- add suspended convective cloud water to grid-scale cloud water - ! only for cloud fraction & radiation computation - ! it is to enhance cloudiness due to suspended convec cloud water - ! for zhao/moorthi's (icmphys=1) & - ! ferrier's (icmphys=2) microphysics schemes - ! - - if (Model%shoc_cld) then - ! all but MG microphys - cldcov(:, 1:lm) = Tbd%phy_f3d(:, 1:lm, Model%ntot3d - 2) - elseif (Model%ncld == 2) then - ! MG microphys (icmphys = 1) - cldcov(:,1:lm) = Tbd%phy_f3d(:, 1:lm, 1) - else - ! neither of the other two cases - cldcov = 0 - end if - - if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then - ! icmphys = 3 - deltaq(:, 1:lm) = Tbd%phy_f3d(:, 1:lm, 5) - cnvw (:, 1:lm) = Tbd%phy_f3d(:, 1:lm, 6) - cnvc (:, 1:lm) = Tbd%phy_f3d(:, 1:lm, 7) - elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then - ! icmphys = 1 - deltaq(:, 1:lm) = 0.0 - cnvw(:, 1:lm) = Tbd%phy_f3d(:, 1:lm, Model%num_p3d + 1) - cnvc(:, 1:lm) = 0.0 - else - ! icmphys = 1 (ncld=2) - deltaq = 0.0 - cnvw = 0.0 - cnvc = 0.0 - endif - - if (lextop) then - cldcov(:, lyb) = cldcov(:, lya) - deltaq(:, lyb) = deltaq(:, lya) - cnvw(:, lyb) = cnvw(:, lya) - cnvc(:, lyb) = cnvc(:, lya) - endif - - if (icmphys == 1) then - clw(:, 1:lmk) = clw(:, 1:lmk) + cnvw(:, 1:lmk) - end if - - if (icmphys == 1) then - ! zhao/moorthi's prognostic cloud scheme - ! or unified cloud and/or with MG microphysics - if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni (plyr, plvl, tlyr, tvly, clw, ciw, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, & - im, lmk, lmp, cldcov(:, 1:lmk), & - clouds, cldsa, mtopa, mbota) ! --- outputs - else - call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, & ! --- inputs - rhly, clw, Grid%xlat, Grid%xlon, & - Sfcprop%slmsk, im, lmk, lmp, & - Model%uni_cld, Model%lmfshal, & - Model%lmfdeep2, cldcov(:, 1:lmk), & - clouds, cldsa, mtopa, mbota) ! --- outputs - endif - - elseif(icmphys == 3) then ! zhao/moorthi's prognostic cloud+pdfcld - - call progcld3 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly,& ! --- inputs - clw, cnvw, cnvc, Grid%xlat, Grid%xlon, & - Sfcprop%slmsk, im, lmk, lmp, deltaq, & - Model%sup, Model%kdt, me, & - clouds, cldsa, mtopa, mbota) ! --- outputs - - endif - - else - ! diagnostic cloud scheme - cvt1(:) = 0.01 * Cldprop%cvt(:) - cvb1(:) = 0.01 * Cldprop%cvb(:) - - do k = 1, lm - k1 = k + kd - vvel(:, k1) = 0.01 * Statein%vvl(:, k) - end do - - if (lextop) then - vvel(:, lyb) = vvel(:, lya) - endif - - ! --- compute diagnostic cloud related quantities - call diagcld1 (plyr, plvl, tlyr, rhly, vvel, Cldprop%cv, & ! --- inputs - cvt1, cvb1, Grid%xlat, Grid%xlon, & - Sfcprop%slmsk, im, lmk, lmp, & - clouds, cldsa, mtopa, mbota) ! --- outputs - - endif ! end_if_ntcw - - end subroutine Get_cloud_info !> - For time averaged output quantities (including total-sky and @@ -1939,31 +1420,31 @@ subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, end subroutine Zero_out_heatrate_flux - subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & - coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & - facsf, facwf, fice, tisfc, IMAX, lsswr, sfcalb, sfalb) +! subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & +! coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & +! facsf, facwf, fice, tisfc, IMAX, lsswr, sfcalb, sfalb) - implicit none +! implicit none - integer, intent(in) :: IMAX - real (kind = kind_phys), dimension(:), intent(in) :: slmsk, snowf, & - zorlf, coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, & - alnwf, facsf, facwf, fice, tisfc, sncovr, snoalb - logical, intent(in) :: lsswr +! integer, intent(in) :: IMAX +! real (kind = kind_phys), dimension(:), intent(in) :: slmsk, snowf, & +! zorlf, coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, & +! alnwf, facsf, facwf, fice, tisfc, sncovr, snoalb +! logical, intent(in) :: lsswr - real (kind = kind_phys), dimension(IMAX, NF_ALBD), intent(out) :: sfcalb - real (kind = kind_phys), dimension(:), intent(out) :: sfalb +! real (kind = kind_phys), dimension(IMAX, NF_ALBD), intent(out) :: sfcalb +! real (kind = kind_phys), dimension(:), intent(out) :: sfalb - if (.not. lsswr) return +! if (.not. lsswr) return - call setalb (slmsk, snowf, sncovr, snoalb, zorlf, & - coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & - facsf, facwf, fice, tisfc, IMAX, sfcalb) +! call setalb (slmsk, snowf, sncovr, snoalb, zorlf, & +! coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & +! facsf, facwf, fice, tisfc, IMAX, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. - sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) +! sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) - end subroutine Set_sfc_albedo +! end subroutine Set_sfc_albedo subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, lsswr) @@ -2129,139 +1610,139 @@ subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) end subroutine Post_lw - subroutine Pre_radiation (Model, Grid, lm, me, im, ntrac, & - lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & - tskn, tsfg, Sfcprop, Statein, plvl, plyr, & - tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & - gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & - faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & - mtopa, mbota, sfcalb) - - - implicit none - - integer, intent(inout) :: me, lm, im, lp1, ntrac - integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_statein_type), intent(in) :: Statein - type(GFS_radtend_type), intent(in) :: Radtend - type(GFS_tbd_type), intent(in) :: Tbd - type(GFS_cldprop_type), intent(in) :: Cldprop - - integer, intent(out) :: nday - integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday - real(kind=kind_phys), intent(out) :: raddt - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(inout) :: plvl - real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, 2:Model%ntrac), intent(inout) :: tracer1 - real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(inout) :: olyr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_VGAS), intent(inout) :: gasvmr - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - 1 + LTP), intent(inout) :: tlvl - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(inout) :: tsfa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(inout) :: qlyr, tvly - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NBDSW, NF_AESW), intent(inout) :: faersw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NBDLW, NF_AELW), intent(inout) :: faerlw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(inout) :: aerodp - real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - LTP), intent(out) :: deltaq - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(inout) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa - integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa - real (kind = kind_phys), dimension(im, NF_ALBD), intent(out) :: sfcalb +! subroutine Pre_radiation (Model, Grid, lm, me, im, ntrac, & +! lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & +! tskn, tsfg, Sfcprop, Statein, plvl, plyr, & +! tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & +! gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & +! faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & +! mtopa, mbota, sfcalb) + + +! implicit none + +! integer, intent(inout) :: me, lm, im, lp1, ntrac +! integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb +! type(GFS_control_type), intent(in) :: Model +! type(GFS_grid_type), intent(in) :: Grid +! type(GFS_sfcprop_type), intent(in) :: Sfcprop +! type(GFS_statein_type), intent(in) :: Statein +! type(GFS_radtend_type), intent(in) :: Radtend +! type(GFS_tbd_type), intent(in) :: Tbd +! type(GFS_cldprop_type), intent(in) :: Cldprop + +! integer, intent(out) :: nday +! integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday +! real(kind=kind_phys), intent(out) :: raddt +! real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn +! real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! 1 + LTP), intent(inout) :: plvl +! real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & +! LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl +! real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, 2:Model%ntrac), intent(inout) :: tracer1 +! real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP), intent(inout) :: olyr +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NF_VGAS), intent(inout) :: gasvmr +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! 1 + LTP), intent(inout) :: tlvl +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(inout) :: tsfa +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP), intent(inout) :: qlyr, tvly +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NBDSW, NF_AESW), intent(inout) :: faersw +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NBDLW, NF_AELW), intent(inout) :: faerlw +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(inout) :: aerodp +! real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & +! LTP), intent(out) :: deltaq +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & +! LTP, NF_CLDS), intent(inout) :: clouds +! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa +! integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa +! real (kind = kind_phys), dimension(im, NF_ALBD), intent(out) :: sfcalb ! Set commonly used integers - call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) +! call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) !Set local /level/layer indexes corresponding ! to in/out variables - call Set_local_int (lmk, lm, lmp, kd, kt, & - kb, lla, llb, lya, lyb, lp1, raddt, Model) +! call Set_local_int (lmk, lm, lmp, kd, kt, & +! kb, lla, llb, lya, lyb, lp1, raddt, Model) ! Setup surface ground temperature and ! ground/air skin temperature if required. - call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) +! call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) ! Prepare atmospheric profiles. ! Convert pressure unit from pa to mb - call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & - prslk1, rhly, qstl, Model, Grid) +! call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & +! prslk1, rhly, qstl, Model, Grid) ! Recast remaining all tracers (except sphum) ! forcing them all to be positive - call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & - qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & - lla, lya, lyb) +! call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & +! qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & +! lla, lya, lyb) ! Get layer ozone mass mixing ratio - call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) +! call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) ! Compute cosine of zenith angle. - call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & - im, me, Radtend%coszen, Radtend%coszdg) +! call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & +! im, me, Radtend%coszen, Radtend%coszdg) ! Set up non-prognostic gas volume mixing ratioes - call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) +! call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) ! Get temperature at layer interface, and layer moisture. - call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & - im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) +! call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & +! im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) ! Check for daytime points for SW radiation. - call Find_daytime (im, Radtend, Grid, nday, idxday) +! call Find_daytime (im, Radtend, Grid, nday, idxday) ! Setup aerosols - call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & - tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & - Model%lslwr, faersw,faerlw,aerodp) +! call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & +! tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & +! Model%lslwr, faersw,faerlw,aerodp) ! Obtain cloud information - call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & - Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & - deltaq, plvl, plyr, tlyr, qlyr, tvly, & - rhly, qstl, clouds, cldsa, mtopa, mbota) +! call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & +! Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & +! deltaq, plvl, plyr, tlyr, qlyr, tvly, & +! rhly, qstl, clouds, cldsa, mtopa, mbota) ! Setup surface albedo for SW calculation - call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & - Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & - Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, im, Model%lsswr, & - sfcalb, Radtend%sfalb) ! --- outputs +! call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: +! Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & +! Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & +! Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & +! Sfcprop%tisfc, im, Model%lsswr, & +! sfcalb, Radtend%sfalb) ! --- outputs ! Setup surface emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - Radtend%semis) ! --- outputs +! call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs +! Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & +! tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & +! Radtend%semis) ! --- outputs - end subroutine Pre_radiation +! end subroutine Pre_radiation subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index cc76eb5e4..ff2bab147 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -14,26 +14,81 @@ subroutine GFS_RRTMG_pre_init end subroutine GFS_RRTMG_pre_init !!\section arg_table_GFS_RRTMG_pre_run Argument Table -!!| local var name | longname | description | units | rank | type | kind | intent | optional | -!!|----------------|----------------------------------- -----------|----------------------------------------------------------------------|-------------|------|-------------------------------|-----------|--------|----------| -!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | -!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | -!!| lm -!!| me -!!| im -!!| ntrac -!!| lmk - subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & - lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & - tskn, tsfg, Sfcprop, Statein, plvl, plyr, & - tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & - gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & - faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & - mtopa, mbota, sfcalb) - - - -!zhang implicit none +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|-------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | +!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | | in | F | +!!| Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | | in | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | +!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | +!!| lmk | vertical_layer_dimension_with_extra_top_layer | number of vertical layers with extra top layer | index | 0 | integer | | out | F | +!!| lmp | vertical_level_dimension_with_extra_top_layer | number of vertical levels with extra top layer | index | 0 | integer | | out | F | +!!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | +!!| kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | +!!| kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | +!!| raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | +!!| plvl | air_pressure_at_interface_for_radiation | air pressure at vertical interface for radiation calculation | mb | 2 | real | kind_phys | out | F | +!!| plyr | air_pressure_at_layer_for_radiation | air pressure at vertical layer for radiation calculation | mb | 2 | real | kind_phys | out | F | +!!| tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | +!!| tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | +!!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature | K | 1 | real | kind_phys | out | F | +!!| tsfa | surface_layer_temperature_for_radiation | air temperature at the first layer | K | 1 | real | kind_phys | out | F | +!!| qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | +!!| nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | out | F | +!!| idxday | daytime_points | daytime points | none | 1 | integer | | out | F | +!!| olyr | ozone_mixing_ratio_for_radiation | ozone mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_co2 | volume_mixing_ratio_co2 | CO2 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_n2o | volume_mixing_ratio_n2o | N2O volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_ch4 | volume_mixing_ratio_ch4 | CH4 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_o2 | volume_mixing_ratio_o2 | O2 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_co | volume_mixing_ratio_co | CO volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc11 | volume_mixing_ratio_cfc11 | CFC11 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc12 | volume_mixing_ratio_cfc12 | CFC12 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc22 | volume_mixing_ratio_cfc22 | CFC22 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_ccl4 | volume_mixing_ratio_ccl4 | CCL4 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc113 | volume_mixing_ratio_cfc113 | CFC113 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| faersw1 | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faersw2 | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faersw3 | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry parameter for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| aerodp | vertical_integrated_aerosol_optical_depth | vertical integrated aerosol optical depth | | 2 | real | kind_phys | out | F | +!!| clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | +!!| clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | +!!| clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | +!!| clouds6 | rain_water_path | layer rain drop water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | +!!| clouds8 | snow_water_path | layer snow flake water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | +!!| cldsa | level_cloud_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | +!!| mtopa | vertical_indices_for_cloud_tops | vertical indices for low, middle and high cloud tops (IX, 3) | index | 2 | integer | | out | F | +!!| mbota | vertical_indices_for_cloud_bases | vertical indices for low, middle and high cloud bases (IX, 3) | index | 2 | integer | | out | F | +!!| sfcalb1 | surface_near_IR_direct_albedo | the near IR direct beam component of mean surface albedo | none | 1 | real | kind_phys | out | F | +!!| sfcalb2 | surface_near_IR_diffused_albedo | the near IR diffused component of mean surface albedo | none | 1 | real | kind_phys | out | F | +!!| sfcalb3 | surface_UV-VIS_direct_albedo | the UV+VIS direct beam component of mean surface albedo | none | 1 | real | kind_phys | out | F | +!!| sfcalb4 | surface_UV-VIS_diffused_albedo | the UV+VIS diffused component of mean surface albedo | none | 1 | real | kind_phys | out | F | +!! + subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input + Tbd, Cldprop, Radtend, & + lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output + tlvl, tlyr, tsfg, tsfa, qlyr, nday, idxday, olyr, & + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & + gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, & + gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113, & + faersw1, faersw2, faersw3, & + faerlw1, faerlw2, faerlw3, aerodp, & + clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & + clouds7, clouds8, clouds9, cldsa, mtopa, mbota, & + sfcalb1, sfcalb2, sfcalb3, sfcalb4 ) + + use machine, only: kind_phys use GFS_typedefs, only: GFS_statein_type, & GFS_stateout_type, & @@ -66,57 +121,19 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type,cmpfsw_type,NBDSW -!zhang use module_radsw_main, only: rswinit, swrad use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW -!zhang use module_radlw_main, only: rlwinit, lwrad implicit none - !integer, intent(inout) :: me, lm, im, lp1, ntrac - !integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_statein_type), intent(in) :: Statein - type(GFS_radtend_type), intent(in) :: Radtend - type(GFS_tbd_type), intent(in) :: Tbd - type(GFS_cldprop_type), intent(in) :: Cldprop - - !integer, intent(out) :: nday - !integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday - !real(kind=kind_phys), intent(out) :: raddt - !real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn - !real(kind=kind_phys), dimension(Size(Grid%xlon, 1), Model%levr+1+LTP), intent(inout) :: plvl - !real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr+LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl - !real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! LTP, 2:Model%ntrac), intent(inout) :: tracer1 - !real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! LTP), intent(inout) :: olyr - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! LTP, NF_VGAS), intent(inout) :: gasvmr - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! 1 + LTP), intent(inout) :: tlvl - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1)) :: tsfa,tem1d - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr+LTP), intent(inout) :: qlyr, tvly - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! LTP, NBDSW, NF_AESW), intent(inout) :: faersw - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! LTP, NBDLW, NF_AELW), intent(inout) :: faerlw - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(inout) :: aerodp - !real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & - ! LTP), intent(out) :: deltaq - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - ! LTP, NF_CLDS), intent(inout) :: clouds - !real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa - !integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa - !real (kind = kind_phys), dimension(im, NF_ALBD), intent(out) :: sfcalb - !real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & - ! htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & - ! qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & - ! tem2db, cldcov, deltaq, cnvc, cnvw - + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_statein_type), intent(in) :: Statein + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop ! --- version tag and last revision date character(40), parameter :: & @@ -179,8 +196,11 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & real(kind=kind_phys), dimension(size(Grid%xlon,1),5) :: cldsa real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1) :: aerodp +!CCPP: NSPC1=NSPC+1; NSPC: num of species for optional aod output fields real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb - +!CCPP: NF_ALBD=4 + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + sfcalb1, sfcalb2, sfcalb3, sfcalb4 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & @@ -189,9 +209,19 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP) :: plvl, tlvl real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 +!CCPP: ntrac= 3; # meteorological tracers + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr +!CCPP: NF_CLDS = 9 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & + clouds7, clouds8, clouds9 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr +!CCPP: NF_VGAS=10; # gases species + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, & + gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw @@ -199,10 +229,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw - - !pedro Set commonly used integers - !pedro call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) - ! !===> ... begin here ! @@ -216,11 +242,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & LP1 = LM + 1 ! num of in/out levels - !pedro Set local /level/layer indexes corresponding - !pedro to in/out variables - !pedro call Set_local_int (lmk, lm, lmp, kd, kt, & - !pedro kb, lla, llb, lya, lyb, lp1, raddt, Model) - ! --- ... set local /level/layer indexes corresponding to in/out ! variables @@ -259,9 +280,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & raddt = min(Model%fhswr, Model%fhlwr) ! print *,' in grrad : raddt=',raddt - !pedro Setup surface ground temperature and - !pedro ground/air skin temperature if required. - !pedro call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) !> -# Setup surface ground temperature and ground/air skin temperature !! if required. @@ -279,12 +297,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & endif - - !pedro Prepare atmospheric profiles. - !pedro Convert pressure unit from pa to mb - !pedro call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & - ! prslk1, rhly, qstl, Model, Grid) - !> -# Prepare atmospheric profiles for radiation input. ! ! convert pressure unit from pa to mb @@ -305,14 +317,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & enddo enddo - - - !pedro Recast remaining all tracers (except sphum) - !pedro forcing them all to be positive - !pedro call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & - ! qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & - ! lla, lya, lyb) - !--- recast remaining all tracers (except sphum) forcing them all !to be positive do j = 2, NTRAC @@ -342,9 +346,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & endif - !pedro Get layer ozone mass mixing ratio - !pedro call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) - !> - Get layer ozone mass mixing ratio (if use ozone climatology data, !! call getozn()). @@ -355,20 +356,12 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & olyr) ! --- outputs endif ! end_if_ntoz - - - !pedro Compute cosine of zenith angle. - !pedro call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & - !pedor im, me, Radtend%coszen, Radtend%coszdg) !> - Call coszmn(), to compute cosine of zenith angle. call coszmn (Grid%xlon,Grid%sinlat, & ! --- inputs Grid%coslat,Model%solhr, IM, me, & Radtend%coszen, Radtend%coszdg) ! --- outputs - !pedro Set up non-prognostic gas volume mixing ratioes - !pedro call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) - !> - Call getgases(), to set up non-prognostic gas volume mixing !! ratioes (gasvmr). ! - gasvmr(:,:,1) - co2 volume mixing ratio @@ -380,17 +373,28 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & ! - gasvmr(:,:,7) - cf12 volume mixing ratio ! - gasvmr(:,:,8) - cf22 volume mixing ratio ! - gasvmr(:,:,9) - ccl4 volume mixing ratio +! - gasvmr(:,:,10) - cfc113 volumne mixing ratio ! --- ... set up non-prognostic gas volume mixing ratioes call getgases (plvl, Grid%xlon, Grid%xlat, IM, LMK, & ! --- inputs gasvmr) ! --- outputs - - - !pedro Get temperature at layer interface, and layer moisture. - !pedro call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & - !pedro im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) +!CCPP: re-assign gasvmr(:,:,NF_VGAS) to gasvmr_X(:,:) + do k = 1, LMK + do i = 1, IM + gasvmr_co2 (i,k) = gasvmr(i,k,1) + gasvmr_n2o (i,k) = gasvmr(i,k,2) + gasvmr_ch4 (i,k) = gasvmr(i,k,3) + gasvmr_o2 (i,k) = gasvmr(i,k,4) + gasvmr_co (i,k) = gasvmr(i,k,5) + gasvmr_cfc11 (i,k) = gasvmr(i,k,6) + gasvmr_cfc12 (i,k) = gasvmr(i,k,7) + gasvmr_cfc22 (i,k) = gasvmr(i,k,8) + gasvmr_ccl4 (i,k) = gasvmr(i,k,9) + gasvmr_cfc113 (i,k) = gasvmr(i,k,10) + enddo + enddo !> - Get temperature at layer interface, and layer moisture. do k = 2, LMK @@ -470,9 +474,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & endif ! end_if_ivflip - !pedro Check for daytime points for SW radiation. - !pedro call Find_daytime (im, Radtend, Grid, nday, idxday) - !> - Check for daytime points for SW radiation. nday = 0 @@ -483,10 +484,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & endif enddo - !pedro Setup aerosols - !pedro call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & - !pedro tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & - !pedro Model%lslwr, faersw,faerlw,aerodp) !> - Call module_radiation_aerosols::setaer(),to setup aerosols !! property profile for radiation. @@ -499,13 +496,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & faersw,faerlw,aerodp) ! --- outputs - - !pedro Obtain cloud information - !pedro call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & - !pedro Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & - !pedro deltaq, plvl, plyr, tlyr, qlyr, tvly, & - !pedro rhly, qstl, clouds, cldsa, mtopa, mbota) - !> - Obtain cloud information for radiation calculations !! (clouds,cldsa,mtopa,mbota) !!\n for prognostic cloud: @@ -636,13 +626,15 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, lm, me, im, ntrac, & endif ! end_if_ntcw - !pedro Setup surface albedo for SW calculation - !pedro call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - !pedro Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & - !pedro Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & - !pedro Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - !pedro Sfcprop%tisfc, im, Model%lsswr, & - !pedro sfcalb, Radtend%sfalb) ! --- outputs +!CCPP + do i = 1, IM + cldsa_lo(i) = cldsa(i,1) + cldsa_md(i) = cldsa(i,2) + cldsa_hi(i) = cldsa(i,3) + cldsa_tot(i) = cldsa(i,4) + cldsa_bl(i) = cldsa(i,5) + enddo + ! --- ... start radiation calculations ! remember to set heating rate unit to k/sec! From a8ada0a3f17ad0071a23626942d08fa4229a6138 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Mon, 4 Dec 2017 21:58:16 -0700 Subject: [PATCH 084/114] add Randtend%sfcalb as output in GFS_RRTMG_pre_run --- GFS_layer/GFS_radiation_driver.F90 | 142 +---------------------------- physics/GFS_RRTMG_pre.f90 | 43 +++++++-- 2 files changed, 36 insertions(+), 149 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index a89ad918f..95acf1aa0 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1212,16 +1212,15 @@ subroutine GFS_radiation_driver & clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & - cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), & - sfcalb(:,4)) + cldsa, mtopa, mbota, sfcalb, Radtend%sfcalb ) ! Calculate SW heating and fluxes call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & - faersw(:, :, :, 3), sfcalb(:, 1), sfcalb(:,2), sfcalb(:,3), & - sfcalb(:,4), Radtend%coszen, Model%solcon, nday, idxday, im,& + faersw(:, :, :, 3), sfcalb, & + Radtend%coszen, Model%solcon, nday, idxday, im, & lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs @@ -1609,141 +1608,6 @@ subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) end subroutine Post_lw - -! subroutine Pre_radiation (Model, Grid, lm, me, im, ntrac, & -! lmk, lmp, kd, kt, kb, lla, llb, lya, lyb, lp1, raddt, & -! tskn, tsfg, Sfcprop, Statein, plvl, plyr, & -! tlyr, prslk1, rhly, qstl, tracer1, olyr, Radtend, & -! gasvmr, tlvl, tsfa, tvly, qlyr, nday, idxday, faersw, & -! faerlw, aerodp, Tbd, Cldprop, deltaq, clouds, cldsa, & -! mtopa, mbota, sfcalb) - - -! implicit none - -! integer, intent(inout) :: me, lm, im, lp1, ntrac -! integer, intent(inout) :: lmk, lmp, kd, kt, kb, lla, llb, lya, lyb -! type(GFS_control_type), intent(in) :: Model -! type(GFS_grid_type), intent(in) :: Grid -! type(GFS_sfcprop_type), intent(in) :: Sfcprop -! type(GFS_statein_type), intent(in) :: Statein -! type(GFS_radtend_type), intent(in) :: Radtend -! type(GFS_tbd_type), intent(in) :: Tbd -! type(GFS_cldprop_type), intent(in) :: Cldprop - -! integer, intent(out) :: nday -! integer, dimension(Size (Grid%xlon, 1)), intent(inout) :: idxday -! real(kind=kind_phys), intent(out) :: raddt -! real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(inout) :: tsfg, tskn -! real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! 1 + LTP), intent(inout) :: plvl -! real(kind=kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & -! LTP), intent(inout) :: plyr, tlyr, prslk1, rhly, qstl -! real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, 2:Model%ntrac), intent(inout) :: tracer1 -! real(kind=kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP), intent(inout) :: olyr -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NF_VGAS), intent(inout) :: gasvmr -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! 1 + LTP), intent(inout) :: tlvl -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(inout) :: tsfa -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP), intent(inout) :: qlyr, tvly -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NBDSW, NF_AESW), intent(inout) :: faersw -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NBDLW, NF_AELW), intent(inout) :: faerlw -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(inout) :: aerodp -! real(kind = kind_phys), dimension(size(Grid%xlon, 1), Model%levr + & -! LTP), intent(out) :: deltaq -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & -! LTP, NF_CLDS), intent(inout) :: clouds -! real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(out) :: cldsa -! integer, dimension(size(Grid%xlon, 1), 3), intent(out) :: mbota, mtopa -! real (kind = kind_phys), dimension(im, NF_ALBD), intent(out) :: sfcalb - - - ! Set commonly used integers -! call Set_common_int (Model, Grid, lm, me, im, lp1, ntrac) - - !Set local /level/layer indexes corresponding - ! to in/out variables -! call Set_local_int (lmk, lm, lmp, kd, kt, & -! kb, lla, llb, lya, lyb, lp1, raddt, Model) - - - ! Setup surface ground temperature and - ! ground/air skin temperature if required. -! call Set_sfc_vars (im, tskn, tsfg, Sfcprop, Grid) - - - ! Prepare atmospheric profiles. - ! Convert pressure unit from pa to mb -! call Prep_profiles (lm, kd, im, Statein, plvl, plyr, tlyr, & -! prslk1, rhly, qstl, Model, Grid) - - - ! Recast remaining all tracers (except sphum) - ! forcing them all to be positive -! call Recast_tracers (tracer1, plvl, plyr, tlyr, prslk1, rhly, & -! qstl, Statein, Grid, Model, ntrac, lm, im, kd, lp1, llb, & -! lla, lya, lyb) - - - ! Get layer ozone mass mixing ratio -! call Prep_ozone (Model, Grid, im, lmk, tracer1, olyr, prslk1) - - - ! Compute cosine of zenith angle. -! call coszmn (Grid%xlon,Grid%sinlat, Grid%coslat, Model%solhr, & -! im, me, Radtend%coszen, Radtend%coszdg) - - - ! Set up non-prognostic gas volume mixing ratioes -! call getgases (plvl, Grid%xlon, Grid%xlat, im, lmk, gasvmr) - - - ! Get temperature at layer interface, and layer moisture. -! call Prep_t_and_moist (Grid, Model, Statein, lmp, kd, lmk, lm, & -! im, lya, lyb, plyr, tlyr, tlvl, plvl, tsfa, tskn, tvly, qlyr) - - - ! Check for daytime points for SW radiation. -! call Find_daytime (im, Radtend, Grid, nday, idxday) - - - ! Setup aerosols -! call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & -! tracer1, Grid%xlon, Grid%xlat, im, lmk, lmp, Model%lsswr, & -! Model%lslwr, faersw,faerlw,aerodp) - - - ! Obtain cloud information -! call Get_cloud_info (Model, Grid, Tbd, Sfcprop, Cldprop, & -! Statein, tracer1, lmk, lmp, lm, lya, lyb, im, me, kd, & -! deltaq, plvl, plyr, tlyr, qlyr, tvly, & -! rhly, qstl, clouds, cldsa, mtopa, mbota) - - - ! Setup surface albedo for SW calculation -! call Set_sfc_albedo (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: -! Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, tsfg, tsfa, & -! Sfcprop%hprim, Sfcprop%alvsf, Sfcprop%alnsf, Sfcprop%alvwf, & -! Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & -! Sfcprop%tisfc, im, Model%lsswr, & -! sfcalb, Radtend%sfalb) ! --- outputs - - - ! Setup surface emissivity for LW radiation. -! call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs -! Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & -! tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & -! Radtend%semis) ! --- outputs - - -! end subroutine Pre_radiation - subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index ff2bab147..53cf5ae1f 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -70,10 +70,8 @@ end subroutine GFS_RRTMG_pre_init !!| cldsa | level_cloud_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | !!| mtopa | vertical_indices_for_cloud_tops | vertical indices for low, middle and high cloud tops (IX, 3) | index | 2 | integer | | out | F | !!| mbota | vertical_indices_for_cloud_bases | vertical indices for low, middle and high cloud bases (IX, 3) | index | 2 | integer | | out | F | -!!| sfcalb1 | surface_near_IR_direct_albedo | the near IR direct beam component of mean surface albedo | none | 1 | real | kind_phys | out | F | -!!| sfcalb2 | surface_near_IR_diffused_albedo | the near IR diffused component of mean surface albedo | none | 1 | real | kind_phys | out | F | -!!| sfcalb3 | surface_UV-VIS_direct_albedo | the UV+VIS direct beam component of mean surface albedo | none | 1 | real | kind_phys | out | F | -!!| sfcalb4 | surface_UV-VIS_diffused_albedo | the UV+VIS diffused component of mean surface albedo | none | 1 | real | kind_phys | out | F | +!!| sfcalb | surface_albedoes | four-component surface albedoes | none | 2 | real | kind_phys | out | F | +!!| radsfcalb | mean_surface_albedo | mean surface albedo from vis- and nir- diffuse values | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, & @@ -86,7 +84,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9, cldsa, mtopa, mbota, & - sfcalb1, sfcalb2, sfcalb3, sfcalb4 ) + sfcalb, radsfcalb ) use machine, only: kind_phys @@ -199,8 +197,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !CCPP: NSPC1=NSPC+1; NSPC: num of species for optional aod output fields real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb !CCPP: NF_ALBD=4 - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & - sfcalb1, sfcalb2, sfcalb3, sfcalb4 + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: radsfcalb real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & @@ -223,6 +220,8 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, & gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW):: & + faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw !--- TYPED VARIABLES @@ -495,6 +494,29 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%lsswr,Model%lslwr, & faersw,faerlw,aerodp) ! --- outputs +! CCPP + do j = 1,NBDSW + do k = 1, LMK + do i = 1, IM + ! NF_AESW = 3 + faersw1(i,k,j) = faersw(i,k,j,1) + faersw2(i,k,j) = faersw(i,k,j,2) + faersw3(i,k,j) = faersw(i,k,j,3) + enddo + enddo + enddo + + do j = 1,NBDLW + do k = 1, LMK + do i = 1, IM + ! NF_AELW = 3 + faerlw1(i,k,j) = faerlw(i,k,j,1) + faerlw2(i,k,j) = faerlw(i,k,j,2) + faerlw3(i,k,j) = faerlw(i,k,j,3) + enddo + enddo + enddo + !> - Obtain cloud information for radiation calculations !! (clouds,cldsa,mtopa,mbota) @@ -653,13 +675,14 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + !Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + radsfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) endif ! Model%lsswr - !zhang: should called before - !pedro Setup surface emissivity for LW radiation. + !zhang: should called before LW radiation + ! Setup surface emissivity for LW radiation. call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & From 41be59cb5b4cd9d1c01e43aadec45f68216eaacb Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Mon, 4 Dec 2017 22:05:02 -0700 Subject: [PATCH 085/114] clean up codes. --- GFS_layer/GFS_radiation_driver.F90 | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 95acf1aa0..0b866b296 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1418,34 +1418,6 @@ subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, end subroutine Zero_out_heatrate_flux - -! subroutine Set_sfc_albedo (slmsk, snowf, sncovr, snoalb, zorlf, & -! coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & -! facsf, facwf, fice, tisfc, IMAX, lsswr, sfcalb, sfalb) - -! implicit none - -! integer, intent(in) :: IMAX -! real (kind = kind_phys), dimension(:), intent(in) :: slmsk, snowf, & -! zorlf, coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, & -! alnwf, facsf, facwf, fice, tisfc, sncovr, snoalb -! logical, intent(in) :: lsswr - -! real (kind = kind_phys), dimension(IMAX, NF_ALBD), intent(out) :: sfcalb -! real (kind = kind_phys), dimension(:), intent(out) :: sfalb - -! if (.not. lsswr) return - -! call setalb (slmsk, snowf, sncovr, snoalb, zorlf, & -! coszf, tsknf, tairf, hprif, alvsf, alnsf, alvwf, alnwf, & -! facsf, facwf, fice, tisfc, IMAX, sfcalb) - - ! Approximate mean surface albedo from vis- and nir- diffuse values. -! sfalb(:) = Max (0.01, 0.5 * (sfcalb(:, 2) + sfcalb(:, 4))) - -! end subroutine Set_sfc_albedo - - subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, lsswr) implicit none From 0db1ed86fc5874f23d30fd89859adc8031863f53 Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Tue, 5 Dec 2017 16:25:01 -0700 Subject: [PATCH 086/114] bug fixed. --- GFS_layer/GFS_radiation_driver.F90 | 29 +++++++--- physics/GFS_RRTMG_pre.f90 | 34 +++++------ physics/GFS_radlw_post.f90 | 92 ++++++++++++++++++++++++++++++ 3 files changed, 130 insertions(+), 25 deletions(-) create mode 100644 physics/GFS_radlw_post.f90 diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 0b866b296..e0206ebcd 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1200,6 +1200,7 @@ subroutine GFS_radiation_driver & type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw +! L1211-1596 call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output @@ -1207,20 +1208,20 @@ subroutine GFS_radiation_driver & gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10), & - faersw(:,:,1), faersw(:,:,2), faersw(:,:,3), & - faerlw(:,:,1), faerlw(:,:,2), faerlw(:,:,3), aerodp, & + faersw(:,:,:,1), faersw(:,:,:,2), faersw(:,:,:,3), & + faerlw(:,:,:,1), faerlw(:,:,:,2), faerlw(:,:,:,3), aerodp, & clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & - cldsa, mtopa, mbota, sfcalb, Radtend%sfcalb ) + cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4), Radtend%sfalb ) - - ! Calculate SW heating and fluxes +! L1598-1618 call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & - faersw(:, :, :, 3), sfcalb, & - Radtend%coszen, Model%solcon, nday, idxday, im, & + faersw(:, :, :, 3), sfcalb(:,1), sfcalb(:,2),sfcalb(:,3), & + sfcalb(:,4),Radtend%coszen, Model%solcon, nday, idxday, im, & lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs @@ -1229,9 +1230,13 @@ subroutine GFS_radiation_driver & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) +! L1620-1686 +! call swrad_post_run () + +! L1689-1698 +! call lwrad_pre_run () -!CCPP todo list: move setemis here - ! Calculate LW heating rates and fluxes. +! L1703-1714 call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & @@ -1246,6 +1251,12 @@ subroutine GFS_radiation_driver & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) +! L1718-1747 +! call lwrad_post_run () + +! L1757-1841 +! call GFS_RRTMG_post_run () + call Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index 53cf5ae1f..3788b1318 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -70,8 +70,11 @@ end subroutine GFS_RRTMG_pre_init !!| cldsa | level_cloud_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | !!| mtopa | vertical_indices_for_cloud_tops | vertical indices for low, middle and high cloud tops (IX, 3) | index | 2 | integer | | out | F | !!| mbota | vertical_indices_for_cloud_bases | vertical indices for low, middle and high cloud bases (IX, 3) | index | 2 | integer | | out | F | -!!| sfcalb | surface_albedoes | four-component surface albedoes | none | 2 | real | kind_phys | out | F | -!!| radsfcalb | mean_surface_albedo | mean surface albedo from vis- and nir- diffuse values | none | 1 | real | kind_phys | out | F | +!!| sfcalb1 | surface_nir_direct_albedo | surface albedo in fraction of near IR direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb2 | surface_nir_diffused_albedo | surface albedo in fraction of near IR diffused | none | 1 | real | kind_phys | out | F | +!!| sfcalb3 | surface_uvis_direct_albedo | surface albedo in fraction of uv+vis direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb4 | surface_uvis_diffused_albedo | surface albedo in fraction of uv+vis diffused | none | 1 | real | kind_phys | out | F | +!!| radsfalb | mean_surface_albedo | mean surface albedo from vis- and nir- diffuse values | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, & @@ -84,7 +87,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9, cldsa, mtopa, mbota, & - sfcalb, radsfcalb ) + sfcalb1, sfcalb2, sfcalb3, sfcalb4, radsfalb ) use machine, only: kind_phys @@ -197,7 +200,9 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !CCPP: NSPC1=NSPC+1; NSPC: num of species for optional aod output fields real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb !CCPP: NF_ALBD=4 - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: radsfcalb + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + sfcalb1, sfcalb2, sfcalb3, sfcalb4 + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: radsfalb real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & @@ -221,8 +226,10 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW):: & - faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3 + faersw1, faersw2, faersw3 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW):: & + faerlw1, faerlw2, faerlw3 !--- TYPED VARIABLES type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw @@ -648,16 +655,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif ! end_if_ntcw -!CCPP - do i = 1, IM - cldsa_lo(i) = cldsa(i,1) - cldsa_md(i) = cldsa(i,2) - cldsa_hi(i) = cldsa(i,3) - cldsa_tot(i) = cldsa(i,4) - cldsa_bl(i) = cldsa(i,5) - enddo - - ! --- ... start radiation calculations ! remember to set heating rate unit to k/sec! !> -# Start SW radiation calculations @@ -677,7 +674,12 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !> -# Approximate mean surface albedo from vis- and nir- diffuse values. !Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) radsfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - + +! CCPP + sfcalb1(:) = sfcalb(:,1) + sfcalb2(:) = sfcalb(:,2) + sfcalb3(:) = sfcalb(:,3) + sfcalb4(:) = sfcalb(:,4) endif ! Model%lsswr diff --git a/physics/GFS_radlw_post.f90 b/physics/GFS_radlw_post.f90 new file mode 100644 index 000000000..2e5f34c9f --- /dev/null +++ b/physics/GFS_radlw_post.f90 @@ -0,0 +1,92 @@ + subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & + Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & + nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & + clouds, aerodp) + + implicit none + + integer, intent(in) :: lm, kd, im, kt, kb + type(GFS_grid_type), intent(in) :: Grid + type(GFS_control_type), intent(in) :: Model + type(GFS_statein_type), intent(in) :: Statein + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_diag_type), intent(inout) :: Diag + + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP), intent(in) :: htlw0, htlwc, htswc, htsw0 + real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfa + type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb + integer, intent(in) :: nday + real(kind = kind_phys), intent(in) :: raddt + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(in) :: cldsa + integer, dimension(size(Grid%xlon, 1), 3), intent(in) :: mbota, mtopa + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP, NF_CLDS), intent(in) :: clouds + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(in) :: aerodp + + + !pedro Save LW results + !pedro call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) + +!> - Save surface air temp for diurnal adjustment at model t-steps + + if (Model%lslwr) then + Radtend%tsflw (:) = tsfa(:) + + do k = 1, LM + k1 = k + kd + Radtend%htrlw(:,k) = htlwc(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%htrlw (:,k) = Radtend%htrlw (:,LM) + enddo + endif + + if (Model%lwhtr) then + do k = 1, lm + k1 = k + kd + Radtend%lwhc(:,k) = htlw0(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%lwhc(:,k) = Radtend%lwhc(:,LM) + enddo + endif + endif + +! --- radiation fluxes for other physics processes + Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc + + endif ! end_if_lslwr + + + ! post SW + call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + Model%lsswr) + + call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + kd, Model%lsswr) + + ! Surface down and up spectral component fluxes + ! Save two spectral bands' surface downward and upward fluxes for output. + call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + + ! Night time: set SW heating rates and fluxes to zero + call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + Grid, Model, nday, Model%lsswr) + + call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + + + ! Collect the fluxr data for wrtsfc + call Organize_output (Diag, Model, Grid, Radtend, Statein, & + Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & + mtopa, mbota, clouds, aerodp) + + end subroutine Post_radiation + From aee83f1a5647c5f943be49ff36d208c40affe8c6 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Wed, 6 Dec 2017 10:50:36 -0700 Subject: [PATCH 087/114] GFS_RRTMG_pre_run passed B4B test. RMG --- GFS_layer/GFS_radiation_driver.F90 | 15 +++------ physics/GFS_RRTMG_pre.f90 | 52 +++++++++++++++++++----------- 2 files changed, 38 insertions(+), 29 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index e0206ebcd..692694ddf 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1174,31 +1174,26 @@ subroutine GFS_radiation_driver & ! ====================== end of definitions ======================= ! ! ! Local Vars - integer :: me, im, lm, nday, lp1, lmk, lmp, kd, lla, llb, lya, & - lyb, kt, kb, ntrac + integer :: me, im, lm, nday, lmk, lmp, kd, kt, kb integer, dimension(size(Grid%xlon, 1)) :: idxday integer, dimension(size(Grid%xlon, 1), 3) :: mbota, mtopa real(kind = kind_phys) :: raddt - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)) :: tsfa, & - tsfg, tskn + real(kind = kind_phys), dimension(Size (Grid%xlon, 1)) :: tsfa, tsfg real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5) :: cldsa real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1) :: aerodp real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD) :: sfcalb real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP) :: plyr, tlyr, qlyr, olyr, rhly, tvly, qstl, prslk1, deltaq, & - htswc, htsw0, htlw0, htlwc + LTP) :: plyr, tlyr, qlyr, olyr, htswc, htsw0, htlw0, htlwc real(kind = kind_phys), dimension(Size(Grid%xlon, 1), Model%levr+1+LTP) :: plvl, tlvl - - real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, 2:Model%ntrac) :: tracer1 real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NF_CLDS) :: clouds real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NF_VGAS) :: gasvmr - real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NBDSW, NF_AESW) :: faersw real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NBDLW, NF_AELW) :: faerlw - type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw +! call GFS_RRTMG_pre_init (vtagrad, qmin, qme5,qme6, epsq, prsmin, & +! itsfc, month0, iyear0, monthd,loz1st, ltp,lextop) ! L1211-1596 call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index 3788b1318..a872697a3 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -199,9 +199,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1) :: aerodp !CCPP: NSPC1=NSPC+1; NSPC: num of species for optional aod output fields real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb -!CCPP: NF_ALBD=4 - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & - sfcalb1, sfcalb2, sfcalb3, sfcalb4 real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: radsfalb real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & @@ -214,20 +211,21 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !CCPP: ntrac= 3; # meteorological tracers real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds -!CCPP: NF_CLDS = 9 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & - clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & - clouds7, clouds8, clouds9 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr -!CCPP: NF_VGAS=10; # gases species - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & - gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, & - gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw + +! CCPP-compliant + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + sfcalb1, sfcalb2, sfcalb3, sfcalb4 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP):: & + clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & + clouds7, clouds8, clouds9 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP):: & + gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, & + gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW):: & faersw1, faersw2, faersw3 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW):: & faerlw1, faerlw2, faerlw3 @@ -674,12 +672,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !> -# Approximate mean surface albedo from vis- and nir- diffuse values. !Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) radsfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - -! CCPP - sfcalb1(:) = sfcalb(:,1) - sfcalb2(:) = sfcalb(:,2) - sfcalb3(:) = sfcalb(:,3) - sfcalb4(:) = sfcalb(:,4) endif ! Model%lsswr @@ -690,6 +682,28 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & Radtend%semis) ! --- outputs +! CCPP + do k = 1, LMK + do i = 1, IM + clouds1(i,k) = clouds(i,k,1) + clouds2(i,k) = clouds(i,k,2) + clouds3(i,k) = clouds(i,k,3) + clouds4(i,k) = clouds(i,k,4) + clouds5(i,k) = clouds(i,k,5) + clouds6(i,k) = clouds(i,k,6) + clouds7(i,k) = clouds(i,k,7) + clouds8(i,k) = clouds(i,k,8) + clouds9(i,k) = clouds(i,k,9) + enddo + enddo + + do i = 1, im + sfcalb1(i) = sfcalb(i,1) + sfcalb2(i) = sfcalb(i,2) + sfcalb3(i) = sfcalb(i,3) + sfcalb4(i) = sfcalb(i,4) + enddo + end subroutine GFS_RRTMG_pre_run From b77c60ae85ed184113b43c544c6ff4606b49eb83 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Wed, 6 Dec 2017 12:42:34 -0700 Subject: [PATCH 088/114] clean up codes --- GFS_layer/GFS_radiation_driver.F90 | 2 +- physics/GFS_RRTMG_pre.f90 | 7 ++----- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 692694ddf..68ff60b8d 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -1209,7 +1209,7 @@ subroutine GFS_radiation_driver & clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4), Radtend%sfalb ) + sfcalb(:,3), sfcalb(:,4) ) ! L1598-1618 call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index a872697a3..4432ef6df 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -74,7 +74,6 @@ end subroutine GFS_RRTMG_pre_init !!| sfcalb2 | surface_nir_diffused_albedo | surface albedo in fraction of near IR diffused | none | 1 | real | kind_phys | out | F | !!| sfcalb3 | surface_uvis_direct_albedo | surface albedo in fraction of uv+vis direct beam | none | 1 | real | kind_phys | out | F | !!| sfcalb4 | surface_uvis_diffused_albedo | surface albedo in fraction of uv+vis diffused | none | 1 | real | kind_phys | out | F | -!!| radsfalb | mean_surface_albedo | mean surface albedo from vis- and nir- diffuse values | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, & @@ -87,7 +86,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9, cldsa, mtopa, mbota, & - sfcalb1, sfcalb2, sfcalb3, sfcalb4, radsfalb ) + sfcalb1, sfcalb2, sfcalb3, sfcalb4) use machine, only: kind_phys @@ -199,7 +198,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1) :: aerodp !CCPP: NSPC1=NSPC+1; NSPC: num of species for optional aod output fields real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: radsfalb real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & @@ -670,8 +668,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. - !Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - radsfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) endif ! Model%lsswr From 7d74d985e9e38247906e5ac3e228dbb6149258f5 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Thu, 7 Dec 2017 10:19:08 -0700 Subject: [PATCH 089/114] fixed rank error for xmu in moninedmf.f --- physics/moninedmf.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index cd8f15fdb..d003ea97f 100755 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -45,7 +45,7 @@ end subroutine edmf_finalize !! | q1 | tracer_concentration | layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | !! | swh | tendency_of_air_temperature_due_to_shortwave_heating | total sky shortwave heating rate | K s-1 | 2 | real | kind_phys | in | F | !! | hlw | tendency_of_air_temperature_due_to_longwave_heating | total sky longwave heating rate | K s-1 | 2 | real | kind_phys | in | F | -!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 2 | real | kind_phys | in | F | +!! | xmu | zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes | zenith angle temporal adjustment factor for shortwave | none | 1 | real | kind_phys | in | F | !! | psk | exner_function_at_lowest_model_interface | exner function at the surface interface | none | 1 | real | kind_phys | in | F | !! | rbsoil | bulk_richardson_number_at_lowest_model_level | bulk Richardson number at the surface | none | 1 | real | kind_phys | in | F | !! | zorl | surface_roughness_length | surface roughness length in cm | cm | 1 | real | kind_phys | in | F | From c2df93983375aa56d1238710ca9dda2531f63fd9 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 7 Dec 2017 10:31:12 -0700 Subject: [PATCH 090/114] add some fix --- GFS_layer/GFS_radiation_driver.F90 | 59 +++++----- makefile | 1 + physics/GFS_RRTMG_pre.f90 | 22 ++-- physics/GFS_radsw_post.f90 | 166 +++++++++++++++++++++++++++++ physics/radlw_main.f | 6 +- physics/radsw_main.f | 7 +- 6 files changed, 224 insertions(+), 37 deletions(-) create mode 100644 physics/GFS_radsw_post.f90 diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 68ff60b8d..c8cc94d52 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -327,7 +327,9 @@ module module_radiation_driver ! use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type,cmpfsw_type,NBDSW use module_radsw_main, only: rswinit, swrad_run + use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run + use GFS_radsw_post, only: GFS_radsw_post_run use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW @@ -1192,23 +1194,24 @@ subroutine GFS_radiation_driver & real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NBDLW, NF_AELW) :: faerlw type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw +! CCPP: L349-390 ! call GFS_RRTMG_pre_init (vtagrad, qmin, qme5,qme6, epsq, prsmin, & ! itsfc, month0, iyear0, monthd,loz1st, ltp,lextop) -! L1211-1596 +! CCPP: L1211-1596 call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Radtend, & - lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output - tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & - gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & - gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & - gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10), & - faersw(:,:,:,1), faersw(:,:,:,2), faersw(:,:,:,3), & - faerlw(:,:,:,1), faerlw(:,:,:,2), faerlw(:,:,:,3), aerodp, & - clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & - clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & - clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & - cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), & + Tbd, Cldprop, Radtend,itsfc, ltp, lextop, & + lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output + tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & + gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & + gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & + gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10),& + faersw(:,:,:,1), faersw(:,:,:,2), faersw(:,:,:,3), & + faerlw(:,:,:,1), faerlw(:,:,:,2), faerlw(:,:,:,3), aerodp, & + clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & + clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & + clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & + cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), & sfcalb(:,3), sfcalb(:,4) ) ! L1598-1618 @@ -1225,11 +1228,13 @@ subroutine GFS_radiation_driver & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) -! L1620-1686 -! call swrad_post_run () +!CCPP: L1620-1686 + call GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & + ltp, nday, lm, kd, htswc, htsw0, & + sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), sfcalb(:,4), scmpsw) -! L1689-1698 -! call lwrad_pre_run () +!CCPP: L1689-1698 +! call GFS_radlw_pre_run () ! L1703-1714 call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs @@ -1247,7 +1252,7 @@ subroutine GFS_radiation_driver & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) ! L1718-1747 -! call lwrad_post_run () +! call GFS_radlw_post_run () ! L1757-1841 ! call GFS_RRTMG_post_run () @@ -1618,22 +1623,24 @@ subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & ! Save LW results call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) +! CCPP: this part is in GFS_radsw_post_run ! post SW - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - Model%lsswr) + !call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & + ! Model%lsswr) - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - kd, Model%lsswr) + !call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & + ! kd, Model%lsswr) ! Surface down and up spectral component fluxes ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) + !call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - Grid, Model, nday, Model%lsswr) + !call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & + ! Grid, Model, nday, Model%lsswr) - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) + !call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) +!CCPP ! Collect the fluxr data for wrtsfc diff --git a/makefile b/makefile index e4d6992da..dff0c94f9 100644 --- a/makefile +++ b/makefile @@ -116,6 +116,7 @@ SRCS_f = \ SRCS_f90 = \ ./physics/calpreciptype.f90 \ ./physics/GFS_RRTMG_pre.f90 \ + ./physics/GFS_radsw_post.f90 \ ./physics/cs_conv.f90 \ ./physics/funcphys.f90 \ ./physics/gcm_shoc.f90 \ diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index 4432ef6df..57365a1bc 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -10,7 +10,7 @@ module GFS_RRTMG_pre !! @{ !!\section arg_table_GFS_RRTMG_pre_init Argument Table !! - subroutine GFS_RRTMG_pre_init + subroutine GFS_RRTMG_pre_init () end subroutine GFS_RRTMG_pre_init !!\section arg_table_GFS_RRTMG_pre_run Argument Table @@ -23,7 +23,10 @@ end subroutine GFS_RRTMG_pre_init !!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | | in | F | !!| Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | | in | F | !!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | -!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | +!!| itsfc | flag_for_surface_temperature | control flag for surface temperature | none | 0 | integer | | in | F | +!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | +!!| lextop | flag_for_extra_top_layer | control flag for extra top layer | none | 0 | logical | | in | F | +!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | !!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | !!| lmk | vertical_layer_dimension_with_extra_top_layer | number of vertical layers with extra top layer | index | 0 | integer | | out | F | !!| lmp | vertical_level_dimension_with_extra_top_layer | number of vertical levels with extra top layer | index | 0 | integer | | out | F | @@ -57,7 +60,7 @@ end subroutine GFS_RRTMG_pre_init !!| faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | !!| faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | !!| faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| aerodp | vertical_integrated_aerosol_optical_depth | vertical integrated aerosol optical depth | | 2 | real | kind_phys | out | F | +!!| aerodp | vertical_integrated_aerosol_optical_depth | vertical integrated aerosol optical depth | none | 2 | real | kind_phys | out | F | !!| clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | !!| clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | !!| clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | @@ -76,7 +79,7 @@ end subroutine GFS_RRTMG_pre_init !!| sfcalb4 | surface_uvis_diffused_albedo | surface albedo in fraction of uv+vis diffused | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Radtend, & + Tbd, Cldprop, Radtend, itsfc, ltp, lextop, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, nday, idxday, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & @@ -160,7 +163,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !> control flag for LW surface temperature at air/ground interface !! (default=0, the value will be set in subroutine radinit) - integer :: itsfc =0 + !integer :: itsfc =0 !> new data input control variables (set/reset in subroutines !radinit/radupdate): @@ -173,16 +176,17 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input !> optional extra top layer on top of low ceiling models !!\n LTP=0: no extra top layer - integer, parameter :: LTP = 0 ! no extra top layer + !integer, parameter :: LTP = 0 ! no extra top layer ! integer, parameter :: LTP = 1 ! add an extra top layer !> control flag for extra top layer - logical, parameter :: lextop = (LTP > 0) + !logical, parameter :: lextop = (LTP > 0) ! ! --- local variables: (horizontal dimensioned by IM) !--- INTEGER VARIABLES - integer :: me, im, lm, nfxr, ntrac + logical :: lextop + integer :: me, im, lm, nfxr, ntrac,ltp, itsfc integer :: i, j, k, k1, lv, itop, ibtc, nday, LP1, LMK, LMP, kd, & lla, llb, lya, lyb, kt, kb integer, dimension(size(Grid%xlon,1)) :: idxday @@ -706,7 +710,7 @@ end subroutine GFS_RRTMG_pre_run !!\section arg_table_GFS_RRTMG_pre_finalize Argument Table !! - subroutine GFS_RRTMG_pre_finalize + subroutine GFS_RRTMG_pre_finalize () end subroutine GFS_RRTMG_pre_finalize !! @} diff --git a/physics/GFS_radsw_post.f90 b/physics/GFS_radsw_post.f90 new file mode 100644 index 000000000..2cfa90ffa --- /dev/null +++ b/physics/GFS_radsw_post.f90 @@ -0,0 +1,166 @@ +!>\file GFS_radsw_post +!! This file contains + module GFS_radsw_post + contains + +!>\defgroup GFS_radsw_post GFS RRTMG/RADSW Scheme Post +!! @{ +!>\section arg_table_GFS_radsw_post_init Argument Table +!! + subroutine GFS_radsw_post_init () + end subroutine GFS_radsw_post_init + +!>\section arg_table_GFS_radsw_post_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|-------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|-----------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | +!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | +!| in | F | +!!| Cldprop | FV3-GFS_Cldprop_type +!| Fortran DDT containing FV3-GFS cloud fields needed by radiation from +!physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | +!| in | F | +!!| Radtend | FV3-GFS_Radtend_type +!| Fortran DDT containing FV3-GFS radiation tendencies +!| DDT | 0 | GFS_typedefs%GFS_radtend_type | | in +!| F | +!!| itsfc | flag_for_surface_temperature +!| control flag for surface temperature +!| none | 0 | integer | | in +!| F | +!!| ltp | extra_top_layer +!| extra top layers +!| none | 0 | integer | | in +!| F | +!!| lextop | flag_for_extra_top_layer +!| control flag for extra top layer +!| none | 0 | logical | | in +!| F | +!!| lm | vertical_layer_dimension_for_radiation +!| number of vertical layers for radiation calculation +!| index | 0 | integer | | out +!| F | +!!| im | horizontal_loop_extent +!| horizontal loop extent, start at 1 +!| index | 0 | integer | | out +!| F | +!!| lmk | vertical_layer_dimension_with_extra_top_layer +!| number of vertical layers with extra top layer +!| index | 0 | integer | | out +!| F | +!!| lmp | vertical_level_dimension_with_extra_top_layer +!| number of vertical levels with extra top layer +!| index | 0 | integer | | out +!| F | + + + subroutine GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & + ltp, nday, lm, kd, htswc, htsw0, & ! --input + sfcalb1, sfcalb2, sfcalb3, sfcalb4, scmpsw ) + + use machine, only: kind_phys + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & + cmpfsw_type + use GFS_typedefs, only: GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_diag_type + + implicit none + type(GFS_control_type), intent(in) :: Model + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_grid_type), intent(in) :: Grid + type(GFS_diag_type), intent(inout) :: Diag + type(cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw + + + integer :: lm, kd, k1, nday,k,ltp + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP) :: htswc, htsw0 +! CCPP-compliant + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + + + if (Model%lsswr) then + if (nday > 0) then + do k = 1, LM + k1 = k + kd + Radtend%htrsw(:,k) = htswc(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%htrsw (:,k) = Radtend%htrsw (:,LM) + enddo + endif + + if (Model%swhtr) then + do k = 1, lm + k1 = k + kd + Radtend%swhc(:,k) = htsw0(:,k1) + enddo + ! --- repopulate the points above levr + if (Model%levr < Model%levs) then + do k = LM,Model%levs + Radtend%swhc(:,k) = Radtend%swhc(:,LM) + enddo + endif + endif + +! --- surface down and up spectral component fluxes +!> - Save two spectral bands' surface downward and upward fluxes for +!! output. + + Coupling%nirbmdi(:) = scmpsw(:)%nirbm + Coupling%nirdfdi(:) = scmpsw(:)%nirdf + Coupling%visbmdi(:) = scmpsw(:)%visbm + Coupling%visdfdi(:) = scmpsw(:)%visdf + + Coupling%nirbmui(:) = scmpsw(:)%nirbm * sfcalb1(:) + Coupling%nirdfui(:) = scmpsw(:)%nirdf * sfcalb2(:) + Coupling%visbmui(:) = scmpsw(:)%visbm * sfcalb3(:) + Coupling%visdfui(:) = scmpsw(:)%visdf * sfcalb4(:) + + else ! if_nday_block + + Radtend%htrsw(:,:) = 0.0 + + Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + + Coupling%nirbmdi(:) = 0.0 + Coupling%nirdfdi(:) = 0.0 + Coupling%visbmdi(:) = 0.0 + Coupling%visdfdi(:) = 0.0 + + Coupling%nirbmui(:) = 0.0 + Coupling%nirdfui(:) = 0.0 + Coupling%visbmui(:) = 0.0 + Coupling%visdfui(:) = 0.0 + + if (Model%swhtr) then + Radtend%swhc(:,:) = 0 + endif + + endif ! end_if_nday + +! --- radiation fluxes for other physics processes + Coupling%sfcnsw(:) = Radtend%sfcfsw(:)%dnfxc - Radtend%sfcfsw(:)%upfxc + Coupling%sfcdsw(:) = Radtend%sfcfsw(:)%dnfxc + + endif ! end_if_lsswr + + end subroutine GFS_radsw_post_run + +!>\section arg_table_GFS_radsw_post_finalize Argument Table +!! + subroutine GFS_radsw_post_finalize () + end subroutine GFS_radsw_post_finalize +!! @} + end module GFS_radsw_post diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 345c117d8..f863e4c97 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -382,7 +382,7 @@ module module_radlw_main ! ! --- public accessable subprograms - public lwrad_run, rlwinit + public lwrad_init, lwrad_run, lwrad_finalize, rlwinit ! ================ @@ -448,6 +448,8 @@ module module_radlw_main ! !!\n upfxc - total sky upward flux !!\n dnfx0 - clear sky downward flux !!\n upfx0 - clear sky upward flux + subroutine lwrad_init () + end subroutine lwrad_init !! \section arg_table_lwrad_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | @@ -1310,6 +1312,8 @@ subroutine lwrad_run & end subroutine lwrad_run !----------------------------------- !> @} + subroutine lwrad_finalize () + end subroutine lwrad_finalize diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 8a4d58d46..d628d8d1a 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -504,7 +504,7 @@ module module_radsw_main ! ! --- public accessable subprograms - public swrad_run, rswinit + public swrad_init, swrad_run, swrad_finalize, rswinit ! ================= @@ -580,6 +580,8 @@ module module_radsw_main ! !!\n visbm - downward surface uv+vis direct beam flux !!\n visdf - downward surface uv+vis diffused flux + subroutine swrad_init () + end subroutine swrad_init !! \section arg_table_swrad_run Argument Table @@ -1459,6 +1461,9 @@ end subroutine swrad_run !----------------------------------- !> @} + subroutine swrad_finalize () + end subroutine swrad_finalize + !> This subroutine initializes non-varying module variables, conversion !! factors, and look-up tables. From 29b7c29d7c067e28b2359f6ccf3ec275a4092122 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 7 Dec 2017 14:01:04 -0700 Subject: [PATCH 091/114] table in radsw_post --- physics/GFS_radsw_post.f90 | 62 +++++++++++--------------------------- 1 file changed, 17 insertions(+), 45 deletions(-) diff --git a/physics/GFS_radsw_post.f90 b/physics/GFS_radsw_post.f90 index 2cfa90ffa..db42cce63 100644 --- a/physics/GFS_radsw_post.f90 +++ b/physics/GFS_radsw_post.f90 @@ -11,51 +11,23 @@ subroutine GFS_radsw_post_init () end subroutine GFS_radsw_post_init !>\section arg_table_GFS_radsw_post_run Argument Table -!!| local var name | longname | description | units | rank | type | kind | intent | optional | -!!|-------------------|-------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|-----------|----------| -!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | -!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | -!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | -!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | -!!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | -!| in | F | -!!| Cldprop | FV3-GFS_Cldprop_type -!| Fortran DDT containing FV3-GFS cloud fields needed by radiation from -!physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | -!| in | F | -!!| Radtend | FV3-GFS_Radtend_type -!| Fortran DDT containing FV3-GFS radiation tendencies -!| DDT | 0 | GFS_typedefs%GFS_radtend_type | | in -!| F | -!!| itsfc | flag_for_surface_temperature -!| control flag for surface temperature -!| none | 0 | integer | | in -!| F | -!!| ltp | extra_top_layer -!| extra top layers -!| none | 0 | integer | | in -!| F | -!!| lextop | flag_for_extra_top_layer -!| control flag for extra top layer -!| none | 0 | logical | | in -!| F | -!!| lm | vertical_layer_dimension_for_radiation -!| number of vertical layers for radiation calculation -!| index | 0 | integer | | out -!| F | -!!| im | horizontal_loop_extent -!| horizontal loop extent, start at 1 -!| index | 0 | integer | | out -!| F | -!!| lmk | vertical_layer_dimension_with_extra_top_layer -!| number of vertical layers with extra top layer -!| index | 0 | integer | | out -!| F | -!!| lmp | vertical_level_dimension_with_extra_top_layer -!| number of vertical levels with extra top layer -!| index | 0 | integer | | out -!| F | - +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|-----------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS diagnotics data | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS fields targetted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_radtend_type | | inout | F | +!!| Coupling | FV3-GFS_Coupling_type | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_typedefs%GFS_coupling_type| | inout | F | +!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | +!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | in | F | +!!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | +!!| htswc | tendency_of_air_temperature_due_to_shortwave_heating | total sky heating rate due to shortwave radiation | K s-1 | 2 | real | kind_phys | in | F | +!!| htsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky | clear sky heating rates due to shortwave radiation | K s-1 | 2 | real | kind_phys | in | F | +!!| sfcalb1 | surface_albedo_due_to_near_IR_direct +!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused +!!| sfcalb3 +!!| sfcalb4 +!!| scmpsw subroutine GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & ltp, nday, lm, kd, htswc, htsw0, & ! --input From f4353ef3488940a089876ef5fd021e47ce013a9c Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Fri, 8 Dec 2017 15:49:25 -0700 Subject: [PATCH 092/114] add rad interstitial code: GFS_radlw_pre.f90. Table and B4B are done. --- GFS_layer/GFS_radiation_driver.F90 | 6 ++- makefile | 1 + physics/GFS_RRTMG_pre.f90 | 44 +++++++++------------- physics/GFS_radlw_pre.f90 | 60 ++++++++++++++++++++++++++++++ physics/GFS_radsw_post.f90 | 12 +++--- physics/radiation_surface.f | 30 +++++++-------- 6 files changed, 101 insertions(+), 52 deletions(-) create mode 100644 physics/GFS_radlw_pre.f90 diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index c8cc94d52..f2efb6037 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -330,6 +330,7 @@ module module_radiation_driver ! use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run use GFS_radsw_post, only: GFS_radsw_post_run + use GFS_radlw_pre, only: GFS_radlw_pre_run use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW @@ -1214,7 +1215,7 @@ subroutine GFS_radiation_driver & cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), & sfcalb(:,3), sfcalb(:,4) ) -! L1598-1618 +! CCPP: L1598-1618 call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & @@ -1234,7 +1235,8 @@ subroutine GFS_radiation_driver & sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), sfcalb(:,4), scmpsw) !CCPP: L1689-1698 -! call GFS_radlw_pre_run () + call GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, & + im, tsfg, tsfa) ! L1703-1714 call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs diff --git a/makefile b/makefile index dff0c94f9..de3079b97 100644 --- a/makefile +++ b/makefile @@ -117,6 +117,7 @@ SRCS_f90 = \ ./physics/calpreciptype.f90 \ ./physics/GFS_RRTMG_pre.f90 \ ./physics/GFS_radsw_post.f90 \ + ./physics/GFS_radlw_pre.f90 \ ./physics/cs_conv.f90 \ ./physics/funcphys.f90 \ ./physics/gcm_shoc.f90 \ diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index 57365a1bc..252f22501 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -39,7 +39,7 @@ end subroutine GFS_RRTMG_pre_init !!| tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | !!| tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | !!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature | K | 1 | real | kind_phys | out | F | -!!| tsfa | surface_layer_temperature_for_radiation | air temperature at the first layer | K | 1 | real | kind_phys | out | F | +!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | !!| qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | !!| nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | out | F | !!| idxday | daytime_points | daytime points | none | 1 | integer | | out | F | @@ -73,10 +73,10 @@ end subroutine GFS_RRTMG_pre_init !!| cldsa | level_cloud_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | !!| mtopa | vertical_indices_for_cloud_tops | vertical indices for low, middle and high cloud tops (IX, 3) | index | 2 | integer | | out | F | !!| mbota | vertical_indices_for_cloud_bases | vertical indices for low, middle and high cloud bases (IX, 3) | index | 2 | integer | | out | F | -!!| sfcalb1 | surface_nir_direct_albedo | surface albedo in fraction of near IR direct beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb2 | surface_nir_diffused_albedo | surface albedo in fraction of near IR diffused | none | 1 | real | kind_phys | out | F | -!!| sfcalb3 | surface_uvis_direct_albedo | surface albedo in fraction of uv+vis direct beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb4 | surface_uvis_diffused_albedo | surface albedo in fraction of uv+vis diffused | none | 1 | real | kind_phys | out | F | +!!| sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb3 | surface_albedo_due_to_uv+vis_direct | surface albedo due to UV+VIS direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb4 | surface_albedo_due_to_uv+vis_diffused | surface albedo due to UV+VIS diffused beam | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, itsfc, ltp, lextop, & @@ -110,25 +110,20 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input &, rocp => con_rocp use funcphys, only: fpvs - use module_radiation_astronomy,only: sol_init, sol_update, coszmn - use module_radiation_gases, only: NF_VGAS, getgases, getozn, & - & gas_init, gas_update - use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & - & aer_init, aer_update, & + use module_radiation_astronomy,only: coszmn ! sol_init, sol_update + use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, + use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, & NSPC1 - use module_radiation_surface, only: NF_ALBD, sfc_init, setalb, & + use module_radiation_surface, only: NF_ALBD, setalb, & ! sfc_init & setemis - use module_radiation_clouds, only: NF_CLDS, cld_init, & + use module_radiation_clouds, only: NF_CLDS, & ! cld_init & progcld1, progcld2,progcld3,& & progclduni, diagcld1 - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & - & profsw_type,cmpfsw_type,NBDSW - + & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW - implicit none type(GFS_control_type), intent(in) :: Model type(GFS_grid_type), intent(in) :: Grid @@ -210,8 +205,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP) :: plvl, tlvl real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 -!CCPP: ntrac= 3; # meteorological tracers - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_CLDS) :: clouds real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw @@ -231,10 +224,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW):: & faerlw1, faerlw2, faerlw3 - !--- TYPED VARIABLES - type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw - - ! !===> ... begin here ! @@ -676,12 +665,13 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif ! Model%lsswr - !zhang: should called before LW radiation + + ! CCPP: GFS_radlw_pre_run ! Setup surface emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - Radtend%semis) ! --- outputs + ! call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + ! Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + ! tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & + ! Radtend%semis) ! --- outputs ! CCPP do k = 1, LMK diff --git a/physics/GFS_radlw_pre.f90 b/physics/GFS_radlw_pre.f90 new file mode 100644 index 000000000..76b019475 --- /dev/null +++ b/physics/GFS_radlw_pre.f90 @@ -0,0 +1,60 @@ +!>\file GFS_radlw_pre.f90 +!! This file contains a call to module_radiation_surface::setemis() to +!! setup surface emissivity for LW radiation. + module GFS_radlw_pre + contains + +!>\defgroup GFS_radlw_pre GFS RADLW Scheme Pre +!! @{ +!>\section arg_table_GFS_radlw_pre_init Argument Table +!! + subroutine GFS_radlw_pre_init () + end subroutine GFS_radlw_pre_init + +!>\section arg_table_GFS_radlw_pre_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|-------------------------------------------|----------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | inout | F | +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!! + subroutine GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa) + + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_sfcprop_type + use module_radiation_surface, only: setemis + + implicit none + type(GFS_control_type), intent(in) :: Model + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_grid_type), intent(in) :: Grid + + integer :: im + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: tsfa, tsfg + + if (Model%lslwr) then +!> - Call module_radiation_surface::setemis(),to setup surface +!! emissivity for LW radiation. + call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs + Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & + tsfg, tsfa, Sfcprop%hprim, IM, & + Radtend%semis) ! --- outputs + endif + + end subroutine GFS_radlw_pre_run + +!>\section arg_table_GFS_radlw_pre_finalize Argument Table +!! + subroutine GFS_radlw_pre_finalize () + end subroutine GFS_radlw_pre_finalize +!! @} + end module GFS_radlw_pre diff --git a/physics/GFS_radsw_post.f90 b/physics/GFS_radsw_post.f90 index db42cce63..5c256a6af 100644 --- a/physics/GFS_radsw_post.f90 +++ b/physics/GFS_radsw_post.f90 @@ -23,12 +23,12 @@ end subroutine GFS_radsw_post_init !!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | !!| htswc | tendency_of_air_temperature_due_to_shortwave_heating | total sky heating rate due to shortwave radiation | K s-1 | 2 | real | kind_phys | in | F | !!| htsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky | clear sky heating rates due to shortwave radiation | K s-1 | 2 | real | kind_phys | in | F | -!!| sfcalb1 | surface_albedo_due_to_near_IR_direct -!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused -!!| sfcalb3 -!!| sfcalb4 -!!| scmpsw - +!!| sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | none | 1 | real | kind_phys | in | F | +!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | none | 1 | real | kind_phys | in | F | +!!| sfcalb3 | surface_albedo_due_to_uv+vis_direct | surface albedo due to UV+VIS direct beam | none | 1 | real | kind_phys | in | F | +!!| sfcalb4 | surface_albedo_due_to_uv+vis_diffused | surface albedo due to UV+VIS diffused beam | none | 1 | real | kind_phys | in | F | +!!| scmpsw | surface_downward_shortwave_flux_type | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | out | F | +!! subroutine GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & ltp, nday, lm, kd, htswc, htsw0, & ! --input sfcalb1, sfcalb2, sfcalb3, sfcalb4, scmpsw ) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 7910ba59b..f3b8d63c9 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -1,5 +1,5 @@ !> \file radiation_surface.f -!! This file contains routines that set up surface albedo for SW +!! This file contains routines that set up surface albedo for SW !! radiation and surface emissivity for LW radiation. ! ========================================================== !!!!! @@ -74,7 +74,7 @@ !!!!! ========================================================== !!!!! -!> \ingroup rad +!> \ingroup RRTMG !! \defgroup module_radiation_surface module_radiation_surface !! @{ !> This module sets up surface albedo for sw radiation and surface @@ -100,13 +100,13 @@ module module_radiation_surface ! ! --- constant parameters !> num of sfc albedo components - integer, parameter, public :: NF_ALBD = 4 + integer, parameter, public :: NF_ALBD = 4 !> num of longitude points in global emis-type map - integer, parameter, public :: IMXEMS = 360 + integer, parameter, public :: IMXEMS = 360 !> num of latitude points in global emis-type map - integer, parameter, public :: JMXEMS = 180 + integer, parameter, public :: JMXEMS = 180 real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 @@ -180,7 +180,7 @@ subroutine sfc_init & if ( me == 0 ) print *, VTAGSFC ! print out version tag !> - Initialization of surface albedo section -!! \n physparam::ialbflg +!! \n physparam::ialbflg !! - = 0: using climatology surface albedo scheme for SW !! - = 1: using MODIS based land surface albedo for SW @@ -502,11 +502,11 @@ subroutine setalb & enddo ! end_do_i_loop !> -# If use modis based albedo for land area: - else + else do i = 1, IMAX -!> - Calculate snow cover input directly for land model, no +!> - Calculate snow cover input directly for land model, no !! conversion needed. fsno0 = sncovr(i) @@ -541,7 +541,7 @@ subroutine setalb & asend = 0.65 - 3.6875*a1 endif -!> - Calculate diffused snow albedo, land area use input max snow +!> - Calculate diffused snow albedo, land area use input max snow !! albedo. if (nint(slmsk(i)) == 2) then @@ -586,7 +586,7 @@ subroutine setalb & ! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & ! & - 2.02*coszf(i)*coszf(i)*coszf(i) - rfcs = 1.775/(1.0+1.55*coszf(i)) + rfcs = 1.775/(1.0+1.55*coszf(i)) if (tsknf(i) >= con_t0c) then asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & @@ -627,7 +627,7 @@ end subroutine setalb !! -pi/2 range, otherwise see in-line comment !!\param slmsk (IMAX), sea(0),land(1),ice(2) mask on fcst model grid !!\param snowf (IMAX), snow depth water equivalent in mm -!!\param sncovr (IMAX), snow cover over land +!!\param sncovr (IMAX), snow cover over land !!\param zorlf (IMAX), surface roughness in cm !!\param tsknf (IMAX), ground surface temperature in K !!\param tairf (IMAX), lowest model layer air temperature in K @@ -639,7 +639,7 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( xlon,xlat,slmsk,snowf,sncovr,zorlf,tsknf,tairf,hprif, & ! --- inputs: - & IMAX, lslwr, & + & IMAX, & & sfcemis & ! --- outputs: & ) @@ -687,9 +687,8 @@ subroutine setemis & ! --- inputs integer, intent(in) :: IMAX - real (kind=kind_phys), dimension(:), intent(in) :: & + real (kind=kind_phys), dimension(:), intent(in) :: & & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif - logical, intent(in) :: lslwr ! --- outputs real (kind=kind_phys), dimension(:), intent(out) :: sfcemis @@ -710,9 +709,6 @@ subroutine setemis & ! !===> ... begin here ! - - if (.not. lslwr) return - !> -# Set sfcemis default to 1.0 or by surface type and condition. if ( iemslw == 0 ) then ! sfc emiss default to 1.0 From 9e7e9ba6d456488f3c5c1023d1716686d82d124e Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 12 Dec 2017 20:47:58 -0700 Subject: [PATCH 093/114] finish GFS_RRTMG_post.f90 and GFS_radlw_post.f90 --- GFS_layer/GFS_radiation_driver.F90 | 406 +---------------------------- makefile | 2 + physics/GFS_RRTMG_post.f90 | 173 ++++++++++++ physics/GFS_RRTMG_pre.f90 | 128 ++++----- physics/GFS_radlw_post.f90 | 115 ++++---- 5 files changed, 305 insertions(+), 519 deletions(-) create mode 100644 physics/GFS_RRTMG_post.f90 diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index f2efb6037..995340647 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -329,9 +329,10 @@ module module_radiation_driver ! use module_radsw_main, only: rswinit, swrad_run use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run + use GFS_RRTMG_post, only: GFS_RRTMG_post_run use GFS_radsw_post, only: GFS_radsw_post_run use GFS_radlw_pre, only: GFS_radlw_pre_run - + use GFS_radlw_post, only: GFS_radlw_post_run use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW use module_radlw_main, only: rlwinit, lwrad_run @@ -1238,7 +1239,7 @@ subroutine GFS_radiation_driver & call GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, & im, tsfg, tsfa) -! L1703-1714 +!CCPP: L1703-1714 call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & @@ -1253,406 +1254,19 @@ subroutine GFS_radiation_driver & cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) -! L1718-1747 -! call GFS_radlw_post_run () +!CCPP: L1718-1747 + call GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & + ltp, lm, kd, tsfa, htlwc, htlw0) -! L1757-1841 -! call GFS_RRTMG_post_run () +!CCPP: L1757-1841 + call GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & + Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & + cldsa, mtopa, mbota, clouds(:,:,1)) - call Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & - Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & - nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & - clouds, aerodp) end subroutine GFS_radiation_driver - - - !> - For time averaged output quantities (including total-sky and - !! clear-sky SW and LW fluxes at TOA and surface; conventional - !! 3-domain cloud amount, cloud top and base pressure, and cloud top - !! temperature; aerosols AOD, etc.), store computed results in - !! corresponding slots of array fluxr with appropriate time weights. - - ! --- ... collect the fluxr data for wrtsfc - subroutine Organize_output (Diag, Model, Grid, Radtend, Statein, Coupling, & - im, kd, kt, kb, lm, scmpsw, raddt, cldsa, mtopa, mbota, clouds, aerodp) - - implicit none - - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_radtend_type), intent(in) :: Radtend - type(GFS_statein_type), intent(in) :: Statein - type(GFS_diag_type), intent(inout) :: Diag - type(GFS_coupling_type), intent(inout) :: Coupling - - integer, intent(in) :: im, kd, kt, lm, kb - real(kind = kind_phys), intent(in) :: raddt - type (cmpfsw_type), dimension(Size (Grid%xlon, 1)), intent(in) :: scmpsw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(in) :: cldsa - integer, dimension(size(Grid%xlon, 1), 3), intent(in) :: mbota, mtopa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(in) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(in) :: aerodp - - ! Local vars - integer :: i, j, k1, k, itop, ibtc - real(kind = kind_phys) :: tem0d - - - if_lssav: if (Model%lssav) then - if (Model%lsswr) then - Diag%fluxr(:,34) = Diag%fluxr(:,34) + Model%fhswr*aerodp(:,1) ! total aod at 550nm - Diag%fluxr(:,35) = Diag%fluxr(:,35) + Model%fhswr*aerodp(:,2) ! DU aod at 550nm - Diag%fluxr(:,36) = Diag%fluxr(:,36) + Model%fhswr*aerodp(:,3) ! BC aod at 550nm - Diag%fluxr(:,37) = Diag%fluxr(:,37) + Model%fhswr*aerodp(:,4) ! OC aod at 550nm - Diag%fluxr(:,38) = Diag%fluxr(:,38) + Model%fhswr*aerodp(:,5) ! SU aod at 550nm - Diag%fluxr(:,39) = Diag%fluxr(:,39) + Model%fhswr*aerodp(:,6) ! SS aod at 550nm - end if - - ! --- save lw toa and sfc fluxes - if (Model%lslwr) then - ! --- lw total-sky fluxes - Diag%fluxr(:,1 ) = Diag%fluxr(:,1 ) + Model%fhlwr * Diag%topflw(:)%upfxc ! total sky top lw up - Diag%fluxr(:,19) = Diag%fluxr(:,19) + Model%fhlwr * Radtend%sfcflw(:)%dnfxc ! total sky sfc lw dn - Diag%fluxr(:,20) = Diag%fluxr(:,20) + Model%fhlwr * Radtend%sfcflw(:)%upfxc ! total sky sfc lw up - ! --- lw clear-sky fluxes - Diag%fluxr(:,28) = Diag%fluxr(:,28) + Model%fhlwr * Diag%topflw(:)%upfx0 ! clear sky top lw up - Diag%fluxr(:,30) = Diag%fluxr(:,30) + Model%fhlwr * Radtend%sfcflw(:)%dnfx0 ! clear sky sfc lw dn - Diag%fluxr(:,33) = Diag%fluxr(:,33) + Model%fhlwr * Radtend%sfcflw(:)%upfx0 ! clear sky sfc lw up - end if - - ! --- save sw toa and sfc fluxes with proper diurnal sw wgt. coszen=mean cosz over daylight - ! part of sw calling interval, while coszdg= mean cosz over entire interval - if (Model%lsswr) then - do i = 1, im - if (Radtend%coszen(i) > 0.0) then - ! --- sw total-sky fluxes - ! ------------------- - tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) - Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up - Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up - Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn - ! --- sw uv-b fluxes - ! -------------- - Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn - ! --- sw toa incoming fluxes - ! ---------------------- - Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn - ! --- sw sfc flux components - ! ---------------------- - Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn - Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn - Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn - Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn - ! --- sw clear-sky fluxes - ! ------------------- - Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d ! clear sky top sw up - Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up - Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn - end if - end do - end if - - ! --- save total and boundary layer clouds - if (Model%lsswr .or. Model%lslwr) then - Diag%fluxr(:, 17) = Diag%fluxr(:, 17) + raddt * cldsa(:, 4) - Diag%fluxr(:, 18) = Diag%fluxr(:, 18) + raddt * cldsa(:, 5) - - ! --- save cld frac,toplyr,botlyr and top temp, note that the order - ! of h,m,l cloud is reversed for the fluxr output. - ! --- save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, im - tem0d = raddt * cldsa(i, j) - itop = mtopa(i, j) - kd - ibtc = mbota(i, j) - kd - Diag%fluxr(i, 8 - j) = Diag%fluxr(i, 8 - j) + tem0d - Diag%fluxr(i, 11 - j) = Diag%fluxr(i, 11 - j) + tem0d * Statein%prsi(i, itop + kt) - Diag%fluxr(i, 14 - j) = Diag%fluxr(i, 14 - j) + tem0d * Statein%prsi(i, ibtc + kb) - Diag%fluxr(i, 17 - j) = Diag%fluxr(i, 17 - j) + tem0d * Statein%tgrs(i, itop) - end do - end do - end if - - if (.not. Model%uni_cld) then - do k = 1, lm - k1 = k + kd - Coupling%cldcovi(:, k) = clouds(:, k1, 1) - end do - end if - - end if if_lssav - - end subroutine Organize_output - - - subroutine Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, Grid, Model, nday, lsswr) - - implicit none - - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_diag_type), intent(inout) :: Diag - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_grid_type), intent(in) :: Grid - type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw - type(GFS_control_type), intent(in) :: Model - integer, intent(in) :: nday - logical, intent(in) :: lsswr - - if (.not. lsswr) return - - if (nday > 0) then - return - else - Radtend%htrsw(:,:) = 0.0 - - Radtend%sfcfsw = sfcfsw_type(0.0, 0.0, 0.0, 0.0) - Diag%topfsw = topfsw_type(0.0, 0.0, 0.0) - scmpsw = cmpfsw_type(0.0, 0.0, 0.0, 0.0, 0.0, 0.0) - - Coupling%nirbmdi(:) = 0.0 - Coupling%nirdfdi(:) = 0.0 - Coupling%visbmdi(:) = 0.0 - Coupling%visdfdi(:) = 0.0 - - Coupling%nirbmui(:) = 0.0 - Coupling%nirdfui(:) = 0.0 - Coupling%visbmui(:) = 0.0 - Coupling%visdfui(:) = 0.0 - - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 - endif - end if - - end subroutine Zero_out_heatrate_flux - - subroutine Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, lsswr) - - implicit none - - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_grid_type), intent(in) :: Grid - type(cmpfsw_type), dimension(Size (Grid%xlon, 1)), intent(in) :: scmpsw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb - logical, intent(in) :: lsswr - - - if (.not. lsswr) return - - Coupling%nirbmdi(:) = scmpsw(:)%nirbm - Coupling%nirdfdi(:) = scmpsw(:)%nirdf - Coupling%visbmdi(:) = scmpsw(:)%visbm - Coupling%visdfdi(:) = scmpsw(:)%visdf - - Coupling%nirbmui(:) = scmpsw(:)%nirbm * sfcalb(:, 1) - Coupling%nirdfui(:) = scmpsw(:)%nirdf * sfcalb(:, 2) - Coupling%visbmui(:) = scmpsw(:)%visbm * sfcalb(:, 3) - Coupling%visdfui(:) = scmpsw(:)%visdf * sfcalb(:, 4) - - end subroutine Save_sw_fluxes - - - subroutine Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, lsswr) - - implicit none - - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: htswc - integer, intent(in) :: lm, kd - logical, intent(in) :: lsswr - - ! Local vars - integer :: k, k1 - - - if (.not. lsswr) return - - do k = 1, lm - k1 = k + kd - Radtend%htrsw(:, k) = htswc(:, k1) - end do - - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%htrsw (:, k) = Radtend%htrsw (:, lm) - end do - end if - - end subroutine Save_sw_heating_rate - - - subroutine Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, kd, lsswr) - - implicit none - - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: htsw0 - integer, intent(in) :: lm, kd - logical, intent(in) :: lsswr - - ! Local vars - integer :: k, k1 - - - if (.not. lsswr) return - - if (Model%swhtr) then - do k = 1, lm - k1 = k + kd - Radtend%swhc(:, k) = htsw0(:, k1) - end do - - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%swhc(:, k) = Radtend%swhc(:, lm) - end do - end if - end if - - end subroutine Save_sw_heating_rate_csk - - - subroutine Save_more_sw_fluxes (Radtend, Coupling, lsswr) - - implicit none - - type(GFS_radtend_type), intent(in) :: Radtend - type(GFS_coupling_type), intent(inout) :: Coupling - logical, intent(in) :: lsswr - - - if (.not. lsswr) return - - ! Radiation fluxes for other physics processes - Coupling%sfcnsw(:) = Radtend%sfcfsw(:)%dnfxc - Radtend%sfcfsw(:)%upfxc - Coupling%sfcdsw(:) = Radtend%sfcfsw(:)%dnfxc - - end subroutine Save_more_sw_fluxes - - - subroutine Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - - implicit none - - integer, intent(in) :: lm, kd - type(GFS_grid_type), intent(in) :: Grid - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_control_type), intent(in) :: Model - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: htlw0, htlwc - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfa - - ! Local vars - integer :: k, k1 - - - if (.not. Model%lslwr) return - - Radtend%tsflw (:) = tsfa(:) - - do k = 1, lm - k1 = k + kd - Radtend%htrlw(:,k) = htlwc(:, k1) - end do - - ! Repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%htrlw (:, k) = Radtend%htrlw (:, lm) - end do - end if - - do k = 1, lm - k1 = k + kd - Radtend%lwhc(:, k) = htlw0(:, k1) - end do - - ! --- repopulate the points above levr - if (Model%levr < Model%levs) then - do k = lm, Model%levs - Radtend%lwhc(:, k) = Radtend%lwhc(:, lm) - end do - end if - - - ! Radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc - - end subroutine Post_lw - - subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & - Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & - nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & - clouds, aerodp) - - implicit none - - integer, intent(in) :: lm, kd, im, kt, kb - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_statein_type), intent(in) :: Statein - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_diag_type), intent(inout) :: Diag - - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: htlw0, htlwc, htswc, htsw0 - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfa - type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb - integer, intent(in) :: nday - real(kind = kind_phys), intent(in) :: raddt - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(in) :: cldsa - integer, dimension(size(Grid%xlon, 1), 3), intent(in) :: mbota, mtopa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(in) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(in) :: aerodp - - - ! Save LW results - call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) - -! CCPP: this part is in GFS_radsw_post_run - ! post SW - !call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - ! Model%lsswr) - - !call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - ! kd, Model%lsswr) - - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - !call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) - - ! Night time: set SW heating rates and fluxes to zero - !call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - ! Grid, Model, nday, Model%lsswr) - - !call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) -!CCPP - - - ! Collect the fluxr data for wrtsfc - call Organize_output (Diag, Model, Grid, Radtend, Statein, & - Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & - mtopa, mbota, clouds, aerodp) - - end subroutine Post_radiation - - ! !> @} !........................................! diff --git a/makefile b/makefile index de3079b97..749bab283 100644 --- a/makefile +++ b/makefile @@ -116,8 +116,10 @@ SRCS_f = \ SRCS_f90 = \ ./physics/calpreciptype.f90 \ ./physics/GFS_RRTMG_pre.f90 \ + ./physics/GFS_RRTMG_post.f90 \ ./physics/GFS_radsw_post.f90 \ ./physics/GFS_radlw_pre.f90 \ + ./physics/GFS_radlw_post.f90 \ ./physics/cs_conv.f90 \ ./physics/funcphys.f90 \ ./physics/gcm_shoc.f90 \ diff --git a/physics/GFS_RRTMG_post.f90 b/physics/GFS_RRTMG_post.f90 new file mode 100644 index 000000000..8741b1ad8 --- /dev/null +++ b/physics/GFS_RRTMG_post.f90 @@ -0,0 +1,173 @@ +!>\file GFS_RRTMG_post.f90 +!! This file contains + module GFS_RRTMG_post + contains + +!>\defgroup GFS_RRTMG_post GFS RRTMG Scheme Post +!! @{ +!>\section arg_table_GFS_RRTMG_post_init Argument Table +!! + subroutine GFS_RRTMG_post_init () + end subroutine GFS_RRTMG_post_init + +!>\section arg_table_GFS_RRTMG_post_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS diagnotics data | DDT | 0 | GFS_typedefs%GFS_diag_type | | inout | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | +!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!!| Coupling | FV3-GFS_Coupling_type | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_typedefs%GFS_coupling_type| | inout | F | +!!| scmpsw | surface_downward_shortwave_flux_type | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | in | F | +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | in | F | +!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | +!!| kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | in | F | +!!| kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | in | F | +!!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | +!!| raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | in | F | +!!| aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particals | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | in | F | +!!| cldsa | cloud_area_fraction | fraction of clouds for low, middle, high, total and BL | frac | 2 | real | kind_phys | in | F | +!!| mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | in | F | +!!| mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | in | F | +!!| clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | in | F | +!! + subroutine GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & + Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & + cldsa, mtopa, mbota, clouds1) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_diag_type + use module_radiation_aerosols, only: NSPC1 + use module_radsw_parameters, only: cmpfsw_type + use module_radlw_parameters, only: topflw_type, sfcflw_type + use module_radsw_parameters, only: topfsw_type, sfcfsw_type + + implicit none + type(GFS_control_type), intent(in) :: Model + type(GFS_grid_type), intent(in) :: Grid + type(GFS_statein_type), intent(in) :: Statein + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(inout) :: Diag + type(cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw + + integer :: i, j, im, lm, k, k1, itop, ibtc, kd, kt, kb, ltp + real(kind=kind_phys) :: tem0d, raddt + real(kind=kind_phys), dimension(size(Grid%xlon,1),5) :: cldsa + integer, dimension(size(Grid%xlon,1),3) :: mbota, mtopa + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: clouds1 + real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1) :: aerodp + +!> - For time averaged output quantities (including total-sky and +!! clear-sky SW and LW fluxes at TOA and surface; conventional +!! 3-domain cloud amount, cloud top and base pressure, and cloud top +!! temperature; aerosols AOD, etc.), store computed results in +!! corresponding slots of array fluxr with appropriate time weights. + +! --- ... collect the fluxr data for wrtsfc + + if (Model%lssav) then + if (Model%lsswr) then + Diag%fluxr(:,34) = Diag%fluxr(:,34) + Model%fhswr*aerodp(:,1) ! total aod at 550nm + Diag%fluxr(:,35) = Diag%fluxr(:,35) + Model%fhswr*aerodp(:,2) ! DU aod at 550nm + Diag%fluxr(:,36) = Diag%fluxr(:,36) + Model%fhswr*aerodp(:,3) ! BC aod at 550nm + Diag%fluxr(:,37) = Diag%fluxr(:,37) + Model%fhswr*aerodp(:,4) ! OC aod at 550nm + Diag%fluxr(:,38) = Diag%fluxr(:,38) + Model%fhswr*aerodp(:,5) ! SU aod at 550nm + Diag%fluxr(:,39) = Diag%fluxr(:,39) + Model%fhswr*aerodp(:,6) ! SS aod at 550nm + endif + +! --- save lw toa and sfc fluxes + if (Model%lslwr) then +! --- lw total-sky fluxes + Diag%fluxr(:,1 ) = Diag%fluxr(:,1 ) + Model%fhlwr *Diag%topflw(:)%upfxc ! total sky top lw up + Diag%fluxr(:,19) = Diag%fluxr(:,19) + Model%fhlwr *Radtend%sfcflw(:)%dnfxc ! total sky sfc lw dn + Diag%fluxr(:,20) = Diag%fluxr(:,20) + Model%fhlwr *Radtend%sfcflw(:)%upfxc ! total sky sfc lw up +! --- lw clear-sky fluxes + Diag%fluxr(:,28) = Diag%fluxr(:,28) + Model%fhlwr *Diag%topflw(:)%upfx0 ! clear sky top lw up + Diag%fluxr(:,30) = Diag%fluxr(:,30) + Model%fhlwr *Radtend%sfcflw(:)%dnfx0 ! clear sky sfc lw dn + Diag%fluxr(:,33) = Diag%fluxr(:,33) + Model%fhlwr *Radtend%sfcflw(:)%upfx0 ! clear sky sfc lw up + endif + +! --- save sw toa and sfc fluxes with proper diurnal sw wgt. coszen=mean cosz over daylight +! part of sw calling interval, while coszdg= mean cosz over entire interval + if (Model%lsswr) then + do i = 1, IM + if (Radtend%coszen(i) > 0.) then +! --- sw total-sky fluxes +! ------------------- + tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) + Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up + Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up + Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn +! --- sw uv-b fluxes +! -------------- + Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn +! --- sw toa incoming fluxes +! ---------------------- + Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn +! --- sw sfc flux components +! ---------------------- + Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn + Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn + Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn + + Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn +! --- sw clear-sky fluxes +! ------------------- + Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d ! clear sky top sw up + Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up + Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn + endif + enddo + endif + +! --- save total and boundary layer clouds + + if (Model%lsswr .or. Model%lslwr) then + Diag%fluxr(:,17) = Diag%fluxr(:,17) + raddt * cldsa(:,4) + Diag%fluxr(:,18) = Diag%fluxr(:,18) + raddt * cldsa(:,5) + +! --- save cld frac,toplyr,botlyr and top temp, note that the order +! of h,m,l cloud is reversed for the fluxr output. +! --- save interface pressure (pa) of top/bot + + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d + Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt) + Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb) + Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + enddo + enddo + endif + + if (.not. Model%uni_cld) then + do k = 1, LM + k1 = k + kd + !CCPP Coupling%cldcovi(:,k) = clouds(:,k1,1) + Coupling%cldcovi(:,k) = clouds1(:,k1) + + enddo + endif + endif ! end_if_lssav +! + end subroutine GFS_RRTMG_post_run + +!>\section arg_table_GFS_RRTMG_post_finalize Argument Table +!! + subroutine GFS_RRTMG_post_finalize () + end subroutine GFS_RRTMG_post_finalize + +!! @} + end module GFS_RRTMG_post diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index 252f22501..fdf513812 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -14,72 +14,72 @@ subroutine GFS_RRTMG_pre_init () end subroutine GFS_RRTMG_pre_init !!\section arg_table_GFS_RRTMG_pre_run Argument Table -!!| local var name | longname | description | units | rank | type | kind | intent | optional | -!!|-------------------|-------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| -!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | -!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | -!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | -!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | -!!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | | in | F | -!!| Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | | in | F | -!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | -!!| itsfc | flag_for_surface_temperature | control flag for surface temperature | none | 0 | integer | | in | F | -!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | -!!| lextop | flag_for_extra_top_layer | control flag for extra top layer | none | 0 | logical | | in | F | -!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | -!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | -!!| lmk | vertical_layer_dimension_with_extra_top_layer | number of vertical layers with extra top layer | index | 0 | integer | | out | F | -!!| lmp | vertical_level_dimension_with_extra_top_layer | number of vertical levels with extra top layer | index | 0 | integer | | out | F | -!!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | -!!| kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | -!!| kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | -!!| raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | -!!| plvl | air_pressure_at_interface_for_radiation | air pressure at vertical interface for radiation calculation | mb | 2 | real | kind_phys | out | F | -!!| plyr | air_pressure_at_layer_for_radiation | air pressure at vertical layer for radiation calculation | mb | 2 | real | kind_phys | out | F | -!!| tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | -!!| tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | -!!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature | K | 1 | real | kind_phys | out | F | -!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | -!!| qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | -!!| nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | out | F | -!!| idxday | daytime_points | daytime points | none | 1 | integer | | out | F | -!!| olyr | ozone_mixing_ratio_for_radiation | ozone mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_co2 | volume_mixing_ratio_co2 | CO2 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_n2o | volume_mixing_ratio_n2o | N2O volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_ch4 | volume_mixing_ratio_ch4 | CH4 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_o2 | volume_mixing_ratio_o2 | O2 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_co | volume_mixing_ratio_co | CO volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_cfc11 | volume_mixing_ratio_cfc11 | CFC11 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_cfc12 | volume_mixing_ratio_cfc12 | CFC12 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_cfc22 | volume_mixing_ratio_cfc22 | CFC22 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_ccl4 | volume_mixing_ratio_ccl4 | CCL4 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| gasvmr_cfc113 | volume_mixing_ratio_cfc113 | CFC113 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | -!!| faersw1 | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| faersw2 | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| faersw3 | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry parameter for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | -!!| aerodp | vertical_integrated_aerosol_optical_depth | vertical integrated aerosol optical depth | none | 2 | real | kind_phys | out | F | -!!| clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | -!!| clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | -!!| clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | -!!| clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | -!!| clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | -!!| clouds6 | rain_water_path | layer rain drop water path | g m-2 | 2 | real | kind_phys | out | F | -!!| clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | -!!| clouds8 | snow_water_path | layer snow flake water path | g m-2 | 2 | real | kind_phys | out | F | -!!| clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | -!!| cldsa | level_cloud_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | -!!| mtopa | vertical_indices_for_cloud_tops | vertical indices for low, middle and high cloud tops (IX, 3) | index | 2 | integer | | out | F | -!!| mbota | vertical_indices_for_cloud_bases | vertical indices for low, middle and high cloud bases (IX, 3) | index | 2 | integer | | out | F | -!!| sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb3 | surface_albedo_due_to_uv+vis_direct | surface albedo due to UV+VIS direct beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb4 | surface_albedo_due_to_uv+vis_diffused | surface albedo due to UV+VIS diffused beam | none | 1 | real | kind_phys | out | F | +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | +!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | | in | F | +!!| Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | | in | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | +!!| itsfc | flag_for_surface_temperature | control flag for surface temperature | none | 0 | integer | | in | F | +!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | +!!| lextop | flag_for_extra_top_layer | control flag for extra top layer | none | 0 | logical | | in | F | +!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | +!!| lmk | vertical_layer_dimension_with_extra_top_layer | number of vertical layers with extra top layer | index | 0 | integer | | out | F | +!!| lmp | vertical_level_dimension_with_extra_top_layer | number of vertical levels with extra top layer | index | 0 | integer | | out | F | +!!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | +!!| kt | vertical_index_difference_between_layer_and_upper_bound | vertical index difference between layer and upper bound | index | 0 | integer | | out | F | +!!| kb | vertical_index_difference_between_layer_and_lower_bound | vertical index difference between layer and lower bound | index | 0 | integer | | out | F | +!!| raddt | time_step_for_radiation | radiation time step | s | 0 | real | kind_phys | out | F | +!!| plvl | air_pressure_at_interface_for_radiation | air pressure at vertical interface for radiation calculation | mb | 2 | real | kind_phys | out | F | +!!| plyr | air_pressure_at_layer_for_radiation | air pressure at vertical layer for radiation calculation | mb | 2 | real | kind_phys | out | F | +!!| tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | +!!| tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | +!!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature | K | 1 | real | kind_phys | out | F | +!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | +!!| qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | +!!| nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | out | F | +!!| idxday | daytime_points | daytime points | none | 1 | integer | | out | F | +!!| olyr | ozone_mixing_ratio_for_radiation | ozone mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_co2 | volume_mixing_ratio_of_co2 | CO2 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_n2o | volume_mixing_ratio_of_n2o | N2O volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_ch4 | volume_mixing_ratio_of_ch4 | CH4 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_o2 | volume_mixing_ratio_of_o2 | O2 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_co | volume_mixing_ratio_of_co | CO volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc11 | volume_mixing_ratio_of_cfc11 | CFC11 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc12 | volume_mixing_ratio_of_cfc12 | CFC12 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc22 | volume_mixing_ratio_of_cfc22 | CFC22 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_ccl4 | volume_mixing_ratio_of_ccl4 | CCL4 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| gasvmr_cfc113 | volume_mixing_ratio_of_cfc113 | CFC113 volumic mixing ratio | gm gm-1 | 2 | real | kind_phys | out | F | +!!| faersw1 | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faersw2 | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faersw3 | aerosol_asymmetry_parameter_for_shortwave_bands_01-16 | aerosol asymmetry parameter for shortwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faerlw1 | aerosol_optical_depth_for_longwave_bands_01-16 | aerosol optical depth for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faerlw2 | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| faerlw3 | aerosol_asymmetry_parameter_for_longwave_bands_01-16 | aerosol asymmetry parameter for longwave bands 01-16 | none | 3 | real | kind_phys | out | F | +!!| aerodp | atmosphere_optical_thickness_due_to_ambient_aerosol_particals | vertical integrated optical depth for various aerosol species | none | 2 | real | kind_phys | out | F | +!!| clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | out | F | +!!| clouds2 | cloud_liquid_water_path | layer cloud liquid water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds3 | mean_effective_radius_for_liquid_cloud | mean effective radius for liquid cloud | micron | 2 | real | kind_phys | out | F | +!!| clouds4 | cloud_ice_water_path | layer cloud ice water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds5 | mean_effective_radius_for_ice_cloud | mean effective radius for ice cloud | micron | 2 | real | kind_phys | out | F | +!!| clouds6 | rain_water_path | layer rain drop water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | +!!| clouds8 | snow_water_path | layer snow flake water path | g m-2 | 2 | real | kind_phys | out | F | +!!| clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | +!!| cldsa | cloud_area_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | +!!| mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | +!!| mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | +!!| sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb3 | surface_albedo_due_to_uv+vis_direct | surface albedo due to UV+VIS direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb4 | surface_albedo_due_to_uv+vis_diffused | surface albedo due to UV+VIS diffused beam | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Radtend, itsfc, ltp, lextop, & + Tbd, Cldprop, Radtend, itsfc, ltp, lextop, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, nday, idxday, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & diff --git a/physics/GFS_radlw_post.f90 b/physics/GFS_radlw_post.f90 index 2e5f34c9f..992781faf 100644 --- a/physics/GFS_radlw_post.f90 +++ b/physics/GFS_radlw_post.f90 @@ -1,38 +1,52 @@ - subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & - Model, Coupling, Grid, htswc, htsw0, scmpsw, sfcalb, Diag, & - nday, Statein, im, kt, kb, raddt, cldsa, mtopa, mbota, & - clouds, aerodp) - - implicit none - - integer, intent(in) :: lm, kd, im, kt, kb - type(GFS_grid_type), intent(in) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_statein_type), intent(in) :: Statein - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_diag_type), intent(inout) :: Diag - - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP), intent(in) :: htlw0, htlwc, htswc, htsw0 - real(kind = kind_phys), dimension(Size (Grid%xlon, 1)), intent(in) :: tsfa - type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NF_ALBD), intent(in) :: sfcalb - integer, intent(in) :: nday - real(kind = kind_phys), intent(in) :: raddt - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), 5), intent(in) :: cldsa - integer, dimension(size(Grid%xlon, 1), 3), intent(in) :: mbota, mtopa - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & - LTP, NF_CLDS), intent(in) :: clouds - real(kind = kind_phys), dimension(Size (Grid%xlon, 1), NSPC1), intent(in) :: aerodp - - - !pedro Save LW results - !pedro call Post_lw (Radtend, tsfa, lm, kd, htlwc, htlw0, Model, Coupling, Grid) +!>\file GFS_radlw_post +!!This file contains + module GFS_radlw_post + contains + +!>\defgroup GFS_radlw_post GFS RRTMG/RADLW Scheme Post +!! @{ +!>\section arg_table_GFS_radlw_post_init Argument Table +!! + subroutine GFS_radlw_post_init() + end subroutine GFS_radlw_post_init + +!>\section arg_table_GFS_radlw_post_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|-----------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS fields targetted for diagnostic output | DDT | 0 | GFS_typedefs%GFS_radtend_type | | inout | F | +!!| Coupling | FV3-GFS_Coupling_type | Fortran DDT containing FV3-GFS fields to/from coupling with other components | DDT | 0 | GFS_typedefs%GFS_coupling_type| | inout | F | +!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | +!!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | in | F | +!!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | in | F | +!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!!| htlwc | tendency_of_air_temperature_due_to_longwave_heating | total sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | +!!| htlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky | clear sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | +!! + subroutine GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & + ltp, lm, kd, tsfa, htlwc, htlw0) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type + implicit none + type(GFS_control_type), intent(in) :: Model + type(GFS_coupling_type), intent(inout) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_radtend_type), intent(inout) :: Radtend + + integer :: k1,k, LM, kd, ltp + real(kind = kind_phys), dimension(Size (Grid%xlon, 1), Model%levr + & + LTP) :: htlwc, htlw0 + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: tsfa + if (Model%lslwr) then +!> -# Save calculation results !> - Save surface air temp for diurnal adjustment at model t-steps - if (Model%lslwr) then Radtend%tsflw (:) = tsfa(:) do k = 1, LM @@ -56,37 +70,20 @@ subroutine Post_radiation (Radtend, tsfa, lm, kd, htlwc, htlw0, & do k = LM,Model%levs Radtend%lwhc(:,k) = Radtend%lwhc(:,LM) enddo - endif - endif + endif + endif ! --- radiation fluxes for other physics processes Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc endif ! end_if_lslwr + + end subroutine GFS_radlw_post_run +!>\section arg_table_GFS_radlw_post_finalize Argument Table +!! + subroutine GFS_radlw_post_finalize () + end subroutine GFS_radlw_post_finalize - ! post SW - call Save_sw_heating_rate (Radtend, Model, Grid, htswc, lm, kd, & - Model%lsswr) - - call Save_sw_heating_rate_csk (Radtend, Model, Grid, htsw0, lm, & - kd, Model%lsswr) - - ! Surface down and up spectral component fluxes - ! Save two spectral bands' surface downward and upward fluxes for output. - call Save_sw_fluxes (Coupling, scmpsw, Grid, sfcalb, Model%lsswr) - - ! Night time: set SW heating rates and fluxes to zero - call Zero_out_heatrate_flux (Radtend, Diag, scmpsw, Coupling, & - Grid, Model, nday, Model%lsswr) - - call Save_more_sw_fluxes (Radtend, Coupling, Model%lsswr) - - - ! Collect the fluxr data for wrtsfc - call Organize_output (Diag, Model, Grid, Radtend, Statein, & - Coupling, im, kd, kt, kb, lm, scmpsw, raddt, cldsa, & - mtopa, mbota, clouds, aerodp) - - end subroutine Post_radiation - +!! @} + end module GFS_radlw_post From ec6d10cc9a0eb8521bca243e43a688185f87ed06 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Wed, 13 Dec 2017 11:37:04 -0700 Subject: [PATCH 094/114] separate GFS_radsw_pre_run from GFS_RRTMG_pre.f90. pass B4B and table --- GFS_layer/GFS_radiation_driver.F90 | 78 +++++++++++++++--------------- makefile | 1 + physics/GFS_RRTMG_pre.f90 | 57 ++-------------------- 3 files changed, 45 insertions(+), 91 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 995340647..9785e379c 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -330,6 +330,7 @@ module module_radiation_driver ! use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run use GFS_RRTMG_post, only: GFS_RRTMG_post_run + use GFS_radsw_pre, only: GFS_radsw_pre_run use GFS_radsw_post, only: GFS_radsw_post_run use GFS_radlw_pre, only: GFS_radlw_pre_run use GFS_radlw_post, only: GFS_radlw_post_run @@ -1196,28 +1197,29 @@ subroutine GFS_radiation_driver & real(kind = kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP, NBDLW, NF_AELW) :: faerlw type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw -! CCPP: L349-390 -! call GFS_RRTMG_pre_init (vtagrad, qmin, qme5,qme6, epsq, prsmin, & -! itsfc, month0, iyear0, monthd,loz1st, ltp,lextop) - -! CCPP: L1211-1596 - call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Radtend,itsfc, ltp, lextop, & - lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output - tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & - gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & - gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & - gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10),& - faersw(:,:,:,1), faersw(:,:,:,2), faersw(:,:,:,3), & - faerlw(:,:,:,1), faerlw(:,:,:,2), faerlw(:,:,:,3), aerodp, & - clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & - clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & - clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & - cldsa, mtopa, mbota, sfcalb(:,1), sfcalb(:,2), & - sfcalb(:,3), sfcalb(:,4) ) +! CCPP: L1211-1577 + call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input + Tbd, Cldprop, Radtend,itsfc, ltp, lextop, & + lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output + tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & + gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & + gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & + gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10), & + faersw(:,:,:,1), faersw(:,:,:,2), faersw(:,:,:,3), & + faerlw(:,:,:,1), faerlw(:,:,:,2), faerlw(:,:,:,3), aerodp, & + clouds(:,:,1), clouds(:,:,2), clouds(:,:,3), & + clouds(:,:,4), clouds(:,:,5), clouds(:,:,6), & + clouds(:,:,7), clouds(:,:,8), clouds(:,:,9), & + cldsa, mtopa, mbota ) + +! CCPP: L1582-1596 + call GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & + tsfg, tsfa, sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), & + sfcalb(:,4) ) ! CCPP: L1598-1618 - call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, gasvmr(:, :, 1), & ! Inputs: + call swrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! input + gasvmr(:, :, 1), & gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & faersw(:, :, :, 3), sfcalb(:,1), sfcalb(:,2),sfcalb(:,3), & @@ -1231,36 +1233,36 @@ subroutine GFS_radiation_driver & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) !CCPP: L1620-1686 - call GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & - ltp, nday, lm, kd, htswc, htsw0, & + call GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & + ltp, nday, lm, kd, htswc, htsw0, & sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), sfcalb(:,4), scmpsw) !CCPP: L1689-1698 - call GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, & + call GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, & im, tsfg, tsfa) !CCPP: L1703-1714 - call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! --- inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & - Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & - Model%lslwr, & - htlwc, Diag%topflw, Radtend%sfcflw, & ! --- outputs - hlw0=htlw0, & ! --- optional output - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! --- optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7),& + call lwrad_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! inputs + gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & + gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & + gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + Model%lslwr, & + htlwc, Diag%topflw, Radtend%sfcflw, & ! outputs + hlw0=htlw0, & ! optional output + cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! optional input + cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & + cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) !CCPP: L1718-1747 - call GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & + call GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & ltp, lm, kd, tsfa, htlwc, htlw0) !CCPP: L1757-1841 - call GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & - Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & + call GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & + Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & cldsa, mtopa, mbota, clouds(:,:,1)) diff --git a/makefile b/makefile index 749bab283..90e958abb 100644 --- a/makefile +++ b/makefile @@ -117,6 +117,7 @@ SRCS_f90 = \ ./physics/calpreciptype.f90 \ ./physics/GFS_RRTMG_pre.f90 \ ./physics/GFS_RRTMG_post.f90 \ + ./physics/GFS_radsw_pre.f90 \ ./physics/GFS_radsw_post.f90 \ ./physics/GFS_radlw_pre.f90 \ ./physics/GFS_radlw_post.f90 \ diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index fdf513812..0765e2016 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -27,7 +27,7 @@ end subroutine GFS_RRTMG_pre_init !!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | !!| lextop | flag_for_extra_top_layer | control flag for extra top layer | none | 0 | logical | | in | F | !!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | -!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | !!| lmk | vertical_layer_dimension_with_extra_top_layer | number of vertical layers with extra top layer | index | 0 | integer | | out | F | !!| lmp | vertical_level_dimension_with_extra_top_layer | number of vertical levels with extra top layer | index | 0 | integer | | out | F | !!| kd | vertical_index_difference_between_in-out_and_local | vertical index difference between in/out and local | index | 0 | integer | | out | F | @@ -39,7 +39,7 @@ end subroutine GFS_RRTMG_pre_init !!| tlvl | air_temperature_at_interface_for_radiation | air temperature at vertical interface for radiation calculation | K | 2 | real | kind_phys | out | F | !!| tlyr | air_temperature_at_layer_for_radiation | air temperature at vertical layer for radiation calculation | K | 2 | real | kind_phys | out | F | !!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature | K | 1 | real | kind_phys | out | F | -!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | +!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | !!| qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | !!| nday | daytime_points_dimension | daytime points dimension | index | 0 | integer | | out | F | !!| idxday | daytime_points | daytime points | none | 1 | integer | | out | F | @@ -71,12 +71,8 @@ end subroutine GFS_RRTMG_pre_init !!| clouds8 | snow_water_path | layer snow flake water path | g m-2 | 2 | real | kind_phys | out | F | !!| clouds9 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | out | F | !!| cldsa | cloud_area_fraction | fraction of clouds for low, middle,high, total and bl (IX,5) | frac | 2 | real | kind_phys | out | F | -!!| mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | +!!| mtopa | model_layer_number_at_cloud_top | vertical indices for low, middle and high cloud tops | index | 2 | integer | | out | F | !!| mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | -!!| sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb3 | surface_albedo_due_to_uv+vis_direct | surface albedo due to UV+VIS direct beam | none | 1 | real | kind_phys | out | F | -!!| sfcalb4 | surface_albedo_due_to_uv+vis_diffused | surface albedo due to UV+VIS diffused beam | none | 1 | real | kind_phys | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, itsfc, ltp, lextop, & @@ -88,8 +84,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input faersw1, faersw2, faersw3, & faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & - clouds7, clouds8, clouds9, cldsa, mtopa, mbota, & - sfcalb1, sfcalb2, sfcalb3, sfcalb4) + clouds7, clouds8, clouds9, cldsa, mtopa, mbota ) use machine, only: kind_phys @@ -114,8 +109,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, & NSPC1 - use module_radiation_surface, only: NF_ALBD, setalb, & ! sfc_init - & setemis use module_radiation_clouds, only: NF_CLDS, & ! cld_init & progcld1, progcld2,progcld3,& & progclduni, diagcld1 @@ -195,8 +188,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),5) :: cldsa real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1) :: aerodp -!CCPP: NSPC1=NSPC+1; NSPC: num of species for optional aod output fields - real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, plyr, tlyr, & qlyr, olyr, rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & @@ -210,9 +201,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw -! CCPP-compliant - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & - sfcalb1, sfcalb2, sfcalb3, sfcalb4 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP):: & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9 @@ -644,35 +632,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif ! end_if_ntcw -! --- ... start radiation calculations -! remember to set heating rate unit to k/sec! -!> -# Start SW radiation calculations - if (Model%lsswr) then - -!> - Call module_radiation_surface::setalb() to setup surface albedo. -!! for SW radiation. - - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& - tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, IM, & - sfcalb) ! --- outputs - -!> -# Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - - endif ! Model%lsswr - - - ! CCPP: GFS_radlw_pre_run - ! Setup surface emissivity for LW radiation. - ! call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - ! Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - ! tsfg, tsfa, Sfcprop%hprim, im, Model%lslwr, & - ! Radtend%semis) ! --- outputs - ! CCPP do k = 1, LMK do i = 1, IM @@ -688,14 +647,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo - do i = 1, im - sfcalb1(i) = sfcalb(i,1) - sfcalb2(i) = sfcalb(i,2) - sfcalb3(i) = sfcalb(i,3) - sfcalb4(i) = sfcalb(i,4) - enddo - - end subroutine GFS_RRTMG_pre_run !!\section arg_table_GFS_RRTMG_pre_finalize Argument Table From c6ea9704d6c7e64782914f29f4fc28ceac95ce10 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Wed, 13 Dec 2017 16:38:27 -0700 Subject: [PATCH 095/114] add radcons.f90 as use association in radiation. --- GFS_layer/GFS_radiation_driver.F90 | 3 +- makefile | 3 +- physics/GFS_RRTMG_pre.f90 | 57 ++----------------- physics/GFS_radsw_pre.f90 | 90 ++++++++++++++++++++++++++++++ physics/radcons.f90 | 68 ++++++++++++++++++++++ 5 files changed, 166 insertions(+), 55 deletions(-) create mode 100644 physics/GFS_radsw_pre.f90 create mode 100644 physics/radcons.f90 diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 9785e379c..02d57d92c 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -311,6 +311,7 @@ module module_radiation_driver ! & fvirt => con_fvirt & &, rocp => con_rocp use funcphys, only: fpvs + use radcons use module_radiation_astronomy,only: sol_init, sol_update, coszmn use module_radiation_gases, only: NF_VGAS, getgases, getozn, & @@ -1199,7 +1200,7 @@ subroutine GFS_radiation_driver & ! CCPP: L1211-1577 call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Radtend,itsfc, ltp, lextop, & + Tbd, Cldprop, Radtend, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & diff --git a/makefile b/makefile index 90e958abb..bef39a158 100644 --- a/makefile +++ b/makefile @@ -117,7 +117,7 @@ SRCS_f90 = \ ./physics/calpreciptype.f90 \ ./physics/GFS_RRTMG_pre.f90 \ ./physics/GFS_RRTMG_post.f90 \ - ./physics/GFS_radsw_pre.f90 \ + ./physics/GFS_radsw_pre.f90 \ ./physics/GFS_radsw_post.f90 \ ./physics/GFS_radlw_pre.f90 \ ./physics/GFS_radlw_post.f90 \ @@ -133,6 +133,7 @@ SRCS_f90 = \ ./physics/module_nst_water_prop.f90 \ ./physics/ozinterp.f90 \ ./physics/physcons.f90 \ + ./physics/radcons.f90 \ ./physics/wam_f107_kp_mod.f90 SRCS_F = ./physics/aer_cloud.F \ diff --git a/physics/GFS_RRTMG_pre.f90 b/physics/GFS_RRTMG_pre.f90 index 0765e2016..547a15d5e 100644 --- a/physics/GFS_RRTMG_pre.f90 +++ b/physics/GFS_RRTMG_pre.f90 @@ -23,9 +23,6 @@ end subroutine GFS_RRTMG_pre_init !!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | | in | F | !!| Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics | DDT | 0 | GFS_typedefs%GFS_cldprop_type | | in | F | !!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | in | F | -!!| itsfc | flag_for_surface_temperature | control flag for surface temperature | none | 0 | integer | | in | F | -!!| ltp | extra_top_layer | extra top layers | none | 0 | integer | | in | F | -!!| lextop | flag_for_extra_top_layer | control flag for extra top layer | none | 0 | logical | | in | F | !!| lm | vertical_layer_dimension_for_radiation | number of vertical layers for radiation calculation | index | 0 | integer | | out | F | !!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | out | F | !!| lmk | vertical_layer_dimension_with_extra_top_layer | number of vertical layers with extra top layer | index | 0 | integer | | out | F | @@ -75,7 +72,7 @@ end subroutine GFS_RRTMG_pre_init !!| mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | out | F | !! subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Radtend, itsfc, ltp, lextop, & + Tbd, Cldprop, Radtend, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, nday, idxday, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & @@ -103,6 +100,8 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input & epsm1 => con_epsm1, & & fvirt => con_fvirt & &, rocp => con_rocp + use radcons, only: itsfc,ltp, lextop, qmin, & + qme5, qme6, epsq, prsmin use funcphys, only: fpvs use module_radiation_astronomy,only: coszmn ! sol_init, sol_update @@ -126,55 +125,7 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input type(GFS_tbd_type), intent(in) :: Tbd type(GFS_cldprop_type), intent(in) :: Cldprop -! --- version tag and last revision date - character(40), parameter :: & - & VTAGRAD='NCEP-Radiation_driver v5.2 Jan 2013 ' -! & VTAGRAD='NCEP-Radiation_driver v5.1 Nov 2012 ' -! & VTAGRAD='NCEP-Radiation_driver v5.0 Aug 2012 ' - -!>\name Constant values - -!> lower limit of saturation vapor pressure (=1.0e-10) - real (kind=kind_phys) :: QMIN -!> lower limit of specific humidity (=1.0e-7) - real (kind=kind_phys) :: QME5 -!> lower limit of specific humidity (=1.0e-7) - real (kind=kind_phys) :: QME6 -!> EPSQ=1.0e-12 - real (kind=kind_phys) :: EPSQ -! parameter (QMIN=1.0e-10, QME5=1.0e-5, QME6=1.0e-6, EPSQ=1.0e-12) - parameter (QMIN=1.0e-10, QME5=1.0e-7, QME6=1.0e-7, EPSQ=1.0e-12) -! parameter (QMIN=1.0e-10, QME5=1.0e-20, QME6=1.0e-20, EPSQ=1.0e-12) - -!> lower limit of toa pressure value in mb - real, parameter :: prsmin = 1.0e-6 - -!> control flag for LW surface temperature at air/ground interface -!! (default=0, the value will be set in subroutine radinit) - !integer :: itsfc =0 - -!> new data input control variables (set/reset in subroutines -!radinit/radupdate): - integer :: month0=0, iyear0=0, monthd=0 - -!> control flag for the first time of reading climatological ozone data -!! (set/reset in subroutines radinit/radupdate, it is used only if the -!! control parameter ioznflg=0) - logical :: loz1st =.true. - -!> optional extra top layer on top of low ceiling models -!!\n LTP=0: no extra top layer - !integer, parameter :: LTP = 0 ! no extra top layer -! integer, parameter :: LTP = 1 ! add an extra top layer - -!> control flag for extra top layer - !logical, parameter :: lextop = (LTP > 0) - -! -! --- local variables: (horizontal dimensioned by IM) - !--- INTEGER VARIABLES - logical :: lextop - integer :: me, im, lm, nfxr, ntrac,ltp, itsfc + integer :: me, im, lm, nfxr, ntrac integer :: i, j, k, k1, lv, itop, ibtc, nday, LP1, LMK, LMP, kd, & lla, llb, lya, lyb, kt, kb integer, dimension(size(Grid%xlon,1)) :: idxday diff --git a/physics/GFS_radsw_pre.f90 b/physics/GFS_radsw_pre.f90 new file mode 100644 index 000000000..83f0c27c1 --- /dev/null +++ b/physics/GFS_radsw_pre.f90 @@ -0,0 +1,90 @@ +!>\file GFS_radsw_pre.f90 +!! This file contains a subroutine to module_radiation_surface::setalb() to +!! setup surface albedo for SW radiation. + module GFS_radsw_pre + contains + +!>\defgroup GFS_radsw_pre GFS RADSW Scheme Pre +!! @{ +!>\section arg_table_GFS_radsw_pre_init Argument Table +!! + subroutine GFS_radsw_pre_init () + end subroutine GFS_radsw_pre_init + +!>\section arg_table_GFS_radsw_pre_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|----------------|------------------------------------------|----------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 0 | GFS_typedefs%GFS_grid_type | | in | F | +!!| Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_typedefs%GFS_sfcprop_type | | in | F | +!!| Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_typedefs%GFS_radtend_type | | inout | F | +!!| im | horizontal_loop_extent | horizontal loop extent, start at 1 | index | 0 | integer | | in | F | +!!| tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!!| tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | +!!| sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb3 | surface_albedo_due_to_uv+vis_direct | surface albedo due to UV+VIS direct beam | none | 1 | real | kind_phys | out | F | +!!| sfcalb4 | surface_albedo_due_to_uv+vis_diffused | surface albedo due to UV+VIS diffused beam | none | 1 | real | kind_phys | out | F | +!! + subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & + tsfg, tsfa, sfcalb1,sfcalb2, sfcalb3, sfcalb4 ) + + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_sfcprop_type + use module_radiation_surface, only: NF_ALBD, setalb + + implicit none + type(GFS_control_type), intent(in) :: Model + type(GFS_radtend_type), intent(inout) :: Radtend + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_grid_type), intent(in) :: Grid + + integer :: i, im + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: tsfa, tsfg + real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb +! CCPP-compliant + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: & + sfcalb1, sfcalb2, sfcalb3, sfcalb4 + +! --- ... start radiation calculations +! remember to set heating rate unit to k/sec! +!> -# Start SW radiation calculations + if (Model%lsswr) then + +!> - Call module_radiation_surface::setalb() to setup surface albedo. +!! for SW radiation. + + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr,& ! --- inputs: + Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen,& + tsfg, tsfa, Sfcprop%hprim, Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & + Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & + Sfcprop%tisfc, IM, & + sfcalb) ! --- outputs + +!> -# Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + + endif + + do i = 1, im + sfcalb1(i) = sfcalb(i,1) + sfcalb2(i) = sfcalb(i,2) + sfcalb3(i) = sfcalb(i,3) + sfcalb4(i) = sfcalb(i,4) + enddo + + + end subroutine GFS_radsw_pre_run + +!>\section arg_table_GFS_radsw_pre_finalize Argument Table +!! + subroutine GFS_radsw_pre_finalize () + end subroutine GFS_radsw_pre_finalize + +!! @} + end module GFS_radsw_pre diff --git a/physics/radcons.f90 b/physics/radcons.f90 new file mode 100644 index 000000000..4c3711e63 --- /dev/null +++ b/physics/radcons.f90 @@ -0,0 +1,68 @@ +!> \file radcons.f90 +!! This file contains module radcons + + +!> \ingroup rad +!! \defgroup radcons radcons +!! This module contains some of the most frequently used math and physics +!! constants for GCM models. +!! @{ +!========================================! + module radcons ! +!........................................! +! + use machine, only : kind_phys +! + implicit none +! + public + +! --- version tag and last revision date + character(40), parameter :: & + & VTAGRAD='NCEP-Radiation_driver v5.2 Jan 2013 ' +! & VTAGRAD='NCEP-Radiation_driver v5.1 Nov 2012 ' +! & VTAGRAD='NCEP-Radiation_driver v5.0 Aug 2012 ' + +!>\name Constant values + +!> lower limit of saturation vapor pressure (=1.0e-10) + real (kind=kind_phys) :: QMIN +!> lower limit of specific humidity (=1.0e-7) + real (kind=kind_phys) :: QME5 +!> lower limit of specific humidity (=1.0e-7) + real (kind=kind_phys) :: QME6 +!> EPSQ=1.0e-12 + real (kind=kind_phys) :: EPSQ +! parameter (QMIN=1.0e-10, QME5=1.0e-5, QME6=1.0e-6, EPSQ=1.0e-12) + parameter (QMIN=1.0e-10, QME5=1.0e-7, QME6=1.0e-7, EPSQ=1.0e-12) +! parameter (QMIN=1.0e-10, QME5=1.0e-20, QME6=1.0e-20, EPSQ=1.0e-12) + +!> lower limit of toa pressure value in mb + real, parameter :: prsmin = 1.0e-6 + +!> control flag for LW surface temperature at air/ground interface +!! (default=0, the value will be set in subroutine radinit) + integer :: itsfc =0 + +!> new data input control variables (set/reset in subroutines radinit/radupdate): + integer :: month0=0, iyear0=0, monthd=0 + +!> control flag for the first time of reading climatological ozone data +!! (set/reset in subroutines radinit/radupdate, it is used only if the +!! control parameter ioznflg=0) + logical :: loz1st =.true. + +!> optional extra top layer on top of low ceiling models +!!\n LTP=0: no extra top layer + integer, parameter :: LTP = 0 ! no extra top layer +! integer, parameter :: LTP = 1 ! add an extra top layer + +!> control flag for extra top layer + logical, parameter :: lextop = (LTP > 0) + + + +!........................................! + end module radcons ! +!========================================! +!! @} From 0134bdb4153a8399c6f1d9685f4195af3253bd58 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 14 Dec 2017 16:45:02 -0700 Subject: [PATCH 096/114] GFS_rad_time_vary and GFS_radupdate is done. --- GFS_layer/GFS_driver.F90 | 123 ++++++++++---------- GFS_layer/GFS_radiation_driver.F90 | 154 ++++++++++++------------- makefile | 2 + physics/GFS_rad_time_vary.f90 | 107 ++++++++++++++++++ physics/GFS_radsw_pre.f90 | 1 - physics/GFS_radupdate.f90 | 174 +++++++++++++++++++++++++++++ physics/radcons.f90 | 11 ++ 7 files changed, 435 insertions(+), 137 deletions(-) create mode 100644 physics/GFS_rad_time_vary.f90 create mode 100644 physics/GFS_radupdate.f90 diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 9458a1b7d..cee92fa55 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -236,6 +236,7 @@ end subroutine GFS_initialize subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag) + use GFS_rad_time_vary, only: GFS_rad_time_vary_run implicit none !--- interface variables @@ -250,7 +251,7 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) !--- local variables - integer :: nblks + integer :: nblks, ictmflg, isolar real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec @@ -275,7 +276,9 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & call Print_debug_info (Model, sec) !--- radiation time varying routine - call Gfs_rad_time_vary_driver (Model, Statein, Tbd, sec) +! CCPP + call GFS_rad_time_vary_run(Model,Statein, Tbd, blksz, sec, & + ictmflg, isolar) !--- physics time varying routine call GFS_phys_time_vary (Model, Grid, Tbd) @@ -367,64 +370,64 @@ end subroutine GFS_stochastic_driver ! Routine containing all of the setup logic originally in phys/gloopr.f ! !----------------------------------------------------------------------- - subroutine GFS_rad_time_vary (Model, Statein, Tbd, sec) +! subroutine GFS_rad_time_vary (Model, Statein, Tbd, sec) - use physparam, only: ipsd0, ipsdlim, iaerflg - use mersenne_twister, only: random_setseed, random_index, random_stat +! use physparam, only: ipsd0, ipsdlim, iaerflg +! use mersenne_twister, only: random_setseed, random_index, random_stat - implicit none +! implicit none - type(GFS_control_type), intent(inout) :: Model - type(GFS_statein_type), intent(in) :: Statein(:) - type(GFS_tbd_type), intent(inout) :: Tbd(:) - real(kind=kind_phys), intent(in) :: sec +! type(GFS_control_type), intent(inout) :: Model +! type(GFS_statein_type), intent(in) :: Statein(:) +! type(GFS_tbd_type), intent(inout) :: Tbd(:) +! real(kind=kind_phys), intent(in) :: sec !--- local variables - type (random_stat) :: stat - integer :: ix, nb, j, i, nblks, ipseed - integer :: numrdm(Model%cnx*Model%cny*2) +! type (random_stat) :: stat +! integer :: ix, nb, j, i, nblks, ipseed +! integer :: numrdm(Model%cnx*Model%cny*2) - nblks = size(blksz,1) +! nblks = size(blksz,1) - call radupdate (Model%idat, Model%jdat, Model%fhswr, Model%dtf, Model%lsswr, & - Model%me, Model%slag, Model%sdec, Model%cdec, Model%solcon ) +! call radupdate (Model%idat, Model%jdat, Model%fhswr, Model%dtf, Model%lsswr, & +! Model%me, Model%slag, Model%sdec, Model%cdec, Model%solcon ) !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) - if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 - call random_setseed (ipseed, stat) - call random_index (ipsdlim, numrdm, stat) +! if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then +! ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 +! call random_setseed (ipseed, stat) +! call random_index (ipsdlim, numrdm, stat) !--- set the random seeds for each column in a reproducible way - ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx - ix = ix + 1 - if (ix .gt. blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - !--- for testing purposes, replace numrdm with '100' - Tbd(nb)%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) - Tbd(nb)%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) - enddo - enddo - endif ! isubc_lw and isubc_sw - - if (Model%num_p3d == 4) then - if (Model%kdt == 1) then - do nb = 1,nblks - Tbd(nb)%phy_f3d(:,:,1) = Statein(nb)%tgrs - Tbd(nb)%phy_f3d(:,:,2) = max(qmin,Statein(nb)%qgrs(:,:,1)) - Tbd(nb)%phy_f3d(:,:,3) = Statein(nb)%tgrs - Tbd(nb)%phy_f3d(:,:,4) = max(qmin,Statein(nb)%qgrs(:,:,1)) - Tbd(nb)%phy_f2d(:,1) = Statein(nb)%prsi(:,1) - Tbd(nb)%phy_f2d(:,2) = Statein(nb)%prsi(:,1) - enddo - endif - endif - - end subroutine GFS_rad_time_vary +! ix = 0 +! nb = 1 +! do j = 1,Model%ny +! do i = 1,Model%nx +! ix = ix + 1 +! if (ix .gt. blksz(nb)) then +! ix = 1 +! nb = nb + 1 +! endif +! !--- for testing purposes, replace numrdm with '100' +! Tbd(nb)%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) +! Tbd(nb)%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) +! enddo +! enddo +! endif ! isubc_lw and isubc_sw + +! if (Model%num_p3d == 4) then +! if (Model%kdt == 1) then +! do nb = 1,nblks +! Tbd(nb)%phy_f3d(:,:,1) = Statein(nb)%tgrs +! Tbd(nb)%phy_f3d(:,:,2) = max(qmin,Statein(nb)%qgrs(:,:,1)) +! Tbd(nb)%phy_f3d(:,:,3) = Statein(nb)%tgrs +! Tbd(nb)%phy_f3d(:,:,4) = max(qmin,Statein(nb)%qgrs(:,:,1)) +! Tbd(nb)%phy_f2d(:,1) = Statein(nb)%prsi(:,1) +! Tbd(nb)%phy_f2d(:,2) = Statein(nb)%prsi(:,1) +! enddo +! endif +! endif + +! end subroutine GFS_rad_time_vary !----------------------------------------------------------------------- @@ -652,20 +655,20 @@ subroutine Print_debug_info (Model, sec) end subroutine Print_debug_info - subroutine Gfs_rad_time_vary_driver (Model, Statein, Tbd, sec) +! subroutine Gfs_rad_time_vary_driver (Model, Statein, Tbd, sec) - implicit none +! implicit none - type(GFS_control_type), intent(inout) :: Model - type(GFS_statein_type), intent(in) :: Statein(:) - type(GFS_tbd_type), intent(inout) :: Tbd(:) - real(kind=kind_phys), intent(in) :: sec +! type(GFS_control_type), intent(inout) :: Model +! type(GFS_statein_type), intent(in) :: Statein(:) +! type(GFS_tbd_type), intent(inout) :: Tbd(:) +! real(kind=kind_phys), intent(in) :: sec - if (Model%lsswr .or. Model%lslwr) then - call GFS_rad_time_vary (Model, Statein, Tbd, sec) - endif +! if (Model%lsswr .or. Model%lslwr) then +! call GFS_rad_time_vary (Model, Statein, Tbd, sec) +! endif - end subroutine Gfs_rad_time_vary_driver +! end subroutine Gfs_rad_time_vary_driver subroutine Gcycle_driver (nblks, Model, Grid, Sfcprop, Cldprop) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index 02d57d92c..d48587076 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -354,47 +354,47 @@ module module_radiation_driver ! private ! --- version tag and last revision date - character(40), parameter :: & - & VTAGRAD='NCEP-Radiation_driver v5.2 Jan 2013 ' +! character(40), parameter :: & +! & VTAGRAD='NCEP-Radiation_driver v5.2 Jan 2013 ' ! & VTAGRAD='NCEP-Radiation_driver v5.1 Nov 2012 ' ! & VTAGRAD='NCEP-Radiation_driver v5.0 Aug 2012 ' !>\name Constant values !> lower limit of saturation vapor pressure (=1.0e-10) - real (kind=kind_phys) :: QMIN +! real (kind=kind_phys) :: QMIN !> lower limit of specific humidity (=1.0e-7) - real (kind=kind_phys) :: QME5 +! real (kind=kind_phys) :: QME5 !> lower limit of specific humidity (=1.0e-7) - real (kind=kind_phys) :: QME6 +! real (kind=kind_phys) :: QME6 !> EPSQ=1.0e-12 - real (kind=kind_phys) :: EPSQ +! real (kind=kind_phys) :: EPSQ ! parameter (QMIN=1.0e-10, QME5=1.0e-5, QME6=1.0e-6, EPSQ=1.0e-12) - parameter (QMIN=1.0e-10, QME5=1.0e-7, QME6=1.0e-7, EPSQ=1.0e-12) +! parameter (QMIN=1.0e-10, QME5=1.0e-7, QME6=1.0e-7, EPSQ=1.0e-12) ! parameter (QMIN=1.0e-10, QME5=1.0e-20, QME6=1.0e-20, EPSQ=1.0e-12) !> lower limit of toa pressure value in mb - real, parameter :: prsmin = 1.0e-6 +! real, parameter :: prsmin = 1.0e-6 !> control flag for LW surface temperature at air/ground interface !! (default=0, the value will be set in subroutine radinit) - integer :: itsfc =0 +! integer :: itsfc =0 !> new data input control variables (set/reset in subroutines radinit/radupdate): - integer :: month0=0, iyear0=0, monthd=0 +! integer :: month0=0, iyear0=0, monthd=0 !> control flag for the first time of reading climatological ozone data !! (set/reset in subroutines radinit/radupdate, it is used only if the !! control parameter ioznflg=0) - logical :: loz1st =.true. +! logical :: loz1st =.true. !> optional extra top layer on top of low ceiling models !!\n LTP=0: no extra top layer - integer, parameter :: LTP = 0 ! no extra top layer +! integer, parameter :: LTP = 0 ! no extra top layer ! integer, parameter :: LTP = 1 ! add an extra top layer !> control flag for extra top layer - logical, parameter :: lextop = (LTP > 0) +! logical, parameter :: lextop = (LTP > 0) ! --- publicly accessible module programs: @@ -525,6 +525,7 @@ subroutine radinit( si, NLAY, me ) ! ! ! =================================================================== ! ! + use radcons implicit none ! --- inputs: @@ -662,8 +663,8 @@ end subroutine radinit !> \section gen_radupdate General Algorithm !> @{ !----------------------------------- - subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & - & slag,sdec,cdec,solcon) +! subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & +! & slag,sdec,cdec,solcon) !................................... ! ================= subprogram documentation block ================ ! @@ -724,24 +725,25 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & ! ! ! =================================================================== ! ! - implicit none +! use radcons +! implicit none ! --- inputs: - integer, intent(in) :: idate(:), jdate(:), me - logical, intent(in) :: lsswr +! integer, intent(in) :: idate(:), jdate(:), me +! logical, intent(in) :: lsswr - real (kind=kind_phys), intent(in) :: deltsw, deltim +! real (kind=kind_phys), intent(in) :: deltsw, deltim ! --- outputs: - real (kind=kind_phys), intent(out) :: slag, sdec, cdec, solcon +! real (kind=kind_phys), intent(out) :: slag, sdec, cdec, solcon ! --- locals: - integer :: iyear, imon, iday, ihour - integer :: kyear, kmon, kday, khour +! integer :: iyear, imon, iday, ihour +! integer :: kyear, kmon, kday, khour - logical :: lmon_chg ! month change flag - logical :: lco2_chg ! cntrl flag for updating co2 data - logical :: lsol_chg ! cntrl flag for updating solar constant +! logical :: lmon_chg ! month change flag +! logical :: lco2_chg ! cntrl flag for updating co2 data +! logical :: lsol_chg ! cntrl flag for updating solar constant ! !===> ... begin here ! @@ -749,72 +751,72 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & !! (currently co2 only) ! --- ... time stamp at fcst time - iyear = jdate(1) - imon = jdate(2) - iday = jdate(3) - ihour = jdate(5) +! iyear = jdate(1) +! imon = jdate(2) +! iday = jdate(3) +! ihour = jdate(5) ! --- ... set up time stamp used for green house gases (** currently co2 only) - if ( ictmflg==0 .or. ictmflg==-2 ) then ! get external data at initial condition time - kyear = idate(1) - kmon = idate(2) - kday = idate(3) - khour = idate(5) - else ! get external data at fcst or specified time - kyear = iyear - kmon = imon - kday = iday - khour = ihour - endif ! end if_ictmflg_block - - if ( month0 /= imon ) then - lmon_chg = .true. - month0 = imon - else - lmon_chg = .false. - endif +! if ( ictmflg==0 .or. ictmflg==-2 ) then ! get external data at initial condition time +! kyear = idate(1) +! kmon = idate(2) +! kday = idate(3) +! khour = idate(5) +! else ! get external data at fcst or specified time +! kyear = iyear +! kmon = imon +! kday = iday +! khour = ihour +! endif ! end if_ictmflg_block + +! if ( month0 /= imon ) then +! lmon_chg = .true. +! month0 = imon +! else +! lmon_chg = .false. +! endif !> -# Call module_radiation_astronomy::sol_update(), yearly update, no !! time interpolation. - if (lsswr) then - - if ( isolar == 0 .or. isolar == 10 ) then - lsol_chg = .false. - elseif ( iyear0 /= iyear ) then - lsol_chg = .true. - else - lsol_chg = ( isolar==4 .and. lmon_chg ) - endif - iyear0 = iyear - - call sol_update & +! if (lsswr) then + +! if ( isolar == 0 .or. isolar == 10 ) then +! lsol_chg = .false. +! elseif ( iyear0 /= iyear ) then +! lsol_chg = .true. +! else +! lsol_chg = ( isolar==4 .and. lmon_chg ) +! endif +! iyear0 = iyear + +! call sol_update & ! --- inputs: - & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & +! & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & ! --- outputs: - & slag,sdec,cdec,solcon & - & ) +! & slag,sdec,cdec,solcon & +! & ) - endif ! end_if_lsswr_block +! endif ! end_if_lsswr_block !> -# Call module_radiation_aerosols::aer_update(), monthly update, no !! time interpolation - if ( lmon_chg ) then - call aer_update ( iyear, imon, me ) - endif +! if ( lmon_chg ) then +! call aer_update ( iyear, imon, me ) +! endif !> -# Call co2 and other gases update routine: !! module_radiation_gases::gas_update() - if ( monthd /= kmon ) then - monthd = kmon - lco2_chg = .true. - else - lco2_chg = .false. - endif +! if ( monthd /= kmon ) then +! monthd = kmon +! lco2_chg = .true. +! else +! lco2_chg = .false. +! endif - call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me ) +! call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me ) - if ( loz1st ) loz1st = .false. +! if ( loz1st ) loz1st = .false. !> -# Call surface update routine (currently not needed) ! call sfc_update ( iyear, imon, me ) @@ -822,9 +824,9 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & !> -# Call clouds update routine (currently not needed) ! call cld_update ( iyear, imon, me ) ! - return +! return !................................... - end subroutine radupdate +! end subroutine radupdate !----------------------------------- !> @} diff --git a/makefile b/makefile index bef39a158..ac20aa908 100644 --- a/makefile +++ b/makefile @@ -121,6 +121,8 @@ SRCS_f90 = \ ./physics/GFS_radsw_post.f90 \ ./physics/GFS_radlw_pre.f90 \ ./physics/GFS_radlw_post.f90 \ + ./physics/GFS_rad_time_vary.f90 \ + ./physics/GFS_radupdate.f90 \ ./physics/cs_conv.f90 \ ./physics/funcphys.f90 \ ./physics/gcm_shoc.f90 \ diff --git a/physics/GFS_rad_time_vary.f90 b/physics/GFS_rad_time_vary.f90 new file mode 100644 index 000000000..102167c76 --- /dev/null +++ b/physics/GFS_rad_time_vary.f90 @@ -0,0 +1,107 @@ +!>\file GFS_rad_time_vary.f90 +!! This file contains + module GFS_rad_time_vary + contains + +!>\defgroup GFS_rad_time_vary GFS RRTMG Update +!! @{ +!!\section arg_table_GFS_rad_time_vary_init Argument Table +!! + subroutine GFS_rad_time_vary_init + end subroutine GFS_rad_time_vary_init + +!!\section arg_table_GFS_rad_time_vary_run Argument Table +!!| local var name | longname | description | units | rank | type | kind | intent | optional | +!!|-------------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| +!!| Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | in | F | +!!| Statein | FV3-GFS_Stateout_type | Fortran DDT containing FV3-GFS prognostic state data in from dycore | DDT | 0 | GFS_typedefs%GFS_stateout_type| | in | F | +!!| Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS data not yet assigned to a defined container | DDT | 0 | GFS_typedefs%GFS_tbd_type | | in | F | +!!| blksz | horizontal_block_grid_number | horizontal grid number for explicit data blocking | none | 1 | integer | | in | F | +!!| sec | forecast_time_at_previous_step | forecast time in second at previous_step | s | 0 | real | kind_phys | in | F | +!!| ictmflg | flag_for_initial_time-date_control | flag for initial time/date control | none | 0 | integer | | in | F | +!!| isolar | flag_for_solar_constant | solar constant control flag | none | 0 | integer | | in | F | +!! + subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, blksz, sec, ictmflg, isolar) + + use physparam, only: ipsd0, ipsdlim, iaerflg + use mersenne_twister, only: random_setseed, random_index, random_stat + use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_tbd_type + !use module_radiation_driver, only: radupdate + use GFS_radupdate, only: GFS_radupdate_run + use radcons, only: qmin, con_100 + + + + implicit none + + type(GFS_control_type), intent(inout) :: Model + type(GFS_statein_type), intent(in) :: Statein(:) + type(GFS_tbd_type), intent(inout) :: Tbd(:) + real(kind=kind_phys), intent(in) :: sec + integer, intent(in) :: ictmflg, isolar + integer, allocatable :: blksz(:) + + !--- local variables + type (random_stat) :: stat + integer :: ix, nb, j, i, nblks, ipseed + integer :: numrdm(Model%cnx*Model%cny*2) + + + if (Model%lsswr .or. Model%lslwr) then + + nblks = size(blksz,1) +! + call GFS_radupdate_run (Model%idat, Model%jdat, Model%fhswr, Model%dtf, Model%lsswr, & + Model%me, Model%slag, Model%sdec, Model%cdec, Model%solcon, & + ictmflg, isolar ) + + !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) + if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + !--- set the random seeds for each column in a reproducible way + ix = 0 + nb = 1 + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + !--- for testing purposes, replace numrdm with '100' + Tbd(nb)%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) + Tbd(nb)%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) + enddo + enddo + endif ! isubc_lw and isubc_sw + + if (Model%num_p3d == 4) then + if (Model%kdt == 1) then + do nb = 1,nblks + Tbd(nb)%phy_f3d(:,:,1) = Statein(nb)%tgrs + Tbd(nb)%phy_f3d(:,:,2) = max(qmin,Statein(nb)%qgrs(:,:,1)) + Tbd(nb)%phy_f3d(:,:,3) = Statein(nb)%tgrs + Tbd(nb)%phy_f3d(:,:,4) = max(qmin,Statein(nb)%qgrs(:,:,1)) + Tbd(nb)%phy_f2d(:,1) = Statein(nb)%prsi(:,1) + Tbd(nb)%phy_f2d(:,2) = Statein(nb)%prsi(:,1) + enddo + endif + endif + + endif + + end subroutine GFS_rad_time_vary_run + +!!\section arg_table_GFS_rad_time_vary_finalize Argument Table +!! + subroutine GFS_rad_time_vary_finalize() + end subroutine GFS_rad_time_vary_finalize +!! @} + end module GFS_rad_time_vary diff --git a/physics/GFS_radsw_pre.f90 b/physics/GFS_radsw_pre.f90 index 83f0c27c1..107850f54 100644 --- a/physics/GFS_radsw_pre.f90 +++ b/physics/GFS_radsw_pre.f90 @@ -78,7 +78,6 @@ subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & sfcalb4(i) = sfcalb(i,4) enddo - end subroutine GFS_radsw_pre_run !>\section arg_table_GFS_radsw_pre_finalize Argument Table diff --git a/physics/GFS_radupdate.f90 b/physics/GFS_radupdate.f90 new file mode 100644 index 000000000..b695b618e --- /dev/null +++ b/physics/GFS_radupdate.f90 @@ -0,0 +1,174 @@ + module GFS_radupdate + contains + + subroutine GFS_radupdate_run ( idate,jdate,deltsw,deltim,lsswr, me, & + & slag,sdec,cdec,solcon, ictmflg, isolar) + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: radupdate calls many update subroutines to check and ! +! update radiation required but time varying data sets and module ! +! variables. ! +! ! +! usage: call radupdate ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm sp ! +! ! +! ==================== definition of variables ==================== ! +! ! +! input parameters: ! +! idate(8) : ncep absolute date and time of initial condition ! +! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! +! jdate(8) : ncep absolute date and time at fcst time ! +! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! +! deltsw : sw radiation calling frequency in seconds ! +! deltim : model timestep in seconds ! +! lsswr : logical flags for sw radiation calculations ! +! me : print control flag ! +! ! +! outputs: ! +! slag : equation of time in radians ! +! sdec, cdec : sin and cos of the solar declination angle ! +! solcon : sun-earth distance adjusted solar constant(w/m2) ! +! ! +! external module variables: ! +! isolar : solar constant cntrl (in module physparam) ! +! = 0: use the old fixed solar constant in "physcon" ! +! =10: use the new fixed solar constant in "physcon" ! +! = 1: use noaa ann-mean tsi tbl abs-scale with cycleapprx! +! = 2: use noaa ann-mean tsi tbl tim-scale with cycleapprx! +! = 3: use cmip5 ann-mean tsi tbl tim-scale with cyclapprx! +! = 4: use cmip5 mon-mean tsi tbl tim-scale with cyclapprx! +! ictmflg : =yyyy#, external data ic time/date control flag ! +! = -2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! = -1: use user provided external data for the ! +! forecast time, no extrapolation. ! +! = 0: use data at initial cond time, if not ! +! available, use latest, no extrapolation. ! +! = 1: use data at the forecast time, if not ! +! available, use latest and extrapolation. ! +! =yyyy0: use yyyy data for the forecast time, ! +! no further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! ! +! module variables: ! +! loz1st : first-time clim ozone data read flag ! +! ! +! subroutines called: sol_update, aer_update, gas_update ! +! ! +! =================================================================== ! +! + use radcons + use module_radiation_astronomy, only: sol_update + use module_radiation_gases, only: gas_update + use module_radiation_aerosols, only: aer_update + + implicit none + +! --- inputs: + integer, intent(in) :: idate(:), jdate(:), me + logical, intent(in) :: lsswr + + real (kind=kind_phys), intent(in) :: deltsw, deltim + +! --- outputs: + real (kind=kind_phys), intent(out) :: slag, sdec, cdec, solcon + +! --- locals: + integer :: iyear, imon, iday, ihour + integer :: kyear, kmon, kday, khour + + logical :: lmon_chg ! month change flag + logical :: lco2_chg ! cntrl flag for updating co2 data + logical :: lsol_chg ! cntrl flag for updating solar constant + integer :: ictmflg, isolar +! +!===> ... begin here +! +!> -# Set up time stamp at fcst time and that for green house gases +!! (currently co2 only) +! --- ... time stamp at fcst time + + iyear = jdate(1) + imon = jdate(2) + iday = jdate(3) + ihour = jdate(5) + +! --- ... set up time stamp used for green house gases (** currently co2 only) + + if ( ictmflg==0 .or. ictmflg==-2 ) then ! get external data at initial condition time + kyear = idate(1) + kmon = idate(2) + kday = idate(3) + khour = idate(5) + else ! get external data at fcst or specified time + kyear = iyear + kmon = imon + kday = iday + khour = ihour + endif ! end if_ictmflg_block + + if ( month0 /= imon ) then + lmon_chg = .true. + month0 = imon + else + lmon_chg = .false. + endif + +!> -# Call module_radiation_astronomy::sol_update(), yearly update, no +!! time interpolation. + if (lsswr) then + + if ( isolar == 0 .or. isolar == 10 ) then + lsol_chg = .false. + elseif ( iyear0 /= iyear ) then + lsol_chg = .true. + else + lsol_chg = ( isolar==4 .and. lmon_chg ) + endif + iyear0 = iyear + + call sol_update & +! --- inputs: + & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & +! --- outputs: + & slag,sdec,cdec,solcon & + & ) + + endif ! end_if_lsswr_block + +!> -# Call module_radiation_aerosols::aer_update(), monthly update, no +!! time interpolation + if ( lmon_chg ) then + call aer_update ( iyear, imon, me ) + endif + +!> -# Call co2 and other gases update routine: +!! module_radiation_gases::gas_update() + if ( monthd /= kmon ) then + monthd = kmon + lco2_chg = .true. + else + lco2_chg = .false. + endif + + call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me ) + + if ( loz1st ) loz1st = .false. + +!> -# Call surface update routine (currently not needed) +! call sfc_update ( iyear, imon, me ) + +!> -# Call clouds update routine (currently not needed) +! call cld_update ( iyear, imon, me ) +! + return +!................................... + end subroutine GFS_radupdate_run +!----------------------------------- + + end module GFS_radupdate diff --git a/physics/radcons.f90 b/physics/radcons.f90 index 4c3711e63..1079b07d9 100644 --- a/physics/radcons.f90 +++ b/physics/radcons.f90 @@ -60,6 +60,17 @@ module radcons ! !> control flag for extra top layer logical, parameter :: lextop = (LTP > 0) +!---------------------------- +! Module variable definitions +!---------------------------- +!CCPP: copy from GFS_driver.F90 + real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + ! real(kind=kind_phys), parameter :: qmin = 1.0e-10 + + !........................................! From 3f7e1595ef36693b83b8c93ff51e730b4d0481d4 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 14 Dec 2017 20:26:49 -0700 Subject: [PATCH 097/114] fix bugs --- GFS_layer/GFS_driver.F90 | 2 +- GFS_layer/GFS_radiation_driver.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index cee92fa55..3e284bcda 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -7,7 +7,7 @@ module GFS_driver GFS_control_type, GFS_grid_type, & GFS_tbd_type, GFS_cldprop_type, & GFS_radtend_type, GFS_diag_type - use module_radiation_driver, only: GFS_radiation_driver, radupdate + use module_radiation_driver, only: GFS_radiation_driver !, radupdate use module_physics_driver, only: GFS_physics_driver use module_radsw_parameters, only: topfsw_type, sfcfsw_type use module_radlw_parameters, only: topflw_type, sfcflw_type diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index d48587076..8f350f5de 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -398,7 +398,7 @@ module module_radiation_driver ! ! --- publicly accessible module programs: - public radinit, radupdate, GFS_radiation_driver + public radinit, GFS_radiation_driver ! ================= From 93535602000d740f65a0e7b1340391f4c90647b1 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Mon, 18 Dec 2017 16:45:27 -0700 Subject: [PATCH 098/114] added GFS_suite_setup.f90 for separating IPD_setup_step => GFS_time_vary_step --- makefile | 1 + physics/GFS_suite_setup.f90 | 199 ++++++++++++++++++++++++++++++++++++ 2 files changed, 200 insertions(+) create mode 100644 physics/GFS_suite_setup.f90 diff --git a/makefile b/makefile index afeaa4f7a..50eea730c 100644 --- a/makefile +++ b/makefile @@ -125,6 +125,7 @@ SRCS_f90 = \ ./physics/GFS_SCNV_generic.f90 \ ./physics/GFS_PBL_generic.f90 \ ./physics/GFS_suite_interstitial.f90 \ + ./physics/GFS_suite_setup.f90 \ ./physics/h2ointerp.f90 \ ./physics/m_micro_driver.f90 \ ./physics/module_nst_model.f90 \ diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 new file mode 100644 index 000000000..9c07eb9b0 --- /dev/null +++ b/physics/GFS_suite_setup.f90 @@ -0,0 +1,199 @@ +!> \file GFS_suite_setup.f90 +!! Contains code related to GFS physics suite setup. + + module GFS_suite_setup_1 + + contains + + subroutine GFS_suite_setup_1_init () + end subroutine GFS_suite_setup_1_init + + subroutine GFS_suite_setup_1_finalize() + end subroutine GFS_suite_setup_1_finalize + +!> \section arg_table_GFS_suite_interstitial_1_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | +!! + subroutine GFS_suite_setup_1_run (Model) + + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type + + type(GFS_control_type), intent(inout) :: Model + + real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys) :: rinc(5) + real(kind=kind_phys) :: sec + + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- update calendars and triggers + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + sec = rinc(4) + Model%phour = sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (sec + Model%dtp)/con_hr + Model%kdt = nint((sec + Model%dtp)/Model%dtp) + + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr + endif + + end subroutine GFS_suite_setup_1_run + + end module + + module GFS_suite_setup_2 + + contains + + subroutine GFS_suite_setup_2_init () + end subroutine GFS_suite_setup_2_init + + subroutine GFS_suite_setup_2_finalize() + end subroutine GFS_suite_setup_2_finalize + +!> \section arg_table_GFS_suite_interstitial_2_run Argument Table +!! | local var name | longname | description | units | rank | type | kind | intent | optional | +!! |----------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| +!! | blksz | horizontal_block_size | number of grid columns used for explicit data blocking for physics | count | 1 | integer | | in | F | +!! | Grid | FV3-GFS_Grid_type | Fortran DDT containing FV3-GFS grid and interpolation related data | DDT | 1 | GFS_typedefs%GFS_grid_type | | in | F | +!! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | +!! | Tbd | FV3-GFS_Tbd_type | Fortran DDT containing FV3-GFS miscellaneous data | DDT | 1 | GFS_typedefs%GFS_tbd_type | | inout | F | +!! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 1 | GFS_typedefs%GFS_sfcprop_type | | inout | F | +!! | Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields | DDT | 1 | GFS_typedefs%GFS_cldprop_type | | inout | F | +!! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 1 | GFS_typedefs%GFS_diag_type | | inout | F | +!! + subroutine GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) + + use machine, only: kind_phys + use physcons, only: dxmin, dxinv + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & + GFS_Tbd_type, GFS_sfcprop_type, GFS_cldprop_type, GFS_diag_type + + type(GFS_grid_type), intent(in) :: Grid(:) + type(GFS_control_type), intent(inout) :: Model + type(GFS_tbd_type), intent(inout) :: Tbd(:) + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + type(GFS_cldprop_type), intent(inout) :: Cldprop(:) + type(GFS_diag_type), intent(inout) :: Diag(:) + + integer, allocatable, intent(in) :: blksz(:) + + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + + integer :: i, j, k, iseed, iskip, ix, nb + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(Model%cny) + real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) + + nblks = size(blksz) + + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then + !--- initialize,accumulate,convert + Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (mod(Model%kdt,Model%nsswr) == 0) then + !--- accumulate,convert + Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (Model%lsswr) then + !--- initialize,accumulate + Model%clstp = 1100 + else + !--- accumulate + Model%clstp = 0100 + endif + + !--- random number needed for RAS and old SAS and when cal_pre=.true. + if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then + iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 + call random_setseed(iseed) + call random_number(wrk) + do i = 1,Model%cnx*Model%nrcm + iseed = iseed + nint(wrk(1)) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) + enddo + + do k = 1,Model%nrcm + iskip = (k-1)*Model%cnx*Model%cny + ix = 0 + nb = 1 + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + Tbd(nb)%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) + enddo + enddo + enddo + endif ! imfdeepcnv, cal_re, random_clds + + !--- o3 interpolation + if (Model%ntoz > 0) then + do nb = 1, nblks + call ozinterpol (Model%me, blksz(nb), Model%idate, Model%fhour, & + Grid(nb)%jindx1_o3, Grid(nb)%jindx2_o3, & + Tbd(nb)%ozpl, Grid(nb)%ddy_o3) + enddo + endif + + !--- h2o interpolation + if (Model%h2o_phys) then + do nb = 1, nblks + call h2ointerpol (Model%me, blksz(nb), Model%idate, Model%fhour, & + Grid(nb)%jindx1_h, Grid(nb)%jindx2_h, & + Tbd(nb)%h2opl, Grid(nb)%ddy_h) + enddo + endif + + !--- repopulate specific time-varying sfc properties for AMIP/forecast runs + if (Model%nscyc > 0) then + if (mod(Model%kdt,Model%nscyc) == 1) THEN + call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) + endif + endif + + !--- determine if diagnostics buckets need to be cleared + if (mod(Model%kdt,Model%nszero) == 1) then + do nb = 1,nblks + call Diag(nb)%rad_zero (Model) + call Diag(nb)%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + enddo + endif + + end subroutine GFS_suite_setup_2_run + + end module From f583edc62bd7e54b8a47743a6cb21b74a89123f0 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 10:54:32 -0700 Subject: [PATCH 099/114] added GFS_driver.F90 (left out in the previous commit by mistake) --- GFS_layer/GFS_driver.F90 | 216 ++++----------------------------------- 1 file changed, 19 insertions(+), 197 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 9458a1b7d..cf21142fa 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -12,6 +12,8 @@ module GFS_driver use module_radsw_parameters, only: topfsw_type, sfcfsw_type use module_radlw_parameters, only: topflw_type, sfcflw_type use funcphys, only: gfuncphys + use GFS_suite_setup_1, only: GFS_suite_setup_1_run + use GFS_suite_setup_2, only: GFS_suite_setup_2_run implicit none @@ -22,7 +24,7 @@ module GFS_driver !-------------------------------------------------------------------------------- ! This container is the minimum set of data required from the dycore/atmosphere ! component to allow proper initialization of the GFS physics -! +! ! Type is defined in GFS_typedefs.F90 !-------------------------------------------------------------------------------- ! type GFS_init_type @@ -62,7 +64,7 @@ module GFS_driver ! character(len=65) :: fn_nml !< namelist filename ! end type GFS_init_type !-------------------------------------------------------------------------------- - + !------------------ ! Module parameters !------------------ @@ -96,7 +98,7 @@ module GFS_driver ! GFS initialze !-------------- subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & - Coupling, Grid, Tbd, Cldprop, Radtend, & + Coupling, Grid, Tbd, Cldprop, Radtend, & Diag, Init_parm) use module_microphysics, only: gsmconst @@ -160,7 +162,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & !--- populate the grid components call GFS_grid_populate (Grid, Init_parm%xlon, Init_parm%xlat, Init_parm%area) - + !--- read in and initialize ozone and water if (Model%ntoz > 0) then do nb = 1, nblks @@ -181,7 +183,7 @@ subroutine GFS_initialize (Model, Statein, Stateout, Sfcprop, & call gsmconst (Model%dtp, Model%me, .TRUE.) - !--- define sigma level for radiation initialization + !--- define sigma level for radiation initialization !--- The formula converting hybrid sigma pressure coefficients to sigma coefficients follows Eckermann (2009, MWR) !--- ps is replaced with p0. The value of p0 uses that in http://www.emc.ncep.noaa.gov/officenotes/newernotes/on461.pdf !--- ak/bk have been flipped from their original FV3 orientation and are defined sfc -> toa @@ -233,7 +235,7 @@ end subroutine GFS_initialize ! 5) interpolates coefficients for prognostic ozone calculation ! 6) performs surface data cycling via the GFS gcycle routine !------------------------------------------------------------------------- - subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & + subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag) implicit none @@ -250,41 +252,18 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) !--- local variables - integer :: nblks + integer :: nb, nblks real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec - - ! Set the value of nblks - call Set_nblks (nblks) - - !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 - !--- update calendars and triggers - call Update_cal_and_triggers (Model, rinc, sec) - - !--- set current bucket hour - call Set_bucket_hour (Model, sec) - - !--- radiation triggers - call Set_radiation_triggers (Model) - - !--- set the solar hour based on a combination of phour and time initial hour - call Set_solar_h (Model) - - ! Print debug info - call Print_debug_info (Model, sec) + call GFS_suite_setup_1_run (Model) !--- radiation time varying routine - call Gfs_rad_time_vary_driver (Model, Statein, Tbd, sec) - - !--- physics time varying routine - call GFS_phys_time_vary (Model, Grid, Tbd) - - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - call Gcycle_driver (nblks, Model, Grid, Sfcprop, Cldprop) + if (Model%lsswr .or. Model%lslwr) then + call GFS_rad_time_vary (Model, Statein, Tbd, sec) + endif - !--- determine if diagnostics buckets need to be cleared - call Clear_buckets (Model, Diag, nblks) + call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) end subroutine GFS_time_vary_step @@ -322,15 +301,15 @@ subroutine GFS_stochastic_driver (Model, Statein, Stateout, Sfcprop, Coupling, & if (Model%do_sppt) then do k = 1,size(Statein%tgrs,2) do i = 1,size(Statein%tgrs,1) - + upert = (Stateout%gu0(i,k) - Statein%ugrs(i,k)) * Coupling%sppt_wts(i,k) vpert = (Stateout%gv0(i,k) - Statein%vgrs(i,k)) * Coupling%sppt_wts(i,k) tpert = (Stateout%gt0(i,k) - Statein%tgrs(i,k)) * Coupling%sppt_wts(i,k) - Tbd%dtdtr(i,k) qpert = (Stateout%gq0(i,k,1) - Statein%qgrs(i,k,1)) * Coupling%sppt_wts(i,k) - + Stateout%gu0(i,k) = Statein%ugrs(i,k)+upert Stateout%gv0(i,k) = Statein%vgrs(i,k)+vpert - + !negative humidity check qnew = Statein%qgrs(i,k,1)+qpert if (qnew .GE. 1.0e-10) then @@ -339,7 +318,7 @@ subroutine GFS_stochastic_driver (Model, Statein, Stateout, Sfcprop, Coupling, & endif enddo enddo - + Diag%totprcp(:) = Diag%totprcp(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%dtotprcp(:) Diag%cnvprcp(:) = Diag%cnvprcp(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%dcnvprcp(:) Coupling%rain_cpl(:) = Coupling%rain_cpl(:) + (Coupling%sppt_wts(:,15) - 1.0)*Tbd%drain_cpl(:) @@ -449,7 +428,7 @@ subroutine GFS_phys_time_vary (Model, Grid, Tbd) nblks = size(blksz,1) - !--- switch for saving convective clouds - cnvc90.f + !--- switch for saving convective clouds - cnvc90.f !--- aka Ken Campana/Yu-Tai Hou legacy if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then !--- initialize,accumulate,convert @@ -554,161 +533,4 @@ subroutine GFS_grid_populate (Grid, xlon, xlat, area) end subroutine GFS_grid_populate - - ! Subroutines added by PAJ - - subroutine Set_nblks (nblks) - - implicit none - - integer, intent(out) :: nblks - - ! blksz is a global var - nblks = size(blksz) - - end subroutine Set_nblks - - - subroutine Update_cal_and_triggers (Model, rinc, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - real(kind=kind_phys), intent(inout) :: rinc(:) - real(kind=kind_phys), intent(inout) :: sec - - - rinc(1:5) = 0 - call W3difdat (Model%jdat, Model%idat, 4, rinc) - sec = rinc(4) - Model%phour = sec/con_hr - - end subroutine Update_cal_and_triggers - - - subroutine Set_bucket_hour (Model, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - real(kind=kind_phys), intent(in) :: sec - - Model%zhour = Model%phour - ! con_hr is a global var - Model%fhour = (sec + Model%dtp)/con_hr - Model%kdt = nint((sec + Model%dtp)/Model%dtp) - - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. - - end subroutine Set_bucket_hour - - - subroutine Set_radiation_triggers (Model) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - - Model%lsswr = (mod (Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod (Model%kdt, Model%nslwr) == 1) - - end subroutine Set_radiation_triggers - - - subroutine Set_solar_h (Model) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - - ! con_24 is a global variable - Model%solhr = mod (Model%phour + Model%idate(1), con_24) - - end subroutine Set_solar_h - - - subroutine Print_debug_info (Model, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - real(kind=kind_phys), intent(in) :: sec - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr - endif - - end subroutine Print_debug_info - - - subroutine Gfs_rad_time_vary_driver (Model, Statein, Tbd, sec) - - implicit none - - type(GFS_control_type), intent(inout) :: Model - type(GFS_statein_type), intent(in) :: Statein(:) - type(GFS_tbd_type), intent(inout) :: Tbd(:) - real(kind=kind_phys), intent(in) :: sec - - if (Model%lsswr .or. Model%lslwr) then - call GFS_rad_time_vary (Model, Statein, Tbd, sec) - endif - - end subroutine Gfs_rad_time_vary_driver - - - subroutine Gcycle_driver (nblks, Model, Grid, Sfcprop, Cldprop) - - implicit none - - integer, intent(in) :: nblks - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid(nblks) - type(GFS_sfcprop_type), intent(inout) :: Sfcprop(nblks) - type(GFS_cldprop_type), intent(inout) :: Cldprop(nblks) - - - if (Model%nscyc > 0) then - if (mod (Model%kdt, Model%nscyc) == 1) then - call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - end if - end if - - end subroutine Gcycle_driver - - - subroutine Clear_buckets (Model, Diag, nblks) - - implicit none - - type(GFS_control_type), intent(in) :: Model - type(GFS_diag_type), intent(inout) :: Diag(:) - integer, intent(in) :: nblks - - ! Local vars - integer :: nb - - - if (mod (Model%kdt, Model%nszero) == 1) then - do nb = 1, nblks - call Diag(nb)%rad_zero (Model) - call Diag(nb)%phys_zero (Model) - enddo - endif - - end subroutine Clear_buckets - - end module GFS_driver - From 857f5b60e72c0944a8b74d94941f8618b71b79e9 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 11:05:00 -0700 Subject: [PATCH 100/114] added use statement in GFS_suite_setup_2_run for random number generation --- physics/GFS_suite_setup.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 9c07eb9b0..b5f4b0c36 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -89,7 +89,7 @@ end subroutine GFS_suite_setup_2_finalize !! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 1 | GFS_typedefs%GFS_diag_type | | inout | F | !! subroutine GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) - + use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys use physcons, only: dxmin, dxinv use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & From 29515e80b68d1732c5212db0ff1e1dccae6bca6e Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 11:28:36 -0700 Subject: [PATCH 101/114] rolling back use of GFS_suite_setup_2_run due to b4b failure --- GFS_layer/GFS_driver.F90 | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index cf21142fa..a8a6eb0a4 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -263,7 +263,27 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & call GFS_rad_time_vary (Model, Statein, Tbd, sec) endif - call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) + !--- physics time varying routine + call GFS_phys_time_vary (Model, Grid, Tbd) + + !--- repopulate specific time-varying sfc properties for AMIP/forecast runs + if (Model%nscyc > 0) then + if (mod(Model%kdt,Model%nscyc) == 1) THEN + call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) + endif + endif + + !--- determine if diagnostics buckets need to be cleared + if (mod(Model%kdt,Model%nszero) == 1) then + do nb = 1,nblks + call Diag(nb)%rad_zero (Model) + call Diag(nb)%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + enddo + endif + + +! call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) end subroutine GFS_time_vary_step From ec2c3a10d8a72ae5bac2a7c86ea1e35beead96de Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 11:37:45 -0700 Subject: [PATCH 102/114] rolling back GFS_suite_setup_1_run due to b4b failure --- GFS_layer/GFS_driver.F90 | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index a8a6eb0a4..3a255417d 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -256,7 +256,42 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec - call GFS_suite_setup_1_run (Model) +! call GFS_suite_setup_1_run (Model) + nblks = size(blksz) + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 + !--- update calendars and triggers + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + sec = rinc(4) + Model%phour = sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (sec + Model%dtp)/con_hr + Model%kdt = nint((sec + Model%dtp)/Model%dtp) + + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr + endif !--- radiation time varying routine if (Model%lsswr .or. Model%lslwr) then @@ -280,7 +315,7 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & call Diag(nb)%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED enddo - endif + endif ! call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) From a1abd4e196fec623305760a8ec49a556a8963336 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 12:57:55 -0700 Subject: [PATCH 103/114] testing GFS_suite_setup_1_run --- GFS_layer/GFS_driver.F90 | 69 +++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 33 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 3a255417d..bbb7ba18e 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -256,42 +256,45 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec -! call GFS_suite_setup_1_run (Model) + nblks = size(blksz) + + call GFS_suite_setup_1_run (Model) + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - rinc(1:5) = 0 - call w3difdat(Model%jdat,Model%idat,4,rinc) - sec = rinc(4) - Model%phour = sec/con_hr - !--- set current bucket hour - Model%zhour = Model%phour - Model%fhour = (sec + Model%dtp)/con_hr - Model%kdt = nint((sec + Model%dtp)/Model%dtp) - - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. - - !--- radiation triggers - Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - - !--- set the solar hour based on a combination of phour and time initial hour - Model%solhr = mod(Model%phour+Model%idate(1),con_24) - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr - endif + ! rinc(1:5) = 0 + ! call w3difdat(Model%jdat,Model%idat,4,rinc) + ! sec = rinc(4) + ! Model%phour = sec/con_hr + ! !--- set current bucket hour + ! Model%zhour = Model%phour + ! Model%fhour = (sec + Model%dtp)/con_hr + ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) + ! + ! Model%ipt = 1 + ! Model%lprnt = .false. + ! Model%lssav = .true. + ! + ! !--- radiation triggers + ! Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + ! Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + ! + ! !--- set the solar hour based on a combination of phour and time initial hour + ! Model%solhr = mod(Model%phour+Model%idate(1),con_24) + ! + ! if ((Model%debug) .and. (Model%me == Model%master)) then + ! print *,' sec ', sec + ! print *,' kdt ', Model%kdt + ! print *,' nsswr ', Model%nsswr + ! print *,' nslwr ', Model%nslwr + ! print *,' nscyc ', Model%nscyc + ! print *,' lsswr ', Model%lsswr + ! print *,' lslwr ', Model%lslwr + ! print *,' fhour ', Model%fhour + ! print *,' phour ', Model%phour + ! print *,' solhr ', Model%solhr + ! endif !--- radiation time varying routine if (Model%lsswr .or. Model%lslwr) then From 83b1023c60cd6329fe807a21490ee6d59df185a0 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 13:10:49 -0700 Subject: [PATCH 104/114] partial GFS_suite_setup_1 for testing purpose --- GFS_layer/GFS_driver.F90 | 52 +++++++++++++++++++------------------ physics/GFS_suite_setup.f90 | 46 ++++++++++++++++---------------- 2 files changed, 50 insertions(+), 48 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index bbb7ba18e..0466cda93 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -259,7 +259,7 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & nblks = size(blksz) - call GFS_suite_setup_1_run (Model) + !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers @@ -271,30 +271,32 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & ! Model%zhour = Model%phour ! Model%fhour = (sec + Model%dtp)/con_hr ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) - ! - ! Model%ipt = 1 - ! Model%lprnt = .false. - ! Model%lssav = .true. - ! - ! !--- radiation triggers - ! Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - ! Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - ! - ! !--- set the solar hour based on a combination of phour and time initial hour - ! Model%solhr = mod(Model%phour+Model%idate(1),con_24) - ! - ! if ((Model%debug) .and. (Model%me == Model%master)) then - ! print *,' sec ', sec - ! print *,' kdt ', Model%kdt - ! print *,' nsswr ', Model%nsswr - ! print *,' nslwr ', Model%nslwr - ! print *,' nscyc ', Model%nscyc - ! print *,' lsswr ', Model%lsswr - ! print *,' lslwr ', Model%lslwr - ! print *,' fhour ', Model%fhour - ! print *,' phour ', Model%phour - ! print *,' solhr ', Model%solhr - ! endif + + call GFS_suite_setup_1_run (Model) + + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr + endif !--- radiation time varying routine if (Model%lsswr .or. Model%lslwr) then diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index b5f4b0c36..8108be668 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -39,29 +39,29 @@ subroutine GFS_suite_setup_1_run (Model) Model%fhour = (sec + Model%dtp)/con_hr Model%kdt = nint((sec + Model%dtp)/Model%dtp) - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. - - !--- radiation triggers - Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - - !--- set the solar hour based on a combination of phour and time initial hour - Model%solhr = mod(Model%phour+Model%idate(1),con_24) - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr - endif + ! Model%ipt = 1 + ! Model%lprnt = .false. + ! Model%lssav = .true. + ! + ! !--- radiation triggers + ! Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + ! Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + ! + ! !--- set the solar hour based on a combination of phour and time initial hour + ! Model%solhr = mod(Model%phour+Model%idate(1),con_24) + ! + ! if ((Model%debug) .and. (Model%me == Model%master)) then + ! print *,' sec ', sec + ! print *,' kdt ', Model%kdt + ! print *,' nsswr ', Model%nsswr + ! print *,' nslwr ', Model%nslwr + ! print *,' nscyc ', Model%nscyc + ! print *,' lsswr ', Model%lsswr + ! print *,' lslwr ', Model%lslwr + ! print *,' fhour ', Model%fhour + ! print *,' phour ', Model%phour + ! print *,' solhr ', Model%solhr + ! endif end subroutine GFS_suite_setup_1_run From f3b281f4467a17b265985817decee2deb95619c5 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 13:22:00 -0700 Subject: [PATCH 105/114] only GFS_suite_setup_2 for testing purpose --- GFS_layer/GFS_driver.F90 | 60 ++++++++++++++++++------------------- physics/GFS_suite_setup.f90 | 46 ++++++++++++++-------------- 2 files changed, 53 insertions(+), 53 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 0466cda93..d545289df 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -263,16 +263,16 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - ! rinc(1:5) = 0 - ! call w3difdat(Model%jdat,Model%idat,4,rinc) - ! sec = rinc(4) - ! Model%phour = sec/con_hr - ! !--- set current bucket hour - ! Model%zhour = Model%phour - ! Model%fhour = (sec + Model%dtp)/con_hr - ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + sec = rinc(4) + Model%phour = sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (sec + Model%dtp)/con_hr + Model%kdt = nint((sec + Model%dtp)/Model%dtp) - call GFS_suite_setup_1_run (Model) + ! call GFS_suite_setup_1_run (Model) Model%ipt = 1 Model%lprnt = .false. @@ -303,27 +303,27 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & call GFS_rad_time_vary (Model, Statein, Tbd, sec) endif - !--- physics time varying routine - call GFS_phys_time_vary (Model, Grid, Tbd) - - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - if (Model%nscyc > 0) then - if (mod(Model%kdt,Model%nscyc) == 1) THEN - call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - endif - endif - - !--- determine if diagnostics buckets need to be cleared - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Diag(nb)%rad_zero (Model) - call Diag(nb)%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - - -! call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) + ! !--- physics time varying routine + ! call GFS_phys_time_vary (Model, Grid, Tbd) + ! + ! !--- repopulate specific time-varying sfc properties for AMIP/forecast runs + ! if (Model%nscyc > 0) then + ! if (mod(Model%kdt,Model%nscyc) == 1) THEN + ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) + ! endif + ! endif + ! + ! !--- determine if diagnostics buckets need to be cleared + ! if (mod(Model%kdt,Model%nszero) == 1) then + ! do nb = 1,nblks + ! call Diag(nb)%rad_zero (Model) + ! call Diag(nb)%phys_zero (Model) + ! !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + ! enddo + ! endif + + + call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) end subroutine GFS_time_vary_step diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 8108be668..b5f4b0c36 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -39,29 +39,29 @@ subroutine GFS_suite_setup_1_run (Model) Model%fhour = (sec + Model%dtp)/con_hr Model%kdt = nint((sec + Model%dtp)/Model%dtp) - ! Model%ipt = 1 - ! Model%lprnt = .false. - ! Model%lssav = .true. - ! - ! !--- radiation triggers - ! Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - ! Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - ! - ! !--- set the solar hour based on a combination of phour and time initial hour - ! Model%solhr = mod(Model%phour+Model%idate(1),con_24) - ! - ! if ((Model%debug) .and. (Model%me == Model%master)) then - ! print *,' sec ', sec - ! print *,' kdt ', Model%kdt - ! print *,' nsswr ', Model%nsswr - ! print *,' nslwr ', Model%nslwr - ! print *,' nscyc ', Model%nscyc - ! print *,' lsswr ', Model%lsswr - ! print *,' lslwr ', Model%lslwr - ! print *,' fhour ', Model%fhour - ! print *,' phour ', Model%phour - ! print *,' solhr ', Model%solhr - ! endif + Model%ipt = 1 + Model%lprnt = .false. + Model%lssav = .true. + + !--- radiation triggers + Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + + !--- set the solar hour based on a combination of phour and time initial hour + Model%solhr = mod(Model%phour+Model%idate(1),con_24) + + if ((Model%debug) .and. (Model%me == Model%master)) then + print *,' sec ', sec + print *,' kdt ', Model%kdt + print *,' nsswr ', Model%nsswr + print *,' nslwr ', Model%nslwr + print *,' nscyc ', Model%nscyc + print *,' lsswr ', Model%lsswr + print *,' lslwr ', Model%lslwr + print *,' fhour ', Model%fhour + print *,' phour ', Model%phour + print *,' solhr ', Model%solhr + endif end subroutine GFS_suite_setup_1_run From a2361da56b55fe85e145313d9963a056267971c2 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 13:34:38 -0700 Subject: [PATCH 106/114] only GFS_suite_setup_2 + partial GFS_suite_setup_1 for testing purpose --- GFS_layer/GFS_driver.F90 | 50 ++++++++++++++++++------------------- physics/GFS_suite_setup.f90 | 16 ++++++------ 2 files changed, 33 insertions(+), 33 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index d545289df..851027f61 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -272,31 +272,31 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & Model%fhour = (sec + Model%dtp)/con_hr Model%kdt = nint((sec + Model%dtp)/Model%dtp) - ! call GFS_suite_setup_1_run (Model) - - Model%ipt = 1 - Model%lprnt = .false. - Model%lssav = .true. - - !--- radiation triggers - Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - - !--- set the solar hour based on a combination of phour and time initial hour - Model%solhr = mod(Model%phour+Model%idate(1),con_24) - - if ((Model%debug) .and. (Model%me == Model%master)) then - print *,' sec ', sec - print *,' kdt ', Model%kdt - print *,' nsswr ', Model%nsswr - print *,' nslwr ', Model%nslwr - print *,' nscyc ', Model%nscyc - print *,' lsswr ', Model%lsswr - print *,' lslwr ', Model%lslwr - print *,' fhour ', Model%fhour - print *,' phour ', Model%phour - print *,' solhr ', Model%solhr - endif + call GFS_suite_setup_1_run (Model) + + ! Model%ipt = 1 + ! Model%lprnt = .false. + ! Model%lssav = .true. + ! + ! !--- radiation triggers + ! Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) + ! Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) + ! + ! !--- set the solar hour based on a combination of phour and time initial hour + ! Model%solhr = mod(Model%phour+Model%idate(1),con_24) + ! + ! if ((Model%debug) .and. (Model%me == Model%master)) then + ! print *,' sec ', sec + ! print *,' kdt ', Model%kdt + ! print *,' nsswr ', Model%nsswr + ! print *,' nslwr ', Model%nslwr + ! print *,' nscyc ', Model%nscyc + ! print *,' lsswr ', Model%lsswr + ! print *,' lslwr ', Model%lslwr + ! print *,' fhour ', Model%fhour + ! print *,' phour ', Model%phour + ! print *,' solhr ', Model%solhr + ! endif !--- radiation time varying routine if (Model%lsswr .or. Model%lslwr) then diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index b5f4b0c36..90b151732 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -30,14 +30,14 @@ subroutine GFS_suite_setup_1_run (Model) !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - rinc(1:5) = 0 - call w3difdat(Model%jdat,Model%idat,4,rinc) - sec = rinc(4) - Model%phour = sec/con_hr - !--- set current bucket hour - Model%zhour = Model%phour - Model%fhour = (sec + Model%dtp)/con_hr - Model%kdt = nint((sec + Model%dtp)/Model%dtp) + ! rinc(1:5) = 0 + ! call w3difdat(Model%jdat,Model%idat,4,rinc) + ! sec = rinc(4) + ! Model%phour = sec/con_hr + ! !--- set current bucket hour + ! Model%zhour = Model%phour + ! Model%fhour = (sec + Model%dtp)/con_hr + ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) Model%ipt = 1 Model%lprnt = .false. From d19937c35393aff70294f03c914291efc7c08f54 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 13:44:20 -0700 Subject: [PATCH 107/114] only GFS_suite_setup_2 + partial GFS_suite_setup_1 for testing purpose; isolating call to w3 lib function --- GFS_layer/GFS_driver.F90 | 16 ++++++++-------- physics/GFS_suite_setup.f90 | 16 ++++++++-------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 851027f61..4ba04bf7a 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -265,14 +265,14 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & !--- update calendars and triggers rinc(1:5) = 0 call w3difdat(Model%jdat,Model%idat,4,rinc) - sec = rinc(4) - Model%phour = sec/con_hr - !--- set current bucket hour - Model%zhour = Model%phour - Model%fhour = (sec + Model%dtp)/con_hr - Model%kdt = nint((sec + Model%dtp)/Model%dtp) - - call GFS_suite_setup_1_run (Model) + ! sec = rinc(4) + ! Model%phour = sec/con_hr + ! !--- set current bucket hour + ! Model%zhour = Model%phour + ! Model%fhour = (sec + Model%dtp)/con_hr + ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) + + call GFS_suite_setup_1_run (Model, rinc) ! Model%ipt = 1 ! Model%lprnt = .false. diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 90b151732..4d3891289 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -16,7 +16,7 @@ end subroutine GFS_suite_setup_1_finalize !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | !! - subroutine GFS_suite_setup_1_run (Model) + subroutine GFS_suite_setup_1_run (Model, rinc) use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type @@ -25,19 +25,19 @@ subroutine GFS_suite_setup_1_run (Model) real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys) :: rinc(5) + real(kind=kind_phys), intent(in) :: rinc(5) real(kind=kind_phys) :: sec !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers ! rinc(1:5) = 0 ! call w3difdat(Model%jdat,Model%idat,4,rinc) - ! sec = rinc(4) - ! Model%phour = sec/con_hr - ! !--- set current bucket hour - ! Model%zhour = Model%phour - ! Model%fhour = (sec + Model%dtp)/con_hr - ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) + sec = rinc(4) + Model%phour = sec/con_hr + !--- set current bucket hour + Model%zhour = Model%phour + Model%fhour = (sec + Model%dtp)/con_hr + Model%kdt = nint((sec + Model%dtp)/Model%dtp) Model%ipt = 1 Model%lprnt = .false. From 52e17e0928a1c163631ffbe00ab7f634e39faf0b Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 14:05:15 -0700 Subject: [PATCH 108/114] only GFS_suite_setup_2 + partial GFS_suite_setup_1 for testing purpose; isolating call to w3 lib function --- GFS_layer/GFS_driver.F90 | 6 +++--- physics/GFS_suite_setup.f90 | 10 +++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 4ba04bf7a..4493851aa 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -265,14 +265,14 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & !--- update calendars and triggers rinc(1:5) = 0 call w3difdat(Model%jdat,Model%idat,4,rinc) - ! sec = rinc(4) - ! Model%phour = sec/con_hr + sec = rinc(4) + Model%phour = sec/con_hr ! !--- set current bucket hour ! Model%zhour = Model%phour ! Model%fhour = (sec + Model%dtp)/con_hr ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) - call GFS_suite_setup_1_run (Model, rinc) + call GFS_suite_setup_1_run (Model, sec) ! Model%ipt = 1 ! Model%lprnt = .false. diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 4d3891289..f841cba72 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -16,7 +16,7 @@ end subroutine GFS_suite_setup_1_finalize !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | !! - subroutine GFS_suite_setup_1_run (Model, rinc) + subroutine GFS_suite_setup_1_run (Model, sec) use machine, only: kind_phys use GFS_typedefs, only: GFS_control_type @@ -25,15 +25,15 @@ subroutine GFS_suite_setup_1_run (Model, rinc) real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), intent(in) :: rinc(5) - real(kind=kind_phys) :: sec + real(kind=kind_phys) :: rinc(5) + real(kind=kind_phys), intent(in) :: sec !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers ! rinc(1:5) = 0 ! call w3difdat(Model%jdat,Model%idat,4,rinc) - sec = rinc(4) - Model%phour = sec/con_hr + ! sec = rinc(4) + ! Model%phour = sec/con_hr !--- set current bucket hour Model%zhour = Model%phour Model%fhour = (sec + Model%dtp)/con_hr From 8eb6827b985e597e9bd76ac1290d74b09651b505 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 15:05:43 -0700 Subject: [PATCH 109/114] local variable 'sec' within GFS_driver needs to be output of GFS_suite_setup_1_run --- GFS_layer/GFS_driver.F90 | 10 +++++----- physics/GFS_suite_setup.f90 | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 4493851aa..221918b41 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -257,16 +257,16 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & real(kind=kind_phys) :: sec - nblks = size(blksz) + ! nblks = size(blksz) !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - rinc(1:5) = 0 - call w3difdat(Model%jdat,Model%idat,4,rinc) - sec = rinc(4) - Model%phour = sec/con_hr + ! rinc(1:5) = 0 + ! call w3difdat(Model%jdat,Model%idat,4,rinc) + ! sec = rinc(4) + ! Model%phour = sec/con_hr ! !--- set current bucket hour ! Model%zhour = Model%phour ! Model%fhour = (sec + Model%dtp)/con_hr diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index f841cba72..886fbfdea 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -26,14 +26,14 @@ subroutine GFS_suite_setup_1_run (Model, sec) real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys) :: rinc(5) - real(kind=kind_phys), intent(in) :: sec + real(kind=kind_phys), intent(inout) :: sec !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - ! rinc(1:5) = 0 - ! call w3difdat(Model%jdat,Model%idat,4,rinc) - ! sec = rinc(4) - ! Model%phour = sec/con_hr + rinc(1:5) = 0 + call w3difdat(Model%jdat,Model%idat,4,rinc) + sec = rinc(4) + Model%phour = sec/con_hr !--- set current bucket hour Model%zhour = Model%phour Model%fhour = (sec + Model%dtp)/con_hr From 6c8a86977b4f76f1b24eec0acedfdc34a8a82c6c Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 15:14:28 -0700 Subject: [PATCH 110/114] removing unneeded declarations --- GFS_layer/GFS_driver.F90 | 4 ++-- physics/GFS_suite_setup.f90 | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index 221918b41..f8effdf6b 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -252,8 +252,8 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) !--- local variables - integer :: nb, nblks - real(kind=kind_phys) :: rinc(5) + !integer :: nb, nblks + !real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 886fbfdea..8d7b879c7 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -15,6 +15,7 @@ end subroutine GFS_suite_setup_1_finalize !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | +!! | sec | seconds_elapsed | seconds elapsed since the initialization | s | 0 | real | kind_phys | inout | F | !! subroutine GFS_suite_setup_1_run (Model, sec) From 1084543961927d14d05bde40f46c87b0ca572c0e Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 15:36:42 -0700 Subject: [PATCH 111/114] cleaned up commented-out code --- GFS_layer/GFS_driver.F90 | 62 ---------------------------------------- 1 file changed, 62 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index f8effdf6b..85201c3a5 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -252,77 +252,15 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) !--- local variables - !integer :: nb, nblks - !real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec - - ! nblks = size(blksz) - - - - !--- Model%jdat is being updated directly inside of FV3GFS_cap.F90 - !--- update calendars and triggers - ! rinc(1:5) = 0 - ! call w3difdat(Model%jdat,Model%idat,4,rinc) - ! sec = rinc(4) - ! Model%phour = sec/con_hr - ! !--- set current bucket hour - ! Model%zhour = Model%phour - ! Model%fhour = (sec + Model%dtp)/con_hr - ! Model%kdt = nint((sec + Model%dtp)/Model%dtp) - call GFS_suite_setup_1_run (Model, sec) - ! Model%ipt = 1 - ! Model%lprnt = .false. - ! Model%lssav = .true. - ! - ! !--- radiation triggers - ! Model%lsswr = (mod(Model%kdt, Model%nsswr) == 1) - ! Model%lslwr = (mod(Model%kdt, Model%nslwr) == 1) - ! - ! !--- set the solar hour based on a combination of phour and time initial hour - ! Model%solhr = mod(Model%phour+Model%idate(1),con_24) - ! - ! if ((Model%debug) .and. (Model%me == Model%master)) then - ! print *,' sec ', sec - ! print *,' kdt ', Model%kdt - ! print *,' nsswr ', Model%nsswr - ! print *,' nslwr ', Model%nslwr - ! print *,' nscyc ', Model%nscyc - ! print *,' lsswr ', Model%lsswr - ! print *,' lslwr ', Model%lslwr - ! print *,' fhour ', Model%fhour - ! print *,' phour ', Model%phour - ! print *,' solhr ', Model%solhr - ! endif - !--- radiation time varying routine if (Model%lsswr .or. Model%lslwr) then call GFS_rad_time_vary (Model, Statein, Tbd, sec) endif - ! !--- physics time varying routine - ! call GFS_phys_time_vary (Model, Grid, Tbd) - ! - ! !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - ! if (Model%nscyc > 0) then - ! if (mod(Model%kdt,Model%nscyc) == 1) THEN - ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - ! endif - ! endif - ! - ! !--- determine if diagnostics buckets need to be cleared - ! if (mod(Model%kdt,Model%nszero) == 1) then - ! do nb = 1,nblks - ! call Diag(nb)%rad_zero (Model) - ! call Diag(nb)%phys_zero (Model) - ! !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - ! enddo - ! endif - - call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) end subroutine GFS_time_vary_step From df2b18364fd1497a194ef4ab94a79833ce1042e4 Mon Sep 17 00:00:00 2001 From: "Grant.Firl" Date: Tue, 19 Dec 2017 15:41:48 -0700 Subject: [PATCH 112/114] fixed argument table names --- physics/GFS_suite_setup.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 8d7b879c7..567896f9c 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -11,7 +11,7 @@ end subroutine GFS_suite_setup_1_init subroutine GFS_suite_setup_1_finalize() end subroutine GFS_suite_setup_1_finalize -!> \section arg_table_GFS_suite_interstitial_1_run Argument Table +!> \section arg_table_GFS_suite_setup_1_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|--------------------------------------------------------|-----------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_typedefs%GFS_control_type | | inout | F | @@ -78,7 +78,7 @@ end subroutine GFS_suite_setup_2_init subroutine GFS_suite_setup_2_finalize() end subroutine GFS_suite_setup_2_finalize -!> \section arg_table_GFS_suite_interstitial_2_run Argument Table +!> \section arg_table_GFS_suite_setup_2_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|-------------------------------------------------------------------------|-------------------------------------------------------------------------|---------------|------|-------------------------------|-----------|--------|----------| !! | blksz | horizontal_block_size | number of grid columns used for explicit data blocking for physics | count | 1 | integer | | in | F | From bc2c5247d983455043f60cd57a058cb5bacaa823 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Dec 2017 11:32:01 -0700 Subject: [PATCH 113/114] Corrected formatting/indents and added module names to 'end module' statements --- makefile | 283 ++++++++++++++++++------------------ physics/GFS_suite_setup.f90 | 226 ++++++++++++++-------------- 2 files changed, 253 insertions(+), 256 deletions(-) diff --git a/makefile b/makefile index 539fa2d22..f3b035ea9 100644 --- a/makefile +++ b/makefile @@ -22,155 +22,152 @@ FFLAGS += -I../fms -I../fms/include CPPDEFS = -DNEW_TAUCTMAX -DSMALL_PE -DNEMS_GSM SRCS_f = \ - ./physics/cnvc90.f \ - ./physics/co2hc.f \ - ./physics/date_def.f \ - ./physics/dcyc2.f \ - ./physics/dcyc2.pre.rad.f \ - ./physics/efield.f \ - ./physics/get_prs.f \ - ./physics/gfs_phy_tracer_config.f \ - ./physics/gocart_tracer_config_stub.f \ - ./physics/gscond.f \ - ./physics/gscondp.f \ - ./physics/gwdc.f \ - ./physics/gwdps.f \ - ./physics/h2o_def.f \ - ./physics/h2oc.f \ - ./physics/h2ohdc.f \ - ./physics/h2ophys.f \ - ./physics/ideaca.f \ - ./physics/idea_co2.f \ - ./physics/idea_composition.f \ - ./physics/idea_dissipation.f \ - ./physics/idea_h2o.f \ - ./physics/idea_ion.f \ - ./physics/idea_o2_o3.f \ - ./physics/idea_phys.f \ - ./physics/idea_solar_heating.f \ - ./physics/idea_tracer.f \ - ./physics/iounitdef.f \ - ./physics/lrgsclr.f \ - ./physics/mersenne_twister.f \ - ./physics/mfdeepcnv.f \ - ./physics/mfpbl.f \ - ./physics/mfshalcnv.f \ - ./physics/module_bfmicrophysics.f \ - ./physics/moninedmf.f \ - ./physics/moninp.f \ - ./physics/moninp1.f \ - ./physics/moninq.f \ - ./physics/moninq1.f \ - ./physics/moninshoc.f \ - ./physics/mstadb.f \ - ./physics/mstadbtn.f \ - ./physics/mstadbtn2.f \ - ./physics/mstcnv.f \ - ./physics/namelist_soilveg.f \ - ./physics/ozne_def.f \ - ./physics/ozphys.f \ - ./physics/ozphys_2015.f \ - ./physics/physparam.f \ - ./physics/precpd.f \ - ./physics/precpd_shoc.f \ - ./physics/precpdp.f \ - ./physics/precpd_shoc.f \ - ./physics/progt2.f \ - ./physics/progtm_module.f \ - ./physics/rad_initialize.f \ - ./physics/radiation_aerosols.f \ - ./physics/radiation_astronomy.f \ - ./physics/radiation_clouds.f \ - ./physics/radiation_gases.f \ - ./physics/radiation_surface.f \ - ./physics/radlw_datatb.f \ - ./physics/radlw_main.f \ - ./physics/radlw_param.f \ - ./physics/radsw_datatb.f \ - ./physics/radsw_main.f \ - ./physics/radsw_param.f \ - ./physics/rascnvv2.f \ - ./physics/rayleigh_damp.f \ - ./physics/rayleigh_damp_mesopause.f \ - ./physics/sascnv.f \ - ./physics/sascnvn.f \ - ./physics/set_soilveg.f \ -# DH*? - ./physics/GFS_surface_loop_control.f \ -# *DH? - ./physics/sfc_cice.f \ - ./physics/sfc_diag.f \ - ./physics/sfc_diff.f \ - ./physics/sfc_drv.f \ - ./physics/sfc_land.f \ - ./physics/sfc_nst.f \ - ./physics/sfc_ocean.f \ - ./physics/sfc_sice.f \ - ./physics/sfcsub.f \ - ./physics/sflx.f \ - ./physics/shalcnv.f \ - ./physics/shalcv.f \ - ./physics/shalcv_1lyr.f \ - ./physics/shalcv_fixdp.f \ - ./physics/shalcv_opr.f \ - ./physics/tracer_const_h.f \ - ./physics/tridi.f \ - ./physics/tridi2t3.f + ./physics/cnvc90.f \ + ./physics/co2hc.f \ + ./physics/date_def.f \ + ./physics/dcyc2.f \ + ./physics/dcyc2.pre.rad.f \ + ./physics/efield.f \ + ./physics/get_prs.f \ + ./physics/gfs_phy_tracer_config.f \ + ./physics/gocart_tracer_config_stub.f \ + ./physics/gscond.f \ + ./physics/gscondp.f \ + ./physics/gwdc.f \ + ./physics/gwdps.f \ + ./physics/h2o_def.f \ + ./physics/h2oc.f \ + ./physics/h2ohdc.f \ + ./physics/h2ophys.f \ + ./physics/ideaca.f \ + ./physics/idea_co2.f \ + ./physics/idea_composition.f \ + ./physics/idea_dissipation.f \ + ./physics/idea_h2o.f \ + ./physics/idea_ion.f \ + ./physics/idea_o2_o3.f \ + ./physics/idea_phys.f \ + ./physics/idea_solar_heating.f \ + ./physics/idea_tracer.f \ + ./physics/iounitdef.f \ + ./physics/lrgsclr.f \ + ./physics/mersenne_twister.f \ + ./physics/mfdeepcnv.f \ + ./physics/mfpbl.f \ + ./physics/mfshalcnv.f \ + ./physics/module_bfmicrophysics.f \ + ./physics/moninedmf.f \ + ./physics/moninp.f \ + ./physics/moninp1.f \ + ./physics/moninq.f \ + ./physics/moninq1.f \ + ./physics/moninshoc.f \ + ./physics/mstadb.f \ + ./physics/mstadbtn.f \ + ./physics/mstadbtn2.f \ + ./physics/mstcnv.f \ + ./physics/namelist_soilveg.f \ + ./physics/ozne_def.f \ + ./physics/ozphys.f \ + ./physics/ozphys_2015.f \ + ./physics/physparam.f \ + ./physics/precpd.f \ + ./physics/precpd_shoc.f \ + ./physics/precpdp.f \ + ./physics/precpd_shoc.f \ + ./physics/progt2.f \ + ./physics/progtm_module.f \ + ./physics/rad_initialize.f \ + ./physics/radiation_aerosols.f \ + ./physics/radiation_astronomy.f \ + ./physics/radiation_clouds.f \ + ./physics/radiation_gases.f \ + ./physics/radiation_surface.f \ + ./physics/radlw_datatb.f \ + ./physics/radlw_main.f \ + ./physics/radlw_param.f \ + ./physics/radsw_datatb.f \ + ./physics/radsw_main.f \ + ./physics/radsw_param.f \ + ./physics/rascnvv2.f \ + ./physics/rayleigh_damp.f \ + ./physics/rayleigh_damp_mesopause.f \ + ./physics/sascnv.f \ + ./physics/sascnvn.f \ + ./physics/set_soilveg.f \ + ./physics/GFS_surface_loop_control.f \ + ./physics/sfc_cice.f \ + ./physics/sfc_diag.f \ + ./physics/sfc_diff.f \ + ./physics/sfc_drv.f \ + ./physics/sfc_land.f \ + ./physics/sfc_nst.f \ + ./physics/sfc_ocean.f \ + ./physics/sfc_sice.f \ + ./physics/sfcsub.f \ + ./physics/sflx.f \ + ./physics/shalcnv.f \ + ./physics/shalcv.f \ + ./physics/shalcv_1lyr.f \ + ./physics/shalcv_fixdp.f \ + ./physics/shalcv_opr.f \ + ./physics/tracer_const_h.f \ + ./physics/tridi.f \ + ./physics/tridi2t3.f SRCS_f90 = \ - ./physics/GFS_calpreciptype.f90 \ - ./physics/GFS_MP_generic_post.f90 \ - ./physics/GFS_MP_generic_pre.f90 \ - ./physics/GFS_zhao_carr_pre.f90 \ - ./physics/GFS_RRTMG_pre.f90 \ - ./physics/GFS_RRTMG_post.f90 \ - ./physics/GFS_radsw_pre.f90 \ - ./physics/GFS_radsw_post.f90 \ - ./physics/GFS_radlw_pre.f90 \ - ./physics/GFS_radlw_post.f90 \ - ./physics/GFS_rad_time_vary.f90 \ - ./physics/GFS_radupdate.f90 \ - ./physics/cs_conv.f90 \ - ./physics/funcphys.f90 \ - ./physics/gcm_shoc.f90 \ - ./physics/gcycle.f90 \ - ./physics/get_prs_fv3.f90 \ - ./physics/GFS_DCNV_generic.f90 \ - ./physics/GFS_SCNV_generic.f90 \ - ./physics/GFS_PBL_generic.f90 \ - ./physics/GFS_suite_interstitial.f90 \ - ./physics/GFS_suite_setup.f90 \ - ./physics/h2ointerp.f90 \ - ./physics/m_micro_driver.f90 \ - ./physics/module_nst_model.f90 \ - ./physics/module_nst_parameters.f90 \ - ./physics/module_nst_water_prop.f90 \ - ./physics/ozinterp.f90 \ - ./physics/physcons.f90 \ -# DH*? - ./physics/radcons.f90 \ -# *DH? - ./physics/wam_f107_kp_mod.f90 + ./physics/GFS_calpreciptype.f90 \ + ./physics/GFS_MP_generic_post.f90 \ + ./physics/GFS_MP_generic_pre.f90 \ + ./physics/GFS_zhao_carr_pre.f90 \ + ./physics/GFS_RRTMG_pre.f90 \ + ./physics/GFS_RRTMG_post.f90 \ + ./physics/GFS_radsw_pre.f90 \ + ./physics/GFS_radsw_post.f90 \ + ./physics/GFS_radlw_pre.f90 \ + ./physics/GFS_radlw_post.f90 \ + ./physics/GFS_rad_time_vary.f90 \ + ./physics/GFS_radupdate.f90 \ + ./physics/cs_conv.f90 \ + ./physics/funcphys.f90 \ + ./physics/gcm_shoc.f90 \ + ./physics/gcycle.f90 \ + ./physics/get_prs_fv3.f90 \ + ./physics/GFS_DCNV_generic.f90 \ + ./physics/GFS_SCNV_generic.f90 \ + ./physics/GFS_PBL_generic.f90 \ + ./physics/GFS_suite_interstitial.f90 \ + ./physics/GFS_suite_setup.f90 \ + ./physics/GFS_surface_generic.f90 \ + ./physics/h2ointerp.f90 \ + ./physics/m_micro_driver.f90 \ + ./physics/module_nst_model.f90 \ + ./physics/module_nst_parameters.f90 \ + ./physics/module_nst_water_prop.f90 \ + ./physics/ozinterp.f90 \ + ./physics/physcons.f90 \ + ./physics/radcons.f90 \ + ./physics/wam_f107_kp_mod.f90 SRCS_F = \ - ./physics/aer_cloud.F \ - ./physics/cldmacro.F \ - ./physics/cldwat2m_micro.F \ - ./physics/machine.F \ - ./physics/num_parthds.F \ - ./physics/wv_saturation.F + ./physics/aer_cloud.F \ + ./physics/cldmacro.F \ + ./physics/cldwat2m_micro.F \ + ./physics/machine.F \ + ./physics/num_parthds.F \ + ./physics/wv_saturation.F SRCS_F90 = \ - ./physics/GFDL_parse_tracers.F90 \ - ./GFS_layer/GFS_abstraction_layer.F90 \ - ./GFS_layer/GFS_diagnostics.F90 \ - ./GFS_layer/GFS_driver.F90 \ - ./GFS_layer/GFS_physics_driver.F90 \ - ./GFS_layer/GFS_radiation_driver.F90 \ - ./GFS_layer/GFS_restart.F90 \ - ./GFS_layer/GFS_typedefs.F90 \ - ./IPD_layer/IPD_driver.F90 \ - ./IPD_layer/IPD_typedefs.F90 + ./physics/GFDL_parse_tracers.F90 \ + ./GFS_layer/GFS_abstraction_layer.F90 \ + ./GFS_layer/GFS_diagnostics.F90 \ + ./GFS_layer/GFS_driver.F90 \ + ./GFS_layer/GFS_physics_driver.F90 \ + ./GFS_layer/GFS_radiation_driver.F90 \ + ./GFS_layer/GFS_restart.F90 \ + ./GFS_layer/GFS_typedefs.F90 \ + ./IPD_layer/IPD_driver.F90 \ + ./IPD_layer/IPD_typedefs.F90 SRCS_c = diff --git a/physics/GFS_suite_setup.f90 b/physics/GFS_suite_setup.f90 index 567896f9c..08fc768e3 100644 --- a/physics/GFS_suite_setup.f90 +++ b/physics/GFS_suite_setup.f90 @@ -1,7 +1,7 @@ !> \file GFS_suite_setup.f90 !! Contains code related to GFS physics suite setup. - module GFS_suite_setup_1 + module GFS_suite_setup_1 contains @@ -66,17 +66,17 @@ subroutine GFS_suite_setup_1_run (Model, sec) end subroutine GFS_suite_setup_1_run - end module + end module GFS_suite_setup_1 module GFS_suite_setup_2 - contains + contains - subroutine GFS_suite_setup_2_init () - end subroutine GFS_suite_setup_2_init + subroutine GFS_suite_setup_2_init () + end subroutine GFS_suite_setup_2_init - subroutine GFS_suite_setup_2_finalize() - end subroutine GFS_suite_setup_2_finalize + subroutine GFS_suite_setup_2_finalize() + end subroutine GFS_suite_setup_2_finalize !> \section arg_table_GFS_suite_setup_2_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | @@ -89,112 +89,112 @@ end subroutine GFS_suite_setup_2_finalize !! | Cldprop | FV3-GFS_Cldprop_type | Fortran DDT containing FV3-GFS cloud fields | DDT | 1 | GFS_typedefs%GFS_cldprop_type | | inout | F | !! | Diag | FV3-GFS_Diag_type | Fortran DDT containing FV3-GFS fields targeted for diagnostic output | DDT | 1 | GFS_typedefs%GFS_diag_type | | inout | F | !! - subroutine GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) - use mersenne_twister, only: random_setseed, random_number - use machine, only: kind_phys - use physcons, only: dxmin, dxinv - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_sfcprop_type, GFS_cldprop_type, GFS_diag_type - - type(GFS_grid_type), intent(in) :: Grid(:) - type(GFS_control_type), intent(inout) :: Model - type(GFS_tbd_type), intent(inout) :: Tbd(:) - type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) - type(GFS_cldprop_type), intent(inout) :: Cldprop(:) - type(GFS_diag_type), intent(inout) :: Diag(:) - - integer, allocatable, intent(in) :: blksz(:) - - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - - integer :: i, j, k, iseed, iskip, ix, nb - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - nblks = size(blksz) - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)) * i + subroutine GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag) + use mersenne_twister, only: random_setseed, random_number + use machine, only: kind_phys + use physcons, only: dxmin, dxinv + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & + GFS_Tbd_type, GFS_sfcprop_type, GFS_cldprop_type, GFS_diag_type + + type(GFS_grid_type), intent(in) :: Grid(:) + type(GFS_control_type), intent(inout) :: Model + type(GFS_tbd_type), intent(inout) :: Tbd(:) + type(GFS_sfcprop_type), intent(inout) :: Sfcprop(:) + type(GFS_cldprop_type), intent(inout) :: Cldprop(:) + type(GFS_diag_type), intent(inout) :: Diag(:) + + integer, allocatable, intent(in) :: blksz(:) + + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + + integer :: i, j, k, iseed, iskip, ix, nb + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(Model%cny) + real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) + + nblks = size(blksz) + + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then + !--- initialize,accumulate,convert + Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (mod(Model%kdt,Model%nsswr) == 0) then + !--- accumulate,convert + Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (Model%lsswr) then + !--- initialize,accumulate + Model%clstp = 1100 + else + !--- accumulate + Model%clstp = 0100 + endif + + !--- random number needed for RAS and old SAS and when cal_pre=.true. + if ( ((Model%imfdeepcnv <= 0) .or. (Model%cal_pre)) .and. (Model%random_clds) ) then + iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo - - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny - ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx - ix = ix + 1 - if (ix .gt. blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - Tbd(nb)%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) + call random_number(wrk) + do i = 1,Model%cnx*Model%nrcm + iseed = iseed + nint(wrk(1)) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) + enddo + + do k = 1,Model%nrcm + iskip = (k-1)*Model%cnx*Model%cny + ix = 0 + nb = 1 + do j = 1,Model%ny + do i = 1,Model%nx + ix = ix + 1 + if (ix .gt. blksz(nb)) then + ix = 1 + nb = nb + 1 + endif + Tbd(nb)%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) + enddo enddo enddo - enddo - endif ! imfdeepcnv, cal_re, random_clds - - !--- o3 interpolation - if (Model%ntoz > 0) then - do nb = 1, nblks - call ozinterpol (Model%me, blksz(nb), Model%idate, Model%fhour, & - Grid(nb)%jindx1_o3, Grid(nb)%jindx2_o3, & - Tbd(nb)%ozpl, Grid(nb)%ddy_o3) - enddo - endif - - !--- h2o interpolation - if (Model%h2o_phys) then - do nb = 1, nblks - call h2ointerpol (Model%me, blksz(nb), Model%idate, Model%fhour, & - Grid(nb)%jindx1_h, Grid(nb)%jindx2_h, & - Tbd(nb)%h2opl, Grid(nb)%ddy_h) - enddo - endif - - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - if (Model%nscyc > 0) then - if (mod(Model%kdt,Model%nscyc) == 1) THEN - call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - endif - endif - - !--- determine if diagnostics buckets need to be cleared - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Diag(nb)%rad_zero (Model) - call Diag(nb)%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - - end subroutine GFS_suite_setup_2_run - - end module + endif ! imfdeepcnv, cal_re, random_clds + + !--- o3 interpolation + if (Model%ntoz > 0) then + do nb = 1, nblks + call ozinterpol (Model%me, blksz(nb), Model%idate, Model%fhour, & + Grid(nb)%jindx1_o3, Grid(nb)%jindx2_o3, & + Tbd(nb)%ozpl, Grid(nb)%ddy_o3) + enddo + endif + + !--- h2o interpolation + if (Model%h2o_phys) then + do nb = 1, nblks + call h2ointerpol (Model%me, blksz(nb), Model%idate, Model%fhour, & + Grid(nb)%jindx1_h, Grid(nb)%jindx2_h, & + Tbd(nb)%h2opl, Grid(nb)%ddy_h) + enddo + endif + + !--- repopulate specific time-varying sfc properties for AMIP/forecast runs + if (Model%nscyc > 0) then + if (mod(Model%kdt,Model%nscyc) == 1) THEN + call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) + endif + endif + + !--- determine if diagnostics buckets need to be cleared + if (mod(Model%kdt,Model%nszero) == 1) then + do nb = 1,nblks + call Diag(nb)%rad_zero (Model) + call Diag(nb)%phys_zero (Model) + !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED + enddo + endif + + end subroutine GFS_suite_setup_2_run + + end module GFS_suite_setup_2 From 9941edecf67d2af772c264e4fba816040fee3c89 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Dec 2017 11:40:05 -0700 Subject: [PATCH 114/114] Fixed bug in GFS_time_vary_step calling GFS_rad_time_vary_run with local/uninitialized variables ictmflg, isolar instead of the correct parameters defined in physparam --- GFS_layer/GFS_driver.F90 | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/GFS_layer/GFS_driver.F90 b/GFS_layer/GFS_driver.F90 index e9b818372..dd6bb4e88 100644 --- a/GFS_layer/GFS_driver.F90 +++ b/GFS_layer/GFS_driver.F90 @@ -12,8 +12,6 @@ module GFS_driver use module_radsw_parameters, only: topfsw_type, sfcfsw_type use module_radlw_parameters, only: topflw_type, sfcflw_type use funcphys, only: gfuncphys - use GFS_suite_setup_1, only: GFS_suite_setup_1_run - use GFS_suite_setup_2, only: GFS_suite_setup_2_run implicit none @@ -238,6 +236,9 @@ end subroutine GFS_initialize subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & Grid, Tbd, Cldprop, Radtend, Diag) + use physparam, only: ictmflg, isolar + use GFS_suite_setup_1, only: GFS_suite_setup_1_run + use GFS_suite_setup_2, only: GFS_suite_setup_2_run use GFS_rad_time_vary, only: GFS_rad_time_vary_run implicit none @@ -253,21 +254,11 @@ subroutine GFS_time_vary_step (Model, Statein, Stateout, Sfcprop, Coupling, & type(GFS_radtend_type), intent(inout) :: Radtend(:) type(GFS_diag_type), intent(inout) :: Diag(:) !--- local variables - ! DH* - where are those coming from? - !integer :: nblks, ictmflg, isolar - integer :: ictmflg, isolar - !real(kind=kind_phys) :: rinc(5) real(kind=kind_phys) :: sec call GFS_suite_setup_1_run (Model, sec) - !--- radiation time varying routine -! CCPP - call GFS_rad_time_vary_run(Model,Statein, Tbd, blksz, sec, & - ictmflg, isolar) - - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - call Gcycle_driver (nblks, Model, Grid, Sfcprop, Cldprop) + call GFS_rad_time_vary_run(Model, Statein, Tbd, blksz, sec, ictmflg, isolar) call GFS_suite_setup_2_run (blksz, Grid, Model, Tbd, Sfcprop, Cldprop, Diag)