diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 9a0303e72..38515117e 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -20,11 +20,14 @@ end subroutine GFS_PBL_generic_pre_finalize !! | levs | vertical_dimension | vertical layer dimension | count | 0 | integer | | in | F | !! | nvdiff | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | !! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | +!! | ntke | index_for_turbulence_kinetic_energy | tracer index for turbulence kinetic energy | index | 0 | integer | | in | F | +!! | ntkev | index_of_TKE_vertical_diffusion_tracer | index of TKE in the vertically diffused tracer array | index | 0 | integer | | in | F | !! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | !! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | !! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | !! | imp_physics_wsm6 | flag_for_wsm6_microphysics_scheme | choice of WSM6 microphysics scheme | flag | 0 | integer | | in | F | !! | ltaerosol | flag_for_aerosol_physics | flag for aerosol physics | flag | 0 | logical | | in | F | +!! | satmedmf | flag_for_scale_aware_TKE_moist_EDMF_PBL | flag for scale-aware TKE moist EDMF PBL scheme | flag | 0 | logical | | in | F | !! | qgrs | tracer_concentration | model layer mean tracer concentration | kg kg-1 | 3 | real | kind_phys | in | F | !! | qgrs_water_vapor | water_vapor_specific_humidity | water vapor specific humidity | kg kg-1 | 2 | real | kind_phys | in | F | !! | qgrs_liquid_cloud | cloud_condensed_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) | kg kg-1 | 2 | real | kind_phys | in | F | @@ -37,27 +40,29 @@ end subroutine GFS_PBL_generic_pre_finalize !! | qgrs_rain | rain_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of rain water | kg kg-1 | 2 | real | kind_phys | in | F | !! | qgrs_snow | snow_water_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of snow water | kg kg-1 | 2 | real | kind_phys | in | F | !! | qgrs_graupel | graupel_mixing_ratio | moist (dry+vapor, no condensates) mixing ratio of graupel | kg kg-1 | 2 | real | kind_phys | in | F | +!! | qgrs_tke | turbulent_kinetic_energy | turbulent kinetic energy | J | 2 | real | kind_phys | in | F | !! | vdftra | vertically_diffused_tracer_concentration | tracer concentration diffused by PBL scheme | kg kg-1 | 3 | real | kind_phys | inout | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! #endif - subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_wsm6, ltaerosol, qgrs, qgrs_water_vapor, qgrs_liquid_cloud, qgrs_ice_cloud, qgrs_ozone, & - qgrs_cloud_droplet_num_conc, qgrs_cloud_ice_num_conc, qgrs_water_aer_num_conc, qgrs_ice_aer_num_conc, qgrs_rain, & - qgrs_snow, qgrs_graupel, vdftra, errmsg, errflg) + subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ntke, ntkev, imp_physics, imp_physics_gfdl, imp_physics_thompson, & + imp_physics_wsm6, ltaerosol, satmedmf, qgrs, qgrs_water_vapor, qgrs_liquid_cloud, qgrs_ice_cloud, qgrs_ozone, & + qgrs_cloud_droplet_num_conc, qgrs_cloud_ice_num_conc, qgrs_water_aer_num_conc, qgrs_ice_aer_num_conc, qgrs_rain, & + qgrs_snow, qgrs_graupel, qgrs_tke, vdftra, errmsg, errflg) use machine, only : kind_phys implicit none - integer, intent(in) :: im, levs, nvdiff, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - logical, intent(in) :: ltaerosol + integer, intent(in) :: im, levs, nvdiff, ntrac, ntke, ntkev + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 + logical, intent(in) :: ltaerosol, satmedmf real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs), intent(in) :: qgrs_water_vapor, qgrs_liquid_cloud, qgrs_ice_cloud, & qgrs_ozone, qgrs_cloud_droplet_num_conc, qgrs_cloud_ice_num_conc, qgrs_water_aer_num_conc, qgrs_ice_aer_num_conc, & - qgrs_rain, qgrs_snow, qgrs_graupel + qgrs_rain, qgrs_snow, qgrs_graupel, qgrs_tke real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra character(len=*), intent(out) :: errmsg @@ -124,6 +129,15 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, imp_physics, imp_ph enddo enddo endif + + if (satmedmf) then + do k=1,levs + do i=1,im + vdftra(i,k,ntkev) = qgrs_tke(i,k) + enddo + enddo + endif + endif end subroutine GFS_PBL_generic_pre_run @@ -150,6 +164,8 @@ end subroutine GFS_PBL_generic_post_finalize !! | nvdiff | number_of_vertical_diffusion_tracers | number of tracers to diffuse vertically | count | 0 | integer | | in | F | !! | ntrac | number_of_tracers | number of tracers | count | 0 | integer | | in | F | !! | ntoz | index_for_ozone | tracer index for ozone mixing ratio | index | 0 | integer | | in | F | +!! | ntke | index_for_turbulence_kinetic_energy | tracer index for turbulence kinetic energy | index | 0 | integer | | in | F | +!! | ntkev | index_of_TKE_vertical_diffusion_tracer | index of TKE in the vertically diffused tracer array | index | 0 | integer | | in | F | !! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | !! | imp_physics_gfdl | flag_for_gfdl_microphysics_scheme | choice of GFDL microphysics scheme | flag | 0 | integer | | in | F | !! | imp_physics_thompson | flag_for_thompson_microphysics_scheme | choice of Thompson microphysics scheme | flag | 0 | integer | | in | F | @@ -161,6 +177,7 @@ end subroutine GFS_PBL_generic_post_finalize !! | lsidea | flag_idealized_physics | flag for idealized physics | flag | 0 | logical | | in | F | !! | hybedmf | flag_for_hedmf | flag for hybrid edmf pbl scheme (moninedmf) | flag | 0 | logical | | in | F | !! | do_shoc | flag_for_shoc | flag for SHOC | flag | 0 | logical | | in | F | +!! | satmedmf | flag_for_scale_aware_TKE_moist_EDMF_PBL | flag for scale-aware TKE moist EDMF PBL scheme | flag | 0 | logical | | in | F | !! | dvdftra | tendency_of_vertically_diffused_tracer_concentration | updated tendency of the tracers due to vertical diffusion in PBL scheme | kg kg-1 s-1 | 3 | real | kind_phys | 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 | @@ -185,6 +202,7 @@ end subroutine GFS_PBL_generic_post_finalize !! | dqdt_rain | tendency_of_rain_water_mixing_ratio_due_to_model_physics | moist (dry+vapor, no condensates) mixing ratio of rain water tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | !! | dqdt_snow | tendency_of_snow_water_mixing_ratio_due_to_model_physics | moist (dry+vapor, no condensates) mixing ratio of snow water tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | !! | dqdt_graupel | tendency_of_graupel_mixing_ratio_due_to_model_physics | moist (dry+vapor, no condensates) mixing ratio of graupel tendency due to model physics | kg kg-1 s-1 | 2 | real | kind_phys | inout | F | +!! | dqdt_tke | tendency_of_turbulent_kinetic_energy_due_to_model_physics | turbulent kinetic energy tendency due to model physics | J s-1 | 2 | real | kind_phys | inout | F | !! | dusfc_cpl | cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep | cumulative sfc u momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | !! | dvsfc_cpl | cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep | cumulative sfc v momentum flux multiplied by timestep | Pa s | 1 | real | kind_phys | inout | F | !! | dtsfc_cpl | cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep | cumulative sfc sensible heat flux multiplied by timestep | W m-2 s | 1 | real | kind_phys | inout | F | @@ -212,21 +230,24 @@ end subroutine GFS_PBL_generic_post_finalize !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! #endif - subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ntoz, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_wsm6, ltaerosol, cplflx, lssav, ldiag3d, lsidea, hybedmf, do_shoc, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, & - dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu,& - dqdt, dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice_cloud, dqdt_ozone, dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc,& - dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, dqdt_rain, dqdt_snow, dqdt_graupel, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & - dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & - dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & + subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ntoz, ntke, ntkev, & + imp_physics, imp_physics_gfdl, imp_physics_thompson, & + imp_physics_wsm6, ltaerosol, cplflx, lssav, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, & + dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & + dqdt, dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice_cloud, dqdt_ozone, dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & + dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, dqdt_rain, dqdt_snow, dqdt_graupel, dqdt_tke, & + dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & + dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & + dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & dq3dt_ozone, errmsg, errflg) use machine, only: kind_phys implicit none - integer, intent(in) :: im, levs, nvdiff, ntrac, ntoz, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 - logical, intent(in) :: ltaerosol, cplflx, lssav, ldiag3d, lsidea, hybedmf, do_shoc + integer, intent(in) :: im, levs, nvdiff, ntrac, ntoz, ntke, ntkev + integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6 + logical, intent(in) :: ltaerosol, cplflx, lssav, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), dimension(im, levs, nvdiff), intent(in) :: dvdftra @@ -236,7 +257,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ntoz, imp_physics, real(kind=kind_phys), dimension(im, levs, ntrac), intent(inout) :: dqdt real(kind=kind_phys), dimension(im, levs), intent(inout) :: dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice_cloud, dqdt_ozone, & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc, dqdt_rain,& - dqdt_snow, dqdt_graupel, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, dq3dt_ozone + dqdt_snow, dqdt_graupel, dqdt_tke, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, dq3dt_ozone real(kind=kind_phys), dimension(im), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag @@ -303,16 +324,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ntoz, imp_physics, enddo enddo endif - endif ! nvdiff == ntrac -! if (lprnt) then -! write(0,*) ' dusfc1=',dusfc1(ipr),' kdt=',kdt,' lat=',lat -! write(0,*)' dtsfc1=',dtsfc1(ipr) -! write(0,*)' dqsfc1=',dqsfc1(ipr) -! write(0,*)' dtdtc=',(dtdt(ipr,k),k=1,15) -! write(0,*)' dqdtc=',(dqdt(ipr,k,1),k=1,15) -! print *,' dudtm=',dudt(ipr,:) -! endif + if (satmedmf) then + do k=1,levs + do i=1,im + dqdt_tke(i,k) = dvdftra(i,k,ntkev) + enddo + enddo + endif + + endif ! nvdiff == ntrac ! --- ... coupling insertion diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index 87b4f9860..368da00e5 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -32,14 +32,14 @@ end subroutine GFS_rrtmg_post_init !! | 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 | -!! | clouds10 | cloud_optical_depth_weighted | cloud optical depth, weighted | none | 2 | real | kind_phys | in | F | -!! | clouds11 | cloud_optical_depth_layers_678 | cloud optical depth from bands 6,7,8 | none | 2 | real | kind_phys | in | F | +!! | cldtaulw | cloud_optical_depth_layers_at_10mu_band | approx 10mu band layer cloud optical depth | none | 2 | real | kind_phys | in | F | +!! | cldtausw | cloud_optical_depth_layers_at_0.55mu_band | approx .55mu band layer cloud optical depth | none | 2 | real | kind_phys | in | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | !! subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & - cldsa, mtopa, mbota, clouds1, clouds10, clouds11, & + cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, & errmsg, errflg) use machine, only: kind_phys @@ -72,8 +72,8 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & 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), intent(in) :: clouds1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: clouds10 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: clouds11 + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: cldtausw + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: cldtaulw character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -86,6 +86,8 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & errmsg = '' errflg = 0 + if (.not. (Model%lsswr .or. Model%lslwr)) return + !> - 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 @@ -178,9 +180,9 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & ! Anning adds optical depth and emissivity output tem1 = 0. tem2 = 0. - do k=ibtc+kb,itop+kt - tem1 = tem1 + clouds10(i,k) - tem2 = tem2 + clouds11(i,k) + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel + tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel end do Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 7adf06125..15f6da3f9 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -32,6 +32,8 @@ end subroutine GFS_rrtmg_pre_init !! | 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 | +!! | delp | layer_pressure_thickness_for_radiation | layer pressure thickness on radiation levels | hPa | 2 | real | kind_phys | out | F | +!! | dz | layer_thickness_for_radiation | layer thickness on radiation levels | km | 2 | real | kind_phys | out | F | !! | plvl | air_pressure_at_interface_for_radiation_in_hPa | air pressure at vertical interface for radiation calculation | hPa | 2 | real | kind_phys | out | F | !! | plyr | air_pressure_at_layer_for_radiation_in_hPa | air pressure at vertical layer for radiation calculation | hPa | 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 | @@ -66,11 +68,10 @@ end subroutine GFS_rrtmg_pre_init !! | clouds7 | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | micron | 2 | real | kind_phys | out | F | !! | clouds8 | cloud_snow_water_path | cloud snow 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 | -!! | clouds10 | cloud_optical_depth_weighted | cloud optical depth, weighted | none | 2 | real | kind_phys | out | F | -!! | clouds11 | cloud_optical_depth_layers_678 | cloud optical depth from bands 6,7,8 | none | 2 | real | kind_phys | out | F | !! | cldsa | cloud_area_fraction_for_radiation | fraction of clouds for low, middle,high, total and BL | 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 | +!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | out | F | !! | alb1d | surface_albedo_perturbation | surface albedo perturbation | frac | 1 | real | kind_phys | out | F | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | @@ -81,7 +82,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & Radtend, & ! input/output lm, im, lmk, lmp, & ! input - kd, kt, kb, raddt, plvl, plyr, & ! output + kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, & @@ -89,8 +90,8 @@ 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, clouds10, clouds11, & - cldsa, mtopa, mbota, alb1d, errmsg, errflg) + clouds7, clouds8, clouds9, cldsa, & + mtopa, mbota, de_lgth, alb1d, errmsg, errflg) use machine, only: kind_phys use GFS_typedefs, only: GFS_statein_type, & @@ -107,6 +108,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input use physcons, only: eps => con_eps, & & epsm1 => con_epsm1, & & fvirt => con_fvirt & + &, rog => con_rog & &, rocp => con_rocp use radcons, only: itsfc,ltp, lextop, qmin, & qme5, qme6, epsq, prsmin @@ -119,7 +121,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input use module_radiation_clouds, only: NF_CLDS, & ! cld_init & progcld1, progcld3, & & progcld4, progcld5, & - & progclduni, diagcld1 + & progclduni use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & @@ -141,6 +143,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(out) :: kd, kt, kb real(kind=kind_phys), intent(out) :: raddt + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz 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) :: plyr real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: tlvl @@ -178,11 +182,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds7 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds8 real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds9 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds10 - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: clouds11 real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(out) :: cldsa integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota integer, dimension(size(Grid%xlon,1),3), intent(out) :: mtopa + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: alb1d character(len=*), intent(out) :: errmsg @@ -200,9 +203,12 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & - tem2db, cldcov, deltaq, cnvc, cnvw, & + cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db +! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,Model%ncnd) :: ccnd 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 @@ -216,6 +222,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input errmsg = '' errflg = 0 + if (.not. (Model%lsswr .or. Model%lslwr)) return + !--- set commonly used integers me = Model%me NFXR = Model%nfxr @@ -352,10 +360,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif ! end_if_ntoz !> - 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 - + if( Model%lsswr ) then + call coszmn (Grid%xlon,Grid%sinlat, & ! --- inputs + Grid%coslat,Model%solhr, IM, me, & + Radtend%coszen, Radtend%coszdg) ! --- outputs + endif !> - Call getgases(), to set up non-prognostic gas volume mixing !! ratioes (gasvmr). @@ -403,7 +412,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do i = 1, IM tem1d (i) = QME6 tem2da(i,1) = log( plyr(i,1) ) - tem2db(i,1) = 1.0 + tem2db(i,1) = log( max(prsmin, plvl(i,1)) ) + tem2db(i,LMP) = log( plvl(i,LMP) ) tsfa (i) = tlyr(i,LMK) ! sfc layer air temp tlvl(i,1) = tlyr(i,1) tlvl(i,LMP) = tskn(i) @@ -415,6 +425,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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) + delp(i,k1) = plvl(i,k1+1) - plvl(i,k1) enddo enddo @@ -422,6 +433,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do i = 1, IM qlyr(i,lyb) = qlyr(i,lya) tvly(i,lyb) = tvly(i,lya) + delp(i,lyb) = plvl(i,lla) - plvl(i,llb) enddo endif @@ -433,12 +445,27 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo +! --- ... level height and layer thickness (km) + + tem0d = 0.001 * rog + do i = 1, IM + do k = 1, LMK + dz(i,k) = tem0d * (tem2db(i,k+1) - tem2db(i,k)) * tvly(i,k) + enddo + +! hz(i,LMP) = 0.0 +! do k = LMK, 1, -1 +! hz(i,k) = hz(i,k+1) + dz(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) ) + tem2db(i,LMP) = log( max(prsmin, plvl(i,LMP)) ) tsfa (i) = tlyr(i,1) ! sfc layer air temp tlvl(i,1) = tskn(i) tlvl(i,LMP) = tlyr(i,LMK) @@ -449,6 +476,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input 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) + delp(i,k) = plvl(i,k) - plvl(i,k+1) enddo enddo @@ -456,6 +484,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do i = 1, IM qlyr(i,lyb) = qlyr(i,lya) tvly(i,lyb) = tvly(i,lya) + delp(i,lyb) = plvl(i,lla) - plvl(i,llb) enddo endif @@ -467,6 +496,20 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo +! --- ... level height and layer thickness (km) + + tem0d = 0.001 * rog + do i = 1, IM + do k = LMK, 1, -1 + dz(i,k) = tem0d * (tem2db(i,k) - tem2db(i,k+1)) * tvly(i,k) + enddo + +! hz(i,1) = 0.0 +! do k = 1, LMP +! hz(i,k+1) = hz(i,k) + dz(i,k) +! enddo + enddo + endif ! end_if_ivflip !> - Call module_radiation_aerosols::setaer(),to setup aerosols @@ -510,13 +553,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input !! - 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 (ntcw > 0) then ! prognostic cloud schemes +! if (ntcw > 0) then ! prognostic cloud schemes if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist do k=1,LMK @@ -679,19 +719,19 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! or unified cloud and/or with MG microphysics if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni (plyr, plvl, tlyr, tvly, ccnd, Model%ncnd, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, & - IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota) ! --- outputs + call progclduni (plyr, plvl, tlyr, tvly, ccnd, Model%ncnd, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & + IM, LMK, LMP, cldcov, & + effrl, effri, effrr, effrs, Model%effr_in, & + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, & - Sfcprop%slmsk, IM, LMK, LMP, & + Sfcprop%slmsk, dz, delp, IM, LMK, LMP, & Model%uni_cld, Model%lmfshal, & Model%lmfdeep2, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota) ! --- outputs + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif elseif(Model%imp_physics == 98) then ! zhao/moorthi's prognostic cloud+pdfcld @@ -699,9 +739,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input call progcld3 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ccnd(1:IM,1:LMK,1), & cnvw, cnvc, Grid%xlat, Grid%xlon, & - Sfcprop%slmsk,im, lmk, lmp, deltaq, & + Sfcprop%slmsk, dz, delp, im, lmk, lmp, deltaq, & Model%sup, Model%kdt, me, & - clouds, cldsa, mtopa, mbota) ! --- outputs + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs elseif (Model%imp_physics == 11) then ! GFDL cloud scheme @@ -709,21 +749,22 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ccnd(1:IM,1:LMK,1), cnvw, cnvc, & Grid%xlat, Grid%xlon, Sfcprop%slmsk, & - cldcov, im, lmk, lmp, & - clouds, cldsa, mtopa, mbota) ! --- outputs + cldcov, dz, delp, im, lmk, lmp, & + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else call progclduni (plyr, plvl, tlyr, tvly, ccnd, Model%ncnd, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, & + Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & IM, LMK, LMP, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota) ! --- outputs -! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs +! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ! tracer1, Grid%xlat, Grid%xlon, Sfcprop%slmsk, & +! dz, delp, & ! ntrac-1, Model%ntcw-1,Model%ntiw-1,Model%ntrw-1,& ! Model%ntsw-1,Model%ntgl-1,Model%ntclamt-1, & ! im, lmk, lmp, & -! clouds, cldsa, mtopa, mbota) ! --- outputs +! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then ! Thompson / WSM6 cloud micrphysics scheme @@ -734,41 +775,19 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,3) = 250. endif - call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - clouds,cldsa,mtopa,mbota) ! --- outputs + call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs endif ! end if_imp_physics - else ! diagnostic cloud scheme - - do i=1,im - cvt1(i) = 0.01 * Cldprop%cvt(i) - cvb1(i) = 0.01 * Cldprop%cvb(i) - enddo - - do k = 1, LM - k1 = k + kd - vvel(1:im,k1) = 0.01 * Statein%vvl(1:im,k) - enddo - if (lextop) then - vvel(1:im,lyb) = vvel(1:im,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 +! endif ! end_if_ntcw ! CCPP do k = 1, LMK @@ -782,8 +801,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input clouds7(i,k) = clouds(i,k,7) clouds8(i,k) = clouds(i,k,8) clouds9(i,k) = clouds(i,k,9) - clouds10(i,k) = clouds(i,k,10) - clouds11(i,k) = clouds(i,k,11) enddo enddo diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 0a537f068..9c99076cc 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -3,10 +3,12 @@ module GFS_rrtmg_setup use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& - iaermdl, laswflg, lalwflg, lavoflg, icldflg, & - iovrsw , iovrlw , lcrick , lcnorm , lnoprec, & - ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & - kind_phys +! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & + & iaermdl, icldflg, & + & iovrsw , iovrlw , lcrick , lcnorm , lnoprec, & + & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & + & iswcliq, & + & kind_phys use radcons, only: ltp, lextop @@ -58,6 +60,7 @@ module GFS_rrtmg_setup !! | iovr_lw | flag_for_max-random_overlap_clouds_for_longwave_radiation | lw: max-random overlap clouds | flag | 0 | integer | | in | F | !! | isubc_sw | flag_for_sw_clouds_without_sub-grid_approximation | flag for sw clouds without sub-grid approximation | flag | 0 | integer | | in | F | !! | isubc_lw | flag_for_lw_clouds_without_sub-grid_approximation | flag for lw clouds without sub-grid approximation | flag | 0 | integer | | in | F | +!! | icliq_sw | flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation | sw optical property for liquid clouds | flag | 0 | integer | | in | F | !! | crick_proof | flag_for_CRICK-proof_cloud_water | flag for CRICK-Proof cloud water | flag | 0 | logical | | in | F | !! | ccnorm | flag_for_cloud_condensate_normalized_by_cloud_cover | flag for cloud condensate normalized by cloud cover | flag | 0 | logical | | in | F | !! | imp_physics | flag_for_microphysics_scheme | choice of microphysics scheme | flag | 0 | integer | | in | F | @@ -75,20 +78,120 @@ module GFS_rrtmg_setup subroutine GFS_rrtmg_setup_init ( & si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, num_p2d, & num_p3d, npdf3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & - crick_proof, ccnorm, & + icliq_sw, crick_proof, ccnorm, & imp_physics, & norad_precip, idate, iflip, & im, faerlw, faersw, aerodp, & ! for consistency checks me, errmsg, errflg) - +! ================= subprogram documentation block ================ ! +! ! +! subprogram: GFS_rrtmg_setup_init - a subprogram to initialize radiation ! +! ! +! usage: call GFS_rrtmg_setup_init ! +! ! +! attributes: ! +! language: fortran 90 ! +! ! +! program history: ! +! mar 2012 - yu-tai hou create the program to initialize fixed ! +! control variables for radiaion processes. this ! +! subroutine is called at the start of model run. ! +! nov 2012 - yu-tai hou modified control parameter through ! +! module 'physparam'. ! +! mar 2014 - sarah lu iaermdl is determined from iaer ! +! jul 2014 - s moorthi add npdf3d for pdf clouds ! +! ! +! ==================== defination of variables ==================== ! +! ! +! input parameters: ! +! si : model vertical sigma interface or equivalence ! +! levr : number of model vertical layers ! +! ictm :=yyyy#, external data 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. ! +! isol := 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 data tabl! +! = 2: use noaa ann-mean tsi tbl tim-scale data tabl! +! = 3: use cmip5 ann-mean tsi tbl tim-scale data tbl! +! = 4: use cmip5 mon-mean tsi tbl tim-scale data tbl! +! ico2 :=0: use prescribed global mean co2 (old oper) ! +! =1: use observed co2 annual mean value only ! +! =2: use obs co2 monthly data with 2-d variation ! +! iaer : 4-digit aerosol flag (dabc for aermdl,volc,lw,sw)! +! d: =0 or none, opac-climatology aerosol scheme ! +! =1 use gocart climatology aerosol scheme ! +! =2 use gocart progostic aerosol scheme ! +! a: =0 use background stratospheric aerosol ! +! =1 incl stratospheric vocanic aeros ! +! b: =0 no topospheric aerosol in lw radiation ! +! =1 include tropspheric aerosols for lw ! +! c: =0 no topospheric aerosol in sw radiation ! +! =1 include tropspheric aerosols for sw ! +! ialb : control flag for surface albedo schemes ! +! =0: climatology, based on surface veg types ! +! =1: modis retrieval based surface albedo scheme ! +! iems : ab 2-digit control flag ! +! a: =0 set sfc air/ground t same for lw radiation ! +! =1 set sfc air/ground t diff for lw radiation ! +! b: =0 use fixed sfc emissivity=1.0 (black-body) ! +! =1 use varying climtology sfc emiss (veg based)! +! =2 future development (not yet) ! +! ntcw :=0 no cloud condensate calculated ! +! >0 array index location for cloud condensate ! +! num_p3d :=3: ferrier's microphysics cloud scheme ! +! =4: zhao/carr/sundqvist microphysics cloud ! +! npdf3d =0 no pdf clouds ! +! =3 (when num_p3d=4) pdf clouds with zhao/carr/ ! +! sundqvist scheme ! +! ntoz : ozone data control flag ! +! =0: use climatological ozone profile ! +! >0: use interactive ozone profile ! +! icliq_sw : sw optical property for liquid clouds ! +! =0:input cld opt depth, ignoring iswcice setting ! +! =1:cloud optical property scheme based on Hu and ! +! Stamnes(1993) \cite hu_and_stamnes_1993 method ! +! =2:cloud optical property scheme based on Hu and ! +! Stamnes(1993) -updated ! +! iovr_sw/iovr_lw : control flag for cloud overlap (sw/lw rad) ! +! =0: random overlapping clouds ! +! =1: max/ran overlapping clouds ! +! =2: maximum overlap clouds (mcica only) ! +! =3: decorrelation-length overlap (mcica only) ! +! isubc_sw/isubc_lw: sub-column cloud approx control flag (sw/lw rad) ! +! =0: with out sub-column cloud approximation ! +! =1: mcica sub-col approx. prescribed random seed ! +! =2: mcica sub-col approx. provided random seed ! +! crick_proof : control flag for eliminating CRICK ! +! ccnorm : control flag for in-cloud condensate mixing ratio! +! norad_precip : control flag for not using precip in radiation ! +! idate(4) : ncep absolute date and time of initial condition ! +! (hour, month, day, year) ! +! iflip : control flag for direction of vertical index ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! me : print control flag ! +! ! +! subroutines called: radinit ! +! ! +! =================================================================== ! +! use module_radsw_parameters, only: NBDSW use module_radlw_parameters, only: NBDLW use module_radiation_aerosols,only: NF_AELW, NF_AESW, NSPC1 use module_radiation_clouds, only: NF_CLDS use module_radiation_gases, only: NF_VGAS use module_radiation_surface, only: NF_ALBD - ! DH* ? use ozne_def, only: levozp, oz_coeff, oz_pres - ! DH* ? use h2o_def, only: levh2o, h2o_coeff implicit none @@ -110,6 +213,7 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: iovr_lw integer, intent(in) :: isubc_sw integer, intent(in) :: isubc_lw + integer, intent(in) :: icliq_sw logical, intent(in) :: crick_proof logical, intent(in) :: ccnorm integer, intent(in) :: imp_physics @@ -126,8 +230,6 @@ subroutine GFS_rrtmg_setup_init ( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! local variables - integer :: icld ! For consistency checks real(kind_phys), dimension(im,levr+ltp,NBDLW,NF_AELW) :: faerlw_check real(kind_phys), dimension(im,levr+ltp,NBDSW,NF_AESW) :: faersw_check @@ -184,20 +286,19 @@ subroutine GFS_rrtmg_setup_init ( & else iaerflg = mod(iaer, 1000) endif - laswflg= (mod(iaerflg,10) > 0) ! control flag for sw tropospheric aerosol - lalwflg= (mod(iaerflg/10,10) > 0) ! control flag for lw tropospheric aerosol - lavoflg= (iaerflg >= 100) ! control flag for stratospheric volcanic aeros iaermdl = iaer/1000 ! control flag for aerosol scheme selection - if ( iaermdl < 0 .or. iaermdl > 2) then + if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then print *, ' Error -- IAER flag is incorrect, Abort' stop 7777 endif - if ( ntcw > 0 ) then +! if ( ntcw > 0 ) then icldflg = 1 ! prognostic cloud optical prop scheme - else - icldflg = 0 ! diagnostic cloud optical prop scheme - endif +! else +! icldflg = 0 ! no support for diag cloud opt prop scheme +! endif + + iswcliq = icliq_sw ! optical property for liquid clouds for sw iovrsw = iovr_sw ! cloud overlapping control flag for sw iovrlw = iovr_lw ! cloud overlapping control flag for lw @@ -226,7 +327,8 @@ subroutine GFS_rrtmg_setup_init ( & & ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr_sw=',iovr_sw, & & ' iovr_lw=',iovr_lw,' isubc_sw=',isubc_sw, & - & ' isubc_lw=',isubc_lw,' iflip=',iflip,' me=',me + & ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & + & ' iflip=',iflip,' me=',me print *,' crick_proof=',crick_proof, & & ' ccnorm=',ccnorm,' norad_precip=',norad_precip endif diff --git a/physics/cldwat2m_micro.F b/physics/cldwat2m_micro.F index 9ec871124..4f5f2d92c 100644 --- a/physics/cldwat2m_micro.F +++ b/physics/cldwat2m_micro.F @@ -2072,7 +2072,7 @@ subroutine mmicro_pcond ( lchnk, ncol, deltatin, tn, ttend, if (.false.) then vaux = ts_auto_ice * 10.0_r8 - + nprci(k) = (niic(i, k)/vaux)*exp(-lami(k)*dcs) tx1 = one / lami(k) tx2 = tx1 * tx1 @@ -3177,7 +3177,7 @@ subroutine mmicro_pcond ( lchnk, ncol, deltatin, tn, ttend, tx2 = 9.1_r8*rhof(i,k) unr(k) = min(tx1*cons4, tx2) umr(k) = min(tx1*(cons5/6._r8),tx2) - + else lamr(k) = zero n0r(k) = zero diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index 7cf7b6ffa..255f3991b 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -437,7 +437,7 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! ! output arguments of CS_CUMLUS ! - real(r8), dimension(IM,KMAX,nctp) :: vverti + real(r8), dimension(IM,KMAX,nctp) :: vverti real(r8) GTT(IJSDIM,KMAX) ! temperature tendency [K/s] real(r8) GTQ(IJSDIM,KMAX,NTR) ! tracer tendency [kg/kg/s] @@ -586,7 +586,8 @@ subroutine cs_conv_run(IM , IJSDIM , KMAX , ntracp1 , NN, & ! !*************************************************************************************** call CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions - otspt(1,1), otspt(1,2), lprnt, ipr,& + otspt(1:ntr,1), otspt(1:ntr,2), & + lprnt , ipr , & GTT , GTQ , GTU , GTV , & ! output dt_mf , & ! output GTPRP , GSNWP , ud_mf , & ! output @@ -1177,6 +1178,10 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !! CUMUP computes In-cloud Properties +! DH* GNU crashes - check all arguments to CUMUP for their dimensions +! before and after CUMUP (i.e. here), and inside the routine, in +! particular: gctm, gcqm, gcwm, gchm, gcwt, gclm, gcim,gctrm +! also, inside, check that no reads/writes out of bounds occur *DH CALL CUMUP(IJSDIM, KMAX, NTR, ntrq, & !DD dimensions ACWF , & ! output GCLZ , GCIZ , GPRCIZ , GSNWIZ, & ! output @@ -2151,15 +2156,10 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(r8) :: esat, tem ! REAL(r8) :: esat, tem, rhs_h, rhs_q ! -! [INTERNAL FUNC] -! REAL(r8) FPREC ! precipitation ratio in condensate -! REAL(r8) FRICE ! ice ratio in cloud water REAL(r8) Z ! altitude REAL(r8) ZH ! scale height REAL(r8) T ! temperature ! -! FPREC(Z,ZH) = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) -! FRICE(T) = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) ! ! Note: iteration is not made to diagnose cloud ice for simplicity ! diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 4b5b9c402..58e5e27cd 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -6,7 +6,6 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) USE PHYSCONS, only: PI => con_PI USE GFS_typedefs, only: GFS_control_type, GFS_grid_type, & GFS_sfcprop_type, GFS_cldprop_type - use module_nst_water_prop, only: get_dtzm_point implicit none integer, intent(in) :: nblks @@ -52,7 +51,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) STCFC1 (Model%nx*Model%ny*Model%lsoil), & SLCFC1 (Model%nx*Model%ny*Model%lsoil) - real(kind=kind_phys) :: sig1t, pifac, zsea1, zsea2, dtzm + real(kind=kind_phys) :: sig1t, pifac integer :: npts, len, nb, ix, ls, ios logical :: exists ! @@ -74,7 +73,11 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) OROG (len) = Sfcprop(nb)%oro (ix) OROG_UF (len) = Sfcprop(nb)%oro_uf (ix) SLIFCS (len) = Sfcprop(nb)%slmsk (ix) + if ( Model%nstf_name(1) > 0 ) then + TSFFCS(len) = Sfcprop(nb)%tref (ix) + else TSFFCS (len) = Sfcprop(nb)%tsfc (ix) + endif SNOFCS (len) = Sfcprop(nb)%weasd (ix) ZORFCS (len) = Sfcprop(nb)%zorl (ix) TG3FCS (len) = Sfcprop(nb)%tg3 (ix) @@ -158,19 +161,15 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) close (Model%nlunit) #endif - zsea1 = 0.001*real(Model%nstf_name(4)) - zsea2 = 0.001*real(Model%nstf_name(5)) len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) + if ( Model%nstf_name(1) > 0 ) then + Sfcprop(nb)%tref(ix) = TSFFCS (len) + else Sfcprop(nb)%tsfc (ix) = TSFFCS (len) - if ( Sfcprop(nb)%slmsk(ix) == 0.0 .and. Model%nstf_name(1) > 0 ) then - call get_dtzm_point(Sfcprop(nb)%xt(ix), Sfcprop(nb)%xz(ix), & - Sfcprop(nb)%dt_cool(ix), Sfcprop(nb)%z_c(ix), & - zsea1, zsea2, dtzm) - Sfcprop(nb)%tref(ix) = Sfcprop(nb)%tsfc(ix)-dtzm endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) diff --git a/physics/gwdps.f b/physics/gwdps.f index 48d2548a8..4cfe43608 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -477,8 +477,8 @@ subroutine gwdps_run( & real(kind=kind_phys) wk(IM) real(kind=kind_phys) bnv2lm(IM,KM),PE(IM),EK(IM),ZBK(IM),UP(IM) real(kind=kind_phys) DB(IM,KM),ANG(IM,KM),UDS(IM,KM) - real(kind=kind_phys) ZLEN, DBTMP, R, PHIANG, CDmb, DBIM - real(kind=kind_phys) ENG0, ENG1 + real(kind=kind_phys) ZLEN, DBTMP, R, PHIANG, CDmb, DBIM, ZR + real(kind=kind_phys) ENG0, ENG1, COSANG2, SINANG2 ! ! Some constants ! @@ -842,8 +842,16 @@ subroutine gwdps_run( & !! where \f$\psi\f$, which is derived from THETA, is the angle between !! the incident flow direction and the normal ridge direcion. !! \f$\gamma\f$ is the orographic anisotropy (GAMMA). - R = (cos(ANG(I,K))**2 + GAMMA(J) * sin(ANG(I,K))**2) / - & (gamma(J) * cos(ANG(I,K))**2 + sin(ANG(I,K))**2) + COSANG2 = cos(ANG(I,K))*cos(ANG(I,K)) + SINANG2 = sin(ANG(I,K))*sin(ANG(I,K)) + if ( abs(GAMMA(J) * COSANG2 + SINANG2) + & .lt. 1.e-06 ) then + ZR = 2.0 + else + R = (COSANG2 + GAMMA(J) * SINANG2) / + & (GAMMA(J) * COSANG2 + SINANG2) + ZR = MAX( 2. - 1. / R, 0. ) + endif ! --- (negitive of DB -- see sign at tendency) !> - In each model layer below the dividing streamlines, a drag from !! the blocked flow is exerted by the obstacle on the large scale flow. @@ -855,8 +863,7 @@ subroutine gwdps_run( & !! where \f$C_{d}\f$ is a specified constant, \f$\sigma\f$ is the !! orographic slope. - DBTMP = 0.25 * CDmb * - & MAX( 2. - 1. / R, 0. ) * sigma(J) * + DBTMP = 0.25 * CDmb * ZR * sigma(J) * & MAX(cos(ANG(I,K)), gamma(J)*sin(ANG(I,K))) * & ZLEN / hprime(J) DB(I,K) = DBTMP * UDS(I,K) @@ -872,6 +879,7 @@ subroutine gwdps_run( & ! if(lprnt) print *,' @K=1,ZLEN,DBTMP=',K,ZLEN,DBTMP endif ENDDO +! !............................. !............................. ! end mtn blocking section diff --git a/physics/physparam.f b/physics/physparam.f index d9bb61785..f67d9255b 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -73,6 +73,7 @@ module physparam !!\n =0:input cld opt depth, ignoring iswcice setting !!\n =1:cloud optical property scheme based on Hu and Stamnes(1993) \cite !! hu_and_stamnes_1993 method +!!\n =2:cloud optical property scheme based on Hu and Stamnes(1993) -updated integer,save :: iswcliq = 1 !> SW optical property for ice clouds (only iswcliq>0) @@ -162,8 +163,10 @@ module physparam !!\n =0:seasonal global distributed OPAC aerosol climatology !!\n =1:monthly global distributed GOCART aerosol climatology !!\n =2: GOCART prognostic aerosol model +!!\n =5: OPAC climatoloy with new band mapping !!\n Opr GFS=0; Opr CFS=n/a integer, save :: iaermdl = 0 + !> aerosol effect control flag !!\n 3-digit flag 'abc': !!\n a-stratospheric volcanic aerols @@ -172,19 +175,7 @@ module physparam !!\n =0:aerosol effect is not included; =1:aerosol effect is included !!\n Opr GFS/CFS =111; see IAER in run scripts integer, save :: iaerflg = 0 -!> LW aerosols effect control flag -!!\n =.true.:aerosol effect is included in LW radiation -!!\n =.false.:aerosol effect is not included in LW radiation - logical, save :: lalwflg = .true. -!> SW aerosols effect control flag -!!\n =.true.:aerosol effect is included in SW radiation -!!\n =.false.:aerosol effect is not included in SW radiation - logical, save :: laswflg = .true. -!> stratospheric volcanic aerosol effect flag -!!\n =.true.:historical events of stratosphere volcanic aerosol effect -!! is included radiation (limited by data availability) -!!\n =.false.:volcanic aerosol effect is not included in radiation - logical, save :: lavoflg = .true. + !> external aerosols data file: aerosol.dat character, save :: aeros_file*26 ! data aeros_file / 'climaeropac_global.txt ' / @@ -200,6 +191,7 @@ module physparam !!\n =2:monthly 15 degree horizontal resolution from observations !!\n Opr GFS/CFS=2; see ICO2 in run scripts integer, save :: ico2flg = 0 + !> controls external data at initial time and data usage during !! forecast time !!\n =-2:as in 0,but superimpose with seasonal climatology cycle @@ -210,11 +202,13 @@ module physparam !!\n =yyyy1:use yyyy year of data, extrapolate when necessary !!\n Opr GFS/CFS=1; see ICTM in run scripts integer, save :: ictmflg = 0 + !> ozone data source control flag !!\n =0:use seasonal climatology ozone data !!\n >0:use prognostic ozone scheme (also depend on other model control !! variable at initial time) integer, save :: ioznflg = 1 + !> external co2 2d monthly obsv data table: co2historicaldata_2004.txt character, save :: co2dat_file*26 !> external co2 global annual mean data tb: co2historicaldata_glob.txt @@ -236,21 +230,35 @@ module physparam !!\n =0:use diagnostic cloud scheme for cloud cover and mean optical properties !!\n =1:use prognostic cloud scheme for cloud cover and cloud properties integer, save :: icldflg = 1 -!> cloud micorphysics scheme control flag -!!\n =1:modified Zhao/Carr/Sundqvist scheme (Moorthi, 2001) -!!\n =2:Ferrier microphysics scheme (Ferrier et al. 2002) -!!\n =3:as in 1 but with pdf method defined cloud cover -! integer, save :: icmphys = 1 + !> cloud overlapping control flag for SW !!\n =0:use random cloud overlapping method !!\n =1:use maximum-random cloud overlapping method +!!\n =2:use maximum cloud overlapping method +!!\n =3:use decorrelation length overlapping method !!\n Opr GFS/CFS=1; see IOVR_SW in run scripts integer, save :: iovrsw = 1 !> cloud overlapping control flag for LW !!\n =0:use random cloud overlapping method !!\n =1:use maximum-random cloud overlapping method +!!\n =2:use maximum cloud overlapping method +!!\n =3:use decorrelation length overlapping method !!\n Opr GFS/CFS=1; see IOVR_LW in run scripts integer, save :: iovrlw = 1 + +!> sub-column cloud approx flag in SW radiation +!!\n =0:no McICA approximation in SW radiation +!!\n =1:use McICA with precribed permutation seeds (test mode) +!!\n =2:use McICA with randomly generated permutation seeds +!!\n Opr GFS/CFS=2; see ISUBC_SW in run scripts + integer, save :: isubcsw = 0 +!> sub-column cloud approx flag in LW radiation +!!\n =0:no McICA approximation in LW radiation +!!\n =1:use McICA with prescribed permutation seeds (test mode) +!!\n =2:use McICA with randomly generatedo +!!\n Opr GFS/CFS=2; see ISUBC_LW in run scripts + integer, save :: isubclw = 0 + !> eliminating CRICK control flag logical, save :: lcrick =.false. !> in-cld condensate control flag @@ -268,6 +276,7 @@ module physparam !!\n =0:vegetation type based climatological albedo scheme !!\n =1:seasonal albedo derived from MODIS measurements integer, save :: ialbflg = 0 + !> surface emissivity scheme control flag !!\n =0:black-body surface emissivity(=1.0) !!\n =1:vegetation type based climatology emissivity(<1.0) @@ -284,18 +293,7 @@ module physparam !> vertical profile indexing flag integer, save :: ivflip = 1 -!> sub-column cloud approx flag in SW radiation -!!\n =0:no McICA approximation in SW radiation -!!\n =1:use McICA with precribed permutation seeds (test mode) -!!\n =2:use McICA with randomly generated permutation seeds -!!\n Opr GFS/CFS=2; see ISUBC_SW in run scripts - integer, save :: isubcsw = 0 -!> sub-column cloud approx flag in LW radiation -!!\n =0:no McICA approximation in LW radiation -!!\n =1:use McICA with prescribed permutation seeds (test mode) -!!\n =2:use McICA with randomly generated -!!\n Opr GFS/CFS=2; see ISUBC_LW in run scripts - integer, save :: isubclw = 0 + !> initial permutaion seed for mcica radiation integer, save :: ipsd0 = 0 integer, save :: ipsdlim = 1e8 diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 9c42a6992..34b50ce21 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -97,6 +97,9 @@ ! Aug 2013 --- s. moorthi - merge sarah's gocart changes with! ! yutai's changes ! ! 13Feb2014 --- Sarah lu - compute aod at 550nm ! +! jun 2018 --- h-m lin and y-t hou updated spectral band ! +! mapping method for aerosol optical properties. controled by ! +! internal variable lmap_new through namelist variable iaer. ! ! ! ! references for opac climatological aerosols: ! ! hou et al. 2002 (ncep office note 441) ! @@ -154,9 +157,8 @@ !! radiation computations. module module_radiation_aerosols ! - use physparam,only : iaermdl, iaerflg, lavoflg, lalwflg, laswflg, & - & lalw1bd, aeros_file, ivflip, kind_phys & - &, kind_io4, kind_io8 + use physparam,only : iaermdl, iaerflg, lalw1bd, aeros_file, & + & ivflip, kind_phys, kind_io4, kind_io8 use physcons, only : con_pi, con_rd, con_g, con_t0c, con_c, & & con_boltz, con_plnk, con_amd @@ -202,6 +204,21 @@ module module_radiation_aerosols integer, save :: NLWBND = NBDLW ! total number of bands for sw+lw aerosols integer, save :: NSWLWBD = NBDSW+NBDLW +! LW aerosols effect control flag +! =.true.:aerosol effect is included in LW radiation +! =.false.:aerosol effect is not included in LW radiation + logical, save :: lalwflg = .true. +! SW aerosols effect control flag +! =.true.:aerosol effect is included in SW radiation +! =.false.:aerosol effect is not included in SW radiation + logical, save :: laswflg = .true. +! stratospheric volcanic aerosol effect flag +! =.true.:historical events of stratosphere volcanic aerosol effect +! is included radiation (limited by data availability) +! =.false.:volcanic aerosol effect is not included in radiation + logical, save :: lavoflg = .true. + + logical, save :: lmap_new = .true. ! use new mapping method (set in aer_init) ! --------------------------------------------------------------------- ! ! section-1 : module variables for spectral band interpolation ! @@ -270,6 +287,8 @@ module module_radiation_aerosols & 6.52736E-3, 4.99410E-3, 4.39350E-3, 2.21676E-3, 1.33812E-3, & & 1.12320E-3, 5.59000E-4, 3.60000E-4, 2.98080E-4, 7.46294E-5 / + real (kind=kind_phys), dimension(NBDSW), save :: wvn_sw1, wvn_sw2 + real (kind=kind_phys), dimension(NBDLW), save :: wvn_lw1, wvn_lw2 ! --------------------------------------------------------------------- ! ! section-2 : module variables for stratospheric volcanic aerosols ! ! from historical data (sato et al. 1993) ! @@ -694,6 +713,7 @@ subroutine aer_init & ! external module variables: (in physparam) ! ! iaermdl - tropospheric aerosol model scheme flag ! ! =0 opac-clim; =1 gocart-clim, =2 gocart-prognostic ! +! =5 opac-clim new spectral mapping ! ! lalwflg - logical lw aerosols effect control flag ! ! =t compute lw aerosol optical prop ! ! laswflg - logical sw aerosols effect control flag ! @@ -734,6 +754,10 @@ subroutine aer_init & kyrsav = 1 kmonsav = 1 + laswflg= (mod(iaerflg,10) > 0) ! control flag for sw tropospheric aerosol + lalwflg= (mod(iaerflg/10,10) > 0) ! control flag for lw tropospheric aerosol + lavoflg= (iaerflg >= 100) ! control flag for stratospheric volcanic aeros + !> -# Call wrt_aerlog() to write aerosol parameter configuration to output logs. if ( me == 0 ) then @@ -768,6 +792,23 @@ subroutine aer_init & NSWLWBD = NSWBND + NLWBND + wvn_sw1(:) = wvnsw1(:) + wvn_sw2(:) = wvnsw2(:) + wvn_lw1(:) = wvnlw1(:) + wvn_lw2(:) = wvnlw2(:) + +! note: for result consistency, the defalt opac-clim aeros setting still use +! old spectral band mapping. use iaermdl=5 to use new mapping method + + if ( iaermdl == 0 ) then ! opac-climatology scheme + lmap_new = .false. + + wvn_sw1(2:NBDSW-1) = wvn_sw1(2:NBDSW-1) + 1 + wvn_lw1(2:NBDLW) = wvn_lw1(2:NBDLW) + 1 + else + lmap_new = .true. + endif + if ( iaerflg /= 100 ) then !> -# Call set_spectrum() to set up spectral one wavenumber solar/IR @@ -779,7 +820,7 @@ subroutine aer_init & !> -# Call clim_aerinit() to invoke tropospheric aerosol initialization. - if ( iaermdl == 0 ) then ! opac-climatology scheme + if ( iaermdl==0 .or. iaermdl==5 ) then ! opac-climatology scheme call clim_aerinit & ! --- inputs: @@ -842,7 +883,7 @@ subroutine wrt_aerlog ! ! ! external module variables: (in physparam) ! ! iaermdl - aerosol scheme flag: 0:opac-clm; 1:gocart-clim; ! -! 2:gocart-prog ! +! 2:gocart-prog; 5:opac-clim+new mapping ! ! iaerflg - aerosol effect control flag: 3-digits (volc,lw,sw) ! ! lalwflg - toposphere lw aerosol effect: =f:no; =t:yes ! ! laswflg - toposphere sw aerosol effect: =f:no; =t:yes ! @@ -865,7 +906,7 @@ subroutine wrt_aerlog ! print *, VTAGAER ! print out version tag - if ( iaermdl == 0 ) then + if ( iaermdl==0 .or. iaermdl==5 ) then print *,' - Using OPAC-seasonal climatology for tropospheric', & & ' aerosol effect' elseif ( iaermdl == 1 ) then @@ -1255,9 +1296,9 @@ subroutine set_aercoef ! --- locals: integer, dimension(NAERBND) :: iendwv - integer :: i, j, k, m, mb, ib, ii, id, iw, iw1, iw2 + integer :: i, j, k, m, mb, ib, ii, id, iw, iw1, iw2, ik, ibs, ibe - real (kind=kind_phys) :: sumsol, sumir + real (kind=kind_phys) :: sumsol, sumir, fac, tmp, wvs, wve logical :: file_exist character :: cline*80 @@ -1380,23 +1421,54 @@ subroutine set_aercoef enddo enddo -!$omp parallel do private(ib,mb,ii,iw1,iw2,iw,nv_aod,sumsol) - do ib = 1, NSWBND + ibs = 1 + ibe = 1 + wvs = wvn_sw1(1) + wve = wvn_sw1(1) + nv_aod = 1 + do ib = 2, NSWBND mb = ib + NSWSTR - 1 - ii = 1 - iw1 = nint(wvnsw1(mb)) - iw2 = nint(wvnsw2(mb)) - - if ( wvnsw2(mb) >= wvn550 .and. wvn550 >= wvnsw1(mb) ) then + if ( wvn_sw2(mb) >= wvn550 .and. wvn550 >= wvn_sw1(mb) ) then nv_aod = ib ! sw band number covering 550nm wavelenth endif + if ( wvn_sw1(mb) < wvs ) then + wvs = wvn_sw1(mb) + ibs = ib + endif + if ( wvn_sw1(mb) > wve ) then + wve = wvn_sw1(mb) + ibe = ib + endif + enddo + +!$omp parallel do private(ib,mb,ii,iw1,iw2,iw,sumsol,fac,tmp,ibs,ibe) + do ib = 1, NSWBND + mb = ib + NSWSTR - 1 + ii = 1 + iw1 = nint(wvn_sw1(mb)) + iw2 = nint(wvn_sw2(mb)) + Lab_swdowhile : do while ( iw1 > iendwv(ii) ) if ( ii == NAERBND ) exit Lab_swdowhile ii = ii + 1 enddo Lab_swdowhile + if ( lmap_new ) then + if (ib == ibs) then sumsol = f_zero + else + sumsol = -0.5 * solfwv(iw1) + endif + if (ib == ibe) then + fac = f_zero + else + fac = -0.5 + endif + solbnd(ib) = sumsol + else + sumsol = f_zero + endif nv1(ib) = ii do iw = iw1, iw2 @@ -1417,6 +1489,12 @@ subroutine set_aercoef solwaer(ib,ii) = sumsol endif + if ( lmap_new ) then + tmp = fac * solfwv(iw2) + solwaer(ib,ii) = solwaer(ib,ii) + tmp + solbnd(ib) = solbnd(ib) + tmp + endif + nv2(ib) = ii ! frcbnd(ib) = solbnd(ib) / soltot enddo ! end do_ib_block for sw @@ -1434,7 +1512,25 @@ subroutine set_aercoef enddo enddo -!$omp parallel do private(ib,ii,iw1,iw2,iw,mb,sumir) + ibs = 1 + ibe = 1 + if (NLWBND > 1 ) then + wvs = wvn_lw1(1) + wve = wvn_lw1(1) + do ib = 2, NLWBND + mb = ib + NLWSTR - 1 + if ( wvn_lw1(mb) < wvs ) then + wvs = wvn_lw1(mb) + ibs = ib + endif + if ( wvn_lw1(mb) > wve ) then + wve = wvn_lw1(mb) + ibe = ib + endif + enddo + endif + +!$omp parallel do private(ib,ii,iw1,iw2,iw,mb,sumir,fac,tmp,ibs,ibe) do ib = 1, NLWBND ii = 1 if ( NLWBND == 1 ) then @@ -1443,8 +1539,8 @@ subroutine set_aercoef iw2 = 2500 ! corresponding 4 mu else mb = ib + NLWSTR - 1 - iw1 = nint(wvnlw1(mb)) - iw2 = nint(wvnlw2(mb)) + iw1 = nint(wvn_lw1(mb)) + iw2 = nint(wvn_lw2(mb)) endif Lab_lwdowhile : do while ( iw1 > iendwv(ii) ) @@ -1452,7 +1548,21 @@ subroutine set_aercoef ii = ii + 1 enddo Lab_lwdowhile + if ( lmap_new ) then + if (ib == ibs) then sumir = f_zero + else + sumir = -0.5 * eirfwv(iw1) + endif + if (ib == ibe) then + fac = f_zero + else + fac = -0.5 + endif + eirbnd(ib) = sumir + else + sumir = f_zero + endif nr1(ib) = ii do iw = iw1, iw2 @@ -1473,6 +1583,12 @@ subroutine set_aercoef eirwaer(ib,ii) = sumir endif + if ( lmap_new ) then + tmp = fac * eirfwv(iw2) + eirwaer(ib,ii) = eirwaer(ib,ii) + tmp + eirbnd(ib) = eirbnd(ib) + tmp + endif + nr2(ib) = ii enddo ! end do_ib_block for lw endif ! end if_lalwflg_block @@ -2397,7 +2513,7 @@ subroutine setaer & !SARAH ! if ( iaerflg == 1 ) then ! use opac aerosol climatology - if ( iaermdl == 0 ) then ! use opac aerosol climatology + if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology call aer_property & ! --- inputs: @@ -2547,14 +2663,14 @@ subroutine setaer & do m = 1, NBDSW mb = NSWSTR + m - 1 - if ( wvnsw1(mb) > 20000 ) then ! range of wvlth < 0.5mu + if ( wvn_sw1(mb) > 20000 ) then ! range of wvlth < 0.5mu tmp2 = 0.74 - elseif ( wvnsw2(mb) < 20000 ) then ! range of wvlth > 0.5mu + elseif ( wvn_sw2(mb) < 20000 ) then ! range of wvlth > 0.5mu tmp2 = 1.14 else ! range of wvlth in btwn tmp2 = 0.94 endif - tmp1 = (0.275e-4 * (wvnsw2(mb)+wvnsw1(mb))) ** tmp2 + tmp1 = (0.275e-4 * (wvn_sw2(mb)+wvn_sw1(mb))) ** tmp2 do i = 1, IMAX kh = kcuth(i) @@ -2609,7 +2725,7 @@ subroutine setaer & else do m = 1, NBDLW - tmp1 = (0.275e-4 * (wvnlw2(m) + wvnlw1(m))) ** 1.2 + tmp1 = (0.275e-4 * (wvn_lw2(m) + wvn_lw1(m))) ** 1.2 do i = 1, IMAX kh = kcuth(i) @@ -2665,14 +2781,14 @@ subroutine setaer & do m = 1, NBDSW mb = NSWSTR + m - 1 - if ( wvnsw1(mb) > 20000 ) then ! range of wvlth < 0.5mu + if ( wvn_sw1(mb) > 20000 ) then ! range of wvlth < 0.5mu tmp2 = 0.74 - elseif ( wvnsw2(mb) < 20000 ) then ! range of wvlth > 0.5mu + elseif ( wvn_sw2(mb) < 20000 ) then ! range of wvlth > 0.5mu tmp2 = 1.14 else ! range of wvlth in btwn tmp2 = 0.94 endif - tmp1 = (0.275e-4 * (wvnsw2(mb)+wvnsw1(mb))) ** tmp2 + tmp1 = (0.275e-4 * (wvn_sw2(mb)+wvn_sw1(mb))) ** tmp2 do i = 1, IMAX kh = kcuth(i) @@ -2726,7 +2842,7 @@ subroutine setaer & else do m = 1, NBDLW - tmp1 = (0.275e-4 * (wvnlw2(m) + wvnlw1(m))) ** 1.2 + tmp1 = (0.275e-4 * (wvn_lw2(m) + wvn_lw1(m))) ** 1.2 do i = 1, IMAX kh = kcuth(i) @@ -3625,12 +3741,12 @@ subroutine gocart_init & real (kind=kind_phys), dimension(NBDSW) :: solbnd real (kind=kind_phys), dimension(NLWBND,KAERBND) :: eirwaer real (kind=kind_phys), dimension(NLWBND) :: eirbnd - real (kind=kind_phys) :: sumsol, sumir + real (kind=kind_phys) :: sumsol, sumir, fac, tmp, wvs, wve integer, dimension(NBDSW) :: nv1, nv2 integer, dimension(NLWBND) :: nr1, nr2 - integer :: i, mb, ib, ii, iw, iw1, iw2 + integer :: i, mb, ib, ii, iw, iw1, iw2, ik, ibs, ibe !===> ... begin here @@ -3700,25 +3816,52 @@ subroutine gocart_init & nv_aod = 1 + ibs = 1 + ibe = 1 + wvs = wvn_sw1(1) + wve = wvn_sw1(1) + do ib = 2, NBDSW + mb = ib + NSWSTR - 1 + if ( wvn_sw2(mb) >= wvn550 .and. wvn550 >= wvn_sw1(mb) ) then + nv_aod = ib ! sw band number covering 550nm wavelenth + endif + + if ( wvn_sw1(mb) < wvs ) then + wvs = wvn_sw1(mb) + ibs = ib + endif + if ( wvn_sw1(mb) > wve ) then + wve = wvn_sw1(mb) + ibe = ib + endif + enddo + do ib = 1, NBDSW mb = ib + NSWSTR - 1 ii = 1 - iw1 = nint(wvnsw1(mb)) - iw2 = nint(wvnsw2(mb)) -! -! --- locate the spectral band for 550nm (for aod diag) -! - if (10000./iw1 >= 0.55 .and. & - & 10000./iw2 <= 0.55 ) then - nv_aod = ib - endif + iw1 = nint(wvn_sw1(mb)) + iw2 = nint(wvn_sw2(mb)) Lab_swdowhile : do while ( iw1 > iendwv_grt(ii) ) if ( ii == KAERBND ) exit Lab_swdowhile ii = ii + 1 enddo Lab_swdowhile + if ( lmap_new ) then + if (ib == ibs) then sumsol = f_zero + else + sumsol = -0.5 * solfwv(iw1) + endif + if (ib == ibe) then + fac = f_zero + else + fac = -0.5 + endif + solbnd(ib) = sumsol + else + sumsol = f_zero + endif nv1(ib) = ii do iw = iw1, iw2 @@ -3739,6 +3882,12 @@ subroutine gocart_init & solwaer(ib,ii) = sumsol endif + if ( lmap_new ) then + tmp = fac * solfwv(iw2) + solwaer(ib,ii) = solwaer(ib,ii) + tmp + solbnd(ib) = solbnd(ib) + tmp + endif + nv2(ib) = ii if((me==0) .and. lckprnt) print *,'RAD-nv1,nv2:', & @@ -3750,8 +3899,8 @@ subroutine gocart_init & ! --- check the spectral range for the nv_550 band if((me==0) .and. lckprnt) then mb = nv_aod + NSWSTR - 1 - iw1 = nint(wvnsw1(mb)) - iw2 = nint(wvnsw2(mb)) + iw1 = nint(wvn_sw1(mb)) + iw2 = nint(wvn_sw2(mb)) print *,'RAD-nv_aod:', & & nv_aod, iw1, iw2, 10000./iw1, 10000./iw2 endif @@ -3762,14 +3911,31 @@ subroutine gocart_init & eirbnd (:) = f_zero eirwaer(:,:) = f_zero + ibs = 1 + ibe = 1 + if (NLWBND > 1 ) then + wvs = wvn_lw1(1) + wve = wvn_lw1(1) + do ib = 2, NLWBND + if ( wvn_lw1(ib) < wvs ) then + wvs = wvn_lw1(ib) + ibs = ib + endif + if ( wvn_lw1(ib) > wve ) then + wve = wvn_lw1(ib) + ibe = ib + endif + enddo + endif + do ib = 1, NLWBND ii = 1 if ( NLWBND == 1 ) then iw1 = 400 ! corresponding 25 mu iw2 = 2500 ! corresponding 4 mu else - iw1 = nint(wvnlw1(ib)) - iw2 = nint(wvnlw2(ib)) + iw1 = nint(wvn_lw1(ib)) + iw2 = nint(wvn_lw2(ib)) endif Lab_lwdowhile : do while ( iw1 > iendwv_grt(ii) ) @@ -3777,7 +3943,21 @@ subroutine gocart_init & ii = ii + 1 enddo Lab_lwdowhile + if ( lmap_new ) then + if (ib == ibs) then sumir = f_zero + else + sumir = -0.5 * eirfwv(iw1) + endif + if (ib == ibe) then + fac = f_zero + else + fac = -0.5 + endif + eirbnd(ib) = sumir + else + sumir = f_zero + endif nr1(ib) = ii do iw = iw1, iw2 @@ -3800,6 +3980,12 @@ subroutine gocart_init & nr2(ib) = ii + if ( lmap_new ) then + tmp = fac * eirfwv(iw2) + eirwaer(ib,ii) = eirwaer(ib,ii) + tmp + eirbnd(ib) = eirbnd(ib) + tmp + endif + if(me==0 .and. lckprnt) print *,'RAD-nr1,nr2:', & & ib,iw1,iw2,nr1(ib),iendwv_grt(nr1(ib)), & & nr2(ib),iendwv_grt(nr2(ib)), & @@ -3816,9 +4002,9 @@ subroutine gocart_init & print *, 'RAD -After optavg_grt, sw band info' do ib = 1, NBDSW mb = ib + NSWSTR - 1 - print *,'RAD -wvnsw1,wvnsw2: ',ib,wvnsw1(mb),wvnsw2(mb) - print *,'RAD -lamda1,lamda2: ',ib,10000./wvnsw1(mb), & - & 10000./wvnsw2(mb) + print *,'RAD -wvnsw1,wvnsw2: ',ib,wvn_sw1(mb),wvn_sw2(mb) + print *,'RAD -lamda1,lamda2: ',ib,10000./wvn_sw1(mb), & + & 10000./wvn_sw2(mb) print *,'RAD -extrhi_grt:', extrhi_grt(:,ib) ! do i = 1, KRHLEV do i = 1, KRHLEV, 10 @@ -3829,9 +4015,9 @@ subroutine gocart_init & print *, 'RAD -After optavg_grt, lw band info' do ib = 1, NLWBND ii = NBDSW + ib - print *,'RAD -wvnlw1,wvnlw2: ',ib,wvnlw1(ib),wvnlw2(ib) - print *,'RAD -lamda1,lamda2: ',ib,10000./wvnlw1(ib), & - & 10000./wvnlw2(ib) + print *,'RAD -wvnlw1,wvnlw2: ',ib,wvn_lw1(ib),wvn_lw2(ib) + print *,'RAD -lamda1,lamda2: ',ib,10000./wvn_lw1(ib), & + & 10000./wvn_lw2(ib) print *,'RAD -extrhi_grt:', extrhi_grt(:,ii) ! do i = 1, KRHLEV do i = 1, KRHLEV, 10 @@ -4578,7 +4764,17 @@ subroutine rd_gocart_clim !................................... ! --- inputs: (in scope variables) ! --- outputs: (in scope variables) -! + +! ================================================================== ! +! ! +! subprogram: rd_gocart_clim ! +! ! +! 1. read in aerosol dry mass and surface pressure from GEOS3-GOCART ! +! C3.1 2000 monthly data set ! +! or aerosol mixing ratio and surface pressure from GEOS4-GOCART ! +! 2000-2007 averaged monthly data set ! +! 2. compute goes lat/lon array (for horizontal mapping) ! +! ! ! ==================== defination of variables =================== ! ! ! ! inputs arguments: ! diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index b1b7427f9..2b62d291b 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -21,52 +21,64 @@ ! 'progcld1' --- zhao/moorthi prognostic cloud scheme ! ! inputs: ! ! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, ! -! xlat,xlon,slmsk, ! +! xlat,xlon,slmsk,dz,delp, ! ! IX, NLAY, NLP1, ! +! uni_cld, lmfshal, lmfdeep2, cldcov, ! +! effrl,effri,effrr,effrs,effr_in, ! ! outputs: ! -! clouds,clds,mtop,mbot) ! +! clouds,clds,mtop,mbot,de_lgth) ! ! ! ! 'progcld2' --- ferrier prognostic cloud microphysics ! ! inputs: ! ! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, ! -! xlat,xlon,slmsk, f_ice,f_rain,r_rime,flgmin, ! -! IX, NLAY, NLP1, ! +! xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, ! +! IX, NLAY, NLP1, lmfshal, lmfdeep2, ! ! outputs: ! -! clouds,clds,mtop,mbot) ! +! clouds,clds,mtop,mbot,de_lgth) ! ! ! ! 'progcld3' --- zhao/moorthi prognostic cloud + pdfcld! ! inputs: ! ! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, cnvw,cnvc, ! -! xlat,xlon,slmsk, ! +! xlat,xlon,slmsk, dz, delp, ! ! ix, nlay, nlp1, ! ! deltaq,sup,kdt,me, ! ! outputs: ! -! clouds,clds,mtop,mbot) +! clouds,clds,mtop,mbot,de_lgth) ! ! ! -! 'progclduni' --- for unified clouds with MG microphys! +! 'progcld4' --- gfdl-lin cloud microphysics ! ! inputs: ! -! (plyr,plvl,tlyr,tvly,clw,ciw, ! -! xlat,xlon,slmsk, ! -! IX, NLAY, NLP1, ! +! (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, ! +! xlat,xlon,slmsk, dz, delp, ! +! ix, nlay, nlp1, ! ! outputs: ! -! clouds,clds,mtop,mbot) ! +! clouds,clds,mtop,mbot,de_lgth) ! ! ! -! 'diagcld1' --- diagnostic cloud calc routine ! +! 'progcld4o' --- inactive ! +! ! +! 'progcld5' --- thompson/wsm6 cloud microphysics ! ! inputs: ! -! (plyr,plvl,tlyr,rhly,vvel,cv,cvt,cvb, ! -! xlat,xlon,slmsk, ! -! IX, NLAY, NLP1, ! +! (plyr,plvl,tlyr,qlyr,qstl,rhly,clw, ! +! xlat,xlon,slmsk, dz, delp, ! +! ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, ! +! ix, nlay, nlp1, ! +! uni_cld, lmfshal, lmfdeep2, cldcov, ! +! re_cloud,re_ice,re_snow, ! +! outputs: ! +! clouds,clds,mtop,mbot,de_lgth) ! +! ! +! 'progclduni' --- for unified clouds with MG microphys! +! inputs: ! +! (plyr,plvl,tlyr,tvly,ccnd,ncnd, ! +! xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, ! +! effrl,effri,effrr,effrs,effr_in, ! ! outputs: ! -! clouds,clds,mtop,mbot) ! +! clouds,clds,mtop,mbot,de_lgth) ! ! ! ! internal accessable only subroutines: ! ! 'gethml' --- get diagnostic hi, mid, low clouds ! ! ! -! 'rhtable' --- rh lookup table for diag cloud scheme ! -! ! ! ! ! cloud array description: ! -! --- for prognostic cloud: icldflg=1 --- ! ! clouds(:,:,1) - layer total cloud fraction ! ! clouds(:,:,2) - layer cloud liq water path ! ! clouds(:,:,3) - mean effective radius for liquid cloud ! @@ -77,11 +89,6 @@ ! ** clouds(:,:,8) - layer snow flake water path ! ! clouds(:,:,9) - mean effective radius for snow flake ! ! ** fu's scheme need to be normalized by snow density (g/m**3/1.0e6)! -! --- for diagnostic cloud: icldflg=0 --- ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud optical depth ! -! clouds(:,:,3) - layer cloud single scattering albedo ! -! clouds(:,:,4) - layer cloud asymmetry factor ! ! ! ! external modules referenced: ! ! ! @@ -142,6 +149,10 @@ ! ! ! jul 2014 s. moorthi - merging with gfs version ! ! feb 2017 a. cheng - add odepth output, effective radius input ! +! jun 2018 h-m lin/y-t hou - removed the legacy subroutine ! +! 'diagcld1' for diagnostic cloud scheme, added new cloud ! +! overlapping method of de-correlation length, and optimized ! +! the code structure. ! ! ! !!!!! ========================================================== !!!!! !!!!! end descriptions !!!!! @@ -195,6 +206,34 @@ !! Maximum-randomly cloud overlapping is used in both long-wave !! radiation and short-wave radiation. Convective clouds are not !! considered in radiation. +!!\n +!! -# The parameterization of effective radius of water/ice droplet +!! (\f$r_{e}\f$) +!>\n Cloud properties in the GFS model are derived from atmospheric +!! condition and cloud condensate amount(NCEP Office Note 441). Cloud +!! condensate information can be provided by one of the choices of +!! different cloud microphysics built in the model. The legacy version +!! of diagnostic cloud scheme in the early GFS has been discontinued. +!! \n For the parameterization of effective radius,\f$r_{ew}\f$, of +!! water droplet, we fix \f$r_{ew}\f$ to a value of \f$10\mu m\f$ over +!! the oceans. Over the land, \f$\f$ is defined as: +!!\f[ +!! r_{ew} = 5+5\times F +!!\f] +!! Thus, the effective radius of cloud water droplets will reach to a +!! minimum values of \f$5\mu m\f$ when F=0, and to a maximum value of +!! \f$10\mu m\f$ when the ice fraction is increasing. +!! \n For ice clouds, following Heymsfield and McFarquhar (1996) +!! \cite heymsfield_and_mcfarquhar_1996, +!! we have made the effective ice droplet radius to be an empirical +!! function of ice water concentration (IWC) and environmental temperature as: +!! \f[ +!! r_{ei}=\begin{cases}(1250/9.917)IWC^{0.109} & T <-50^0C \\(1250/9.337)IWC^{0.080} & -50^0C \leq T<-40^0C\\(1250/9.208)IWC^{0.055} & -40^0C\leq T <-30^0C\\(1250/9.387)IWC^{0.031} & -30^0C \leq T\end{cases} +!! \f] +!! where IWC and IWP satisfy: +!! \f[ +!! IWP_{\triangle Z}=\int_{\triangle Z} IWCdZ +!! \f] !! @} !> This module computes cloud related quantities for radiation computations. @@ -222,7 +261,7 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: gfac=1.0e5/con_g & &, gord=con_g/con_rd !> number of fields in cloud array - integer, parameter, public :: NF_CLDS = 11 + integer, parameter, public :: NF_CLDS = 9 !> number of cloud vertical domains integer, parameter, public :: NK_CLDS = 3 @@ -245,51 +284,18 @@ module module_radiation_clouds ! default snow radius to 250 micron real (kind=kind_phys), parameter :: rsnow_def = 250.0 -! rh in one percent interval - integer, parameter :: NBIN=100 -! =1,2 for eastern and western hemispheres - integer, parameter :: NLON=2 -! =1,4 for 60n-30n,30n-equ,equ-30s,30s-60s - integer, parameter :: NLAT=4 -! =1,4 for bl,low,mid,hi cld type - integer, parameter :: MCLD=4 -! =1,2 for land,sea - integer, parameter :: NSEAL=2 - ! default cld single scat albedo real (kind=kind_phys), parameter :: cldssa_def = 0.99 ! default cld asymmetry factor real (kind=kind_phys), parameter :: cldasy_def = 0.84 -! --- xlabdy: lat bndry between tuning regions, +/- xlim for transition -! xlobdy: lon bndry between tuning regions -! lat bndry between tuning regions - real (kind=kind_phys) :: xlabdy(3) -! lon bndry between tuning regions - real (kind=kind_phys) :: xlobdy(3) -! +/- xlim for transition - real (kind=kind_phys), parameter :: xlim=5.0 - - data xlabdy / 30.0, 0.0, -30.0 /, xlobdy / 0.0, 180., 360. / - -! low cloud vertical velocity adjustment boundaries in mb/sec - real (kind=kind_phys), parameter :: vvcld1= 0.0003e0 -! low cloud vertical velocity adjustment boundaries in mb/sec - real (kind=kind_phys), parameter :: vvcld2=-0.0005e0 - -! --- those data will be set up by "cld_init" -! rhcl : tuned rh relation table for diagnostic cloud scheme - -! tuned relative humidity relation table for diagnostic cloud scheme - real (kind=kind_phys) :: rhcl(NBIN,NLON,NLAT,MCLD,NSEAL) - ! upper limit of boundary layer clouds integer :: llyr = 2 ! maximum-random cloud overlapping method integer :: iovr = 1 public progcld1, progcld2, progcld3, progcld4, progclduni, & - & diagcld1, cld_init, progcld5, progcld4o + & cld_init, progcld5, progcld4o ! ================= @@ -333,7 +339,7 @@ subroutine cld_init & ! ! ! external module variables: (in physparam) ! ! icldflg : cloud optical property scheme control flag ! -! =0: model use diagnostic cloud method ! +! =0: abort! diagnostic cloud method discontinued ! ! =1: model use prognostic cloud method ! ! imp_physics : cloud microphysics scheme control flag ! ! =99: zhao/carr/sundqvist microphysics cloud ! @@ -345,6 +351,8 @@ subroutine cld_init & ! iovrsw/iovrlw : sw/lw control flag for cloud overlapping scheme ! ! =0: random overlapping clouds ! ! =1: max/ran overlapping clouds ! +! =2: maximum overlap clouds (mcica only) ! +! =3: decorrelation-length overlap (mcica only) ! ! ivflip : control flag for direction of vertical index ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -376,18 +384,9 @@ subroutine cld_init & if (me == 0) print *, VTAGCLD !print out version tag if ( icldflg == 0 ) then - if (me == 0) print *,' - Using Diagnostic Cloud Method' - -!> - If using diagnostic cloud method, call rhtable() to set up tuned relative humidity table; -!! If using prognostic cloud method, check if the MP exists. - call rhtable( me, ier ) + print *,' - Diagnostic Cloud Method has been discontinued' + stop - if (ier < 0) then - write(6,99) ier - 99 format(3x,' *** Error in finding tuned RH table ***' & - &, /3x,' STOP at calling subroutine RHTABLE !!'/) - stop 99 - endif else if (me == 0) then print *,' - Using Prognostic Cloud Method' @@ -453,6 +452,8 @@ end subroutine cld_init !! -pi/2 range, otherwise see in-line comment !!\param xlon (IX), grid longitude in radians (not used) !!\param slmsk (IX), sea/land mask array (sea:0,land:1,sea-ice:2) +!!\param dz (IX,NLAY), layer thickness (km) +!!\param delp (IX,NLAY), model layer pressure thickness in mb (100Pa) !!\param IX horizontal dimention !!\param NLAY1 vertical layer !!\param NLP1 level dimensions @@ -478,14 +479,15 @@ end subroutine cld_init !!\param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases +!!\param de_lgth (IX), clouds decorrelation length (km) !>\section gen_progcld1 progcld1 General Algorithm !> @{ subroutine progcld1 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk, IX, NLAY, NLP1, & + & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & effrl,effri,effrr,effrs,effr_in, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -524,6 +526,8 @@ subroutine progcld1 & ! range, otherwise see in-line comment ! ! xlon (IX) : grid longitude in radians (not used) ! ! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! ! uni_cld : logical - true for cloud fraction from shoc ! @@ -546,6 +550,7 @@ subroutine progcld1 & ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -570,7 +575,7 @@ subroutine progcld1 & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, cldcov, & + & tlyr, tvly, qlyr, qstl, rhly, clw, cldcov, delp, dz, & & effrl, effri, effrr, effrs real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & @@ -580,14 +585,15 @@ subroutine progcld1 & real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, delp, tem2d, clwf + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -670,38 +676,28 @@ subroutine progcld1 & ! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; ! --- i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo !> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - if ( ivflip == 0 ) then ! input data from toa to sfc do k = 1, NLAY do i = 1, IX - delp(i,k) = plvl(i,k+1) - plvl(i,k) clwt = max(0.0, clwf(i,k)) * gfac * delp(i,k) cip(i,k) = clwt * tem2d(i,k) cwp(i,k) = clwt - cip(i,k) enddo enddo - else ! input data from sfc to toa - do k = 1, NLAY - do i = 1, IX - delp(i,k) = plvl(i,k) - plvl(i,k+1) - clwt = max(0.0, clwf(i,k)) * gfac * delp(i,k) - cip(i,k) = clwt * tem2d(i,k) - cwp(i,k) = clwt - cip(i,k) - enddo - enddo - endif ! end_if_ivflip !> - Compute effective liquid cloud droplet radius over land. @@ -715,7 +711,6 @@ subroutine progcld1 & enddo endif -!> - Compute layer cloud fraction. if (uni_cld) then ! use unified sgs clouds generated outside do k = 1, NLAY do i = 1, IX @@ -725,57 +720,7 @@ subroutine progcld1 & else - if ( ivflip == 0 ) then ! input data from toa to sfc - - clwmin = 0.0 - if (.not. lmfshal) then - do k = NLAY, 1, -1 - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 -! tem1 = 1000.0 / tem1 - - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - else - do k = NLAY, 1, -1 - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - endif - - else ! input data from sfc to toa +!> - Compute layer cloud fraction. clwmin = 0.0 if (.not. lmfshal) then @@ -827,7 +772,6 @@ subroutine progcld1 & enddo endif - endif ! end_if_flip endif ! if (uni_cld) then do k = 1, NLAY @@ -900,6 +844,14 @@ subroutine progcld1 & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif !> - Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, @@ -908,7 +860,7 @@ subroutine progcld1 & !! 'iovr', which may be different for lw and sw radiation programs. call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -933,19 +885,18 @@ end subroutine progcld1 !!\param qstl (IX,NLAY), layer saturate humidity in gm/gm !!\param rhly (IX,NLAY), layer relative humidity (=qlyr/qstl) !!\param clw (IX,NLAY), layer cloud condensate amount +!!\param f_ice (IX,NLAY), fraction of layer cloud ice (ferrier micro-phys) +!!\param f_rain (IX,NLAY), fraction of layer rain water (ferrier micro-phys) +!!\param r_rime (IX,NLAY), mass ratio of total ice to unrimed ice (>=1) +!!\param flgmin (IX), minimum large ice fraction !!\param xlat (IX), grid latitude in radians, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment !!\param xlon (IX), grid longitude in radians (not used) !!\param slmsk (IX), sea/land mask array (sea:0,land:1,sea-ice:2) -!!\param f_ice (IX,NLAY), fraction of layer cloud ice (Ferrier micro-phys) -!!\param f_rain (IX,NLAY), fraction of layer rain water (Ferrier micro-phys) -!!\param r_rime (IX,NLAY), mass ratio of total ice to unrimed ice (>=1) -!!\param flgmin (IX), minimum large ice fraction +!!\param dz (IX,NLAY), layer thickness (km) +!!\param delp (IX,NLAY), model layer pressure thickness in mb (100Pa) !!\param IX horizontal dimention -!!\param NLAY vertical layer dimension -!!\param NLP1 vertical level dimension -!!\param lmfshal mass-flux shallow convective scheme flag -!!\param lmfdeep2 scale-aware mass-flux deep convective scheme flag +!!\param NLAY,NLP1 vertical layer/level dimensions !!\param clouds (IX,NLAY,NF_CLDS), cloud profiles !!\n (:,:,1) - layer total cloud fraction !!\n (:,:,2) - layer cloud liq water path \f$(g/m^2)\f$ @@ -959,13 +910,14 @@ end subroutine progcld1 !!\param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases +!!\param de_lgth (IX), clouds decorrelation length (km) !>\section gen_progcld2 progcld2 General Algorithm !! @{ subroutine progcld2 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk, f_ice,f_rain,r_rime,flgmin, & + & xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, & & IX, NLAY, NLP1, lmfshal, lmfdeep2, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -1008,6 +960,8 @@ subroutine progcld2 & ! range, otherwise see in-line comment ! ! xlon (IX) : grid longitude in radians (not used) ! ! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! ! ! @@ -1026,6 +980,7 @@ subroutine progcld2 & ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! external module variables: ! ! ivflip : control flag of vertical index direction ! @@ -1055,7 +1010,8 @@ subroutine progcld2 & logical, intent(in) :: lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, f_ice, f_rain, r_rime + & tlyr, tvly, qlyr, qstl, rhly, clw, f_ice, f_rain, r_rime, & + & dz, delp real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk @@ -1065,6 +1021,7 @@ subroutine progcld2 & real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth integer, dimension(:,:), intent(out) :: mtop,mbot @@ -1073,7 +1030,7 @@ subroutine progcld2 & & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clw2, & & qcwat, qcice, qrain, fcice, frain, rrime, rsden, clwf - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -1132,14 +1089,16 @@ subroutine progcld2 & ! - ptopc(k,i): top pressure of each cld domain (k=1-4 are sfc,l,m, !! h; i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo @@ -1177,87 +1136,15 @@ subroutine progcld2 & & ) - if ( ivflip == 0 ) then ! input data from toa to sfc do k = 1, NLAY do i = 1, IX tem2d(i,k) = (con_g * plyr(i,k)) & - & / (con_rd* (plvl(i,k+1) - plvl(i,k))) + & / (con_rd* delp(i,k)) enddo enddo - else ! input data from sfc to toa - do k = 1, NLAY - do i = 1, IX - tem2d(i,k) = (con_g * plyr(i,k)) & - & / (con_rd* (plvl(i,k) - plvl(i,k+1))) - enddo - enddo - endif ! end_if_ivflip !> - Calculate layer cloud fraction. - if ( ivflip == 0 ) then ! input data from toa to sfc - - clwmin = 0.0 - if (.not. lmfshal) then - do k = NLAY, 1, -1 - do i = 1, IX -! clwt = 1.0e-7 * (plyr(i,k)*0.001) -! clwt = 1.0e-6 * (plyr(i,k)*0.001) - clwt = 2.0e-6 * (plyr(i,k)*0.001) -! clwt = 5.0e-6 * (plyr(i,k)*0.001) -! clwt = 5.0e-6 - - if (clw2(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - -! tem1 = min(max(sqrt(onemrh*qstl(i,k)),0.0001),1.0) -! tem1 = 100.0 / tem1 - - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 -! tem1 = 2400.0 / tem1 -!cnt tem1 = 2500.0 / tem1 -! tem1 = min(max(sqrt(onemrh*qstl(i,k)),0.0001),1.0) -! tem1 = 2000.0 / tem1 -! tem1 = 1000.0 / tem1 -! tem1 = 100.0 / tem1 - - value = max( min( tem1*(clw2(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - else - do k = NLAY, 1, -1 - do i = 1, IX -! clwt = 1.0e-6 * (plyr(i,k)*0.001) - clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clw2(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif -! - value = max( min( tem1*(clw2(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - endif - - else ! input data from sfc to toa - clwmin = 0.0e-6 if (.not. lmfshal) then do k = 1, NLAY @@ -1317,8 +1204,6 @@ subroutine progcld2 & enddo endif - endif ! end_if_flip - do k = 1, NLAY do i = 1, IX if (cldtot(i,k) < climit) then @@ -1403,6 +1288,14 @@ subroutine progcld2 & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif !> - Call gethml(), to compute low, mid, high, total, and boundary !! layer cloud fractions and clouds top/bottom layer indices for low, @@ -1413,7 +1306,7 @@ subroutine progcld2 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -1438,18 +1331,17 @@ end subroutine progcld2 !!\param qstl (ix,nlay), layer saturate humidity in gm/gm !!\param rhly (ix,nlay), layer relative humidity (=qlyr/qstl) !!\param clw (ix,nlay), layer cloud condensate amount -!!\param cnvw (ix,nlay), layer convective cloud condensate -!!\param cnvc (ix,nlay), layer convective cloud cover !!\param xlat (ix), grid latitude in radians, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment !!\param xlon (ix), grid longitude in radians (not used) !!\param slmsk (ix), sea/land mask array (sea:0,land:1,sea-ice:2) +!!\param dz (IX,NLAY), layer thickness (km) +!!\param delp (IX,NLAY), model layer pressure thickness in mb (100Pa) !!\param ix horizontal dimention -!!\param nlay vertical layer dimension -!!\param nlp1 vertical level dimension +!!\param nlay,nlp1 vertical layer/level dimensions !!\param deltaq (ix,nlay), half total water distribution width !!\param sup supersaturation -!!\param kdt current forecast iteration +!!\param kdt !!\param me print control flag !!\param clouds (ix,nlay,nf_clds), cloud profiles !!\n (:,:,1) - layer total cloud fraction @@ -1464,14 +1356,15 @@ end subroutine progcld2 !!\param clds (ix,5), fraction of clouds for low, mid, hi, tot, bl !!\param mtop (ix,3), vertical indices for low, mid, hi cloud tops !!\param mbot (ix,3), vertical indices for low, mid, hi cloud bases +!!\param de_lgth (ix), clouds decorrelation length (km) !>\section gen_progcld3 progcld3 General Algorithm !! @{ subroutine progcld3 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: - & xlat,xlon,slmsk, & + & xlat,xlon,slmsk, dz, delp, & & ix, nlay, nlp1, & & deltaq,sup,kdt,me, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -1510,6 +1403,8 @@ subroutine progcld3 & ! range, otherwise see in-line comment ! ! xlon (ix) : grid longitude in radians (not used) ! ! slmsk (ix) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! ix : horizontal dimention ! ! nlay,nlp1 : vertical layer/level dimensions ! ! cnvw (ix,nlay) : layer convective cloud condensate ! @@ -1533,6 +1428,7 @@ subroutine progcld3 & ! clds (ix,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (ix,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (ix,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -1553,7 +1449,7 @@ subroutine progcld3 & integer, intent(in) :: ix, nlay, nlp1,kdt real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw + & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp ! & tlyr, tvly, qlyr, qstl, rhly, clw, cnvw, cnvc ! real (kind=kind_phys), dimension(:,:), intent(in) :: deltaq real (kind=kind_phys), dimension(:,:) :: deltaq, cnvw, cnvc @@ -1569,14 +1465,15 @@ subroutine progcld3 & real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: real (kind=kind_phys), dimension(ix,nlay) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, delp, tem2d, clwf + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - real (kind=kind_phys) :: ptop1(ix,nk_clds+1) + real (kind=kind_phys) :: ptop1(ix,nk_clds+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -1642,38 +1539,28 @@ subroutine progcld3 & ! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,l,m,h; ! --- i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, ix - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo !> -# Calculate liquid/ice condensate path in \f$ g/m^2 \f$ - if ( ivflip == 0 ) then ! input data from toa to sfc do k = 1, nlay do i = 1, ix - delp(i,k) = plvl(i,k+1) - plvl(i,k) clwt = max(0.0,(clwf(i,k)+cnvw(i,k))) * gfac * delp(i,k) cip(i,k) = clwt * tem2d(i,k) cwp(i,k) = clwt - cip(i,k) enddo enddo - else ! input data from sfc to toa - do k = 1, nlay - do i = 1, ix - delp(i,k) = plvl(i,k) - plvl(i,k+1) - clwt = max(0.0,(clwf(i,k)+cnvw(i,k))) * gfac * delp(i,k) - cip(i,k) = clwt * tem2d(i,k) - cwp(i,k) = clwt - cip(i,k) - enddo - enddo - endif ! end_if_ivflip !> -# Calculate effective liquid cloud droplet radius over land. @@ -1687,46 +1574,6 @@ subroutine progcld3 & !> -# Calculate layer cloud fraction. - if ( ivflip == 0 ) then ! input data from toa to sfc - do k = nlay, 1, -1 - do i = 1, ix - tem1 = tlyr(i,k) - 273.16 - if(tem1 < con_thgni) then ! for pure ice, has to be consistent with gscond - qsc = sup * qstl(i,k) - rhs = sup - else - qsc = qstl(i,k) - rhs = 1.0 - endif - if(rhly(i,k) >= rhs) then - cldtot(i,k) = 1.0 - else - qtmp = qlyr(i,k) + clwf(i,k) - qsc - if(deltaq(i,k) > epsq) then - if(qtmp < -deltaq(i,k) .or. clwf(i,k) < epsq) then -! if(qtmp < -deltaq(i,k)) then - cldtot(i,k) = 0.0 - elseif(qtmp >= deltaq(i,k)) then - cldtot(i,k) = 1.0 - else - cldtot(i,k) = 0.5*qtmp/deltaq(i,k) + 0.5 - cldtot(i,k) = max(cldtot(i,k),0.0) - cldtot(i,k) = min(cldtot(i,k),1.0) - endif - else - if(qtmp.gt.0) then - cldtot(i,k) = 1.0 - else - cldtot(i,k) = 0.0 - endif - endif - endif - cldtot(i,k) = cnvc(i,k)+(1-cnvc(i,k))*cldtot(i,k) - cldtot(i,k) = max(cldtot(i,k),0.) - cldtot(i,k) = min(cldtot(i,k),1.) - enddo - enddo - else ! input data from sfc to toa do k = 1, nlay do i = 1, ix tem1 = tlyr(i,k) - 273.16 @@ -1766,7 +1613,6 @@ subroutine progcld3 & enddo enddo - endif ! end_if_flip do k = 1, nlay do i = 1, ix @@ -1837,6 +1683,14 @@ subroutine progcld3 & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif !> -# Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, @@ -1848,7 +1702,7 @@ subroutine progcld3 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & ix,nlay, & ! --- outputs: & clds, mtop, mbot & @@ -1902,9 +1756,9 @@ end subroutine progcld3 !! @{ subroutine progcld4 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: - & xlat,xlon,slmsk,cldtot, & + & xlat,xlon,slmsk,cldtot, dz, delp, & & IX, NLAY, NLP1, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -1945,6 +1799,8 @@ subroutine progcld4 & ! range, otherwise see in-line comment ! ! xlon (IX) : grid longitude in radians (not used) ! ! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! ! ! @@ -1963,6 +1819,7 @@ subroutine progcld4 & ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -1984,7 +1841,8 @@ subroutine progcld4 & integer, intent(in) :: IX, NLAY, NLP1 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, cldtot, cnvw, cnvc + & tlyr, tvly, qlyr, qstl, rhly, clw, cldtot, cnvw, cnvc, & + & delp, dz real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk @@ -1993,14 +1851,15 @@ subroutine progcld4 & real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, delp, tem2d, clwf + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -2058,38 +1917,28 @@ subroutine progcld4 & !!\n ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; !! i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo !> - Compute liquid/ice condensate path in \f$g m^{-2}\f$. - if ( ivflip == 0 ) then ! input data from toa to sfc - do k = 1, NLAY - do i = 1, IX - delp(i,k) = plvl(i,k+1) - plvl(i,k) - clwt = max(0.0,(clwf(i,k)+cnvw(i,k))) * gfac * delp(i,k) - cip(i,k) = clwt * tem2d(i,k) - cwp(i,k) = clwt - cip(i,k) - enddo - enddo - else ! input data from sfc to toa do k = 1, NLAY do i = 1, IX - delp(i,k) = plvl(i,k) - plvl(i,k+1) clwt = max(0.0,(clwf(i,k)+cnvw(i,k))) * gfac * delp(i,k) cip(i,k) = clwt * tem2d(i,k) cwp(i,k) = clwt - cip(i,k) enddo enddo - endif ! end_if_ivflip !> - Compute effective liquid cloud droplet radius over land. @@ -2168,16 +2017,24 @@ subroutine progcld4 & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later -!> - Call gethml() to compute low, mid, high, total, and boundary layer cloud fractions -!! and clouds top/bottom layer indices for low, mid, and high clouds. -!! The three cloud domain boundaries are defined by ptopc. The cloud -!! overlapping method is defined by control flag 'iovr', which may -!! be different for lw and sw radiation programs. + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif + +! --- compute low, mid, high, total, and boundary layer cloud fractions +! and clouds top/bottom layer indices for low, mid, and high clouds. +! The three cloud domain boundaries are defined by ptopc. The cloud +! overlapping method is defined by control flag 'iovr', which may +! be different for lw and sw radiation programs. call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -2236,10 +2093,10 @@ end subroutine progcld4 !! @{ subroutine progcld4o & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk, & + & xlat,xlon,slmsk, dz, delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntclamt, & & IX, NLAY, NLP1, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2279,6 +2136,8 @@ subroutine progcld4o & ! range, otherwise see in-line comment ! ! xlon (IX) : grid longitude in radians (not used) ! ! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! ! ! @@ -2297,6 +2156,7 @@ subroutine progcld4o & ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2320,7 +2180,7 @@ subroutine progcld4o & & ntclamt real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly + & tlyr, tvly, qlyr, qstl, rhly, delp, dz real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -2331,14 +2191,15 @@ subroutine progcld4o & real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, delp, tem2d + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -2379,34 +2240,23 @@ subroutine progcld4o & !! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; !! i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo !> - Compute liquid/ice condensate path in \f$g m^{-2}\f$ - if ( ivflip == 0 ) then ! input data from toa to sfc - do k = 1, NLAY - do i = 1, IX - delp(i,k) = plvl(i,k+1) - plvl(i,k) - cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) - cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) - crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & - & gfac * delp(i,k)) - enddo - enddo - else ! input data from sfc to toa do k = 1, NLAY do i = 1, IX - delp(i,k) = plvl(i,k) - plvl(i,k+1) cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) @@ -2414,7 +2264,6 @@ subroutine progcld4o & & gfac * delp(i,k)) enddo enddo - endif ! end_if_ivflip !> - Compute effective liquid cloud droplet radius over land. @@ -2493,6 +2342,14 @@ subroutine progcld4o & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif !> - Call gethml() to compute low, mid, high, total, and boundary layer cloud fractions !! and clouds top/bottom layer indices for low, mid, and high clouds. @@ -2502,7 +2359,7 @@ subroutine progcld4o & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -2522,12 +2379,12 @@ end subroutine progcld4o !! microphysics scheme. subroutine progcld5 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk, & + & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & & IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2566,6 +2423,8 @@ subroutine progcld5 & ! range, otherwise see in-line comment ! ! xlon (IX) : grid longitude in radians (not used) ! ! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! ! uni_cld : logical - true for cloud fraction from shoc ! @@ -2588,6 +2447,7 @@ subroutine progcld5 & ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2613,7 +2473,7 @@ subroutine progcld5 & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, cldcov, & + & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & & re_cloud, re_ice, re_snow real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -2625,14 +2485,15 @@ subroutine progcld5 & real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, delp, tem2d, clwf + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -2699,34 +2560,23 @@ subroutine progcld5 & !! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; !! i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo !> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - if ( ivflip == 0 ) then ! input data from toa to sfc - do k = 1, NLAY - do i = 1, IX - delp(i,k) = plvl(i,k+1) - plvl(i,k) - cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) - cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) - crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & - & gfac * delp(i,k)) - enddo - enddo - else ! input data from sfc to toa do k = 1, NLAY do i = 1, IX - delp(i,k) = plvl(i,k) - plvl(i,k+1) cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) @@ -2734,7 +2584,6 @@ subroutine progcld5 & & gfac * delp(i,k)) enddo enddo - endif ! end_if_ivflip if (uni_cld) then ! use unified sgs clouds generated outside do k = 1, NLAY @@ -2747,61 +2596,9 @@ subroutine progcld5 & !> - Calculate layer cloud fraction. - if ( ivflip == 0 ) then ! input data from toa to sfc - clwmin = 0.0 if (.not. lmfshal) then - do k = NLAY, 1, -1 - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 -! tem1 = 1000.0 / tem1 - - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - else - do k = NLAY, 1, -1 - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - endif - - else ! input data from sfc to toa - - clwmin = 0.0 - if (.not. lmfshal) then - do k = 1, NLAY + do k = 1, NLAY do i = 1, IX clwt = 1.0e-6 * (plyr(i,k)*0.001) ! clwt = 2.0e-6 * (plyr(i,k)*0.001) @@ -2849,7 +2646,6 @@ subroutine progcld5 & enddo endif - endif ! end_if_flip endif ! if (uni_cld) then do k = 1, NLAY @@ -2893,6 +2689,14 @@ subroutine progcld5 & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif !> - Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, @@ -2905,7 +2709,7 @@ subroutine progcld5 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -2932,6 +2736,8 @@ end subroutine progcld5 !! -pi/2 range, otherwise see in-line comment !!\param xlon (IX), grid longitude in radians (not used) !!\param slmsk (IX), sea/land mask array (sea:0,land:1,sea-ice:2) +!!\param dz (IX,NLAY), layer thickness (km) +!!\param delp (IX,NLAY), model layer pressure thickness in mb (100Pa) !!\param IX horizontal dimention !!\param NLAY,NLP1 vertical layer/level dimensions !!\param clouds (IX,NLAY,NF_CLDS), cloud profiles @@ -2948,13 +2754,14 @@ end subroutine progcld5 !!\param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases +!!\param de_lgth (IX), clouds decorrelation length (km) !>\section gen_progclduni progclduni General Algorithm !> @{ subroutine progclduni & & ( plyr,plvl,tlyr,tvly,ccnd,ncnd, & ! --- inputs: - & xlat,xlon,slmsk, IX, NLAY, NLP1, cldtot, & + & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, & & effrl,effri,effrr,effrs,effr_in, & - & clouds,clds,mtop,mbot & ! --- outputs: + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2999,6 +2806,8 @@ subroutine progclduni & ! effrr (ix,nlay) : effective radius for rain water ! ! effrs (ix,nlay) : effective radius for snow water ! ! effr_in : logical - if .true. use input effective radii ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -3015,6 +2824,7 @@ subroutine progclduni & ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -3039,7 +2849,7 @@ subroutine progclduni & real (kind=kind_phys), dimension(:,:,:), intent(in) :: ccnd real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr,& - & tlyr, tvly, cldtot, effrl, effri, effrr, effrs + & tlyr, tvly, cldtot, effrl, effri, effrr, effrs, dz, delp real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk @@ -3049,14 +2859,16 @@ subroutine progclduni & real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, cwp, cip, & - & crp, csp, rew, rei, res, rer, delp, tem2d + & crp, csp, rew, rei, res, rer, tem2d real (kind=kind_phys), dimension(IX,NLAY,ncnd) :: cndf - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: tem1, tem2, tem3 @@ -3132,24 +2944,24 @@ subroutine progclduni & ! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; ! --- i=1,2 are low-lat (<45 degree) and pole regions) + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + do id = 1, 4 tem1 = ptopc(id,2) - ptopc(id,1) do i =1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo -!> -# Compute cloud liquid/ice/rain/snow condensate path in \f$ g/m^2 \f$ . +!> -# Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - if ( ivflip == 0 ) then ! input data from toa to sfc if (ncnd == 2) then do k = 1, NLAY do i = 1, IX - delp(i,k) = plvl(i,k+1) - plvl(i,k) tem1 = gfac * delp(i,k) cwp(i,k) = cndf(i,k,1) * tem1 cip(i,k) = cndf(i,k,2) * tem1 @@ -3158,29 +2970,6 @@ subroutine progclduni & elseif (ncnd == 4 .or. ncnd == 5) then do k = 1, NLAY do i = 1, IX - delp(i,k) = plvl(i,k+1) - plvl(i,k) - tem1 = gfac * delp(i,k) - cwp(i,k) = cndf(i,k,1) * tem1 - cip(i,k) = cndf(i,k,2) * tem1 - crp(i,k) = cndf(i,k,3) * tem1 - csp(i,k) = cndf(i,k,4) * tem1 - enddo - enddo - endif - else ! input data from sfc to toa - if (ncnd == 2) then - do k = 1, NLAY - do i = 1, IX - delp(i,k) = plvl(i,k) - plvl(i,k+1) - tem1 = gfac * delp(i,k) - cwp(i,k) = cndf(i,k,1) * tem1 - cip(i,k) = cndf(i,k,2) * tem1 - enddo - enddo - elseif (ncnd == 4 .or. ncnd == 5) then - do k = 1, NLAY - do i = 1, IX - delp(i,k) = plvl(i,k) - plvl(i,k+1) tem1 = gfac * delp(i,k) cwp(i,k) = cndf(i,k,1) * tem1 cip(i,k) = cndf(i,k,2) * tem1 @@ -3190,8 +2979,6 @@ subroutine progclduni & enddo endif - endif ! end_if_ivflip - !> -# Compute effective liquid cloud droplet radius over land. if(.not. effr_in) then @@ -3273,6 +3060,14 @@ subroutine progclduni & enddo enddo +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif !> -# Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, @@ -3285,7 +3080,7 @@ subroutine progclduni & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & @@ -3299,629 +3094,6 @@ end subroutine progclduni !----------------------------------- !> @} -!> \ingroup module_radiation_clouds -!> This subroutine computes cloud fractions for radiation calculations. -!!\param plyr (IX,NLAY), model layer mean pressure in mb (100Pa) -!!\param plvl (IX,NLP1), model level pressure in mb (100Pa) -!!\param tlyr (IX,NLAY), model layer mean temperature in K -!!\param rhly (IX,NLAY), layer relative humidity -!!\param vvel (IX,NLAY), layer mean vertical velocity in mb/sec -!!\param cv (IX), fraction of convective cloud -!!\param cvt, cvb (IX), conv cloud top/bottom pressure in mb -!!\param xlat (IX), grid latitude in radians, default to pi/2 -> -!! -pi/2 range, otherwise see in-line comment -!!\param xlon (IX), grid longitude in radians, ok for both 0->2pi -!! or -pi -> +pi ranges -!!\param slmsk (IX), sea/land mask array (sea:0,land:1,sea-ice:2) -!!\param IX horizontal dimention -!!\param NLAY,NLP1 vertical layer/level dimensions -!!\param clouds (IX,NLAY,NF_CLDS), cloud profiles -!!\n (:,:,1) - layer total cloud fraction -!!\n (:,:,2) - layer cloud optical depth -!!\n (:,:,3) - layer cloud single scattering albedo -!!\n (:,:,4) - layer cloud asymmetry factor -!!\param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl -!!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops -!!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases -!!\section gen_diagcld1 diagcld1 General Algorithm -!> @{ - subroutine diagcld1 & - & ( plyr,plvl,tlyr,rhly,vvel,cv,cvt,cvb, & ! --- inputs: - & xlat,xlon,slmsk, & - & IX, NLAY, NLP1, & - & clouds,clds,mtop,mbot & ! --- outputs: - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: diagcld1 computes cloud fractions for radiation ! -! calculations. ! -! ! -! abstract: clouds are diagnosed from layer relative humidity, and ! -! estimate cloud optical depth from temperature and layer thickness. ! -! then computes the low, mid, high, total and boundary layer cloud ! -! fractions and the vertical indices of low, mid, and high cloud top ! -! and base. the three vertical cloud domains are set up in the ! -! initial subroutine "cld_init". ! -! ! -! usage: call diagcld1 ! -! ! -! subprograms called: gethml ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input variables: ! -! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! -! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! -! tlyr (IX,NLAY) : model layer mean temperature in k ! -! rhly (IX,NLAY) : layer relative humidity ! -! vvel (IX,NLAY) : layer mean vertical velocity in mb/sec ! -! clw (IX,NLAY) : layer cloud condensate amount (not used) ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! -! range, otherwise see in-line comment ! -! xlon (IX) : grid longitude in radians, ok for both 0->2pi or ! -! -pi -> +pi ranges ! -! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! -! cv (IX) : fraction of convective cloud ! -! cvt, cvb (IX) : conv cloud top/bottom pressure in mb ! -! IX : horizontal dimention ! -! NLAY,NLP1 : vertical layer/level dimensions ! -! ! -! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud optical depth ! -! clouds(:,:,3) - layer cloud single scattering albedo ! -! clouds(:,:,4) - layer cloud asymmetry factor ! -! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! -! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! -! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! -! ! -! external module variables: ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, rhly, vvel - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk, cv, cvt, cvb - -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds - - real (kind=kind_phys), dimension(:,:), intent(out) :: clds - - integer, dimension(:,:), intent(out) :: mtop,mbot - -! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cldtau, taufac, dthdp, tem2d - - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1) - - real (kind=kind_phys) :: cr1, cr2, crk, pval, cval, omeg, value, & - & tem1, tem2 - - integer, dimension(IX):: idom, kcut - -! --- for rh-cl calculation - real (kind=kind_phys) :: xlatdg, xlondg, xlnn, xlss, xrgt, xlft, & - & rhcla(NBIN,NLON,MCLD,NSEAL), rhcld(IX,NBIN,MCLD) - - integer :: ireg, ib, ic, id, id1, il, is, nhalf - - integer :: i, j, k, klowt -! integer :: klowb - - logical :: notstop - -! -!===> ... begin here -! - clouds(:,:,:) = 0.0 - - tem1 = 180.0 / con_pi - - lab_do_i_IX : do i = 1, IX - - xlatdg = xlat(i) * tem1 ! if xlat in pi/2 -> -pi/2 range -! xlatdg = 90.0 - xlat(i)*tem1 ! if xlat in 0 -> pi range - - xlondg = xlon(i) * tem1 - if (xlondg < 0.0) xlondg = xlondg + 360.0 ! if in -180->180, chg to 0->360 range - - ireg = 4 - -!> -# Get rh-cld relation for this lat. - - lab_do_j : do j = 1, 3 - if (xlatdg > xlabdy(j)) then - ireg = j - exit lab_do_j - endif - enddo lab_do_j - - do is = 1, NSEAL - do ic = 1, MCLD - do il = 1, NLON - do ib = 1, NBIN - rhcla(ib,il,ic,is) = rhcl(ib,il,ireg,ic,is) - enddo - enddo - enddo - enddo - -!> -# Linear transition between latitudinal regions. - do j = 1, 3 - xlnn = xlabdy(j) + xlim - xlss = xlabdy(j) - xlim - - if (xlatdg < xlnn .and. xlatdg > xlss) then - do is = 1, NSEAL - do ic = 1, MCLD - do il = 1, NLON - do ib = 1, NBIN - rhcla(ib,il,ic,is) = rhcl(ib,il,j+1,ic,is) & - & + (rhcl(ib,il,j,ic,is)-rhcl(ib,il,j+1,ic,is)) & - & * (xlatdg-xlss) / (xlnn-xlss) - enddo - enddo - enddo - enddo - endif - - enddo ! end_j_loop - -!> -# Get rh-cld relationship for each grid point, interpolating -!! longitudinally between regions if necessary. - - if (slmsk(i) < 1.0) then - is = 2 - else - is = 1 - endif - -! --- which hemisphere (e,w) - - if (xlondg > 180.e0) then - il = 2 - else - il = 1 - endif - - do ic = 1, MCLD - do ib = 1, NBIN - rhcld(i,ib,ic) = rhcla(ib,il,ic,is) - enddo - - lab_do_k : do k = 1, 3 - tem2 = abs(xlondg - xlobdy(k)) - - if (tem2 < xlim) then - id = il - id1= id + 1 - if (id1 > NLON) id1 = 1 - - xlft = xlobdy(k) - xlim - xrgt = xlobdy(k) + xlim - - do ib = 1, NBIN - rhcld(i,ib,ic) = rhcla(ib,id1,ic,is) & - & + (rhcla(ib,id,ic,is) - rhcla(ib,id1,ic,is)) & - & * (xlondg-xrgt)/(xlft-xrgt) - enddo - exit lab_do_k - endif - - enddo lab_do_k - - enddo ! end_do_ic_loop - enddo lab_do_i_IX - -!> -# Find top pressure for each cloud domain. - - do j = 1, 4 - tem1 = ptopc(j,2) - ptopc(j,1) - - do i = 1, IX - tem2 = xlat(i) / con_pi ! if xlat in pi/2 -> -pi/2 range -! tem2 = 0.5 - xlat(i)/con_pi ! if xlat in 0 -> pi range - - ptop1(i,j) = ptopc(j,1) + tem1*max( 0.0, 4.0*abs(tem2)-1.0 ) - enddo - enddo - -!> -# Compute stratiform cloud optical depth. - - do k = 1, NLAY - do i = 1, IX - tem1 = tlyr(i,k) - con_ttp - if (tem1 <= -10.0) then - cldtau(i,k) = max( 0.1e-3, 2.0e-6*(tem1+82.5)**2 ) - else - cldtau(i,k) = min( 0.08, 6.949e-3*tem1+0.08 ) - endif - enddo - enddo - -!> -# Calculate potential temperature and its lapse rate. - - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - tem1 = (plyr(i,k)*0.001) ** (-con_rocp) - tem2d(i,k) = tem1 * tlyr(i,k) - enddo - enddo - - do k = 1, NLAY-1 - do i = 1, IX - dthdp(i,k) = (tem2d(i,k+1)-tem2d(i,k))/(plyr(i,k+1)-plyr(i,k)) - enddo - enddo -! -!> -# Diagnostic method to find cloud amount cldtot, cldcnv. -! - - if ( ivflip == 0 ) then ! input data from toa to sfc - -!> - Find the lowest low cloud top sigma level, computed for each -!! lat cause domain definition changes with latitude. - -! klowb = 1 - klowt = 1 - do k = 1, NLAY - do i = 1, IX -! if (plvl(i,k) < ptop1(i,2)) klowb = k - if (plvl(i,k) < ptop1(i,2)) klowt = max(klowt,k) - taufac(i,k) = plvl(i,k+1) - plvl(i,k) - enddo - enddo - - do i = 1, IX - -!> - Find the stratosphere cut off layer for high cloud (about -!! 250mb). It is assumed to be above the layerwith dthdp less than -!! -0.25 in the high cloud domain. - - kcut(i) = 2 - lab_do_kcut0 : do k = klowt-1, 2, -1 - if (plyr(i,k) <= ptop1(i,3) .and. & - & dthdp(i,k) < -0.25e0) then - kcut(i) = k - exit lab_do_kcut0 - endif - enddo lab_do_kcut0 - -!> - Put convective cloud into 'cldcnv', no merge at this point. - - if (cv(i) >= climit .and. cvt(i) < cvb(i)) then - id = NLAY - id1 = NLAY - - lab_do_k_cvt0 : do k = 2, NLAY - if (cvt(i) <= plyr(i,k)) then - id = k - 1 - exit lab_do_k_cvt0 - endif - enddo lab_do_k_cvt0 - - lab_do_k_cvb0 : do k = NLAY-1, 1, -1 - if (cvb(i) >= plyr(i,k)) then - id1 = k + 1 - exit lab_do_k_cvb0 - endif - enddo lab_do_k_cvb0 - - tem1 = plyr(i,id1) - plyr(i,id) - do k = id, id1 - cldcnv(i,k) = cv(i) - taufac(i,k) = taufac(i,k) * max( 0.25, 1.0-0.125*tem1 ) - cldtau(i,k) = 0.06 - enddo - endif - - enddo ! end_do_i_loop - -!> - Calculate stratiform cloud and put into array 'cldtot' using -!! the cld-rh relationship from table look-up, where tables -!! obtained using k.mitchell frequency distribution tuning. -!bl (observations are daily means from us af rtneph).....k.a.c. -!bl tables created without lowest 10 percent of atmos.....k.a.c. -! (observations are synoptic using -6,+3 window from rtneph) -! tables are created with lowest 10-percent-of-atmos, and are -! --- now used.. 25 october 1995 ... kac. - - do k = NLAY-1, 2, -1 - - if (k < llyr) then - do i = 1, IX - idom(i) = 0 - enddo - - do i = 1, IX - lab_do_ic0 : do ic = 2, 4 - if(plyr(i,k) >= ptop1(i,ic)) then - idom(i) = ic - exit lab_do_ic0 - endif - enddo lab_do_ic0 - enddo - else - do i = 1, IX - idom(i) = 1 - enddo - endif - - do i = 1, IX - id = idom(i) - nhalf = (NBIN + 1) / 2 - - if (id <= 0 .or. k < kcut(i)) then - cldtot(i,k) = 0.0 - elseif (rhly(i,k) <= rhcld(i,1,id)) then - cldtot(i,k) = 0.0 - elseif (rhly(i,k) >= rhcld(i,NBIN,id)) then - cldtot(i,k) = 1.0 - else - ib = nhalf - crk = rhly(i,k) - - notstop = .true. - do while ( notstop ) - nhalf = (nhalf + 1) / 2 - cr1 = rhcld(i,ib, id) - cr2 = rhcld(i,ib+1,id) - - if (crk <= cr1) then - ib = max( ib-nhalf, 1 ) - elseif (crk > cr2) then - ib = min( ib+nhalf, NBIN-1 ) - else - cldtot(i,k) = 0.01 * (ib + (crk - cr1)/(cr2 - cr1)) - notstop = .false. - endif - enddo ! end_do_while - endif - enddo ! end_do_i_loop - - enddo ! end_do_k_loop - -!> - Compute vertical velocity adjustment on low clouds. - - value = vvcld1 - vvcld2 - do k = klowt, llyr+1 - do i = 1, IX - - omeg = vvel(i,k) - cval = cldtot(i,k) - pval = plyr(i,k) - -! --- vertical velocity adjustment on low clouds - - if (cval >= climit .and. pval >= ptop1(i,2)) then - if (omeg >= vvcld1) then - cldtot(i,k) = 0.0 - elseif (omeg > vvcld2) then - tem1 = (vvcld1 - omeg) / value - cldtot(i,k) = cldtot(i,k) * sqrt(tem1) - endif - endif - - enddo ! end_do_i_loop - enddo ! end_do_k_loop - - else ! input data from sfc to toa - -! --- find the lowest low cloud top sigma level, computed for each lat cause -! domain definition changes with latitude... - -! klowb = NLAY - klowt = NLAY - do k = NLAY, 1, -1 - do i = 1, IX -! if (plvl(i,k) < ptop1(i,2)) klowb = k - if (plvl(i,k) < ptop1(i,2)) klowt = min(klowt,k) - taufac(i,k) = plvl(i,k) - plvl(i,k+1) ! dp for later cal cldtau use - enddo - enddo - - do i = 1, IX - -! --- find the stratosphere cut off layer for high cloud (about 250mb). -! it is assumed to be above the layer with dthdp less than -0.25 in -! the high cloud domain - - kcut(i) = NLAY - 1 - lab_do_kcut1 : do k = klowt+1, NLAY-1 - if (plyr(i,k) <= ptop1(i,3) .and. & - & dthdp(i,k) < -0.25e0) then - kcut(i) = k - exit lab_do_kcut1 - endif - enddo lab_do_kcut1 - -! --- put convective cloud into 'cldcnv', no merge at this point.. - - if (cv(i) >= climit .and. cvt(i) < cvb(i)) then - id = 1 - id1 = 1 - - lab_do_k_cvt : do k = NLAY-1, 1, -1 - if (cvt(i) <= plyr(i,k)) then - id = k + 1 - exit lab_do_k_cvt - endif - enddo lab_do_k_cvt - - lab_do_k_cvb : do k = 2, NLAY - if (cvb(i) >= plyr(i,k)) then - id1 = k - 1 - exit lab_do_k_cvb - endif - enddo lab_do_k_cvb - - tem1 = plyr(i,id1) - plyr(i,id) - do k = id1, id - cldcnv(i,k) = cv(i) - taufac(i,k) = taufac(i,k) * max( 0.25, 1.0-0.125*tem1 ) - cldtau(i,k) = 0.06 - enddo - endif - - enddo ! end_do_i_loop - -! --- calculate stratiform cloud and put into array 'cldtot' using -! the cloud-rel.humidity relationship from table look-up..where -! tables obtained using k.mitchell frequency distribution tuning -!bl (observations are daily means from us af rtneph).....k.a.c. -!bl tables created without lowest 10 percent of atmos.....k.a.c. -! (observations are synoptic using -6,+3 window from rtneph) -! tables are created with lowest 10-percent-of-atmos, and are -! --- now used.. 25 october 1995 ... kac. - - do k = 2, NLAY-1 - - if (k > llyr) then - do i = 1, IX - idom(i) = 0 - enddo - - do i = 1, IX - lab_do_ic1 : do ic = 2, 4 - if(plyr(i,k) >= ptop1(i,ic)) then - idom(i) = ic - exit lab_do_ic1 - endif - enddo lab_do_ic1 - enddo - else - do i = 1, IX - idom(i) = 1 - enddo - endif - - do i = 1, IX - id = idom(i) - nhalf = (NBIN + 1) / 2 - - if (id <= 0 .or. k > kcut(i)) then - cldtot(i,k) = 0.0 - elseif (rhly(i,k) <= rhcld(i,1,id)) then - cldtot(i,k) = 0.0 - elseif (rhly(i,k) >= rhcld(i,NBIN,id)) then - cldtot(i,k) = 1.0 - else - ib = nhalf - crk = rhly(i,k) - - notstop = .true. - do while ( notstop ) - nhalf = (nhalf + 1) / 2 - cr1 = rhcld(i,ib, id) - cr2 = rhcld(i,ib+1,id) - - if (crk <= cr1) then - ib = max( ib-nhalf, 1 ) - elseif (crk > cr2) then - ib = min( ib+nhalf, NBIN-1 ) - else - cldtot(i,k) = 0.01 * (ib + (crk - cr1)/(cr2 - cr1)) - notstop = .false. - endif - enddo ! end_do_while - endif - enddo ! end_do_i_loop - - enddo ! end_do_k_loop - -! --- vertical velocity adjustment on low clouds - - value = vvcld1 - vvcld2 - do k = llyr-1, klowt - do i = 1, IX - - omeg = vvel(i,k) - cval = cldtot(i,k) - pval = plyr(i,k) - -! --- vertical velocity adjustment on low clouds - - if (cval >= climit .and. pval >= ptop1(i,2)) then - if (omeg >= vvcld1) then - cldtot(i,k) = 0.0 - elseif (omeg > vvcld2) then - tem1 = (vvcld1 - omeg) / value - cldtot(i,k) = cldtot(i,k) * sqrt(tem1) - endif - endif - - enddo ! end_do_i_loop - enddo ! end_do_k_loop - - endif ! end_if_ivflip - -!> - Calculate diagnostic cloud optical depth. - -! cldtau = cldtau * taufac - - where (cldtot < climit) - cldtot = 0.0 - endwhere - where (cldcnv < climit) - cldcnv = 0.0 - endwhere - - where (cldtot < climit .and. cldcnv < climit) - cldtau = 0.0 - endwhere - - do k = 1, NLAY - do i = 1, IX - clouds(i,k,1) = max(cldtot(i,k), cldcnv(i,k)) - clouds(i,k,2) = cldtau(i,k) * taufac(i,k) - clouds(i,k,3) = cldssa_def - clouds(i,k,4) = cldasy_def - enddo - enddo - -!> -# Call gethml(), to compute low, mid, high, total, and boundary -!! layer cloud fractions and cloud top/bottom layer indices for low, -!! mid, and high clouds. -! the three cloud domain boundaries are defined by ptopc. the cloud -! overlapping method is defined by control flag 'iovr', which may -! be different for lw and sw radiation programs. - - call gethml & -! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, & - & IX, NLAY, & -! --- outputs: - & clds, mtop, mbot & - & ) - -! - return -!................................... - end subroutine diagcld1 -!----------------------------------- -!> @} - !> \ingroup module_radiation_clouds !> This subroutine computes high, mid, low, total, and boundary cloud !! fractions and cloud top/bottom layer indices for model diagnostic @@ -3933,16 +3105,18 @@ end subroutine diagcld1 !! (sfc,low,mid,high) in mb (100Pa) !> \param cldtot (IX,NLAY), total or stratiform cloud profile in fraction !> \param cldcnv (IX,NLAY), convective cloud (for diagnostic scheme only) +!> \param dz (IX,NLAY), layer thickness (km) +!> \param de_lgth (IX), clouds decorrelation length (km) !> \param IX horizontal dimension !> \param NLAY vertical layer dimensions !> \param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl !> \param mtop (IX,3),vertical indices for low, mid, hi cloud tops !> \param mbot (IX,3),vertical indices for low, mid, hi cloud bases !! -!>\section detail gethml General Algorithm +!>\section detail Detailed Algorithm !! @{ subroutine gethml & - & ( plyr, ptop1, cldtot, cldcnv, & ! --- inputs: + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & ! --- inputs: & IX, NLAY, & & clds, mtop, mbot & ! --- outputs: & ) @@ -3972,6 +3146,8 @@ subroutine gethml & ! (sfc,low,mid,high) in mb (100Pa) ! ! cldtot(IX,NLAY) : total or straiform cloud profile in fraction ! ! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! +! dz (ix,nlay) : layer thickness (km) ! +! de_lgth(ix) : clouds vertical de-correlation length (km) ! ! IX : horizontal dimention ! ! NLAY : vertical layer dimensions ! ! ! @@ -3989,7 +3165,8 @@ subroutine gethml & ! iovr : control flag for cloud overlap ! ! =0 random overlapping clouds ! ! =1 max/ran overlapping clouds ! -! ! +! =2 maximum overlapping ( for mcica only ) ! +! =3 decorr-length ovlp ( for mcica only ) ! ! ! ! ==================== end of description ===================== ! ! @@ -3999,7 +3176,8 @@ subroutine gethml & integer, intent(in) :: IX, NLAY real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & - & cldtot, cldcnv + & cldtot, cldcnv, dz + real (kind=kind_phys), dimension(:), intent(in) :: de_lgth ! --- outputs real (kind=kind_phys), dimension(:,:), intent(out) :: clds @@ -4007,8 +3185,8 @@ subroutine gethml & integer, dimension(:,:), intent(out) :: mtop, mbot ! --- local variables: - real (kind=kind_phys) :: cl1(IX), cl2(IX) - real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt + real (kind=kind_phys) :: cl1(IX), cl2(IX), dz1(ix) + real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 integer :: i, k, id, id1, kstr, kend, kinc @@ -4058,7 +3236,7 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) ! save total cloud enddo - else ! max/ran overlap + elseif ( iovr == 1 ) then ! max/ran overlap do k = kstr, kend, kinc do i = 1, IX @@ -4082,6 +3260,59 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo + elseif ( iovr == 2 ) then ! maximum overlap all levels + + cl1(:) = 0.0 + + do k = kstr, kend, kinc + do i = 1, IX + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) cl1(i) = max( cl1(i), ccur ) + enddo + + if (k == llyr) then + do i = 1, IX + clds(i,5) = cl1(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, IX + clds(i,4) = cl1(i) ! save total cloud + enddo + + elseif ( iovr == 3 ) then ! random if clear-layer divided, + ! otherwise de-corrlength method + do i = 1, ix + dz1(i) = - dz(i,kstr) + enddo + + do k = kstr, kend, kinc + do i = 1, ix + ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) + if (ccur >= climit) then ! cloudy layer + alfa = exp( -0.5*((dz1(i)+dz(i,k)))/de_lgth(i) ) + dz1(i) = dz(i,k) + cl2(i) = alfa * min(cl2(i), (1.0 - ccur)) & ! maximum part + & + (1.0 - alfa) * (cl2(i) * (1.0 - ccur)) ! random part + else ! clear layer + cl1(i) = cl1(i) * cl2(i) + cl2(i) = 1.0 + if (k /= kend) dz1(i) = -dz(i,k+kinc) + endif + enddo + + if (k == llyr) then + do i = 1, ix + clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud + enddo + endif + enddo + + do i = 1, ix + clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud + enddo + endif ! end_if_iovr ! --- high, mid, low clouds, where cl1, cl2 are cloud fractions @@ -4264,268 +3495,6 @@ end subroutine gethml !----------------------------------- !! @} -!> \ingroup module_radiation_clouds -!> cld-rh relations obtained from mitchell-hahn procedure. -!\section rhtable_gen rhtable General Algorithm - subroutine rhtable & - & ( me & ! --- inputs: - &, ier ) ! --- outputs: - -! =================================================================== ! -! ! -! abstract: cld-rh relations obtained from mitchell-hahn procedure, ! -! here read cld/rh tuning tables for day 0,1,...,5 and merge into 1 ! -! file. ! -! ! -! inputs: ! -! me : check print control flag ! -! ! -! outputs: ! -! ier : error flag ! -! ! -! =================================================================== ! -! - implicit none! - -! --- inputs: - integer, intent(in) :: me - -! --- output: - integer, intent(out) :: ier - -! --- locals: - real (kind=kind_phys), dimension(NBIN,NLON,NLAT,MCLD,NSEAL) :: & - & rhfd, rtnfd, rhcf, rtncf, rhcla - - real (kind=kind_io4), dimension(NBIN,NLON,NLAT,MCLD,NSEAL) :: & - & rhfd4, rtnfd4 - - real(kind=kind_io4) :: fhour - - real(kind=kind_phys) :: binscl, cfrac, clsat, rhsat, cstem - - integer, dimension(NLON,NLAT,MCLD,NSEAL) :: kpts, kkpts - - integer :: icdays(15), idate(4), nbdayi, isat - - integer :: i, i1, j, k, l, m, id, im, iy - -! -!===> ... begin here -! - - ier = 1 - - rewind NICLTUN - - binscl = 1.0 / NBIN - -! --- array initializations - - do m=1,NSEAL - do l=1,MCLD - do k=1,NLAT - do j=1,NLON - do i=1,NBIN - rhcf (i,j,k,l,m) = 0.0 - rtncf(i,j,k,l,m) = 0.0 - rhcla(i,j,k,l,m) = -0.1 - enddo - enddo - enddo - enddo - enddo - - kkpts = 0 - -! --- read the data off the rotating file - - read (NICLTUN,ERR=998,END=999) nbdayi, icdays - - if (me == 0) print 11, nbdayi - 11 format(' from rhtable DAYS ON FILE =',i5) - - do i = 1, nbdayi - id = icdays(i) / 10000 - im = (icdays(i)-id*10000) / 100 - iy = icdays(i)-id*10000-im*100 - if (me == 0) print 51, id,im,iy - 51 format(' from rhtable ARCHV DATA FROM DA,MO,YR=',3i4) - enddo - - read (NICLTUN,ERR=998,END=999) fhour,idate - - do i1 = 1, nbdayi - read (NICLTUN) rhfd4 - rhfd = rhfd4 - - read (NICLTUN) rtnfd4 - rtnfd = rtnfd4 - - read (NICLTUN) kpts - - do m=1,NSEAL - do l=1,MCLD - do k=1,NLAT - do j=1,NLON - do i=1,NBIN - rhcf (i,j,k,l,m) = rhcf (i,j,k,l,m) + rhfd (i,j,k,l,m) - rtncf(i,j,k,l,m) = rtncf(i,j,k,l,m) + rtnfd(i,j,k,l,m) - enddo - enddo - enddo - enddo - enddo - - kkpts = kkpts + kpts - - enddo ! end_do_i1_loop - - do m = 1, NSEAL - do l = 1, MCLD - do k = 1, NLAT - do j = 1, NLON - -! --- compute the cumulative frequency distribution - - do i = 2, NBIN - rhcf (i,j,k,l,m) = rhcf (i-1,j,k,l,m) + rhcf (i,j,k,l,m) - rtncf(i,j,k,l,m) = rtncf(i-1,j,k,l,m) + rtncf(i,j,k,l,m) - enddo ! end_do_i_loop - - if (kkpts(j,k,l,m) > 0) then - do i = 1, NBIN - rhcf (i,j,k,l,m)= rhcf (i,j,k,l,m)/kkpts(j,k,l,m) - rtncf(i,j,k,l,m)=min(1., rtncf(i,j,k,l,m)/kkpts(j,k,l,m)) - enddo - -! --- cause we mix calculations of rh retune with cray and ibm words -! the last value of rhcf is close to but ne 1.0, -! --- so we reset it in order that the 360 loop gives complete tabl - - rhcf(NBIN,j,k,l,m) = 1.0 - - do i = 1, NBIN - lab_do_i1 : do i1 = 1, NBIN - if (rhcf(i1,j,k,l,m) >= rtncf(i,j,k,l,m)) then - rhcla(i,j,k,l,m) = i1 * binscl - exit lab_do_i1 - endif - enddo lab_do_i1 - enddo - - else ! if_kkpts -! --- no critical rh - - do i = 1, NBIN - rhcf (i,j,k,l,m) = -0.1 - rtncf(i,j,k,l,m) = -0.1 - enddo - - if (me == 0) then - print 210, k,j,m - 210 format(' NO CRIT RH FOR LAT=',I3,' AND LON BAND=',I3, & - & ' LAND(=1) SEA=',I3//' MODEL RH ',' OBS RTCLD') - do i = 1, NBIN - print 203, rhcf(i,j,k,l,m), rtncf(i,j,k,l,m) - 203 format(2f10.2) - enddo - endif - - endif ! if_kkpts - - enddo ! end_do_j_loop - enddo ! end_do_k_loop - enddo ! end_do_l_loop - enddo ! end_do_m_loop - - do m = 1, NSEAL - do l = 1, MCLD - do k = 1, NLAT - do j = 1, NLON - - isat = 0 - do i = 1, NBIN-1 - cfrac = binscl * (i - 1) - - if (rhcla(i,j,k,l,m) < 0.0) then - print 1941, i,m,l,k,j - 1941 format(' NEG RHCLA FOR IT,NSL,NC,LAT,LON=',5I4 & - &, '...STOPPP..') - stop - endif - - if (rtncf(i,j,k,l,m) >= 1.0) then - if (isat <= 0) then - isat = i - rhsat = rhcla(i,j,k,l,m) - clsat = cfrac - endif - - rhcla(i,j,k,l,m) = rhsat + (1.0 - rhsat) & - & * (cfrac - clsat) / (1.0 - clsat) - endif - enddo - - rhcla(NBIN,j,k,l,m) = 1.0 - - enddo ! end_do_j_loop - enddo ! end_do_k_loop - enddo ! end_do_l_loop - enddo ! end_do_m_loop - -! --- smooth out the table as it reaches rh=1.0, via linear interpolation -! between location of rh ge .98 and the NBIN bin (where rh=1.0) -! previously rh=1.0 occurred for many of the latter bins in the -! --- table, thereby giving a cloud value of less then 1.0 for rh=1.0 - - rhcl = rhcla - - do m = 1, NSEAL - do l = 1, MCLD - do k = 1, NLAT - do j = 1, NLON - - lab_do_i : do i = 1, NBIN - 2 - cfrac = binscl * i - - if (rhcla(i,j,k,l,m) >= 0.98) then - do i1 = i, NBIN - cstem = binscl * i1 - - rhcl(i1,j,k,l,m) = rhcla(i,j,k,l,m) & - & + (rhcla(NBIN,j,k,l,m) - rhcla(i,j,k,l,m)) & - & * (cstem - cfrac) / (1.0 - cfrac) - enddo - exit lab_do_i - endif - enddo lab_do_i - - enddo ! end_do_j_loop - enddo ! end_do_k_loop - enddo ! end_do_l_loop - enddo ! end_do_m_loop - - if (me == 0) then - print *,'completed rhtable for cloud tuninig tables' - endif - return - - 998 print 988 - 988 format(' from rhtable ERROR READING TABLES') - ier = -1 - return - - 999 print 989 - 989 format(' from rhtable E.O.F READING TABLES') - ier = -1 - return - -!................................... - end subroutine rhtable -!----------------------------------- - - ! !........................................! end module module_radiation_clouds ! diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index d652b9777..a2cbf55ac 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -68,6 +68,8 @@ ! subr 'sfc_init'. ! ! nov 2012 y. hou - modified control parameters through ! ! module 'physparam'. ! +! jun 2018 h-m lin/y-t hou - correct error in clim-scheme of ! +! weak/strong factor and restore to the orig form ! ! ! !!!!! ========================================================== !!!!! !!!!! end descriptions !!!!! @@ -478,10 +480,8 @@ subroutine setalb & !> - Calculate direct sea surface albedo. if (coszf(i) > 0.0001) then -! rfcs = 1.4 / (f_one + 0.8*coszf(i)) -! rfcw = 1.3 / (f_one + 0.6*coszf(i)) - rfcs = 2.14 / (f_one + 1.48*coszf(i)) - rfcw = rfcs + rfcs = 1.4 / (f_one + 0.8*coszf(i)) + rfcw = 1.1 / (f_one + 0.2*coszf(i)) if (tsknf(i) >= con_t0c) then asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 8b136bad6..00603e315 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -39,9 +39,10 @@ ! inputs: ! ! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! ! clouds,icseed,aerosols,sfemis,sfgtmp, ! +! dzlyr,delpin,de_lgth, ! ! npts, nlay, nlp1, lprnt, ! ! outputs: ! -! hlwc,topflx,sfcflx, ! +! hlwc,topflx,sfcflx,cldtau, ! !! optional outputs: ! ! HLW0,HLWB,FLXPRF) ! ! ! @@ -230,7 +231,8 @@ ! nov 2012, yu-tai hou -- modified control parameters thru ! ! module 'physparam'. ! ! FEB 2017 A.Cheng - add odpth output, effective radius input ! -! ! +! jun 2018, h-m lin/y-t hou -- added new option of cloud overlap ! +! method 'de-correlation-length' for mcica application ! ! ! !!!!! ============================================================== !!!!! !!!!! end descriptions !!!!! @@ -400,6 +402,9 @@ end subroutine rrtmg_lw_init !! | aerssa | aerosol_single_scattering_albedo_for_longwave_bands_01-16 | aerosol single scattering albedo for longwave bands 01-16 | frac | 3 | real | kind_phys | in | F | !! | sfemis | surface_longwave_emissivity | surface emissivity | frac | 1 | real | kind_phys | in | F | !! | sfgtmp | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | +!! | dzlyr | layer_thickness_for_radiation | layer thickness | km | 2 | real | kind_phys | in | F | +!! | delpin | layer_pressure_thickness_for_radiation | layer pressure thickness | hPa | 2 | real | kind_phys | in | F | +!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | in | F | !! | npts | horizontal_loop_extent | horizontal dimension | count | 0 | integer | | in | F | !! | nlay | adjusted_vertical_layer_dimension_for_radiation | number of vertical layers for radiation | count | 0 | integer | | in | F | !! | nlp1 | adjusted_vertical_level_dimension_for_radiation | number of vertical levels for radiation | count | 0 | integer | | in | F | @@ -409,6 +414,7 @@ end subroutine rrtmg_lw_init !! | hlwc | tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step | longwave total sky heating rate | K s-1 | 2 | real | kind_phys | inout | F | !! | topflx | lw_fluxes_top_atmosphere | longwave total sky fluxes at the top of the atm | W m-2 | 1 | topflw_type | | inout | F | !! | sfcflx | lw_fluxes_sfc | longwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcflw_type | | inout | F | +!! | cldtau | cloud_optical_depth_layers_at_10mu_band | approx 10mu band layer cloud optical depth | none | 2 | real | kind_phys | inout | F | !! | hlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | longwave clear sky heating rate | K s-1 | 2 | real | kind_phys | inout | T | !! | hlwb | lw_heating_rate_spectral | longwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | !! | flxprf | lw_fluxes | lw fluxes total sky / csk and up / down at levels | W m-2 | 2 | proflw_type | | inout | T | @@ -420,8 +426,6 @@ end subroutine rrtmg_lw_init !! | cld_ref_rain | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | 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 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | in | T | -!! | cld_od_total | cloud_optical_depth_weighted | cloud optical depth, weighted | none | 2 | real | kind_phys | in | T | -!! | cld_od_layer | cloud_optical_depth_layers_678 | cloud optical depth, from bands 6,7,8 | none | 2 | real | kind_phys | out | T | !! | cld_od | cloud_optical_depth | cloud optical depth | none | 2 | real | kind_phys | in | T | !! | errmsg | ccpp_error_message | error message for error handling in CCPP | none | 0 | character | len=* | out | F | !! | errflg | ccpp_error_flag | error flag for error handling in CCPP | flag | 0 | integer | | out | F | @@ -433,12 +437,12 @@ subroutine rrtmg_lw_run & & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & & icseed,aeraod,aerssa,sfemis,sfgtmp, & + & dzlyr,delpin,de_lgth, & & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & - & hlwc,topflx,sfcflx, & ! --- outputs + & hlwc,topflx,sfcflx,cldtau, & ! --- 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_total, cld_od_layer, & & cld_od, errmsg, errflg & & ) @@ -464,7 +468,6 @@ subroutine rrtmg_lw_run & ! gasvmr(:,:,9) - ccl4 volume mixing ratio ! ! clouds(npts,nlay,:): layer cloud profiles: ! ! (check module_radiation_clouds for definition) ! -! --- for ilwcliq > 0 --- ! ! clouds(:,:,1) - layer total cloud fraction ! ! clouds(:,:,2) - layer in-cloud liq water path (g/m**2) ! ! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! @@ -474,11 +477,6 @@ subroutine rrtmg_lw_run & ! clouds(:,:,7) - mean eff radius for rain drop (micron) ! ! clouds(:,:,8) - layer snow flake water path (g/m**2) ! ! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! --- for ilwcliq = 0 --- ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud optical depth ! -! clouds(:,:,3) - layer cloud single scattering albedo ! -! clouds(:,:,4) - layer cloud asymmetry factor ! ! icseed(npts) : auxiliary special cloud related array ! ! when module variable isubclw=2, it provides ! ! permutation seed for each column profile that ! @@ -491,6 +489,9 @@ subroutine rrtmg_lw_run & ! (:,:,:,3) - asymmetry parameter ! ! sfemis (npts) : surface emissivity ! ! sfgtmp (npts) : surface ground temperature (k) ! +! dzlyr(npts,nlay) : layer thickness (km) ! +! delpin(npts,nlay): layer pressure thickness (mb) ! +! de_lgth(npts) : cloud decorrelation length (km) ! ! npts : total number of horizontal points ! ! nlay, nlp1 : total number of vertical layers, levels ! ! lprnt : cntl flag for diagnostic print out ! @@ -507,6 +508,7 @@ subroutine rrtmg_lw_run & ! upfx0 - clear sky upward flux at sfc (w/m2) ! ! dnfxc - total sky downward flux at sfc (w/m2) ! ! dnfx0 - clear sky downward flux at sfc (w/m2) ! +! cldtau(npts,nlay): approx 10mu band layer cloud optical depth ! ! ! !! optional output variables: ! ! hlwb(npts,nlay,nbands): spectral band total sky heating rates ! @@ -518,16 +520,14 @@ subroutine rrtmg_lw_run & ! upfx0 - clear sky upward flux ! ! dnfx0 - clear sky dnward flux ! ! ! -! external module variables: (in physparam) ! +! external module variables: (in physparam) ! ! ilwrgas - control flag for rare gases (ch4,n2o,o2,cfcs, etc.) ! ! =0: do not include rare gases ! ! >0: include all rare gases ! ! ilwcliq - control flag for liq-cloud optical properties ! -! =0: input cloud optical depth, ignor ilwcice ! ! =1: input cld liqp & reliq, hu & stamnes (1993) ! ! =2: not used ! ! ilwcice - control flag for ice-cloud optical properties ! -! *** if ilwcliq==0, ilwcice is ignored ! ! =1: input cld icep & reice, ebert & curry (1997) ! ! =2: input cld icep & reice, streamer (1996) ! ! =3: input cld icep & reice, fu (1998) ! @@ -539,6 +539,7 @@ subroutine rrtmg_lw_run & ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (used for isubclw>0 only) ! +! =3: decorrelation-length overlap (for isubclw>0 only) ! ! ivflip - control flag for vertical index direction ! ! =0: vertical index from toa to surface ! ! =1: vertical index from surface to toa ! @@ -622,7 +623,7 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: plvl, & & tlvl real (kind=kind_phys), dimension(npts,nlay), intent(in) :: plyr, & - & tlyr, qlyr, olyr + & tlyr, qlyr, olyr, dzlyr, delpin real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2,& & gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & @@ -632,20 +633,18 @@ subroutine rrtmg_lw_run & 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_total, cld_od - ! Note: as of 06/18/2018, cld_od_total is not used in radlw_main.f - ! thus set intent to intent(in). - real (kind=kind_phys), dimension(npts,nlay),intent(out),optional::& - & cld_od_layer + & cld_od real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & - & sfgtmp + & sfgtmp, de_lgth real (kind=kind_phys), dimension(npts,nlay,nbands),intent(in):: & & aeraod, aerssa ! --- outputs: real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hlwc + real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & + & cldtau type (topflw_type), dimension(npts), intent(inout) :: topflx type (sfcflw_type), dimension(npts), intent(inout) :: sfcflx @@ -674,7 +673,7 @@ subroutine rrtmg_lw_run & & clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, & & coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, & & selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, & - & scaleminorn2, temcol + & scaleminorn2, temcol, dz real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay @@ -697,7 +696,8 @@ subroutine rrtmg_lw_run & ! (:,m,:) m = 1-h2o/co2, 2-h2o/o3, 3-h2o/n2o, 4-h2o/ch4, 5-n2o/co2, 6-o3/co2 real (kind=kind_phys) :: rfrate(nlay,nrates,2) - real (kind=kind_phys) :: tem0, tem1, tem2, pwvcm, summol, stemp + real (kind=kind_phys) :: tem0, tem1, tem2, pwvcm, summol, stemp, & + & delgth integer, dimension(npts) :: ipseed integer, dimension(nlay) :: jp, jt, jt1, indself, indfor, indminor @@ -720,21 +720,19 @@ subroutine rrtmg_lw_run & lflxprf= present ( flxprf ) colamt(:,:) = f_zero + cldtau(:,:) = f_zero !! --- check for optional input arguments, depending on cloud method if (ilwcliq > 0) then ! use prognostic cloud method if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & - & .not.present(cld_swp) .or. .not.present(cld_ref_snow) .or. & - & .not.present(cld_od_total) .or. & - & .not.present(cld_od_layer)) then + & .not.present(cld_swp) .or. .not.present(cld_ref_snow)) then write(errmsg,'(*(a))') & & 'Logic error: ilwcliq>0 requires the following', & & ' optional arguments to be present:', & & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & - & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow', & - & ' cld_od_total, cld_od_layer' + & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' errflg = 1 return end if @@ -782,6 +780,7 @@ subroutine rrtmg_lw_run & endif stemp = sfgtmp(iplon) ! surface ground temp + if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length !> -# Prepare atmospheric profile for use in rrtm. ! the vertical index of internal array is from surface to top @@ -801,9 +800,10 @@ subroutine rrtmg_lw_run & do k = 1, nlay k1 = nlp1 - k pavel(k)= plyr(iplon,k1) - delp(k) = plvl(iplon,k1+1) - plvl(iplon,k1) + delp(k) = delpin(iplon,k1) tavel(k)= tlyr(iplon,k1) tz(k) = tlvl(iplon,k1) + dz(k) = dzlyr(iplon,k1) !> -# Set absorber amount for h2o, co2, and o3. @@ -835,10 +835,10 @@ subroutine rrtmg_lw_run & k1 = nlp1 - k 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 + 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,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 @@ -912,9 +912,10 @@ subroutine rrtmg_lw_run & do k = 1, nlay pavel(k)= plyr(iplon,k) - delp(k) = plvl(iplon,k) - plvl(iplon,k+1) + delp(k) = delpin(iplon,k) tavel(k)= tlyr(iplon,k) tz(k) = tlvl(iplon,k+1) + dz(k) = dzlyr(iplon,k) ! --- ... set absorber amount !test use @@ -932,7 +933,7 @@ subroutine rrtmg_lw_run & 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_co2(iplon,k)) ! 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 @@ -943,10 +944,10 @@ subroutine rrtmg_lw_run & do k = 1, nlay 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 + 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,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 @@ -1064,21 +1065,29 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & nlay, nlp1, ipseed(iplon), & + & nlay, nlp1, ipseed(iplon), dz, delgth, & ! --- outputs: & cldfmc, taucld & & ) +! --- ... save computed layer cloud optical depth for output +! rrtm band-7 is apprx 10mu channel (or use spectral mean of bands 6-8) + + if (ivflip == 0) then ! input from toa to sfc + do k = 1, nlay + k1 = nlp1 - k + cldtau(iplon,k1) = taucld( 7,k) + enddo + else ! input from sfc to toa + do k = 1, nlay + cldtau(iplon,k) = taucld( 7,k) + enddo + endif ! end if_ivflip_block + else cldfmc = f_zero taucld = f_zero endif - if (ilwcliq > 0) then - do k = 1, nlay - cld_od_layer(iplon,k) = taucld(6,k) & - & + taucld(7,k) + taucld(8,k) - enddo - endif ! if (lprnt) then ! print *,' after cldprop' @@ -1339,6 +1348,7 @@ subroutine rlwinit & ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (isubcol>0 only) ! +! =3: decorrelation-length overlap (for isubclw>0 only) ! ! ! ! ******************************************************************* ! ! original code description ! @@ -1382,14 +1392,14 @@ subroutine rlwinit & ! !===> ... begin here ! - if ( iovrlw<0 .or. iovrlw>2 ) then + if ( iovrlw<0 .or. iovrlw>3 ) then print *,' *** Error in specification of cloud overlap flag', & & ' IOVRLW=',iovrlw,' in RLWINIT !!' stop - elseif ( iovrlw==2 .and. isubclw==0 ) then + elseif ( iovrlw>=2 .and. isubclw==0 ) then if (me == 0) then - print *,' *** IOVRLW=2 - maximum cloud overlap, is not yet', & - & ' available for ISUBCLW=0 setting!!' + print *,' *** IOVRLW=',iovrlw,' is not available for', & + & ' ISUBCLW=0 setting!!' print *,' The program uses maximum/random overlap', & & ' instead.' endif @@ -1510,6 +1520,7 @@ end subroutine rlwinit !!\param cdat2 effective radius for rain drop (micron) !!\param cdat3 layer snow flake water path(\f$g/m^2\f$) !!\param cdat4 mean effective radius for snow flake(micron) +!!\n --- for ilwcliq = 0 (diagnostic cloud scheme) - - - !!\param cliqp not used !!\param cicep not used !!\param reliq not used @@ -1527,7 +1538,7 @@ end subroutine rlwinit !> @{ subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, & + & nlay, nlp1, ipseed, dz, de_lgth, & & cldfmc, taucld & ! --- outputs & ) @@ -1561,6 +1572,8 @@ subroutine cldprop & ! cicep - not used nlay ! ! reice - not used nlay ! ! ! +! dz - real, layer thickness (km) nlay ! +! de_lgth- real, layer cloud decorrelation length (km) 1 ! ! nlay - integer, number of vertical layers 1 ! ! nlp1 - integer, number of vertical levels 1 ! ! ipseed- permutation seed for generating random numbers (isubclw>0) ! @@ -1629,7 +1642,8 @@ subroutine cldprop & real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & - & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4 + & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz + real (kind=kind_phys), intent(in) :: de_lgth ! --- outputs: real (kind=kind_phys), dimension(ngptlw,nlay),intent(out):: cldfmc @@ -1804,7 +1818,7 @@ subroutine cldprop & call mcica_subcol & ! --- inputs: - & ( cldf, nlay, ipseed, & + & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- output: & lcloudy & & ) @@ -1836,7 +1850,7 @@ end subroutine cldprop !!\section mcica_subcol_gen mcica_subcol General Algorithm !! @{ subroutine mcica_subcol & - & ( cldf, nlay, ipseed, &! --- inputs + & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs & lcloudy & ! --- outputs & ) @@ -1849,13 +1863,15 @@ subroutine mcica_subcol & ! ** note : if the cloud generator is called multiple times, need ! ! to permute the seed between each call; if between calls ! ! for lw and sw, use values differ by the number of g-pts. ! +! dz - real, layer thickness (km) nlay ! +! de_lgth - real, layer cloud decorrelation length (km) 1 ! ! ! ! output variables: ! ! lcloudy - logical, sub-colum cloud profile flag array ngptlw*nlay! ! ! ! other control flags from module variables: ! ! iovrlw : control flag for cloud overlapping method ! -! =0:random; =1:maximum/random: =2:maximum ! +! =0:random; =1:maximum/random: =2:maximum; =3:decorr ! ! ! ! ===================== end of definitions ==================== ! @@ -1864,14 +1880,16 @@ subroutine mcica_subcol & ! --- inputs: integer, intent(in) :: nlay, ipseed - real (kind=kind_phys), dimension(nlay), intent(in) :: cldf + real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz + real (kind=kind_phys), intent(in) :: de_lgth ! --- outputs: logical, dimension(ngptlw,nlay), intent(out) :: lcloudy ! --- locals: real (kind=kind_phys) :: cdfunc(ngptlw,nlay), rand1d(ngptlw), & - & rand2d(nlay*ngptlw), tem1 + & rand2d(nlay*ngptlw), tem1, fac_lcf(nlay), & + & cdfun2(ngptlw,nlay) type (random_stat) :: stat ! for thread safe random generator @@ -1977,6 +1995,52 @@ subroutine mcica_subcol & enddo enddo + case( 3 ) ! decorrelation length overlap + +! --- compute overlapping factors based on layer midpoint distances +! and decorrelation depths + + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dz(k)+dz(k-1)) / de_lgth ) + enddo + +! --- setup 2 sets of random numbers + + call random_number ( rand2d, stat ) + + k1 = 0 + do k = 1, nlay + do n = 1, ngptlw + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + call random_number ( rand2d, stat ) + + k1 = 0 + do k = 1, nlay + do n = 1, ngptlw + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + +! --- then working from the top down: +! if a random number (from an independent set -cdfun2) is smaller then the +! scale factor: use the upper layer's number, otherwise use a new random +! number (keep the original assigned one). + + do k = nlay-1, 1, -1 + k1 = k + 1 + + do n = 1, ngptlw + if ( cdfun2(n,k) <= fac_lcf(k1) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + end select !> -# Generate subcolumns for homogeneous clouds. diff --git a/physics/radlw_param.f b/physics/radlw_param.f index b06adb251..47ed660d8 100644 --- a/physics/radlw_param.f +++ b/physics/radlw_param.f @@ -119,8 +119,8 @@ module module_radlw_parameters ! !> Band spectrum structures (wavenumber is 1/cm) real (kind=kind_phys) :: wvnlw1(NBANDS), wvnlw2(NBANDS) data wvnlw1 / & - & 10., 351., 501., 631., 701., 821., 981., 1081., & - & 1181., 1391., 1481., 1801., 2081., 2251., 2381., 2601. / + & 10., 350., 500., 630., 700., 820., 980., 1080., & + & 1180., 1390., 1480., 1800., 2080., 2250., 2380., 2600. / data wvnlw2 / & & 350., 500., 630., 700., 820., 980., 1080., 1180., & & 1390., 1480., 1800., 2080., 2250., 2380., 2600., 3250. / diff --git a/physics/radsw_datatb.f b/physics/radsw_datatb.f index 206f2269e..3cc9e2d82 100644 --- a/physics/radsw_datatb.f +++ b/physics/radsw_datatb.f @@ -187,6 +187,9 @@ module module_radsw_cldprtb ! ! module for ncep models. ! ! jun 2008 -- yu-tai hou modified to use aer's newer ! ! release v3.5 data table for cloud ice particles ! +! jun 2018 -- h-m lin/y-t hou updated with aer's newer ! +! version of v3.9-v4.0 liq cloud optical property ! +! coeffs for hu and stamnes scheme ! ! ! ! ********* the original program descriptions ********* ! ! ! @@ -198,7 +201,7 @@ module module_radsw_cldprtb ! ! name type purpose ! ---- : ---- : --------------------------------------------------! ! xxxliq1 : real : optical properties (extinction coefficient, single! -! scattering albedo, assymetry factor) from ! +! xxxliq2 (updated) scattering albedo, assymetry factor) from ! ! hu & stamnes, 1993, j. clim., 6, 728-742 ! ! xbari : real : optical properties (extinction coefficient, single! ! scattering albedo, assymetry factor) calculated ! @@ -227,16 +230,18 @@ module module_radsw_cldprtb ! ! === everything below is for iflagliq >= 1. !>\name Hu and Stamnes (1993) coefficients for cloud liquid condensate (used if iswcliq=1) +!>\name updated Hu and Stamnes (1993) coef for cloud liquid condensate (used if iswcliq=2) !> extinction coefficients real (kind=kind_phys), dimension(58,nblow:nbhgh), public :: & - & extliq1 + & extliq1, extliq2 !> single scattering albedo coefficients real (kind=kind_phys), dimension(58,nblow:nbhgh), public :: & - & ssaliq1 + & ssaliq1, ssaliq2 !> asymmetry coefficients real (kind=kind_phys), dimension(58,nblow:nbhgh), public :: & - & asyliq1 + & asyliq1, asyliq2 + !>\name Streamer V3 (Key 2002) coefficients for cloud ice condensate (used if iswcice=2) !> extinction coefficients @@ -839,6 +844,558 @@ module module_radsw_cldprtb ! & 9.492311e-01,9.499019e-01,9.510077e-01,9.526084e-01,9.547636e-01,& & 9.575331e-01,9.609766e-01,9.6515e-01 / +! --- ... updated extinction coefficient from hu and stamnes + data extliq2(:, 16) / & + & 9.004493E-01,6.366723E-01,4.542354E-01,3.468253E-01,2.816431E-01,& + & 2.383415E-01,2.070854E-01,1.831854E-01,1.642115E-01,1.487539E-01,& + & 1.359169E-01,1.250900E-01,1.158354E-01,1.078400E-01,1.008646E-01,& + & 9.472307E-02,8.928000E-02,8.442308E-02,8.005924E-02,7.612231E-02,& + & 7.255153E-02,6.929539E-02,6.631769E-02,6.358153E-02,6.106231E-02,& + & 5.873077E-02,5.656924E-02,5.455769E-02,5.267846E-02,5.091923E-02,& + & 4.926692E-02,4.771154E-02,4.623923E-02,4.484385E-02,4.351539E-02,& + & 4.224615E-02,4.103385E-02,3.986538E-02,3.874077E-02,3.765462E-02,& + & 3.660077E-02,3.557384E-02,3.457615E-02,3.360308E-02,3.265000E-02,& + & 3.171770E-02,3.080538E-02,2.990846E-02,2.903000E-02,2.816461E-02,& + & 2.731539E-02,2.648231E-02,2.566308E-02,2.485923E-02,2.407000E-02,& + & 2.329615E-02,2.253769E-02,2.179615E-02 / + data extliq2(:, 17) / & + & 6.741200e-01,5.390739e-01,4.198767e-01,3.332553e-01,2.735633e-01,& + & 2.317727e-01,2.012760e-01,1.780400e-01,1.596927e-01,1.447980e-01,& + & 1.324480e-01,1.220347e-01,1.131327e-01,1.054313e-01,9.870534e-02,& + & 9.278200e-02,8.752599e-02,8.282933e-02,7.860600e-02,7.479133e-02,& + & 7.132800e-02,6.816733e-02,6.527401e-02,6.261266e-02,6.015934e-02,& + & 5.788867e-02,5.578134e-02,5.381667e-02,5.198133e-02,5.026067e-02,& + & 4.864466e-02,4.712267e-02,4.568066e-02,4.431200e-02,4.300867e-02,& + & 4.176600e-02,4.057400e-02,3.942534e-02,3.832066e-02,3.725068e-02,& + & 3.621400e-02,3.520533e-02,3.422333e-02,3.326400e-02,3.232467e-02,& + & 3.140535e-02,3.050400e-02,2.962000e-02,2.875267e-02,2.789800e-02,& + & 2.705934e-02,2.623667e-02,2.542667e-02,2.463200e-02,2.385267e-02,& + & 2.308667e-02,2.233667e-02,2.160067e-02 / + data extliq2(:, 18) / & + & 9.250861e-01,6.245692e-01,4.347038e-01,3.320208e-01,2.714869e-01,& + & 2.309516e-01,2.012592e-01,1.783315e-01,1.600369e-01,1.451000e-01,& + & 1.326838e-01,1.222069e-01,1.132554e-01,1.055146e-01,9.876000e-02,& + & 9.281386e-02,8.754000e-02,8.283078e-02,7.860077e-02,7.477769e-02,& + & 7.130847e-02,6.814461e-02,6.524615e-02,6.258462e-02,6.012847e-02,& + & 5.785462e-02,5.574231e-02,5.378000e-02,5.194461e-02,5.022462e-02,& + & 4.860846e-02,4.708462e-02,4.564154e-02,4.427462e-02,4.297231e-02,& + & 4.172769e-02,4.053693e-02,3.939000e-02,3.828462e-02,3.721692e-02,& + & 3.618000e-02,3.517077e-02,3.418923e-02,3.323077e-02,3.229154e-02,& + & 3.137154e-02,3.047154e-02,2.959077e-02,2.872308e-02,2.786846e-02,& + & 2.703077e-02,2.620923e-02,2.540077e-02,2.460615e-02,2.382693e-02,& + & 2.306231e-02,2.231231e-02,2.157923e-02 / + data extliq2(:, 19) / & + & 9.298960e-01,5.776460e-01,4.083450e-01,3.211160e-01,2.666390e-01,& + & 2.281990e-01,1.993250e-01,1.768080e-01,1.587810e-01,1.440390e-01,& + & 1.317720e-01,1.214150e-01,1.125540e-01,1.048890e-01,9.819600e-02,& + & 9.230201e-02,8.706900e-02,8.239698e-02,7.819500e-02,7.439899e-02,& + & 7.095300e-02,6.780700e-02,6.492900e-02,6.228600e-02,5.984600e-02,& + & 5.758599e-02,5.549099e-02,5.353801e-02,5.171400e-02,5.000500e-02,& + & 4.840000e-02,4.688500e-02,4.545100e-02,4.409300e-02,4.279700e-02,& + & 4.156100e-02,4.037700e-02,3.923800e-02,3.813800e-02,3.707600e-02,& + & 3.604500e-02,3.504300e-02,3.406500e-02,3.310800e-02,3.217700e-02,& + & 3.126600e-02,3.036800e-02,2.948900e-02,2.862400e-02,2.777500e-02,& + & 2.694200e-02,2.612300e-02,2.531700e-02,2.452800e-02,2.375100e-02,& + & 2.299100e-02,2.224300e-02,2.151201e-02 / + data extliq2(:, 20) / & + & 8.780964e-01,5.407031e-01,3.961100e-01,3.166645e-01,2.640455e-01,& + & 2.261070e-01,1.974820e-01,1.751775e-01,1.573415e-01,1.427725e-01,& + & 1.306535e-01,1.204195e-01,1.116650e-01,1.040915e-01,9.747550e-02,& + & 9.164800e-02,8.647649e-02,8.185501e-02,7.770200e-02,7.394749e-02,& + & 7.053800e-02,6.742700e-02,6.457999e-02,6.196149e-02,5.954450e-02,& + & 5.730650e-02,5.522949e-02,5.329450e-02,5.148500e-02,4.979000e-02,& + & 4.819600e-02,4.669301e-02,4.527050e-02,4.391899e-02,4.263500e-02,& + & 4.140500e-02,4.022850e-02,3.909500e-02,3.800199e-02,3.694600e-02,& + & 3.592000e-02,3.492250e-02,3.395050e-02,3.300150e-02,3.207250e-02,& + & 3.116250e-02,3.027100e-02,2.939500e-02,2.853500e-02,2.768900e-02,& + & 2.686000e-02,2.604350e-02,2.524150e-02,2.445350e-02,2.368049e-02,& + & 2.292150e-02,2.217800e-02,2.144800e-02 / + data extliq2(:, 21) / & + & 7.937480e-01,5.123036e-01,3.858181e-01,3.099622e-01,2.586829e-01,& + & 2.217587e-01,1.939755e-01,1.723397e-01,1.550258e-01,1.408600e-01,& + & 1.290545e-01,1.190661e-01,1.105039e-01,1.030848e-01,9.659387e-02,& + & 9.086775e-02,8.577807e-02,8.122452e-02,7.712711e-02,7.342193e-02,& + & 7.005387e-02,6.697840e-02,6.416000e-02,6.156903e-02,5.917484e-02,& + & 5.695807e-02,5.489968e-02,5.298097e-02,5.118806e-02,4.950645e-02,& + & 4.792710e-02,4.643581e-02,4.502484e-02,4.368547e-02,4.241001e-02,& + & 4.118936e-02,4.002193e-02,3.889711e-02,3.781322e-02,3.676387e-02,& + & 3.574549e-02,3.475548e-02,3.379033e-02,3.284678e-02,3.192420e-02,& + & 3.102032e-02,3.013484e-02,2.926258e-02,2.840839e-02,2.756742e-02,& + & 2.674258e-02,2.593064e-02,2.513258e-02,2.435000e-02,2.358064e-02,& + & 2.282581e-02,2.208548e-02,2.135936e-02 / + data extliq2(:, 22) / & + & 7.533129e-01,5.033129e-01,3.811271e-01,3.062757e-01,2.558729e-01,& + & 2.196828e-01,1.924372e-01,1.711714e-01,1.541086e-01,1.401114e-01,& + & 1.284257e-01,1.185200e-01,1.100243e-01,1.026529e-01,9.620142e-02,& + & 9.050714e-02,8.544428e-02,8.091714e-02,7.684000e-02,7.315429e-02,& + & 6.980143e-02,6.673999e-02,6.394000e-02,6.136000e-02,5.897715e-02,& + & 5.677000e-02,5.472285e-02,5.281286e-02,5.102858e-02,4.935429e-02,& + & 4.778000e-02,4.629714e-02,4.489142e-02,4.355857e-02,4.228715e-02,& + & 4.107285e-02,3.990857e-02,3.879000e-02,3.770999e-02,3.666429e-02,& + & 3.565000e-02,3.466286e-02,3.370143e-02,3.276143e-02,3.184143e-02,& + & 3.094000e-02,3.005714e-02,2.919000e-02,2.833714e-02,2.750000e-02,& + & 2.667714e-02,2.586714e-02,2.507143e-02,2.429143e-02,2.352428e-02,& + & 2.277143e-02,2.203429e-02,2.130857e-02 / + data extliq2(:, 23) / & + & 7.079894e-01,4.878198e-01,3.719852e-01,3.001873e-01,2.514795e-01,& + & 2.163013e-01,1.897100e-01,1.689033e-01,1.521793e-01,1.384449e-01,& + & 1.269666e-01,1.172326e-01,1.088745e-01,1.016224e-01,9.527085e-02,& + & 8.966240e-02,8.467543e-02,8.021144e-02,7.619344e-02,7.255676e-02,& + & 6.924996e-02,6.623030e-02,6.346261e-02,6.091499e-02,5.856325e-02,& + & 5.638385e-02,5.435930e-02,5.247156e-02,5.070699e-02,4.905230e-02,& + & 4.749499e-02,4.602611e-02,4.463581e-02,4.331543e-02,4.205647e-02,& + & 4.085241e-02,3.969978e-02,3.859033e-02,3.751877e-02,3.648168e-02,& + & 3.547468e-02,3.449553e-02,3.354072e-02,3.260732e-02,3.169438e-02,& + & 3.079969e-02,2.992146e-02,2.905875e-02,2.821201e-02,2.737873e-02,& + & 2.656052e-02,2.575586e-02,2.496511e-02,2.418783e-02,2.342500e-02,& + & 2.267646e-02,2.194177e-02,2.122146e-02 / + data extliq2(:, 24) / & + & 6.850164e-01,4.762468e-01,3.642001e-01,2.946012e-01,2.472001e-01,& + & 2.128588e-01,1.868537e-01,1.664893e-01,1.501142e-01,1.366620e-01,& + & 1.254147e-01,1.158721e-01,1.076732e-01,1.005530e-01,9.431306e-02,& + & 8.879891e-02,8.389232e-02,7.949714e-02,7.553857e-02,7.195474e-02,& + & 6.869413e-02,6.571444e-02,6.298286e-02,6.046779e-02,5.814474e-02,& + & 5.599141e-02,5.399114e-02,5.212443e-02,5.037870e-02,4.874321e-02,& + & 4.720219e-02,4.574813e-02,4.437160e-02,4.306460e-02,4.181810e-02,& + & 4.062603e-02,3.948252e-02,3.838256e-02,3.732049e-02,3.629192e-02,& + & 3.529301e-02,3.432190e-02,3.337412e-02,3.244842e-02,3.154175e-02,& + & 3.065253e-02,2.978063e-02,2.892367e-02,2.808221e-02,2.725478e-02,& + & 2.644174e-02,2.564175e-02,2.485508e-02,2.408303e-02,2.332365e-02,& + & 2.257890e-02,2.184824e-02,2.113224e-02 / + data extliq2(:, 25) / & + & 6.673017e-01,4.664520e-01,3.579398e-01,2.902234e-01,2.439904e-01,& + & 2.104149e-01,1.849277e-01,1.649234e-01,1.488087e-01,1.355515e-01,& + & 1.244562e-01,1.150329e-01,1.069321e-01,9.989310e-02,9.372070e-02,& + & 8.826450e-02,8.340622e-02,7.905378e-02,7.513109e-02,7.157859e-02,& + & 6.834588e-02,6.539114e-02,6.268150e-02,6.018621e-02,5.788098e-02,& + & 5.574351e-02,5.375699e-02,5.190412e-02,5.017099e-02,4.854497e-02,& + & 4.701490e-02,4.557030e-02,4.420249e-02,4.290304e-02,4.166427e-02,& + & 4.047820e-02,3.934232e-02,3.824778e-02,3.719236e-02,3.616931e-02,& + & 3.517597e-02,3.420856e-02,3.326566e-02,3.234346e-02,3.144122e-02,& + & 3.055684e-02,2.968798e-02,2.883519e-02,2.799635e-02,2.717228e-02,& + & 2.636182e-02,2.556424e-02,2.478114e-02,2.401086e-02,2.325657e-02,& + & 2.251506e-02,2.178594e-02,2.107301e-02 / + data extliq2(:, 26) / & + & 6.552414e-01,4.599454e-01,3.538626e-01,2.873547e-01,2.418033e-01,& + & 2.086660e-01,1.834885e-01,1.637142e-01,1.477767e-01,1.346583e-01,& + & 1.236734e-01,1.143412e-01,1.063148e-01,9.933905e-02,9.322026e-02,& + & 8.780979e-02,8.299230e-02,7.867554e-02,7.478450e-02,7.126053e-02,& + & 6.805276e-02,6.512143e-02,6.243211e-02,5.995541e-02,5.766712e-02,& + & 5.554484e-02,5.357246e-02,5.173222e-02,5.001069e-02,4.839505e-02,& + & 4.687471e-02,4.543861e-02,4.407857e-02,4.278577e-02,4.155331e-02,& + & 4.037322e-02,3.924302e-02,3.815376e-02,3.710172e-02,3.608296e-02,& + & 3.509330e-02,3.412980e-02,3.319009e-02,3.227106e-02,3.137157e-02,& + & 3.048950e-02,2.962365e-02,2.877297e-02,2.793726e-02,2.711500e-02,& + & 2.630666e-02,2.551206e-02,2.473052e-02,2.396287e-02,2.320861e-02,& + & 2.246810e-02,2.174162e-02,2.102927e-02 / + data extliq2(:, 27) / & + & 6.430901e-01,4.532134e-01,3.496132e-01,2.844655e-01,2.397347e-01,& + & 2.071236e-01,1.822976e-01,1.627640e-01,1.469961e-01,1.340006e-01,& + & 1.231069e-01,1.138441e-01,1.058706e-01,9.893678e-02,9.285166e-02,& + & 8.746871e-02,8.267411e-02,7.837656e-02,7.450257e-02,7.099318e-02,& + & 6.779929e-02,6.487987e-02,6.220168e-02,5.973530e-02,5.745636e-02,& + & 5.534344e-02,5.337986e-02,5.154797e-02,4.983404e-02,4.822582e-02,& + & 4.671228e-02,4.528321e-02,4.392997e-02,4.264325e-02,4.141647e-02,& + & 4.024259e-02,3.911767e-02,3.803309e-02,3.698782e-02,3.597140e-02,& + & 3.498774e-02,3.402852e-02,3.309340e-02,3.217818e-02,3.128292e-02,& + & 3.040486e-02,2.954230e-02,2.869545e-02,2.786261e-02,2.704372e-02,& + & 2.623813e-02,2.544668e-02,2.466788e-02,2.390313e-02,2.315136e-02,& + & 2.241391e-02,2.168921e-02,2.097903e-02 / + data extliq2(:, 28) / & + & 6.367074e-01,4.495768e-01,3.471263e-01,2.826149e-01,2.382868e-01,& + & 2.059640e-01,1.813562e-01,1.619881e-01,1.463436e-01,1.334402e-01,& + & 1.226166e-01,1.134096e-01,1.054829e-01,9.858838e-02,9.253790e-02,& + & 8.718582e-02,8.241830e-02,7.814482e-02,7.429212e-02,7.080165e-02,& + & 6.762385e-02,6.471838e-02,6.205388e-02,5.959726e-02,5.732871e-02,& + & 5.522402e-02,5.326793e-02,5.144230e-02,4.973440e-02,4.813188e-02,& + & 4.662283e-02,4.519798e-02,4.384833e-02,4.256541e-02,4.134253e-02,& + & 4.017136e-02,3.904911e-02,3.796779e-02,3.692364e-02,3.591182e-02,& + & 3.492930e-02,3.397230e-02,3.303920e-02,3.212572e-02,3.123278e-02,& + & 3.035519e-02,2.949493e-02,2.864985e-02,2.781840e-02,2.700197e-02,& + & 2.619682e-02,2.540674e-02,2.462966e-02,2.386613e-02,2.311602e-02,& + & 2.237846e-02,2.165660e-02,2.094756e-02 / + data extliq2(:, 29) / & + & 4.298416e-01,4.391639e-01,3.975030e-01,3.443028e-01,2.957345e-01,& + & 2.556461e-01,2.234755e-01,1.976636e-01,1.767428e-01,1.595611e-01,& + & 1.452636e-01,1.332156e-01,1.229481e-01,1.141059e-01,1.064208e-01,& + & 9.968527e-02,9.373833e-02,8.845221e-02,8.372112e-02,7.946667e-02,& + & 7.561807e-02,7.212029e-02,6.893166e-02,6.600944e-02,6.332277e-02,& + & 6.084277e-02,5.854721e-02,5.641361e-02,5.442639e-02,5.256750e-02,& + & 5.082499e-02,4.918556e-02,4.763694e-02,4.617222e-02,4.477861e-02,& + & 4.344861e-02,4.217999e-02,4.096111e-02,3.978638e-02,3.865361e-02,& + & 3.755473e-02,3.649028e-02,3.545361e-02,3.444361e-02,3.345666e-02,& + & 3.249167e-02,3.154722e-02,3.062083e-02,2.971250e-02,2.882083e-02,& + & 2.794611e-02,2.708778e-02,2.624500e-02,2.541750e-02,2.460528e-02,& + & 2.381194e-02,2.303250e-02,2.226833e-02 / + +! --- ... updated single scattering albedo from hu and stamnes + data ssaliq2(:, 16) / & + & 8.362119e-01,8.098460e-01,7.762291e-01,7.486042e-01,7.294172e-01,& + & 7.161000e-01,7.060656e-01,6.978387e-01,6.907193e-01,6.843551e-01,& + & 6.785668e-01,6.732450e-01,6.683191e-01,6.637264e-01,6.594307e-01,& + & 6.554033e-01,6.516115e-01,6.480295e-01,6.446429e-01,6.414306e-01,& + & 6.383783e-01,6.354750e-01,6.327068e-01,6.300665e-01,6.275376e-01,& + & 6.251245e-01,6.228136e-01,6.205944e-01,6.184720e-01,6.164330e-01,& + & 6.144742e-01,6.125962e-01,6.108004e-01,6.090740e-01,6.074200e-01,& + & 6.058381e-01,6.043209e-01,6.028681e-01,6.014836e-01,6.001626e-01,& + & 5.988957e-01,5.976864e-01,5.965390e-01,5.954379e-01,5.943972e-01,& + & 5.934019e-01,5.924624e-01,5.915579e-01,5.907025e-01,5.898913e-01,& + & 5.891213e-01,5.883815e-01,5.876851e-01,5.870158e-01,5.863868e-01,& + & 5.857821e-01,5.852111e-01,5.846579e-01 / + data ssaliq2(:, 17) / & + & 6.995459e-01,7.158012e-01,7.076001e-01,6.927244e-01,6.786434e-01,& + & 6.673545e-01,6.585859e-01,6.516314e-01,6.459010e-01,6.410225e-01,& + & 6.367574e-01,6.329554e-01,6.295119e-01,6.263595e-01,6.234462e-01,& + & 6.207274e-01,6.181755e-01,6.157678e-01,6.134880e-01,6.113173e-01,& + & 6.092495e-01,6.072689e-01,6.053717e-01,6.035507e-01,6.018001e-01,& + & 6.001134e-01,5.984951e-01,5.969294e-01,5.954256e-01,5.939698e-01,& + & 5.925716e-01,5.912265e-01,5.899270e-01,5.886771e-01,5.874746e-01,& + & 5.863185e-01,5.852077e-01,5.841460e-01,5.831249e-01,5.821474e-01,& + & 5.812078e-01,5.803173e-01,5.794616e-01,5.786443e-01,5.778617e-01,& + & 5.771236e-01,5.764191e-01,5.757400e-01,5.750971e-01,5.744842e-01,& + & 5.739012e-01,5.733482e-01,5.728175e-01,5.723214e-01,5.718383e-01,& + & 5.713827e-01,5.709471e-01,5.705330e-01 / + data ssaliq2(:, 18) / & + & 9.929711e-01,9.896942e-01,9.852408e-01,9.806820e-01,9.764512e-01,& + & 9.725375e-01,9.688677e-01,9.653832e-01,9.620552e-01,9.588522e-01,& + & 9.557475e-01,9.527265e-01,9.497731e-01,9.468756e-01,9.440270e-01,& + & 9.412230e-01,9.384592e-01,9.357287e-01,9.330369e-01,9.303778e-01,& + & 9.277502e-01,9.251546e-01,9.225907e-01,9.200553e-01,9.175521e-01,& + & 9.150773e-01,9.126352e-01,9.102260e-01,9.078485e-01,9.055057e-01,& + & 9.031978e-01,9.009306e-01,8.987010e-01,8.965177e-01,8.943774e-01,& + & 8.922869e-01,8.902430e-01,8.882551e-01,8.863182e-01,8.844373e-01,& + & 8.826143e-01,8.808499e-01,8.791413e-01,8.774940e-01,8.759019e-01,& + & 8.743650e-01,8.728941e-01,8.714712e-01,8.701065e-01,8.688008e-01,& + & 8.675409e-01,8.663295e-01,8.651714e-01,8.640637e-01,8.629943e-01,& + & 8.619762e-01,8.609995e-01,8.600581e-01 / + data ssaliq2(:, 19) / & + & 9.910612e-01,9.854226e-01,9.795008e-01,9.742920e-01,9.695996e-01,& + & 9.652274e-01,9.610648e-01,9.570521e-01,9.531397e-01,9.493086e-01,& + & 9.455413e-01,9.418362e-01,9.381902e-01,9.346016e-01,9.310718e-01,& + & 9.275957e-01,9.241757e-01,9.208038e-01,9.174802e-01,9.142058e-01,& + & 9.109753e-01,9.077895e-01,9.046433e-01,9.015409e-01,8.984784e-01,& + & 8.954572e-01,8.924748e-01,8.895367e-01,8.866395e-01,8.837864e-01,& + & 8.809819e-01,8.782267e-01,8.755231e-01,8.728712e-01,8.702802e-01,& + & 8.677443e-01,8.652733e-01,8.628678e-01,8.605300e-01,8.582593e-01,& + & 8.560596e-01,8.539352e-01,8.518782e-01,8.498915e-01,8.479790e-01,& + & 8.461384e-01,8.443645e-01,8.426613e-01,8.410229e-01,8.394495e-01,& + & 8.379428e-01,8.364967e-01,8.351117e-01,8.337820e-01,8.325091e-01,& + & 8.312874e-01,8.301169e-01,8.289985e-01 / + data ssaliq2(:, 20) / & + & 9.969802e-01,9.950445e-01,9.931448e-01,9.914272e-01,9.898652e-01,& + & 9.884250e-01,9.870637e-01,9.857482e-01,9.844558e-01,9.831755e-01,& + & 9.819068e-01,9.806477e-01,9.794000e-01,9.781666e-01,9.769461e-01,& + & 9.757386e-01,9.745459e-01,9.733650e-01,9.721953e-01,9.710398e-01,& + & 9.698936e-01,9.687583e-01,9.676334e-01,9.665192e-01,9.654132e-01,& + & 9.643208e-01,9.632374e-01,9.621625e-01,9.611003e-01,9.600518e-01,& + & 9.590144e-01,9.579922e-01,9.569864e-01,9.559948e-01,9.550239e-01,& + & 9.540698e-01,9.531382e-01,9.522280e-01,9.513409e-01,9.504772e-01,& + & 9.496360e-01,9.488220e-01,9.480327e-01,9.472693e-01,9.465333e-01,& + & 9.458211e-01,9.451344e-01,9.444732e-01,9.438372e-01,9.432268e-01,& + & 9.426391e-01,9.420757e-01,9.415308e-01,9.410102e-01,9.405115e-01,& + & 9.400326e-01,9.395716e-01,9.391313e-01 / + data ssaliq2(:, 21) / & + & 9.980034e-01,9.968572e-01,9.958696e-01,9.949747e-01,9.941241e-01,& + & 9.933043e-01,9.924971e-01,9.916978e-01,9.909023e-01,9.901046e-01,& + & 9.893087e-01,9.885146e-01,9.877195e-01,9.869283e-01,9.861379e-01,& + & 9.853523e-01,9.845715e-01,9.837945e-01,9.830217e-01,9.822567e-01,& + & 9.814935e-01,9.807356e-01,9.799815e-01,9.792332e-01,9.784845e-01,& + & 9.777424e-01,9.770042e-01,9.762695e-01,9.755416e-01,9.748152e-01,& + & 9.740974e-01,9.733873e-01,9.726813e-01,9.719861e-01,9.713010e-01,& + & 9.706262e-01,9.699647e-01,9.693144e-01,9.686794e-01,9.680596e-01,& + & 9.674540e-01,9.668657e-01,9.662926e-01,9.657390e-01,9.652019e-01,& + & 9.646820e-01,9.641784e-01,9.636945e-01,9.632260e-01,9.627743e-01,& + & 9.623418e-01,9.619227e-01,9.615194e-01,9.611341e-01,9.607629e-01,& + & 9.604057e-01,9.600622e-01,9.597322e-01 / + data ssaliq2(:, 22) / & + & 9.988219e-01,9.981767e-01,9.976168e-01,9.971066e-01,9.966195e-01,& + & 9.961566e-01,9.956995e-01,9.952481e-01,9.947982e-01,9.943495e-01,& + & 9.938955e-01,9.934368e-01,9.929825e-01,9.925239e-01,9.920653e-01,& + & 9.916096e-01,9.911552e-01,9.907067e-01,9.902594e-01,9.898178e-01,& + & 9.893791e-01,9.889453e-01,9.885122e-01,9.880837e-01,9.876567e-01,& + & 9.872331e-01,9.868121e-01,9.863938e-01,9.859790e-01,9.855650e-01,& + & 9.851548e-01,9.847491e-01,9.843496e-01,9.839521e-01,9.835606e-01,& + & 9.831771e-01,9.827975e-01,9.824292e-01,9.820653e-01,9.817124e-01,& + & 9.813644e-01,9.810291e-01,9.807020e-01,9.803864e-01,9.800782e-01,& + & 9.797821e-01,9.794958e-01,9.792179e-01,9.789509e-01,9.786940e-01,& + & 9.784460e-01,9.782090e-01,9.779789e-01,9.777553e-01,9.775425e-01,& + & 9.773387e-01,9.771420e-01,9.769529e-01 / + data ssaliq2(:, 23) / & + & 9.998902e-01,9.998395e-01,9.997915e-01,9.997442e-01,9.997016e-01,& + & 9.996600e-01,9.996200e-01,9.995806e-01,9.995411e-01,9.995005e-01,& + & 9.994589e-01,9.994178e-01,9.993766e-01,9.993359e-01,9.992948e-01,& + & 9.992533e-01,9.992120e-01,9.991723e-01,9.991313e-01,9.990906e-01,& + & 9.990510e-01,9.990113e-01,9.989716e-01,9.989323e-01,9.988923e-01,& + & 9.988532e-01,9.988140e-01,9.987761e-01,9.987373e-01,9.986989e-01,& + & 9.986597e-01,9.986239e-01,9.985861e-01,9.985485e-01,9.985123e-01,& + & 9.984762e-01,9.984415e-01,9.984065e-01,9.983722e-01,9.983398e-01,& + & 9.983078e-01,9.982758e-01,9.982461e-01,9.982157e-01,9.981872e-01,& + & 9.981595e-01,9.981324e-01,9.981068e-01,9.980811e-01,9.980580e-01,& + & 9.980344e-01,9.980111e-01,9.979908e-01,9.979690e-01,9.979492e-01,& + & 9.979316e-01,9.979116e-01,9.978948e-01 / + data ssaliq2(:, 24) / & + & 9.999978e-01,9.999948e-01,9.999915e-01,9.999905e-01,9.999896e-01,& + & 9.999887e-01,9.999888e-01,9.999888e-01,9.999870e-01,9.999854e-01,& + & 9.999855e-01,9.999856e-01,9.999839e-01,9.999834e-01,9.999829e-01,& + & 9.999809e-01,9.999816e-01,9.999793e-01,9.999782e-01,9.999779e-01,& + & 9.999772e-01,9.999764e-01,9.999756e-01,9.999744e-01,9.999744e-01,& + & 9.999736e-01,9.999729e-01,9.999716e-01,9.999706e-01,9.999692e-01,& + & 9.999690e-01,9.999675e-01,9.999673e-01,9.999660e-01,9.999654e-01,& + & 9.999647e-01,9.999647e-01,9.999625e-01,9.999620e-01,9.999614e-01,& + & 9.999613e-01,9.999607e-01,9.999604e-01,9.999594e-01,9.999589e-01,& + & 9.999586e-01,9.999567e-01,9.999550e-01,9.999557e-01,9.999542e-01,& + & 9.999546e-01,9.999539e-01,9.999536e-01,9.999526e-01,9.999523e-01,& + & 9.999508e-01,9.999534e-01,9.999507e-01 / + data ssaliq2(:, 25) / & + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,& + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,& + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,& + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,9.999995e-01,& + & 9.999995e-01,9.999990e-01,9.999991e-01,9.999991e-01,9.999990e-01,& + & 9.999989e-01,9.999988e-01,9.999988e-01,9.999986e-01,9.999988e-01,& + & 9.999986e-01,9.999987e-01,9.999986e-01,9.999985e-01,9.999985e-01,& + & 9.999985e-01,9.999985e-01,9.999983e-01,9.999983e-01,9.999981e-01,& + & 9.999981e-01,9.999986e-01,9.999985e-01,9.999983e-01,9.999984e-01,& + & 9.999982e-01,9.999983e-01,9.999982e-01,9.999980e-01,9.999981e-01,& + & 9.999978e-01,9.999979e-01,9.999985e-01,9.999985e-01,9.999983e-01,& + & 9.999983e-01,9.999983e-01,9.999983e-01 / + data ssaliq2(:, 26) / & + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,& + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,& + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,& + & 1.000000e+00,1.000000e+00,1.000000e+00,1.000000e+00,9.999991e-01,& + & 9.999990e-01,9.999992e-01,9.999995e-01,9.999986e-01,9.999994e-01,& + & 9.999985e-01,9.999980e-01,9.999984e-01,9.999983e-01,9.999979e-01,& + & 9.999969e-01,9.999977e-01,9.999971e-01,9.999969e-01,9.999969e-01,& + & 9.999965e-01,9.999970e-01,9.999985e-01,9.999973e-01,9.999961e-01,& + & 9.999968e-01,9.999952e-01,9.999970e-01,9.999974e-01,9.999965e-01,& + & 9.999969e-01,9.999970e-01,9.999970e-01,9.999960e-01,9.999923e-01,& + & 9.999958e-01,9.999937e-01,9.999960e-01,9.999953e-01,9.999946e-01,& + & 9.999946e-01,9.999957e-01,9.999951e-01 / + data ssaliq2(:, 27) / & + & 1.000000e+00,1.000000e+00,9.999983e-01,9.999979e-01,9.999965e-01,& + & 9.999949e-01,9.999948e-01,9.999918e-01,9.999917e-01,9.999923e-01,& + & 9.999908e-01,9.999889e-01,9.999902e-01,9.999895e-01,9.999881e-01,& + & 9.999882e-01,9.999876e-01,9.999866e-01,9.999866e-01,9.999858e-01,& + & 9.999860e-01,9.999852e-01,9.999836e-01,9.999831e-01,9.999818e-01,& + & 9.999808e-01,9.999816e-01,9.999800e-01,9.999783e-01,9.999780e-01,& + & 9.999763e-01,9.999746e-01,9.999731e-01,9.999713e-01,9.999762e-01,& + & 9.999740e-01,9.999670e-01,9.999703e-01,9.999687e-01,9.999666e-01,& + & 9.999683e-01,9.999667e-01,9.999611e-01,9.999635e-01,9.999600e-01,& + & 9.999635e-01,9.999594e-01,9.999601e-01,9.999586e-01,9.999559e-01,& + & 9.999569e-01,9.999558e-01,9.999523e-01,9.999535e-01,9.999529e-01,& + & 9.999553e-01,9.999495e-01,9.999490e-01 / + data ssaliq2(:, 28) / & + & 9.999920e-01,9.999873e-01,9.999855e-01,9.999832e-01,9.999807e-01,& + & 9.999778e-01,9.999754e-01,9.999721e-01,9.999692e-01,9.999651e-01,& + & 9.999621e-01,9.999607e-01,9.999567e-01,9.999546e-01,9.999521e-01,& + & 9.999491e-01,9.999457e-01,9.999439e-01,9.999403e-01,9.999374e-01,& + & 9.999353e-01,9.999315e-01,9.999282e-01,9.999244e-01,9.999234e-01,& + & 9.999189e-01,9.999130e-01,9.999117e-01,9.999073e-01,9.999020e-01,& + & 9.998993e-01,9.998987e-01,9.998922e-01,9.998893e-01,9.998869e-01,& + & 9.998805e-01,9.998778e-01,9.998751e-01,9.998708e-01,9.998676e-01,& + & 9.998624e-01,9.998642e-01,9.998582e-01,9.998547e-01,9.998546e-01,& + & 9.998477e-01,9.998487e-01,9.998466e-01,9.998403e-01,9.998412e-01,& + & 9.998406e-01,9.998342e-01,9.998326e-01,9.998333e-01,9.998328e-01,& + & 9.998290e-01,9.998276e-01,9.998249e-01 / + data ssaliq2(:, 29) / & + & 8.383753e-01,8.461471e-01,8.373325e-01,8.212889e-01,8.023834e-01,& + & 7.829501e-01,7.641777e-01,7.466000e-01,7.304023e-01,7.155998e-01,& + & 7.021259e-01,6.898840e-01,6.787615e-01,6.686479e-01,6.594414e-01,& + & 6.510417e-01,6.433668e-01,6.363335e-01,6.298788e-01,6.239398e-01,& + & 6.184633e-01,6.134055e-01,6.087228e-01,6.043786e-01,6.003439e-01,& + & 5.965910e-01,5.930917e-01,5.898280e-01,5.867798e-01,5.839264e-01,& + & 5.812576e-01,5.787592e-01,5.764163e-01,5.742189e-01,5.721598e-01,& + & 5.702286e-01,5.684182e-01,5.667176e-01,5.651237e-01,5.636253e-01,& + & 5.622228e-01,5.609074e-01,5.596713e-01,5.585089e-01,5.574223e-01,& + & 5.564002e-01,5.554411e-01,5.545397e-01,5.536914e-01,5.528967e-01,& + & 5.521495e-01,5.514457e-01,5.507818e-01,5.501623e-01,5.495750e-01,& + & 5.490192e-01,5.484980e-01,5.480046e-01 / + +! --- ... updated asymmetry parameter from hu and stamnes + data asyliq2(:, 16) / & + & 8.038165e-01,8.014154e-01,7.942381e-01,7.970521e-01,8.086621e-01,& + & 8.233392e-01,8.374127e-01,8.495742e-01,8.596945e-01,8.680497e-01,& + & 8.750005e-01,8.808589e-01,8.858749e-01,8.902403e-01,8.940939e-01,& + & 8.975379e-01,9.006450e-01,9.034741e-01,9.060659e-01,9.084561e-01,& + & 9.106675e-01,9.127198e-01,9.146332e-01,9.164194e-01,9.180970e-01,& + & 9.196658e-01,9.211421e-01,9.225352e-01,9.238443e-01,9.250841e-01,& + & 9.262541e-01,9.273620e-01,9.284081e-01,9.294002e-01,9.303395e-01,& + & 9.312285e-01,9.320715e-01,9.328716e-01,9.336271e-01,9.343427e-01,& + & 9.350219e-01,9.356647e-01,9.362728e-01,9.368495e-01,9.373956e-01,& + & 9.379113e-01,9.383987e-01,9.388608e-01,9.392986e-01,9.397132e-01,& + & 9.401063e-01,9.404776e-01,9.408299e-01,9.411641e-01,9.414800e-01,& + & 9.417787e-01,9.420633e-01,9.423364e-01 / + data asyliq2(:, 17) / & + & 8.941000e-01,9.054049e-01,9.049510e-01,9.027216e-01,9.021636e-01,& + & 9.037878e-01,9.069852e-01,9.109817e-01,9.152013e-01,9.193040e-01,& + & 9.231177e-01,9.265712e-01,9.296606e-01,9.324048e-01,9.348419e-01,& + & 9.370131e-01,9.389529e-01,9.406954e-01,9.422727e-01,9.437088e-01,& + & 9.450221e-01,9.462308e-01,9.473488e-01,9.483830e-01,9.493492e-01,& + & 9.502541e-01,9.510999e-01,9.518971e-01,9.526455e-01,9.533554e-01,& + & 9.540249e-01,9.546571e-01,9.552551e-01,9.558258e-01,9.563603e-01,& + & 9.568713e-01,9.573569e-01,9.578141e-01,9.582485e-01,9.586604e-01,& + & 9.590525e-01,9.594218e-01,9.597710e-01,9.601052e-01,9.604181e-01,& + & 9.607159e-01,9.609979e-01,9.612655e-01,9.615184e-01,9.617564e-01,& + & 9.619860e-01,9.622009e-01,9.624031e-01,9.625957e-01,9.627792e-01,& + & 9.629530e-01,9.631171e-01,9.632746e-01 / + data asyliq2(:, 18) / & + & 8.574638e-01,8.351383e-01,8.142977e-01,8.083068e-01,8.129284e-01,& + & 8.215827e-01,8.307238e-01,8.389963e-01,8.460481e-01,8.519273e-01,& + & 8.568153e-01,8.609116e-01,8.643892e-01,8.673941e-01,8.700248e-01,& + & 8.723707e-01,8.744902e-01,8.764240e-01,8.782057e-01,8.798593e-01,& + & 8.814063e-01,8.828573e-01,8.842261e-01,8.855196e-01,8.867497e-01,& + & 8.879164e-01,8.890316e-01,8.900941e-01,8.911118e-01,8.920832e-01,& + & 8.930156e-01,8.939091e-01,8.947663e-01,8.955888e-01,8.963786e-01,& + & 8.971350e-01,8.978617e-01,8.985590e-01,8.992243e-01,8.998631e-01,& + & 9.004753e-01,9.010602e-01,9.016192e-01,9.021542e-01,9.026644e-01,& + & 9.031535e-01,9.036194e-01,9.040656e-01,9.044894e-01,9.048933e-01,& + & 9.052789e-01,9.056481e-01,9.060004e-01,9.063343e-01,9.066544e-01,& + & 9.069604e-01,9.072512e-01,9.075290e-01 / + data asyliq2(:, 19) / & + & 8.349569e-01,8.034579e-01,7.932136e-01,8.010156e-01,8.137083e-01,& + & 8.255339e-01,8.351938e-01,8.428286e-01,8.488944e-01,8.538187e-01,& + & 8.579255e-01,8.614473e-01,8.645338e-01,8.672908e-01,8.697947e-01,& + & 8.720843e-01,8.742015e-01,8.761718e-01,8.780160e-01,8.797479e-01,& + & 8.813810e-01,8.829250e-01,8.843907e-01,8.857822e-01,8.871059e-01,& + & 8.883724e-01,8.895810e-01,8.907384e-01,8.918456e-01,8.929083e-01,& + & 8.939284e-01,8.949060e-01,8.958463e-01,8.967486e-01,8.976129e-01,& + & 8.984463e-01,8.992439e-01,9.000094e-01,9.007438e-01,9.014496e-01,& + & 9.021235e-01,9.027699e-01,9.033859e-01,9.039772e-01,9.045419e-01,& + & 9.050819e-01,9.055975e-01,9.060907e-01,9.065607e-01,9.070093e-01,& + & 9.074389e-01,9.078475e-01,9.082388e-01,9.086117e-01,9.089678e-01,& + & 9.093081e-01,9.096307e-01,9.099410e-01 / + data asyliq2(:, 20) / & + & 8.109692e-01,7.846657e-01,7.881928e-01,8.009509e-01,8.131208e-01,& + & 8.230400e-01,8.309448e-01,8.372920e-01,8.424837e-01,8.468166e-01,& + & 8.504947e-01,8.536642e-01,8.564256e-01,8.588513e-01,8.610011e-01,& + & 8.629122e-01,8.646262e-01,8.661720e-01,8.675752e-01,8.688582e-01,& + & 8.700379e-01,8.711300e-01,8.721485e-01,8.731027e-01,8.740010e-01,& + & 8.748499e-01,8.756564e-01,8.764239e-01,8.771542e-01,8.778523e-01,& + & 8.785211e-01,8.791601e-01,8.797725e-01,8.803589e-01,8.809173e-01,& + & 8.814552e-01,8.819705e-01,8.824611e-01,8.829311e-01,8.833791e-01,& + & 8.838078e-01,8.842148e-01,8.846044e-01,8.849756e-01,8.853291e-01,& + & 8.856645e-01,8.859841e-01,8.862904e-01,8.865801e-01,8.868551e-01,& + & 8.871182e-01,8.873673e-01,8.876059e-01,8.878307e-01,8.880462e-01,& + & 8.882501e-01,8.884453e-01,8.886339e-01 / + data asyliq2(:, 21) / & + & 7.838510e-01,7.803151e-01,7.980477e-01,8.144160e-01,8.261784e-01,& + & 8.344240e-01,8.404278e-01,8.450391e-01,8.487593e-01,8.518741e-01,& + & 8.545484e-01,8.568890e-01,8.589560e-01,8.607983e-01,8.624504e-01,& + & 8.639408e-01,8.652945e-01,8.665301e-01,8.676634e-01,8.687121e-01,& + & 8.696855e-01,8.705933e-01,8.714448e-01,8.722454e-01,8.730014e-01,& + & 8.737180e-01,8.743982e-01,8.750436e-01,8.756598e-01,8.762481e-01,& + & 8.768089e-01,8.773427e-01,8.778532e-01,8.783434e-01,8.788089e-01,& + & 8.792530e-01,8.796784e-01,8.800845e-01,8.804716e-01,8.808411e-01,& + & 8.811923e-01,8.815276e-01,8.818472e-01,8.821504e-01,8.824408e-01,& + & 8.827155e-01,8.829777e-01,8.832269e-01,8.834631e-01,8.836892e-01,& + & 8.839034e-01,8.841075e-01,8.843021e-01,8.844866e-01,8.846631e-01,& + & 8.848304e-01,8.849910e-01,8.851425e-01 / + data asyliq2(:, 22) / & + & 7.760783e-01,7.890215e-01,8.090192e-01,8.230252e-01,8.321369e-01,& + & 8.384258e-01,8.431529e-01,8.469558e-01,8.501499e-01,8.528899e-01,& + & 8.552899e-01,8.573956e-01,8.592570e-01,8.609098e-01,8.623897e-01,& + & 8.637169e-01,8.649184e-01,8.660097e-01,8.670096e-01,8.679338e-01,& + & 8.687896e-01,8.695880e-01,8.703365e-01,8.710422e-01,8.717092e-01,& + & 8.723378e-01,8.729363e-01,8.735063e-01,8.740475e-01,8.745661e-01,& + & 8.750560e-01,8.755275e-01,8.759731e-01,8.764000e-01,8.768071e-01,& + & 8.771942e-01,8.775628e-01,8.779126e-01,8.782483e-01,8.785626e-01,& + & 8.788610e-01,8.791482e-01,8.794180e-01,8.796765e-01,8.799207e-01,& + & 8.801522e-01,8.803707e-01,8.805777e-01,8.807749e-01,8.809605e-01,& + & 8.811362e-01,8.813047e-01,8.814647e-01,8.816131e-01,8.817588e-01,& + & 8.818930e-01,8.820230e-01,8.821445e-01 / + data asyliq2(:, 23) / & + & 7.847907e-01,8.099917e-01,8.257428e-01,8.350423e-01,8.411971e-01,& + & 8.457241e-01,8.493010e-01,8.522565e-01,8.547660e-01,8.569311e-01,& + & 8.588181e-01,8.604729e-01,8.619296e-01,8.632208e-01,8.643725e-01,& + & 8.654050e-01,8.663363e-01,8.671835e-01,8.679590e-01,8.686707e-01,& + & 8.693308e-01,8.699433e-01,8.705147e-01,8.710490e-01,8.715497e-01,& + & 8.720219e-01,8.724669e-01,8.728849e-01,8.732806e-01,8.736550e-01,& + & 8.740099e-01,8.743435e-01,8.746601e-01,8.749610e-01,8.752449e-01,& + & 8.755143e-01,8.757688e-01,8.760095e-01,8.762375e-01,8.764532e-01,& + & 8.766579e-01,8.768506e-01,8.770323e-01,8.772049e-01,8.773690e-01,& + & 8.775226e-01,8.776679e-01,8.778062e-01,8.779360e-01,8.780587e-01,& + & 8.781747e-01,8.782852e-01,8.783892e-01,8.784891e-01,8.785824e-01,& + & 8.786705e-01,8.787546e-01,8.788336e-01 / + data asyliq2(:, 24) / & + & 8.054324e-01,8.266282e-01,8.378075e-01,8.449848e-01,8.502166e-01,& + & 8.542268e-01,8.573477e-01,8.598022e-01,8.617689e-01,8.633859e-01,& + & 8.647536e-01,8.659354e-01,8.669807e-01,8.679143e-01,8.687577e-01,& + & 8.695222e-01,8.702207e-01,8.708591e-01,8.714446e-01,8.719836e-01,& + & 8.724812e-01,8.729426e-01,8.733689e-01,8.737665e-01,8.741373e-01,& + & 8.744834e-01,8.748070e-01,8.751131e-01,8.754011e-01,8.756676e-01,& + & 8.759219e-01,8.761599e-01,8.763857e-01,8.765984e-01,8.767999e-01,& + & 8.769889e-01,8.771669e-01,8.773373e-01,8.774969e-01,8.776469e-01,& + & 8.777894e-01,8.779237e-01,8.780505e-01,8.781703e-01,8.782820e-01,& + & 8.783886e-01,8.784894e-01,8.785844e-01,8.786736e-01,8.787584e-01,& + & 8.788379e-01,8.789130e-01,8.789849e-01,8.790506e-01,8.791141e-01,& + & 8.791750e-01,8.792324e-01,8.792867e-01 / + data asyliq2(:, 25) / & + & 8.249534e-01,8.391988e-01,8.474107e-01,8.526860e-01,8.563983e-01,& + & 8.592389e-01,8.615144e-01,8.633790e-01,8.649325e-01,8.662504e-01,& + & 8.673841e-01,8.683741e-01,8.692495e-01,8.700309e-01,8.707328e-01,& + & 8.713650e-01,8.719432e-01,8.724676e-01,8.729498e-01,8.733922e-01,& + & 8.737981e-01,8.741745e-01,8.745225e-01,8.748467e-01,8.751512e-01,& + & 8.754315e-01,8.756962e-01,8.759450e-01,8.761774e-01,8.763945e-01,& + & 8.766021e-01,8.767970e-01,8.769803e-01,8.771511e-01,8.773151e-01,& + & 8.774689e-01,8.776147e-01,8.777533e-01,8.778831e-01,8.780050e-01,& + & 8.781197e-01,8.782301e-01,8.783323e-01,8.784312e-01,8.785222e-01,& + & 8.786096e-01,8.786916e-01,8.787688e-01,8.788411e-01,8.789122e-01,& + & 8.789762e-01,8.790373e-01,8.790954e-01,8.791514e-01,8.792018e-01,& + & 8.792517e-01,8.792990e-01,8.793429e-01 / + data asyliq2(:, 26) / & + & 8.323091e-01,8.429776e-01,8.498123e-01,8.546929e-01,8.584295e-01,& + & 8.613489e-01,8.636324e-01,8.654303e-01,8.668675e-01,8.680404e-01,& + & 8.690174e-01,8.698495e-01,8.705666e-01,8.711961e-01,8.717556e-01,& + & 8.722546e-01,8.727063e-01,8.731170e-01,8.734933e-01,8.738382e-01,& + & 8.741590e-01,8.744525e-01,8.747295e-01,8.749843e-01,8.752210e-01,& + & 8.754437e-01,8.756524e-01,8.758472e-01,8.760288e-01,8.762030e-01,& + & 8.763603e-01,8.765122e-01,8.766539e-01,8.767894e-01,8.769130e-01,& + & 8.770310e-01,8.771422e-01,8.772437e-01,8.773419e-01,8.774355e-01,& + & 8.775221e-01,8.776047e-01,8.776802e-01,8.777539e-01,8.778216e-01,& + & 8.778859e-01,8.779473e-01,8.780031e-01,8.780562e-01,8.781097e-01,& + & 8.781570e-01,8.782021e-01,8.782463e-01,8.782845e-01,8.783235e-01,& + & 8.783610e-01,8.783953e-01,8.784273e-01 / + data asyliq2(:, 27) / & + & 8.396448e-01,8.480172e-01,8.535934e-01,8.574145e-01,8.600835e-01,& + & 8.620347e-01,8.635500e-01,8.648003e-01,8.658758e-01,8.668248e-01,& + & 8.676697e-01,8.684220e-01,8.690893e-01,8.696807e-01,8.702046e-01,& + & 8.706676e-01,8.710798e-01,8.714478e-01,8.717778e-01,8.720747e-01,& + & 8.723431e-01,8.725889e-01,8.728144e-01,8.730201e-01,8.732129e-01,& + & 8.733907e-01,8.735541e-01,8.737100e-01,8.738533e-01,8.739882e-01,& + & 8.741164e-01,8.742362e-01,8.743485e-01,8.744530e-01,8.745512e-01,& + & 8.746471e-01,8.747373e-01,8.748186e-01,8.748973e-01,8.749732e-01,& + & 8.750443e-01,8.751105e-01,8.751747e-01,8.752344e-01,8.752902e-01,& + & 8.753412e-01,8.753917e-01,8.754393e-01,8.754843e-01,8.755282e-01,& + & 8.755662e-01,8.756039e-01,8.756408e-01,8.756722e-01,8.757072e-01,& + & 8.757352e-01,8.757653e-01,8.757932e-01 / + data asyliq2(:, 28) / & + & 8.374590e-01,8.465669e-01,8.518701e-01,8.547627e-01,8.565745e-01,& + & 8.579065e-01,8.589717e-01,8.598632e-01,8.606363e-01,8.613268e-01,& + & 8.619560e-01,8.625340e-01,8.630689e-01,8.635601e-01,8.640084e-01,& + & 8.644180e-01,8.647885e-01,8.651220e-01,8.654218e-01,8.656908e-01,& + & 8.659294e-01,8.661422e-01,8.663334e-01,8.665037e-01,8.666543e-01,& + & 8.667913e-01,8.669156e-01,8.670242e-01,8.671249e-01,8.672161e-01,& + & 8.672993e-01,8.673733e-01,8.674457e-01,8.675103e-01,8.675713e-01,& + & 8.676267e-01,8.676798e-01,8.677286e-01,8.677745e-01,8.678178e-01,& + & 8.678601e-01,8.678986e-01,8.679351e-01,8.679693e-01,8.680013e-01,& + & 8.680334e-01,8.680624e-01,8.680915e-01,8.681178e-01,8.681428e-01,& + & 8.681654e-01,8.681899e-01,8.682103e-01,8.682317e-01,8.682498e-01,& + & 8.682677e-01,8.682861e-01,8.683041e-01 / + data asyliq2(:, 29) / & + & 7.877069e-01,8.244281e-01,8.367971e-01,8.409074e-01,8.429859e-01,& + & 8.454386e-01,8.489350e-01,8.534141e-01,8.585814e-01,8.641267e-01,& + & 8.697999e-01,8.754223e-01,8.808785e-01,8.860944e-01,8.910354e-01,& + & 8.956837e-01,9.000392e-01,9.041091e-01,9.079071e-01,9.114479e-01,& + & 9.147462e-01,9.178234e-01,9.206903e-01,9.233663e-01,9.258668e-01,& + & 9.282006e-01,9.303847e-01,9.324288e-01,9.343418e-01,9.361356e-01,& + & 9.378176e-01,9.393939e-01,9.408736e-01,9.422622e-01,9.435670e-01,& + & 9.447900e-01,9.459395e-01,9.470199e-01,9.480335e-01,9.489852e-01,& + & 9.498782e-01,9.507168e-01,9.515044e-01,9.522470e-01,9.529409e-01,& + & 9.535946e-01,9.542071e-01,9.547838e-01,9.553256e-01,9.558351e-01,& + & 9.563139e-01,9.567660e-01,9.571915e-01,9.575901e-01,9.579685e-01,& + & 9.583239e-01,9.586602e-01,9.589766e-01 / + ! --- ... spherical ice particle parameterization from streamer v3 ! extinction units (ext coef/iwc): [(m^-1)/(g m^-3)] data extice2(:, 16) / & diff --git a/physics/radsw_main.f b/physics/radsw_main.f index e79a3ed0d..342fe8a3e 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -38,10 +38,11 @@ ! inputs: ! ! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! ! clouds,icseed,aerosols,sfcalb, ! +! dzlyr,delpin,de_lgth, ! ! cosz,solcon,NDAY,idxday, ! ! npts, nlay, nlp1, lprnt, ! ! outputs: ! -! hswc,topflx,sfcflx, ! +! hswc,topflx,sfcflx,cldtau, ! !! optional outputs: ! ! HSW0,HSWB,FLXPRF,FDNCMP) ! ! ) ! @@ -254,6 +255,10 @@ ! into two spectral regions (vis & nir), instead of ! ! designated it in nir region only. ! ! may 2016 yu-tai hou --reverting swflux name back to vrtqdr! +! jun 2018 yu-tai hou --updated cloud optical coeffs with ! +! aer's newer version v3.9-v4.0 for hu and stamnes ! +! scheme. (used if iswcliq=2); added new option of ! +! cloud overlap method 'de-correlation-length'. ! ! ! !!!!! ============================================================== !!!!! !!!!! end descriptions !!!!! @@ -475,6 +480,9 @@ end subroutine rrtmg_sw_init !! | sfcalb_nir_dif | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | in | F | !! | sfcalb_uvis_dir | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | in | F | !! | sfcalb_uvis_dif | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | in | F | +!! | dzlyr | layer_thickness_for_radiation | layer thickness | km | 2 | real | kind_phys | in | F | +!! | delpin | layer_pressure_thickness_for_radiation | layer pressure thickness | hPa | 2 | real | kind_phys | in | F | +!! | de_lgth | cloud_decorrelation_length | cloud decorrelation length | km | 1 | real | kind_phys | in | F | !! | cosz | cosine_of_zenith_angle | cosine of the solar zenit angle | none | 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 | count | 0 | integer | | in | F | @@ -488,6 +496,7 @@ end subroutine rrtmg_sw_init !! | hswc | tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step | shortwave total sky heating rate | K s-1 | 2 | real | kind_phys | inout | F | !! | topflx | sw_fluxes_top_atmosphere | shortwave total sky fluxes at the top of the atm | W m-2 | 1 | topfsw_type | | inout | F | !! | sfcflx | sw_fluxes_sfc | shortwave total sky fluxes at the Earth surface | W m-2 | 1 | sfcfsw_type | | inout | F | +!! | cldtau | cloud_optical_depth_layers_at_0.55mu_band | approx .55mu band layer cloud optical depth | none | 2 | real | kind_phys | inout | F | !! | hsw0 | tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step | shortwave clear sky heating rate | K s-1 | 2 | real | kind_phys | inout | T | !! | hswb | sw_heating_rate_spectral | shortwave total sky heating rate (spectral) | K s-1 | 3 | real | kind_phys | inout | T | !! | flxprf | sw_fluxes | sw fluxes total sky / csk and up / down at levels | W m-2 | 2 | profsw_type | | inout | T | @@ -500,8 +509,6 @@ end subroutine rrtmg_sw_init !! | cld_ref_rain | mean_effective_radius_for_rain_drop | mean effective radius for rain drop | 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 | mean_effective_radius_for_snow_flake | mean effective radius for snow flake | micron | 2 | real | kind_phys | in | T | -!! | cld_od_total | cloud_optical_depth_weighted | cloud optical depth, weighted | none | 2 | real | kind_phys | out | T | -!! | cld_od_layer | cloud_optical_depth_layers_678 | cloud optical depth, from bands 6,7,8 | none | 2 | real | kind_phys | in | T | !! | cld_od | cloud_optical_depth | cloud optical depth | none | 2 | real | kind_phys | in | T | !! | cld_ssa | cloud_single_scattering_albedo | cloud single scattering albedo | frac | 2 | real | kind_phys | in | T | !! | cld_asy | cloud_asymmetry_parameter | cloud asymmetry parameter | none | 2 | real | kind_phys | in | T | @@ -518,14 +525,14 @@ subroutine rrtmg_sw_run & & icseed, aeraod, aerssa, aerasy, & & sfcalb_nir_dir, sfcalb_nir_dif, & & sfcalb_uvis_dir, sfcalb_uvis_dif, & + & dzlyr,delpin,de_lgth, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & & cld_cf, lsswr, & - & hswc,topflx,sfcflx, & ! --- outputs + & hswc,topflx,sfcflx,cldtau, & ! --- 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_total, cld_od_layer, & & cld_od, cld_ssa, cld_asy, errmsg, errflg & ) @@ -551,7 +558,6 @@ subroutine rrtmg_sw_run & ! gasvmr(:,:,9) - ccl4 volume mixing ratio (not used) ! ! clouds(npts,nlay,:): cloud profile ! ! (check module_radiation_clouds for definition) ! -! --- for iswcliq > 0 --- ! ! clouds(:,:,1) - layer total cloud fraction ! ! clouds(:,:,2) - layer in-cloud liq water path (g/m**2) ! ! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! @@ -561,13 +567,6 @@ subroutine rrtmg_sw_run & ! clouds(:,:,7) - mean eff radius for rain drop (micron) ! ! clouds(:,:,8) - layer snow flake water path (g/m**2) ! ! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! clouds(:,:,10) - cloud optical depth, total, weighted (1) ! -! clouds(:,:,11) - cloud optical depth from bands 6,7,8 (1) ! -! --- for iswcliq = 0 --- ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud optical depth ! -! clouds(:,:,3) - layer cloud single scattering albedo ! -! clouds(:,:,4) - layer cloud asymmetry factor ! ! icseed(npts) : auxiliary special cloud related array ! ! when module variable isubcsw=2, it provides ! ! permutation seed for each column profile that ! @@ -584,6 +583,9 @@ subroutine rrtmg_sw_run & ! ( :, 2 ) - near ir diffused albedo ! ! ( :, 3 ) - uv+vis direct beam albedo ! ! ( :, 4 ) - uv+vis diffused albedo ! +! dzlyr(npts,nlay) : layer thickness in km ! +! delpin(npts,nlay): layer pressure thickness (mb) ! +! de_lgth(npts) : clouds decorrelation length (km) ! ! cosz (npts) : cosine of solar zenith angle ! ! solcon : solar constant (w/m**2) ! ! NDAY : num of daytime points ! @@ -605,6 +607,7 @@ subroutine rrtmg_sw_run & ! dnfxc - total sky downward flux at sfc ! ! upfx0 - clear sky upward flux at sfc ! ! dnfx0 - clear sky downward flux at sfc ! +! cldtau(npts,nlay): spectral band layer cloud optical depth (~0.55 mu) ! ! !!optional outputs variables: ! ! hswb(npts,nlay,nbdsw): spectral band total sky heating rates ! @@ -631,7 +634,7 @@ subroutine rrtmg_sw_run & ! iswcliq - control flag for liq-cloud optical properties ! ! =0: input cloud optical depth, fixed ssa, asy ! ! =1: use hu and stamnes(1993) method for liq cld ! -! =2: not used ! +! =2: use updated coeffs for hu and stamnes scheme ! ! iswcice - control flag for ice-cloud optical properties ! ! *** if iswcliq==0, iswcice is ignored ! ! =1: use ebert and curry (1992) scheme for ice clouds ! @@ -649,6 +652,7 @@ subroutine rrtmg_sw_run & ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! +! =3: decorrelation-length overlap clouds ! ! ivflip - control flg for direction of vertical index ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -716,7 +720,7 @@ subroutine rrtmg_sw_run & real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: & & plvl, tlvl real (kind=kind_phys), dimension(npts,nlay), intent(in) :: & - & plyr, tlyr, qlyr, olyr + & plyr, tlyr, qlyr, olyr, dzlyr, delpin real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dir real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dif @@ -737,21 +741,19 @@ subroutine rrtmg_sw_run & 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_layer, & & cld_od, cld_ssa, cld_asy - ! Note: as of 06/18/2018, cld_od_layer is not used in radsw_main.f - ! thus set intent to intent(in). - real (kind=kind_phys), dimension(npts,nlay),intent(out),optional::& - & cld_od_total 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 + real (kind=kind_phys), intent(in) :: cosz(npts), solcon, & + & de_lgth(npts) ! --- outputs: real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hswc + real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & + & cldtau type (topfsw_type), dimension(npts), intent(inout) :: topflx type (sfcfsw_type), dimension(npts), intent(inout) :: sfcflx @@ -785,7 +787,7 @@ subroutine rrtmg_sw_run & & pavel, tavel, coldry, colmol, h2ovmr, o3vmr, temcol, & & cliqp, reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, & & cfrac, fac00, fac01, fac10, fac11, forfac, forfrac, & - & selffac, selffrac, rfdelp + & selffac, selffrac, rfdelp, dz real (kind=kind_phys), dimension(nlp1) :: fnet, flxdc, flxuc, & & flxd0, flxu0 @@ -795,7 +797,7 @@ subroutine rrtmg_sw_run & real (kind=kind_phys) :: cosz1, sntz1, tem0, tem1, tem2, s0fac, & & ssolar, zcf0, zcf1, ftoau0, ftoauc, ftoadc, & - & fsfcu0, fsfcuc, fsfcd0, fsfcdc, suvbfc, suvbf0 + & fsfcu0, fsfcuc, fsfcd0, fsfcdc, suvbfc, suvbf0, delgth ! --- column amount of absorbing gases: ! (:,m) m = 1-h2o, 2-co2, 3-o3, 4-n2o, 5-ch4, 6-o2, 7-co @@ -805,7 +807,6 @@ subroutine rrtmg_sw_run & integer, dimension(nlay) :: indfor, indself, jp, jt, jt1 integer :: i, ib, ipt, j1, k, kk, laytrop, mb - ! !===> ... begin here ! @@ -830,6 +831,7 @@ subroutine rrtmg_sw_run & !> -# Initial output arrays (and optional) as zero. hswc(:,:) = f_zero + cldtau(:,:) = f_zero topflx = topfsw_type ( f_zero, f_zero, f_zero ) sfcflx = sfcfsw_type ( f_zero, f_zero, f_zero, f_zero ) @@ -855,15 +857,12 @@ subroutine rrtmg_sw_run & if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & - & .not.present(cld_swp) .or. .not.present(cld_ref_snow) .or. & - & .not.present(cld_od_total) .or. & - & .not.present(cld_od_layer)) then + & .not.present(cld_swp) .or. .not.present(cld_ref_snow) )then write(errmsg,'(*(a))') & & 'Logic error: iswcliq>0 requires the following', & & ' optional arguments to be present:', & & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & - & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow', & - & ' cld_od_total, cld_od_layer' + & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' errflg = 1 return end if @@ -906,6 +905,7 @@ subroutine rrtmg_sw_run & cosz1 = cosz(j1) sntz1 = f_one / cosz(j1) ssolar = s0fac * cosz(j1) + if (iovrsw == 3) delgth = de_lgth(j1) ! clouds decorr-length !> -# Prepare surface albedo: bm,df - dir,dif; 1,2 - nir,uvv. albbm(1) = sfcalb_nir_dir(j1) @@ -925,7 +925,8 @@ subroutine rrtmg_sw_run & kk = nlp1 - k pavel(k) = plyr(j1,kk) tavel(k) = tlyr(j1,kk) - delp (k) = plvl(j1,kk+1) - plvl(j1,kk) + delp (k) = delpin(j1,kk) + dz (k) = dzlyr (j1,kk) !> -# Set absorber and gas column amount, convert from volume mixing !! ratio to molec/cm2 based on coldry (scaled to 1.0e-20) !! - colamt(nlay,maxgas):column amounts of absorbing gases 1 to @@ -1013,7 +1014,8 @@ subroutine rrtmg_sw_run & do k = 1, nlay pavel(k) = plyr(j1,k) tavel(k) = tlyr(j1,k) - delp (k) = plvl(j1,k) - plvl(j1,k+1) + delp (k) = delpin(j1,k) + dz (k) = dzlyr (j1,k) ! --- ... set absorber amount !test use @@ -1118,9 +1120,9 @@ subroutine rrtmg_sw_run & endif enddo zcf0 = zcf0 * zcf1 - else if (iovrsw == 2) then ! maximum overlapping + else if (iovrsw >= 2) then do k = 1, nlay - zcf0 = min ( zcf0, f_one-cfrac(k) ) + zcf0 = min ( zcf0, f_one-cfrac(k) ) ! used only as clear/cloudy indicator enddo endif @@ -1136,11 +1138,25 @@ subroutine rrtmg_sw_run & call cldprop & ! --- inputs: & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & - & zcf1, nlay, ipseed(j1), & + & zcf1, nlay, ipseed(j1), dz, delgth, & ! --- outputs: & taucw, ssacw, asycw, cldfrc, cldfmc & & ) +! --- ... save computed layer cloud optical depth for output +! rrtm band 10 is approx to the 0.55 mu spectrum + + if (ivflip == 0) then ! input from toa to sfc + do k = 1, nlay + kk = nlp1 - k + cldtau(j1,kk) = taucw(k,10) + enddo + else ! input from sfc to toa + do k = 1, nlay + cldtau(j1,k) = taucw(k,10) + enddo + endif ! end if_ivflip_block + else ! clear sky column cldfrc(:) = f_zero cldfmc(:,:)= f_zero @@ -1152,11 +1168,7 @@ subroutine rrtmg_sw_run & enddo enddo endif ! end if_zcf1_block - if (iswcliq > 0) then - do k = 1, nlay - cld_od_total(j1,k) = taucw(k,10) - end do - endif + !> -# Call setcoef() to compute various coefficients needed in !! radiative transfer calculations. call setcoef & @@ -1423,6 +1435,7 @@ subroutine rswinit & ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! +! =3: decorrelation-length overlap clouds ! ! iswmode - control flag for 2-stream transfer scheme ! ! =1; delta-eddington (joseph et al., 1976) ! ! =2: pifm (zdunkowski et al., 1980) ! @@ -1454,7 +1467,7 @@ subroutine rswinit & ! !===> ... begin here ! - if ( iovrsw<0 .or. iovrsw>2 ) then + if ( iovrsw<0 .or. iovrsw>3 ) then print *,' *** Error in specification of cloud overlap flag', & & ' IOVRSW=',iovrsw,' in RSWINIT !!' stop @@ -1503,6 +1516,17 @@ subroutine rswinit & stop endif + if ( isubcsw==0 .and. iovrsw>2 ) then + if (me == 0) then + print *,' *** IOVRSW=',iovrsw,' is not available for', & + & ' ISUBCSW=0 setting!!' + print *,' The program will use maximum/random overlap', & + & ' instead.' + endif + + iovrsw = 1 + endif + !> -# Setup constant factors for heating rate !! the 1.0e-2 is to convert pressure from mb to \f$N/m^2\f$ . @@ -1574,7 +1598,7 @@ end subroutine rswinit !----------------------------------- subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & cf1, nlay, ipseed, & + & cf1, nlay, ipseed, dz, delgth, & & taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1611,6 +1635,8 @@ subroutine cldprop & ! cf1 - real, effective total cloud cover at surface 1 ! ! nlay - integer, vertical layer number 1 ! ! ipseed- permutation seed for generating random numbers (isubcsw>0) ! +! dz - real, layer thickness (km) nlay ! +! delgth- real, layer cloud decorrelation length (km) 1 ! ! ! ! outputs: ! ! taucw - real, cloud optical depth, w/o delta scaled nlay*nbdsw ! @@ -1634,6 +1660,8 @@ subroutine cldprop & ! ! ! iswcliq=1 : liquid water cloud optical properties are computed ! ! as in hu and stamnes (1993), j. clim., 6, 728-742. ! +! iswcliq=2 : updated coeffs for hu and stamnes (1993) by aer ! +! w v3.9-v4.0. ! ! ! ! iswcice used only when iswcliq > 0 ! ! the cloud ice path (g/m2) and ice effective radius ! @@ -1657,10 +1685,10 @@ subroutine cldprop & ! --- inputs: integer, intent(in) :: nlay, ipseed - real (kind=kind_phys), intent(in) :: cf1 + real (kind=kind_phys), intent(in) :: cf1, delgth real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & - & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac + & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz ! --- outputs: real (kind=kind_phys), dimension(nlay,ngptsw), intent(out) :: & @@ -1755,11 +1783,11 @@ subroutine cldprop & asyliq(ib) = f_zero enddo else - if ( iswcliq == 1 ) then factor = refliq - 1.5 index = max( 1, min( 57, int( factor ) )) fint = factor - float(index) + if ( iswcliq == 1 ) then do ib = nblow, nbhgh extcoliq = max(f_zero, extliq1(index,ib) & & + fint*(extliq1(index+1,ib)-extliq1(index,ib)) ) @@ -1770,6 +1798,21 @@ subroutine cldprop & & + fint*(asyliq1(index+1,ib)-asyliq1(index,ib)) )) ! forcoliq = asycoliq * asycoliq + tauliq(ib) = cldliq * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq + enddo + elseif ( iswcliq == 2 ) then ! use updated coeffs + do ib = nblow, nbhgh + extcoliq = max(f_zero, extliq2(index,ib) & + & + fint*(extliq2(index+1,ib)-extliq2(index,ib)) ) + ssacoliq = max(f_zero, min(f_one, ssaliq2(index,ib) & + & + fint*(ssaliq2(index+1,ib)-ssaliq2(index,ib)) )) + + asycoliq = max(f_zero, min(f_one, asyliq2(index,ib) & + & + fint*(asyliq2(index+1,ib)-asyliq2(index,ib)) )) +! forcoliq = asycoliq * asycoliq + tauliq(ib) = cldliq * extcoliq ssaliq(ib) = tauliq(ib) * ssacoliq asyliq(ib) = ssaliq(ib) * asycoliq @@ -1898,7 +1941,7 @@ subroutine cldprop & call mcica_subcol & ! --- inputs: - & ( cldf, nlay, ipseed, & + & ( cldf, nlay, ipseed, dz, delgth, & ! --- outputs: & lcloudy & & ) @@ -1936,7 +1979,7 @@ end subroutine cldprop !! @{ ! ---------------------------------- subroutine mcica_subcol & - & ( cldf, nlay, ipseed, & ! --- inputs + & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs & lcloudy & ! --- outputs & ) @@ -1949,14 +1992,18 @@ subroutine mcica_subcol & ! ** note : if the cloud generator is called multiple times, need ! ! to permute the seed between each call; if between calls ! ! for lw and sw, use values differ by the number of g-pts. ! +! dz - real, layer thickness (km) nlay ! +! de_lgth-real, layer cloud decorrelation length (km) 1 ! ! ! ! output variables: ! ! lcloudy - logical, sub-colum cloud profile flag array nlay*ngptsw! ! ! ! other control flags from module variables: ! ! iovrsw : control flag for cloud overlapping method ! -! =0:random; =1:maximum/random; =2:maximum ! -! ! +! =0: random ! +! =1: maximum/random overlapping clouds ! +! =2: maximum overlap cloud ! +! =3: cloud decorrelation-length overlap method ! ! ! ! ===================== end of definitions ==================== ! @@ -1965,14 +2012,16 @@ subroutine mcica_subcol & ! --- inputs: integer, intent(in) :: nlay, ipseed - real (kind=kind_phys), dimension(nlay), intent(in) :: cldf + real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz + real (kind=kind_phys), intent(in) :: de_lgth ! --- outputs: logical, dimension(nlay,ngptsw), intent(out):: lcloudy ! --- locals: real (kind=kind_phys) :: cdfunc(nlay,ngptsw), tem1, & - & rand2d(nlay*ngptsw), rand1d(ngptsw) + & rand2d(nlay*ngptsw), rand1d(ngptsw), fac_lcf(nlay), & + & cdfun2(nlay,ngptsw) type (random_stat) :: stat ! for thread safe random generator @@ -2075,6 +2124,51 @@ subroutine mcica_subcol & enddo enddo + case( 3 ) ! decorrelation length overlap + +! --- compute overlapping factors based on layer midpoint distances +! and decorrelation depths + + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dz(k)+dz(k-1)) / de_lgth ) + enddo + +! --- setup 2 sets of random numbers + + call random_number ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(k,n) = rand2d(k1) + enddo + enddo + + call random_number ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfun2(k,n) = rand2d(k1) + enddo + enddo + +! --- then working from the top down: +! if a random number (from an independent set -cdfun2) is smaller then the +! scale factor: use the upper layer's number, otherwise use a new random +! number (keep the original assigned one). + + do n = 1, ngptsw + do k = nlay-1, 1, -1 + k1 = k + 1 + if ( cdfun2(k,n) <= fac_lcf(k1) ) then + cdfunc(k,n) = cdfunc(k1,n) + endif + enddo + enddo + end select !> -# Generate subcolumns for homogeneous clouds. diff --git a/physics/radsw_param.f b/physics/radsw_param.f index d08a6fbc4..d4e697711 100644 --- a/physics/radsw_param.f +++ b/physics/radsw_param.f @@ -158,11 +158,11 @@ module module_radsw_parameters ! & 28,28,28,28,28,28, & ! band 28 & 29,29,29,29,29,29,29,29,29,29,29,29 / ! band 29 -! \name Starting/ending wavenumber for each of the SW bands - real (kind=kind_phys), dimension(NBANDS):: wvnum1, wvnum2 !< Starting/ending wavenumber for each of the SW bands +!> \name Starting/ending wavenumber for each of the SW bands + real (kind=kind_phys), dimension(NBANDS):: wvnum1, wvnum2 data wvnum1(:) / & - & 2600.0, 3251.0, 4001.0, 4651.0, 5151.0, 6151.0, 7701.0, & - & 8051.0,12851.0,16001.0,22651.0,29001.0,38001.0, 820.0 / + & 2600.0, 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, & + & 8050.0,12850.0,16000.0,22650.0,29000.0,38000.0, 820.0 / data wvnum2(:) / & & 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, 8050.0, & & 12850.0,16000.0,22650.0,29000.0,38000.0,50000.0, 2600.0 / diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index dd4249782..4316b7ec6 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -90,7 +90,7 @@ subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc endif ! end_if_lslwr - + end subroutine rrtmg_lw_post_run !> \section arg_table_rrtmg_lw_post_finalize Argument Table diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 3e8033535..d5b4331dc 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -57,7 +57,7 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm Radtend%semis) ! --- outputs endif - end subroutine rrtmg_lw_pre_run + end subroutine rrtmg_lw_pre_run !> \section arg_table_rrtmg_lw_pre_finalize Argument Table !!