From 242dcc985b031d875d59d59a1fc3d61c22c5fa00 Mon Sep 17 00:00:00 2001 From: Qingfu Liu Date: Tue, 22 Feb 2022 19:38:26 +0000 Subject: [PATCH] updated the radiation code based on review's suggestions --- physics/GFS_cloud_diagnostics.F90 | 124 +- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 29 +- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 2 +- physics/GFS_rrtmgp_setup.F90 | 10 +- physics/radiation_cloud_overlap.F90 | 25 +- physics/radiation_clouds.f | 1889 +++++++--------------- physics/radlw_main.F90 | 2 +- physics/radsw_main.F90 | 2 +- 8 files changed, 630 insertions(+), 1453 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 214d12bbd..2258cd73f 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -46,10 +46,10 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr_rand, iovr_maxrand, iovr_m implicit none ! Inputs - integer, intent(in) :: & - nCol, & ! Number of horizontal grid-points - nLev ! Number of vertical-layers - integer, intent(in) :: & + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + nLev ! Number of vertical-layers + integer, intent(in) :: & iovr_rand, & ! Flag for random cloud overlap method iovr_maxrand, & ! Flag for maximum-random cloud overlap method iovr_max, & ! Flag for maximum cloud overlap method @@ -57,33 +57,33 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr_rand, iovr_maxrand, iovr_m iovr_exp, & ! Flag for exponential cloud overlap method iovr_exprand ! Flag for exponential-random cloud overlap method logical, intent(in) :: & - lsswr, & ! Call SW radiation? - lslwr ! Call LW radiation - real(kind_phys), intent(in) :: & - con_pi ! Physical constant: pi - real(kind_phys), dimension(:), intent(in) :: & - lat, & ! Latitude - de_lgth ! Decorrelation length + lsswr, & ! Call SW radiation? + lslwr ! Call LW radiation + real(kind_phys), intent(in) :: & + con_pi ! Physical constant: pi + real(kind_phys), dimension(:), intent(in) :: & + lat, & ! Latitude + de_lgth ! Decorrelation length real(kind_phys), dimension(:,:), intent(in) :: & - p_lay, & ! Pressure at model-layer - cld_frac ! Total cloud fraction + p_lay, & ! Pressure at model-layer + cld_frac ! Total cloud fraction real(kind_phys), dimension(:,:), intent(in) :: & - p_lev ! Pressure at model interfaces + p_lev ! Pressure at model interfaces real(kind_phys), dimension(:,:), intent(in) :: & - deltaZ, & ! Layer thickness (km) - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param ! Precipitation overlap parameter + deltaZ, & ! Layer thickness (km) + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param ! Precipitation overlap parameter ! Outputs - character(len=*), intent(out) :: & - errmsg ! Error message - integer, intent(out) :: & - errflg ! Error flag - integer,dimension(:,:),intent(out) :: & - mbota, & ! Vertical indices for cloud tops - mtopa ! Vertical indices for cloud bases - real(kind_phys), dimension(:,:), intent(out) :: & - cldsa ! Fraction of clouds for low, middle, high, total and BL + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + integer,dimension(:,:),intent(out) :: & + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases + real(kind_phys),dimension(:,:), intent(out) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL ! Local variables integer i,id,iCol,iLay,icld @@ -125,76 +125,6 @@ subroutine GFS_cloud_diagnostics_finalize() end subroutine GFS_cloud_diagnostics_finalize ! ###################################################################################### - ! Initialization routine for High/Mid/Low cloud diagnostics. + ! Subroutine hml_cloud_diagnostics_initialize is removed (refer to GFS_rrtmgp_setup.F90) ! ###################################################################################### - subroutine hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, nLev, & - mpi_rank, sigmainit, errflg) - implicit none - ! Inputs - integer, intent(in) :: & - imp_physics, & ! Flag for MP scheme - imp_physics_fer_hires, & ! Flag for fer-hires scheme - imp_physics_gfdl, & ! Flag for gfdl scheme - imp_physics_thompson, & ! Flag for thompsonscheme - imp_physics_wsm6, & ! Flag for wsm6 scheme - imp_physics_zhao_carr, & ! Flag for zhao-carr scheme - imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme - imp_physics_mg ! Flag for MG scheme - integer, intent(in) :: & - nLev, & ! Number of vertical-layers - mpi_rank - real(kind_phys), dimension(:), intent(in) :: & - sigmainit - ! Outputs - integer, intent(out) :: & - errflg - - ! Local variables - integer :: iLay, kl - - ! Initialize error flag - errflg = 0 - - if (mpi_rank == 0) print *, VTAGCLD !print out version tag - - if ( icldflg == 0 ) then - print *,' - Diagnostic Cloud Method has been discontinued' - errflg = 1 - else - if (mpi_rank == 0) then - print *,' - Using Prognostic Cloud Method' - if (imp_physics == imp_physics_zhao_carr) then - print *,' --- Zhao/Carr/Sundqvist microphysics' - elseif (imp_physics == imp_physics_zhao_carr_pdf) then - print *,' --- zhao/carr/sundqvist + pdf cloud' - elseif (imp_physics == imp_physics_gfdl) then - print *,' --- GFDL Lin cloud microphysics' - elseif (imp_physics == imp_physics_thompson) then - print *,' --- Thompson cloud microphysics' - elseif (imp_physics == imp_physics_wsm6) then - print *,' --- WSM6 cloud microphysics' - elseif (imp_physics == imp_physics_mg) then - print *,' --- MG cloud microphysics' - elseif (imp_physics == imp_physics_fer_hires) then - print *,' --- Ferrier-Aligo cloud microphysics' - else - print *,' !!! ERROR in cloud microphysc specification!!!', & - ' imp_physics (NP3D) =',imp_physics - errflg = 1 - endif - endif - endif - - ! Compute the top of BL cld (llyr), which is the topmost non cld(low) layer for - ! stratiform (at or above lowest 0.1 of the atmosphere). - lab_do_k0 : do iLay = nLev, 2, -1 - kl = iLay - if (sigmainit(iLay) < 0.9e0) exit lab_do_k0 - enddo lab_do_k0 - llyr = kl - - return - end subroutine hml_cloud_diagnostics_initialize end module GFS_cloud_diagnostics diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 index f85621d8f..2b632ea54 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -4,7 +4,7 @@ module GFS_rrtmgp_cloud_overlap_pre use machine, only: kind_phys use radiation_tools, only: check_error_msg - use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exper public GFS_rrtmgp_cloud_overlap_pre_init, GFS_rrtmgp_cloud_overlap_pre_run, GFS_rrtmgp_cloud_overlap_pre_finalize @@ -149,24 +149,25 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra ! Cloud overlap parameter ! if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then - call get_alpha_exp(nCol, nLev, deltaZc, de_lgth, cloud_overlap_param) + call get_alpha_exper(nCol, nLev, iovr, iovr_exprand, deltaZc, & + de_lgth, cld_frac, cloud_overlap_param) else de_lgth(:) = 0. cloud_overlap_param(:,:) = 0. endif - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then - do iLay = 1, nLev - do iCol = 1, nCol - if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then - cloud_overlap_param(iCol,iLay) = 0._kind_phys - endif - enddo - enddo - endif +! ! For exponential random overlap... +! ! Decorrelate layers when a clear layer follows a cloudy layer to enforce +! ! random correlation between non-adjacent blocks of cloudy layers +! if (iovr == iovr_exprand) then +! do iLay = 1, nLev +! do iCol = 1, nCol +! if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then +! cloud_overlap_param(iCol,iLay) = 0._kind_phys +! endif +! enddo +! enddo +! endif ! ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index c6afd6ac0..664da7528 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -5,7 +5,7 @@ module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys use radiation_tools, only: check_error_msg - use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exper use rrtmgp_lw_cloud_optics, only: radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,& radice_lwr => radice_lwrLW, radice_upr => radice_uprLW diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index d518cb6e3..f7f657b50 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -5,7 +5,7 @@ module GFS_rrtmgp_setup use module_radiation_astronomy, only : sol_init, sol_update use module_radiation_aerosols, only : aer_init, aer_update use module_radiation_gases, only : gas_init, gas_update - use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize + ! use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize ! *NOTE* These parameters below are required radiation_****** modules. They are not ! directly used by the RRTMGP routines. use physparam, only : isolar, ictmflg, ico2flg, ioznflg, iaerflg, & @@ -130,10 +130,10 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, call sol_init ( me ) call aer_init ( levr, me ) call gas_init ( me ) - call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,& - errflg) + !call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & + ! imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + ! imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,& + ! errflg) if ( me == 0 ) then print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' diff --git a/physics/radiation_cloud_overlap.F90 b/physics/radiation_cloud_overlap.F90 index a94923ba5..87f2ebbf0 100644 --- a/physics/radiation_cloud_overlap.F90 +++ b/physics/radiation_cloud_overlap.F90 @@ -84,16 +84,22 @@ end subroutine cmp_dcorr_lgth_oreopoulos ! ###################################################################################### ! ! ###################################################################################### - subroutine get_alpha_exp(nCol, nLay, dzlay, dcorr_lgth, alpha) + subroutine get_alpha_exper(nCol, nLay, iovr, iovr_exprand, dzlay, & + dcorr_lgth, cld_frac, alpha) ! Inputs integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLay ! Number of vertical grid points + integer, intent(in) :: & + iovr, & + iovr_exprand real(kind_phys), dimension(nCol), intent(in) :: & dcorr_lgth ! Decorrelation length (km) real(kind_phys), dimension(nCol,nLay), intent(in) :: & dzlay ! + real(kind_phys), dimension(:,:), intent(in) :: & + cld_frac ! Outputs real(kind_phys), dimension(nCol,nLay) :: & @@ -108,9 +114,22 @@ subroutine get_alpha_exp(nCol, nLay, dzlay, dcorr_lgth, alpha) alpha(iCol,iLay) = exp( -(dzlay(iCol,iLay)) / dcorr_lgth(iCol)) enddo enddo - + + ! Revise alpha for exponential-random cloud overlap + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 2, nLay + do iCol = 1, nCol + if (cld_frac(iCol,iLay) == 0.0 .and. cld_frac(iCol,iLay-1) > 0.0) then + alpha(iCol,iLay) = 0.0 + endif + enddo + enddo + endif + return - end subroutine get_alpha_exp + end subroutine get_alpha_exper end module module_radiation_cloud_overlap diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 157350dff..4ee8b146a 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -43,17 +43,15 @@ ! cld_rwp, cld_rerain, cld_swp, cld_resnow, ! ! clds,mtop,mbot,de_lgth,alpha) ! ! ! -! internal/external accessable subroutines: ! +! internal/external accessable subroutines: ! ! 'progcld_zhao_carr' --- zhao/moorthi prognostic cloud scheme ! -! 'progcld2' --- inactive ! ! 'progcld_zhao_carr_pdf' --- zhao/moorthi prognostic cloud + pdfcld ! ! 'progcld_gfdl_lin' --- GFDL-Lin cloud microphysics ! -! 'progcld4o' --- inactive ! ! 'progcld_fer_hires' --- Ferrier-Aligo cloud microphysics ! ! 'progcld_thompson_wsm6' --- Thompson/wsm6 cloud microphysics (EMC) ! -! 'progclduni' --- MG cloud microphysics ! -! --- GFDL cloud microphysics (EMC) ! -! --- Thompson + MYNN PBL (or GF convection) ! +! 'progclduni' --- MG2/3 cloud microphysics ! +! (with/without SHOC) (EMC) ! +! also used by GFDL MP (EMC) ! ! 'progcld_thompson' --- Thompson MP (added by G. Thompson) ! ! 'gethml' --- get diagnostic hi, mid, low clouds ! ! ! @@ -104,8 +102,6 @@ ! apr 2004, yu-tai hou - separated calculation of the ! ! averaged h,m,l,bl cloud amounts from each of the cld schemes ! ! to become an shared individule subprogram 'gethml'. ! -! may 2004, yu-tai hou - rewritten ferrier's scheme as a ! -! separated program 'progcld2' in the cloud module. ! ! apr 2005, yu-tai hou - modified cloud array and module ! ! structures. ! ! dec 2008, yu-tai hou - changed low-cld calculation, ! @@ -114,7 +110,7 @@ ! adjusted for better agreement with observations. ! ! jan 2011, yu-tai hou - changed virtual temperature ! ! as input variable instead of originally computed inside the ! -! two prognostic cld schemes 'progcld_zhao_carr' and 'progcld2'. ! +! two prognostic cld schemes 'progcld_zhao_carr' ! ! aug 2012, yu-tai hou - modified subroutine cld_init ! ! to pass all fixed control variables at the start. and set ! ! their correponding internal module variables to be used by ! @@ -193,7 +189,7 @@ module module_radiation_clouds use module_microphysics, only : rsipath2 use module_iounitdef, only : NICLTUN use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, & - & get_alpha_exp + & get_alpha_exper use machine, only : kind_phys ! implicit none @@ -253,9 +249,9 @@ module module_radiation_clouds & 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, & & 205.728, 214.055, 222.694, 231.661, 240.971, 250.639/) - public progcld_zhao_carr, progcld2, progcld_zhao_carr_pdf, & + public progcld_zhao_carr, progcld_zhao_carr_pdf, & & progcld_gfdl_lin, progclduni, progcld_fer_hires, & - & cld_init, radiation_clouds_prop, progcld4o, & + & cld_init, radiation_clouds_prop, & & progcld_thompson_wsm6, progcld_thompson, cal_cldfra3, & & find_cloudLayers, adjust_cloudIce, adjust_cloudH2O, & & adjust_cloudFinal, gethml @@ -278,7 +274,7 @@ module module_radiation_clouds !!\n =10: MG microphysics !!\n =15: Ferrier-Aligo microphysics !!\param me print control flag -!>\section gen_cld_init cld_init General Algorithm +!>\section cld_init General Algorithm !! @{ subroutine cld_init & & ( si, NLAY, imp_physics, me ) ! --- inputs @@ -405,99 +401,7 @@ end subroutine cld_init !> \ingroup module_radiation_clouds !> Subroutine radiation_clouds_prop computes cloud related quantities !! for different cloud microphysics schemes. -!!\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 tvly (IX,NLAY), model layer virtual temperature in K -!!\param qlyr (IX,NLAY), layer specific humidity in gm/gm -!!\param qstl (IX,NLAY), layer saturate humidity in gm/gm -!!\param rhly (IX,NLAY), layer relative humidity \f$ (=qlyr/qstl) \f$ -!!\param ccnd (IX,NLAY,ncndl), layer cloud condensate amount ! -!! water, ice, rain, snow (+ graupel) ! -!!\param ncndl number of layer cloud condensate types (max of 4) -!!\param cnvw (ix,nlay), layer convective cloud condensate -!!\param cnvc (ix,nlay), layer convective cloud cover -!!\param tracer1 (ix,nlay,1:ntrac-1), all tracers (except sphum) -!!\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 LM vertical layer for radiation calculation -!!\param NLAY adjusted vertical layer -!!\param NLP1 level dimensions -!!\param deltaq (ix,nlay), half total water distribution width -!!\param sup supersaturation -!!\param me print control flag -!!\param icloud cloud effect to the optical depth in radiation -!!\param kdt current time step index -!>\param ntrac number of tracers (Model%ntrac) -!>\param ntcw tracer index for cloud liquid water (Model%ntcw) -!>\param ntiw tracer index for cloud ice water (Model%ntiw) -!>\param ntrw tracer index for rain water (Model%ntrw) -!>\param ntsw tracer index for snow water (Model%ntsw) -!>\param ntgl tracer index for graupel (Model%ntgl) -!>\param ntclamt tracer index for cloud amount (Model%ntclamt) -!!\param imp_physics cloud microphysics scheme control flag -!!\param imp_physics_fer_hires Ferrier-Aligo microphysics (=15) -!!\param imp_physics_gfdl GFDL microphysics cloud (=11) -!!\param imp_physics_thompson Thompson microphysics (=8) -!!\param imp_physics_wsm6 WSM6 microphysics (=6) -!!\param imp_physics_zhao_carr Zhao-Carr/Sundqvist microphysics cloud (=99) -!!\param imp_physics_zhao_carr_pdf Zhao-Carr/Sundqvist microphysics cloud + PDF (=98) -!!\param imp_physics_mg MG microphysics (=10) -!!\param iovr_rand cloud-overlap: random -!!\param iovr_maxrand cloud-overlap: maximum random -!!\param iovr_max cloud-overlap: maximum -!!\param iovr_dcorr cloud-overlap: decorrelation length -!!\param iovr_exp cloud-overlap: exponential -!!\param iovr_exprand cloud-overlap: exponential random -!!\param idcor_con decorrelation-length: Use constant value -!!\param idcor_hogan choice for decorrelation-length -!!\param idcor_oreopoulos choice for decorrelation-length -!!\param imfdeepcnv flag for mass-flux deep convection scheme -!!\param imfdeepcnv_gf flag for scale- & aerosol-aware Grell-Freitas scheme (GSD) -!!\param do_mynnedmf flag for MYNN-EDMF -!!\param lgfdlmprad flag for GFDLMP radiation interaction -!!\param uni_cld logical, true for cloud fraction from shoc -!!\param lmfshal logical, mass-flux shallow convection scheme flag -!!\param lmfdeep2 logical, scale-aware mass-flux deep convection scheme flag -!!\param cldcov layer cloud fraction (used when uni_cld=.true.) -!!\param clouds1 layer total cloud fraction -!!\param effrl effective radius for liquid water -!!\param effri effective radius for ice water -!!\param effrr effective radius for rain water -!!\param effrs effective radius for snow water -!!\param effr_in logical, if .true. use input effective radii -!!\param effrl_inout eff. radius of cloud liquid water particle -!!\param effri_inout eff. radius of cloud ice water particle -!!\param effrs_inout effective radius of cloud snow particle -!!\param lwp_ex total liquid water path from explicit microphysics -!!\param iwp_ex total ice water path from explicit microphysics -!!\param lwp_fc total liquid water path from cloud fraction scheme -!!\param iwp_fc total ice water path from cloud fraction scheme -!!\param dzlay(ix,nlay) distance between model layer centers -!!\param latdeg(ix) latitude (in degrees 90 -> -90) -!!\param julian day of the year (fractional julian day) -!!\param yearlen current length of the year (365/366 days) -!!\param gridkm grid length in km -!!\param cld_frac(:,:) - layer total cloud fraction -!!\param cld_lwp(:,:) - layer cloud liq water path \f$(g/m^2)\f$ -!!\param cld_reliq(:,:) - mean eff radius for liq cloud (micron) -!!\param cld_iwp(:,:) - layer cloud ice water path \f$(g/m^2)\f$ -!!\param cld_reice(:,:) - mean eff radius for ice cloud (micron) -!!\param cld_rwp(:,:) - layer rain drop water path (not assigned) -!!\param cld_rerain(:,:) - mean eff radius for rain drop (micron) -!!\param cld_swp(:,:) - layer snow flake water path (not assigned) -!!\param cld_resnow(:,:) - mean eff radius for snow flake (micron) -!!\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) -!!\param alpha (IX,NLAY), alpha decorrelation parameter -!>\section gen_radiation_clouds_prop radiation_clouds_prop General Algorithm +!>\section radiation_clouds_prop General Algorithm !> @{ subroutine radiation_clouds_prop & & ( plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs: @@ -532,23 +436,23 @@ subroutine radiation_clouds_prop & ! and 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 "radiation_clouds_init". ! +! initial subroutine "cld_init". ! ! ! ! usage: call radiation_clouds_prop ! ! ! ! subprograms called: ! ! ! ! 'progcld_zhao_carr' --- zhao/moorthi prognostic cloud scheme ! -! 'progcld2' --- inactive ! ! 'progcld_zhao_carr_pdf' --- zhao/moorthi prognostic cloud + pdfcld ! ! 'progcld_gfdl_lin' --- GFDL-Lin cloud microphysics ! -! 'progcld4o' --- inactive ! ! 'progcld_fer_hires' --- Ferrier-Aligo cloud microphysics ! ! 'progcld_thompson_wsm6' --- Thompson/wsm6 cloud microphysics (EMC) ! ! 'progclduni' --- MG cloud microphysics ! ! --- GFDL cloud microphysics (EMC) ! ! --- Thompson + MYNN PBL (or GF convection) ! ! 'progcld_thompson' --- Thompson MP (added by G. Thompson) ! +! 'gethml' --- get diagnostic hi, mid, low clouds ! +! ! ! attributes: ! ! language: fortran 90 ! ! machine: ibm-sp, sgi ! @@ -664,16 +568,6 @@ subroutine radiation_clouds_prop & ! lcnorm : control flag for in-cld condensate ! ! =t: normalize cloud condensate ! ! =f: not normalize cloud condensate ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! ! ! ! ==================== end of description ===================== ! implicit none @@ -730,7 +624,6 @@ subroutine radiation_clouds_prop & & lwp_ex, iwp_ex, lwp_fc, iwp_fc ! --- outputs -! real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds real (kind=kind_phys), dimension(:,:), intent(out) :: & & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & @@ -746,7 +639,6 @@ subroutine radiation_clouds_prop & & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) - real (kind=kind_phys), dimension(IX,NLAY,NF_CLDS) :: clouds real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 @@ -765,13 +657,20 @@ subroutine radiation_clouds_prop & & ncndl, lgfdlmprad, do_mynnedmf, imfdeepcnv, kdt end if - do nf=1,nf_clds - do k=1,nlay - do i=1,ix - clouds(i,k,nf) = 0.0 - enddo + do k = 1, NLAY + do i = 1, IX + cld_frac(i,k) = 0.0 + cld_lwp(i,k) = 0.0 + cld_reliq(i,k) = 0.0 + cld_iwp(i,k) = 0.0 + cld_reice(i,k) = 0.0 + cld_rwp(i,k) = 0.0 + cld_rerain(i,k) = 0.0 + cld_swp(i,k) = 0.0 + cld_resnow(i,k) = 0.0 enddo enddo + do k = 1, NLAY do i = 1, IX cldtot(i,k) = 0.0 @@ -790,7 +689,9 @@ subroutine radiation_clouds_prop & & effrl, effri, effrr, effrs, effr_in, & & dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) else call progcld_zhao_carr (plyr ,plvl, tlyr, tvly, qlyr, & ! --- inputs & qstl, rhly, ccnd(1:IX,1:NLAY,1), xlat, xlon, & @@ -799,7 +700,9 @@ subroutine radiation_clouds_prop & & cldcov, effrl, effri, effrr, effrs, effr_in, & & dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) endif elseif(imp_physics == imp_physics_zhao_carr_pdf) then ! zhao/moorthi's prognostic cloud+pdfcld @@ -809,7 +712,9 @@ subroutine radiation_clouds_prop & & xlat, xlon, slmsk, dz, delp, IX, NLAY, NLP1, & & deltaq, sup, kdt, me, dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) elseif (imp_physics == imp_physics_gfdl) then ! GFDL cloud scheme @@ -819,7 +724,9 @@ subroutine radiation_clouds_prop & & xlat, xlon, slmsk, cldcov, dz, delp, & & IX, NLAY, NLP1, dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) else call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, xlat, & ! --- inputs @@ -827,15 +734,9 @@ subroutine radiation_clouds_prop & & effrl, effri, effrr, effrs, effr_in, & & dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs -! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs -! tracer1, xlat, xlon, slmsk, dz, delp, & -! ntrac-1, ntcw-1,ntiw-1,ntrw-1, & -! ntsw-1,ntgl-1,ntclamt-1, & -! IX,NLAY,NLP1, & -! dzlay, & -! cldtot, cldcnv, & ! inout -! clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) endif @@ -855,7 +756,9 @@ subroutine radiation_clouds_prop & & effri_inout(:,:), effrs_inout(:,:), & & dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) elseif(imp_physics == imp_physics_thompson) then ! Thompson MP @@ -871,14 +774,16 @@ subroutine radiation_clouds_prop & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, gridkm, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) else !-- MYNN PBL or convective GF !-- use cloud fractions with SGS clouds do k=1,NLAY do i=1,IX - clouds(i,k,1) = clouds1(i,k) + cld_frac(i,k) = clouds1(i,k) enddo enddo @@ -886,11 +791,13 @@ subroutine radiation_clouds_prop & ! --- make sure that effr_in=.true. in the input.nml! call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs & xlat, xlon, slmsk, dz, delp, IX, NLAY, NLP1, & - & clouds(:,1:NLAY,1), & + & cld_frac, & & effrl, effri, effrr, effrs, effr_in , & & dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) endif else @@ -906,7 +813,9 @@ subroutine radiation_clouds_prop & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, gridkm, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) else call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs @@ -918,27 +827,14 @@ subroutine radiation_clouds_prop & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, & & cldtot, cldcnv, & ! inout - & clouds) ! --- outputs + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, & + & cld_resnow) endif endif ! MYNN PBL or GF endif ! end if_imp_physics - do k = 1, NLAY - do i = 1, IX - cld_frac(i,k) = clouds(i,k,1) - cld_lwp(i,k) = clouds(i,k,2) - cld_reliq(i,k) = clouds(i,k,3) - cld_iwp(i,k) = clouds(i,k,4) - cld_reice(i,k) = clouds(i,k,5) - cld_rwp(i,k) = clouds(i,k,6) - cld_rerain(i,k) = clouds(i,k,7) - cld_swp(i,k) = clouds(i,k,8) - cld_resnow(i,k) = clouds(i,k,9) - enddo - enddo - - !> - Compute SFC/low/middle/high cloud top pressure for each cloud !! domain for given latitude. ! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; @@ -968,28 +864,16 @@ subroutine radiation_clouds_prop & de_lgth(:) = decorr_con endif - ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + ! Call subroutine get_alpha_exper to define alpha parameter for exponential cloud overlap options if ( iovr == iovr_dcorr .or. iovr == iovr_exp & & .or. iovr == iovr_exprand) then - call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + call get_alpha_exper(ix, nLay, iovr, iovr_exprand, dzlay, & + & de_lgth, cld_frac, alpha) else de_lgth(:) = 0. alpha(:,:) = 0. endif - ! Revise alpha for exponential-random cloud overlap - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then - do k = 2, nLay - do i = 1, ix - if (clouds(i,k,1) == 0.0 .and. clouds(i,k-1,1) > 0.0) then - alpha(i,k) = 0.0 - endif - enddo - 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. @@ -1015,44 +899,7 @@ end subroutine radiation_clouds_prop !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! zhao/moorthi's prognostic cloud microphysics scheme. -!!\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 tvly (IX,NLAY), model layer virtual temperature in K -!!\param qlyr (IX,NLAY), layer specific humidity in gm/gm -!!\param qstl (IX,NLAY), layer saturate humidity in gm/gm -!!\param rhly (IX,NLAY), layer relative humidity \f$ (=qlyr/qstl) \f$ -!!\param clw (IX,NLAY), layer cloud condensate amount -!!\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 -!!\param NLP1 level dimensions -!!\param uni_cld logical, true for cloud fraction from shoc -!!\param lmfshal logical, mass-flux shallow convection scheme flag -!!\param lmfdeep2 logical, scale-aware mass-flux deep convection scheme flag -!!\param cldcov layer cloud fraction (used when uni_cld=.true.) -!!\param effrl effective radius for liquid water -!!\param effri effective radius for ice water -!!\param effrr effective radius for rain water -!!\param effrs effective radius for snow water -!!\param effr_in logical, if .true. use input effective radii -!!\param dzlay(ix,nlay) distance between model layer centers -!!\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$ -!!\n (:,:,3) - mean eff radius for liq cloud (micron) -!!\n (:,:,4) - layer cloud ice water path \f$(g/m^2)\f$ -!!\n (:,:,5) - mean eff radius for ice cloud (micron) -!!\n (:,:,6) - layer rain drop water path (not assigned) -!!\n (:,:,7) - mean eff radius for rain drop (micron) -!!\n (:,:,8) - layer snow flake water path (not assigned) -!!\n (:,:,9) - mean eff radius for snow flake (micron) -!>\section gen_progcld_zhao_carr progcld_zhao_carr General Algorithm +!>\section progcld_zhao_carr General Algorithm !> @{ subroutine progcld_zhao_carr & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: @@ -1060,7 +907,8 @@ subroutine progcld_zhao_carr & & uni_cld, lmfshal, lmfdeep2, cldcov, & & effrl,effri,effrr,effrs,effr_in, & & dzlay, cldtot, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! @@ -1107,19 +955,24 @@ subroutine progcld_zhao_carr & ! lmfshal : logical - true for mass flux shallow convection ! ! lmfdeep2 : logical - true for mass flux deep convection ! ! cldcov : layer cloud fraction (used when uni_cld=.true. ! +! effrl : effective radius for liquid water +! effri : effective radius for ice water +! effrr : effective radius for rain water +! effrs : effective radius for snow water +! effr_in : logical, if .true. use input effective radii ! dzlay(ix,nlay) : thickness between model layer centers (km) ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -1150,8 +1003,11 @@ subroutine progcld_zhao_carr & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & @@ -1257,55 +1113,16 @@ subroutine progcld_zhao_carr & !> - Compute layer cloud fraction. - clwmin = 0.0 - if (.not. lmfshal) then - 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) - - 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 + if (.not. lmfshal) then + call cloud_fraction_XuRandall & + & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) & ! --- outputs else - 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) - - 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 + call cloud_fraction_mass_flx_1 & + & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) + endif endif ! if (uni_cld) then @@ -1367,15 +1184,15 @@ subroutine progcld_zhao_carr & ! do k = 1, NLAY do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) -! clouds(i,k,6) = 0.0 - clouds(i,k,7) = rer(i,k) -! clouds(i,k,8) = 0.0 - clouds(i,k,9) = res(i,k) + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) +! cld_rwp(i,k) = 0.0 + cld_rerain(i,k) = rer(i,k) +! cld_swp(i,k) = 0.0 + cld_resnow(i,k) = res(i,k) enddo enddo ! @@ -1384,67 +1201,36 @@ subroutine progcld_zhao_carr & end subroutine progcld_zhao_carr !----------------------------------- !> @} +!----------------------------------- !> \ingroup module_radiation_clouds -!> This subroutine computes cloud related quantities using Ferrier's -!! prognostic cloud microphysics scheme. -!!\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 tvly (IX,NLAY), model layer virtual temperature in K -!!\param qlyr (IX,NLAY), layer specific humidity in gm/gm -!!\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 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 lmfshal flag for mass-flux shallow convection scheme in the cloud fraction calculation -!!\param lmfdeep2 flag for mass-flux deep convection scheme in the cloud fraction calculation -!!\param dzlay(ix,nlay) distance between model layer centers -!!\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$ -!!\n (:,:,3) - mean eff radius for liq cloud (micron) -!!\n (:,:,4) - layer cloud ice water path \f$(g/m^2)\f$ -!!\n (:,:,5) - mean eff radius for ice cloud (micron) -!!\n (:,:,6) - layer rain drop water path \f$(g/m^2)\f$ -!!\n (:,:,7) - mean eff radius for rain drop (micron) -!!\n (:,:,8) - layer snow flake water path \f$(g/m^2)\f$ -!!\n (:,:,9) - mean eff radius for snow flake (micron) -!>\section gen_progcld2 progcld2 General Algorithm for the F-A MP scheme -!> @{ - subroutine progcld2 & - & ( plyr,plvl,tlyr,qlyr,qstl,rhly,tvly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, & - & ntrac, ntcw, ntiw, ntrw, & - & IX, NLAY, NLP1, lmfshal, lmfdeep2, & +!> This subroutine computes cloud related quantities using +!! zhao/moorthi's prognostic cloud microphysics scheme + pdfcld. +!>\section progcld_zhao_carr_pdf General Algorithm +!! @{ + subroutine progcld_zhao_carr_pdf & + & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: + & xlat,xlon,slmsk, dz, delp, & + & ix, nlay, nlp1, & + & deltaq,sup,kdt,me, & & dzlay, cldtot, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! ! ! -! subprogram: progcld2 computes cloud related quantities using ! -! WSM6 cloud microphysics scheme. ! +! subprogram: progcld_zhao_carr_pdf computes cloud related quantities using ! +! zhao/moorthi's prognostic cloud microphysics scheme. ! ! ! ! abstract: this program computes cloud fractions from cloud ! -! condensates, ! +! condensates, calculates liquid/ice cloud droplet effective radius, ! ! and 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 progcld2 ! +! usage: call progcld_zhao_carr_pdf ! ! ! ! subprograms called: gethml ! ! ! @@ -1453,49 +1239,49 @@ subroutine progcld2 & ! machine: ibm-sp, sgi ! ! ! ! ! -! ==================== definition of variables ==================== ! +! ==================== defination 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 ! -! tvly (IX,NLAY) : model layer virtual temperature in k ! -! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! -! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! -! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY) : layer cloud condensate amount ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! +! 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 ! +! tvly (ix,nlay) : model layer virtual temperature in k ! +! qlyr (ix,nlay) : layer specific humidity in gm/gm ! +! qstl (ix,nlay) : layer saturate humidity in gm/gm ! +! rhly (ix,nlay) : layer relative humidity (=qlyr/qstl) ! +! clw (ix,nlay) : layer cloud condensate amount ! +! xlat (ix) : grid latitude in radians, default to pi/2 -> -pi/2! ! 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) ! +! 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 ! -! lmfshal : logical - true for mass flux shallow convection ! -! lmfdeep2 : logical - true for mass flux deep convection ! +! ix : horizontal dimention ! +! nlay,nlp1 : vertical layer/level dimensions ! +! cnvw (ix,nlay) : layer convective cloud condensate ! +! cnvc (ix,nlay) : layer convective cloud cover ! +! deltaq(ix,nlay) : half total water distribution width ! +! sup : supersaturation ! ! dzlay(ix,nlay) : thickness between model layer centers (km) ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! -! lmfshal : mass-flux shallow conv scheme flag ! -! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! +! lcrick : control flag for eliminating crick ! +! =t: apply layer smoothing to eliminate crick ! ! =f: do not apply layer smoothing ! ! lcnorm : control flag for in-cld condensate ! ! =t: normalize cloud condensate ! @@ -1506,24 +1292,29 @@ subroutine progcld2 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw - - logical, intent(in) :: lmfshal, lmfdeep2 - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, tvly, dz, delp, dzlay + integer, intent(in) :: ix, nlay, nlp1,kdt - real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw + real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & + & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp, dzlay +! & tlyr, tvly, qlyr, qstl, rhly, clw, cnvw, cnvc +! real (kind=kind_phys), dimension(:,:), intent(in) :: deltaq + real (kind=kind_phys), dimension(:,:) :: deltaq, cnvw, cnvc + real (kind=kind_phys) qtmp,qsc,rhs + real (kind=kind_phys), intent(in) :: sup + real (kind=kind_phys), parameter :: epsq = 1.0e-12 - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & + real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + integer :: me -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & + real (kind=kind_phys), dimension(ix,nlay) :: cldtot, cldcnv, & & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & @@ -1531,386 +1322,73 @@ subroutine progcld2 & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! - do k = 1, NLAY - do i = 1, IX + do k = 1, nlay + do i = 1, ix cldtot(i,k) = 0.0 cldcnv(i,k) = 0.0 cwp (i,k) = 0.0 cip (i,k) = 0.0 crp (i,k) = 0.0 csp (i,k) = 0.0 - rew (i,k) = reliq_def - rei (i,k) = reice_def + rew (i,k) = reliq_def ! default liq radius to 10 micron + rei (i,k) = reice_def ! default ice radius to 50 micron rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def + res (i,k) = rsnow_def ! default snow radius to 250 micron + tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) clwf(i,k) = 0.0 enddo enddo ! - - do k = 1, NLAY - do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + if ( lcrick ) then + do i = 1, ix + clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) + clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) + enddo + do k = 2, nlay-1 + do i = 1, ix + clwf(i,k) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) enddo - enddo - -!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . + enddo + else + do k = 1, nlay + do i = 1, ix + clwf(i,k) = clw(i,k) + enddo + enddo + endif - do k = 1, NLAY - do i = 1, IX - 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) = 0.0 + if(kdt==1) then + do k = 1, nlay + do i = 1, ix + deltaq(i,k) = (1.-0.95)*qstl(i,k) enddo - enddo + enddo + endif -!> - Compute cloud ice effective radii +!> -# Calculate liquid/ice condensate path in \f$ g/m^2 \f$ - do k = 1, NLAY - do i = 1, IX - tem2 = tlyr(i,k) - con_ttp + do k = 1, nlay + do i = 1, ix + 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 - if (cip(i,k) > 0.0) then - tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) +!> -# Calculate effective liquid cloud droplet radius over land. - if (tem2 < -50.0) then - rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem2 < -40.0) then - rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem2 < -30.0) then - rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif - rei(i,k) = max(10.0, min(rei(i,k), 150.0)) - endif + do i = 1, ix + if (nint(slmsk(i)) == 1) then + do k = 1, nlay + rew(i,k) = 5.0 + 5.0 * tem2d(i,k) enddo + endif enddo -!> - Calculate layer cloud fraction. - - clwmin = 0.0 - if (.not. lmfshal) then - 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) - - 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 = 1, NLAY - 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 - - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) < climit) then - cldtot(i,k) = 0.0 - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo - enddo - - if ( lcnorm ) then - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo - enddo - endif - -! - do k = 1, NLAY - do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) ! added for Thompson - clouds(i,k,9) = res(i,k) - enddo - enddo -! - return -!................................... - end subroutine progcld2 -!................................... - -!> @} -!----------------------------------- - -!> \ingroup module_radiation_clouds -!> This subroutine computes cloud related quantities using -!! zhao/moorthi's prognostic cloud microphysics scheme + pdfcld. -!!\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 tvly (ix,nlay), model layer virtual temperature in K -!!\param qlyr (ix,nlay), layer specific humidity in gm/gm -!!\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,nlp1 vertical layer/level dimensions -!!\param deltaq (ix,nlay), half total water distribution width -!!\param sup supersaturation -!!\param kdt -!!\param me print control flag -!!\param dzlay(ix,nlay) distance between model layer centers -!!\param clouds (ix,nlay,nf_clds), cloud profiles -!!\n (:,:,1) - layer total cloud fraction -!!\n (:,:,2) - layer cloud liq water path (g/m**2) -!!\n (:,:,3) - mean eff radius for liq cloud (micron) -!!\n (:,:,4) - layer cloud ice water path (g/m**2) -!!\n (:,:,5) - mean eff radius for ice cloud (micron) -!!\n (:,:,6) - layer rain drop water path not assigned -!!\n (:,:,7) - mean eff radius for rain drop (micron) -!!\n (:,:,8) - layer snow flake water path not assigned -!!\n (:,:,9) - mean eff radius for snow flake(micron) -!>\section gen_progcld_zhao_carr_pdf progcld_zhao_carr_pdf General Algorithm -!! @{ - subroutine progcld_zhao_carr_pdf & - & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: - & xlat,xlon,slmsk, dz, delp, & - & ix, nlay, nlp1, & - & deltaq,sup,kdt,me, & - & dzlay, cldtot, cldcnv, & - & clouds & ! --- outputs: - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: progcld_zhao_carr_pdf computes cloud related quantities using ! -! zhao/moorthi's prognostic cloud microphysics scheme. ! -! ! -! abstract: this program computes cloud fractions from cloud ! -! condensates, calculates liquid/ice cloud droplet effective radius, ! -! and 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 progcld_zhao_carr_pdf ! -! ! -! subprograms called: gethml ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== defination 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 ! -! tvly (ix,nlay) : model layer virtual temperature in k ! -! qlyr (ix,nlay) : layer specific humidity in gm/gm ! -! qstl (ix,nlay) : layer saturate humidity in gm/gm ! -! rhly (ix,nlay) : layer relative humidity (=qlyr/qstl) ! -! clw (ix,nlay) : layer cloud condensate amount ! -! xlat (ix) : grid latitude in radians, default to pi/2 -> -pi/2! -! 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 ! -! cnvc (ix,nlay) : layer convective cloud cover ! -! deltaq(ix,nlay) : half total water distribution width ! -! sup : supersaturation ! -! dzlay(ix,nlay) : thickness between model layer centers (km) ! -! ! -! output variables: ! -! clouds(ix,nlay,nf_clds) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! ! -! module variables: ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lcrick : control flag for eliminating crick ! -! =t: apply layer smoothing to eliminate crick ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: ix, nlay, nlp1,kdt - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp, dzlay -! & tlyr, tvly, qlyr, qstl, rhly, clw, cnvw, cnvc -! real (kind=kind_phys), dimension(:,:), intent(in) :: deltaq - real (kind=kind_phys), dimension(:,:) :: deltaq, cnvw, cnvc - real (kind=kind_phys) qtmp,qsc,rhs - real (kind=kind_phys), intent(in) :: sup - real (kind=kind_phys), parameter :: epsq = 1.0e-12 - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - integer :: me - -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds - -! --- local variables: - real (kind=kind_phys), dimension(ix,nlay) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf - -! -!===> ... begin here -! - do k = 1, nlay - do i = 1, ix - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = reliq_def ! default liq radius to 10 micron - rei (i,k) = reice_def ! default ice radius to 50 micron - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def ! default snow radius to 250 micron - tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - clwf(i,k) = 0.0 - enddo - enddo -! - if ( lcrick ) then - do i = 1, ix - clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) - clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) - enddo - do k = 2, nlay-1 - do i = 1, ix - clwf(i,k) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) - enddo - enddo - else - do k = 1, nlay - do i = 1, ix - clwf(i,k) = clw(i,k) - enddo - enddo - endif - - if(kdt==1) then - do k = 1, nlay - do i = 1, ix - deltaq(i,k) = (1.-0.95)*qstl(i,k) - enddo - enddo - endif - -!> -# Calculate liquid/ice condensate path in \f$ g/m^2 \f$ - - do k = 1, nlay - do i = 1, ix - 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 - -!> -# Calculate effective liquid cloud droplet radius over land. - - do i = 1, ix - if (nint(slmsk(i)) == 1) then - do k = 1, nlay - rew(i,k) = 5.0 + 5.0 * tem2d(i,k) - enddo - endif - enddo - -!> -# Calculate layer cloud fraction. +!> -# Calculate layer cloud fraction. do k = 1, nlay do i = 1, ix @@ -2007,17 +1485,17 @@ subroutine progcld_zhao_carr_pdf & enddo ! - do k = 1, nlay - do i = 1, ix - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) -! clouds(i,k,6) = 0.0 - clouds(i,k,7) = rer(i,k) -! clouds(i,k,8) = 0.0 - clouds(i,k,9) = res(i,k) + do k = 1, NLAY + do i = 1, IX + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) +! cld_rwp(i,k) = 0.0 + cld_rerain(i,k) = rer(i,k) +! cld_swp(i,k) = 0.0 + cld_resnow(i,k) = res(i,k) enddo enddo ! @@ -2032,45 +1510,15 @@ end subroutine progcld_zhao_carr_pdf !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! GFDL Lin MP prognostic cloud microphysics scheme. -!!\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 tvly (ix,nlay), model layer virtual temperature in K -!!\param qlyr (ix,nlay), layer specific humidity in gm/gm -!!\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 cldtot (ix,nlay), layer total cloud fraction -!!\param dz (ix,nlay), layer thickness (km) -!!\param delp (ix,nlay), model layer pressure thickness in mb (100Pa) -!!\param ix horizontal dimension -!!\param nlay vertical layer dimension -!!\param nlp1 vertical level dimension -!!\param dzlay(ix,nlay) distance between model layer centers -!!\param clouds (ix,nlay,nf_clds), cloud profiles -!!\n clouds(:,:,1) - layer total cloud fraction -!!\n clouds(:,:,2) - layer cloud liquid water path (\f$g m^{-2}\f$) -!!\n clouds(:,:,3) - mean effective radius for liquid cloud (micron) -!!\n clouds(:,:,4) - layer cloud ice water path (\f$g m^{-2}\f$) -!!\n clouds(:,:,5) - mean effective radius for ice cloud (micron) -!!\n clouds(:,:,6) - layer rain drop water path (\f$g m^{-2}\f$) (not assigned) -!!\n clouds(:,:,7) - mean effective radius for rain drop (micron) -!!\n clouds(:,:,8) - layer snow flake water path (not assigned) (\f$g m^{-2}\f$) (not assigned) -!!\n clouds(:,:,9) - mean effective radius for snow flake (micron) -!>\section gen_progcld_gfdl_lin progcld_gfdl_lin General Algorithm +!>\section progcld_gfdl_lin General Algorithm !! @{ subroutine progcld_gfdl_lin & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: & xlat,xlon,slmsk,cldtot, dz, delp, & & IX, NLAY, NLP1, & & dzlay, cldtot1, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! @@ -2118,16 +1566,16 @@ subroutine progcld_gfdl_lin & ! dzlay(ix,nlay) : thickness between model layer centers (km) ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2155,315 +1603,27 @@ subroutine progcld_gfdl_lin & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot1 -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds - -! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf - -! -!===> ... begin here -! -!> - Assign liquid/ice/rain/snow cloud doplet effective radius as default value. - do k = 1, NLAY - do i = 1, IX - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = reliq_def !< default liq radius to 10 micron - rei (i,k) = reice_def !< default ice radius to 50 micron - rer (i,k) = rrain_def !< default rain radius to 1000 micron - res (i,k) = rsnow_def !< default snow radius to 250 micron - tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - clwf(i,k) = 0.0 - enddo - enddo -! - if ( lcrick ) then - do i = 1, IX - clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) - clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) - enddo - do k = 2, NLAY-1 - do i = 1, IX - clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) - enddo - enddo - else - do k = 1, NLAY - do i = 1, IX - clwf(i,k) = clw(i,k) - enddo - enddo - endif - -!> - Compute liquid/ice condensate path in \f$g m^{-2}\f$. - - do k = 1, NLAY - do i = 1, IX - 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 - -!> - Compute effective liquid cloud droplet radius over land. - - do i = 1, IX - if (nint(slmsk(i)) == 1) then - do k = 1, NLAY - rew(i,k) = 5.0 + 5.0 * tem2d(i,k) - enddo - endif - enddo - - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) < climit) then - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo - enddo - - if ( lcnorm ) then - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo - enddo - endif - -!> - Compute effective ice cloud droplet radius in Heymsfield and McFarquhar (1996) -!! \cite heymsfield_and_mcfarquhar_1996 . - - do k = 1, NLAY - do i = 1, IX - tem2 = tlyr(i,k) - con_ttp - - if (cip(i,k) > 0.0) then - tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) - - if (tem2 < -50.0) then - rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem2 < -40.0) then - rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem2 < -30.0) then - rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif -! rei(i,k) = max(20.0, min(rei(i,k), 300.0)) -! rei(i,k) = max(10.0, min(rei(i,k), 100.0)) - rei(i,k) = max(10.0, min(rei(i,k), 150.0)) -! rei(i,k) = max(5.0, min(rei(i,k), 130.0)) - endif - enddo - enddo - - do k = 1, NLAY - do i = 1, IX - cldtot1(i,k) = cldtot(i,k) - enddo - enddo - -! - do k = 1, NLAY - do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) -! clouds(i,k,6) = 0.0 - clouds(i,k,7) = rer(i,k) -! clouds(i,k,8) = 0.0 - clouds(i,k,9) = res(i,k) - enddo - enddo -! - return -!................................... - end subroutine progcld_gfdl_lin -!! @} -!----------------------------------- - -!----------------------------------- -!> \ingroup module_radiation_clouds -!! This subroutine computes cloud related quantities using GFDL Lin MP -!! prognostic cloud microphysics scheme. Moist species from MP are fed -!! into the corresponding arrays for calculation of cloud fractions. -!! -!>\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 tvly (ix,nlay), model layer virtual temperature in K -!>\param qlyr (ix,nlay), layer specific humidity in \f$gm gm^{-1}\f$ -!>\param qstl (ix,nlay), layer saturate humidity in \f$gm gm^{-1}\f$ -!>\param rhly (ix,nlay), layer relative humidity (=qlyr/qstl) -!>\param clw (ix,nlay,ntrac), layer cloud condensate amount -!>\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 layer thickness (km) -!>\param delp model layer pressure thickness in mb (100Pa) -!>\param ntrac number of tracers minus one (Model%ntrac-1) -!>\param ntcw tracer index for cloud liquid water minus one (Model%ntcw-1) -!>\param ntiw tracer index for cloud ice water minus one (Model%ntiw-1) -!>\param ntrw tracer index for rain water minus one (Model%ntrw-1) -!>\param ntsw tracer index for snow water minus one (Model%ntsw-1) -!>\param ntgl tracer index for graupel minus one (Model%ntgl-1) -!>\param ntclamt tracer index for cloud amount minus one (Model%ntclamt-1) -!>\param ix horizontal dimension -!>\param nlay vertical layer dimension -!>\param nlp1 vertical level dimension -!!\param dzlay(ix,nlay) distance between model layer centers -!>\param clouds (ix,nlay,nf_clds), cloud profiles -!!\n clouds(:,:,1) - layer totoal cloud fraction -!!\n clouds(:,:,2) - layer cloud liquid water path (\f$g m^{-2}\f$) -!!\n clouds(:,:,3) - mean effective radius for liquid cloud (micron) -!!\n clouds(:,:,4) - layer cloud ice water path (\f$g m^{-2}\f$) -!!\n clouds(:,:,5) - mean effective radius for ice cloud (micron) -!!\n clouds(:,:,6) - layer rain dropwater path (\f$g m^{-2}\f$) -!!\n clouds(:,:,7) - mean effective radius for rain drop (micron) -!!\n clouds(:,:,8) - layer snow flake water path (\f$g m^{-2}\f$) -!!\n clouds(:,:,9) - mean effective radius for snow flake (micron) -!>\section gen_progcld4o progcld4o General Algorithm -!! @{ - subroutine progcld4o & - & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk, dz, delp, & - & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntclamt, & - & IX, NLAY, NLP1, & - & dzlay, cldtot, cldcnv, & - & clouds & ! --- outputs: - & ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: progcld4o computes cloud related quantities using ! -! GFDL Lin MP prognostic cloud microphysics scheme. Moist species ! -! from MP are fed into the corresponding arrays for calcuation of ! -! ! -! abstract: this program computes cloud fractions from cloud ! -! condensates, calculates liquid/ice cloud droplet effective radius, ! -! and 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 progcld4o ! -! ! -! 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 ! -! tvly (IX,NLAY) : model layer virtual temperature in k ! -! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! -! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! -! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY,NTRAC) : layer cloud condensate amount ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! -! 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 ! -! dzlay(ix,nlay) : thickness between model layer centers (km) ! -! ! -! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! -! 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) ! -! alpha(ix,nlay) : alpha decorrelation parameter -! ! -! module variables: ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lsashal : control flag for shallow convection ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! ==================== end of description ===================== ! -! - implicit none - -! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, & - & ntclamt - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, delp, dz, dzlay - - - real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds + real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot1 + +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot integer :: i, k, id, nf ! !===> ... begin here ! -!> - Assign liquid/ice/rain/snow cloud droplet effective radius as default value. +!> - Assign liquid/ice/rain/snow cloud doplet effective radius as default value. do k = 1, NLAY do i = 1, IX cldcnv(i,k) = 0.0 @@ -2471,24 +1631,40 @@ subroutine progcld4o & cip (i,k) = 0.0 crp (i,k) = 0.0 csp (i,k) = 0.0 - rew (i,k) = reliq_def ! default liq radius to 10 micron - rei (i,k) = reice_def ! default ice radius to 50 micron - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def ! default snow radius to 250 micron + rew (i,k) = reliq_def !< default liq radius to 10 micron + rei (i,k) = reice_def !< default ice radius to 50 micron + rer (i,k) = rrain_def !< default rain radius to 1000 micron + res (i,k) = rsnow_def !< default snow radius to 250 micron tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - cldtot(i,k) = clw(i,k,ntclamt) + clwf(i,k) = 0.0 enddo enddo +! + if ( lcrick ) then + do i = 1, IX + clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) + clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) + enddo + do k = 2, NLAY-1 + do i = 1, IX + clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) + enddo + enddo + else + do k = 1, NLAY + do i = 1, IX + clwf(i,k) = clw(i,k) + enddo + enddo + endif -!> - Compute liquid/ice condensate path in \f$g m^{-2}\f$ +!> - Compute liquid/ice condensate path in \f$g m^{-2}\f$. do k = 1, NLAY do i = 1, IX - 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)) + 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 @@ -2528,7 +1704,7 @@ subroutine progcld4o & endif !> - Compute effective ice cloud droplet radius in Heymsfield and McFarquhar (1996) -!!\cite heymsfield_and_mcfarquhar_1996. +!! \cite heymsfield_and_mcfarquhar_1996 . do k = 1, NLAY do i = 1, IX @@ -2554,24 +1730,30 @@ subroutine progcld4o & enddo enddo + do k = 1, NLAY + do i = 1, IX + cldtot1(i,k) = cldtot(i,k) + enddo + enddo + ! do k = 1, NLAY do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) - clouds(i,k,9) = rei(i,k) + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) +! cld_rwp(i,k) = 0.0 + cld_rerain(i,k) = rer(i,k) +! cld_swp(i,k) = 0.0 + cld_resnow(i,k) = res(i,k) enddo enddo ! return !................................... - end subroutine progcld4o + end subroutine progcld_gfdl_lin !! @} !----------------------------------- @@ -2587,7 +1769,8 @@ subroutine progcld_fer_hires & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & & dzlay, cldtot, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! @@ -2638,16 +1821,16 @@ subroutine progcld_fer_hires & ! dzlay(ix,nlay) : thickness between model layer centers (km) ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -2683,8 +1866,11 @@ subroutine progcld_fer_hires & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & @@ -2767,54 +1953,14 @@ subroutine progcld_fer_hires & !> - Calculate layer cloud fraction. - clwmin = 0.0 if (.not. lmfshal) then - 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) - - 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 + call cloud_fraction_XuRandall & + & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) & ! --- outputs else - 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) - - 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 + call cloud_fraction_mass_flx_1 & + & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) endif endif ! if (uni_cld) then @@ -2844,23 +1990,21 @@ subroutine progcld_fer_hires & enddo enddo endif +! do k = 1, NLAY do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) - clouds(i,k,7) = rer(i,k) - !mz inflg .ne.5 - clouds(i,k,8) = 0. - clouds(i,k,9) = 10. -!mz for diagnostics? + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) + cld_rwp(i,k) = crp(i,k) + cld_rerain(i,k) = rer(i,k) + cld_swp(i,k) = 0.0 + cld_resnow(i,k) = 10.0 re_cloud(i,k) = rew(i,k) re_ice(i,k) = rei(i,k) re_snow(i,k) = 10. - enddo enddo ! @@ -2870,8 +2014,7 @@ end subroutine progcld_fer_hires !................................... -!mz: this is the original progcld_fer_hires for Thompson MP (and WSM6), -! to be replaced by the GSL version of progcld_thompson_wsm6 for Thompson MP +! This subroutine is used by Thompson/wsm6 cloud microphysics (EMC) subroutine progcld_thompson_wsm6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & @@ -2881,7 +2024,8 @@ subroutine progcld_thompson_wsm6 & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, cldtot, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! @@ -2931,16 +2075,16 @@ subroutine progcld_thompson_wsm6 & ! cldcov : layer cloud fraction (used when uni_cld=.true. ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! @@ -2981,8 +2125,11 @@ subroutine progcld_thompson_wsm6 & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & @@ -3079,57 +2226,16 @@ subroutine progcld_thompson_wsm6 & !> - Calculate layer cloud fraction. - clwmin = 0.0 if (.not. lmfshal) then - do k = 1, NLAY - do i = 1, IX - clwt = 1.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 - - 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 + call cloud_fraction_XuRandall & + & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) & ! --- outputs else - do k = 1, NLAY-1 - do i = 1, IX - clwt = 1.0e-10 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - if(rhly(i,k) > 0.99) then - cldtot(i,k) = 1. - else - 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 - else - cldtot(i,k) = 0.0 - endif - enddo - enddo - endif + call cloud_fraction_mass_flx_2 & + & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) + endif + endif ! if (uni_cld) then do k = 1, NLAY @@ -3173,15 +2279,15 @@ subroutine progcld_thompson_wsm6 & do k = 1, NLAY do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) ! added for Thompson - clouds(i,k,9) = res(i,k) + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) + cld_rwp(i,k) = crp(i,k) ! added for Thompson + cld_rerain(i,k) = rer(i,k) + cld_swp(i,k) = csp(i,k) ! added for Thompson + cld_resnow(i,k) = res(i,k) enddo enddo @@ -3212,7 +2318,8 @@ subroutine progcld_thompson & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, gridkm, cldtot, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! @@ -3263,16 +2370,16 @@ subroutine progcld_thompson & ! cldcov : layer cloud fraction (used when uni_cld=.true. ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! ! ! module variables: ! ! ivflip : control flag of vertical index direction ! @@ -3309,8 +2416,11 @@ subroutine progcld_thompson & & slmsk real(kind=kind_phys), dimension(:), intent(in) :: gridkm -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & @@ -3331,14 +2441,6 @@ subroutine progcld_thompson & clwmin = 1.0E-9 - do nf=1,nf_clds - do k=1,nlay - do i=1,ix - clouds(i,k,nf) = 0.0 - enddo - enddo - enddo - do k = 1, NLAY do i = 1, IX cldtot(i,k) = 0.0 @@ -3454,15 +2556,15 @@ subroutine progcld_thompson & do k = 1, NLAY do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) - clouds(i,k,9) = res(i,k) + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) + cld_rwp(i,k) = crp(i,k) ! added for Thompson + cld_rerain(i,k) = rer(i,k) + cld_swp(i,k) = csp(i,k) ! added for Thompson + cld_resnow(i,k) = res(i,k) enddo enddo @@ -3494,50 +2596,20 @@ end subroutine progcld_thompson !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! for unified cloud microphysics scheme. -!!\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 tvly (IX,NLAY), model layer virtual temperature in K -!!\param ccnd (IX,NLAY), layer cloud condensate amount -!!\param ncnd number of layer cloud condensate types -!!\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,NLP1 vertical layer/level dimensions -!!\param cldtot unified cloud fraction from moist physics -!!\param effrl (IX,NLAY), effective radius for liquid water -!!\param effri (IX,NLAY), effective radius for ice water -!!\param effrr (IX,NLAY), effective radius for rain water -!!\param effrs (IX,NLAY), effective radius for snow water -!!\param effr_in logical - if .true. use input effective radii -!!\param dzlay(ix,nlay) distance between model layer centers -!!\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$ -!!\n (:,:,3) - mean eff radius for liq cloud (micron) -!!\n (:,:,4) - layer cloud ice water path \f$(g/m^2)\f$ -!!\n (:,:,5) - mean eff radius for ice cloud (micron) -!!\n (:,:,6) - layer rain drop water path -!!\n (:,:,7) - mean eff radius for rain drop (micron) -!!\n (:,:,8) - layer snow flake water path -!!\n (:,:,9) - mean eff radius for snow flake (micron) -!>\section gen_progclduni progclduni General Algorithm +!>\section progclduni General Algorithm !> @{ subroutine progclduni & & ( plyr,plvl,tlyr,tvly,ccnd,ncnd, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, & & effrl,effri,effrr,effrs,effr_in, & & dzlay, cldtot1, cldcnv, & - & clouds & ! --- outputs: + & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs + & cld_reice,cld_rwp, cld_rerain,cld_swp, cld_resnow & & ) ! ================= subprogram documentation block ================ ! ! ! -! subprogram: progclduni computes cloud related quantities using ! +! subprogram: progclduni computes cloud related quantities using ! ! for unified cloud microphysics scheme. ! ! ! ! abstract: this program computes cloud fractions from cloud ! @@ -3546,8 +2618,11 @@ subroutine progclduni & ! 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". ! +! This program is written by Moorthi ! +! to represent unified cloud across all physics while ! +! using SHOC+MG2/3+convection (RAS or SAS or CSAW) ! ! ! -! usage: call progclduni ! +! usage: call progclduni ! ! ! ! subprograms called: gethml ! ! ! @@ -3583,16 +2658,16 @@ subroutine progclduni & ! dzlay(ix,nlay) : thickness between model layer centers (km) ! ! ! ! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! cloud profiles: ! +! cld_frac (:,:) - layer total cloud fraction ! +! cld_lwp (:,:) - layer cloud liq water path (g/m**2) ! +! cld_reliq (:,:) - mean eff radius for liq cloud (micron) ! +! cld_iwp (:,:) - layer cloud ice water path (g/m**2) ! +! cld_reice (:,:) - mean eff radius for ice cloud (micron) ! +! cld_rwp (:,:) - layer rain drop water path not assigned ! +! cld_rerain(:,:) - mean eff radius for rain drop (micron) ! +! *** cld_swp (:,:) - layer snow flake water path not assigned ! +! cld_resnow(:,:) - mean eff radius for snow flake (micron) ! ! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! @@ -3630,8 +2705,12 @@ subroutine progclduni & & slmsk real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot1 -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds + +! --- inputs/outputs + + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & + & cld_rwp, cld_rerain, cld_swp, cld_resnow ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, cwp, cip, & @@ -3789,15 +2868,15 @@ subroutine progclduni & ! do k = 1, NLAY do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) - clouds(i,k,9) = res(i,k) + cld_frac(i,k) = cldtot(i,k) + cld_lwp(i,k) = cwp(i,k) + cld_reliq(i,k) = rew(i,k) + cld_iwp(i,k) = cip(i,k) + cld_reice(i,k) = rei(i,k) + cld_rwp(i,k) = crp(i,k) ! added for Thompson + cld_rerain(i,k) = rer(i,k) + cld_swp(i,k) = csp(i,k) ! added for Thompson + cld_resnow(i,k) = res(i,k) enddo enddo ! @@ -4688,6 +3767,154 @@ SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte) END SUBROUTINE adjust_cloudFinal + subroutine cloud_fraction_XuRandall & + & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) & ! --- outputs + +! --- inputs: + integer, intent(in) :: IX, NLAY + real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & + & rhly, qstl + +! --- outputs + real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot + +! --- local variables: + + real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & + & tem1, tem2 + integer :: i, k + +!> - Compute layer cloud fraction. + + clwmin = 0.0 + 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) + + 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 + + end subroutine cloud_fraction_XuRandall + + subroutine cloud_fraction_mass_flx_1 & + & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) & ! --- outputs + +! --- inputs: + integer, intent(in) :: IX, NLAY + real (kind=kind_phys), intent(in) :: xrc3 + real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & + & rhly, qstl + logical, intent(in) :: lmfdeep2 + +! --- outputs + real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot + +! --- local variables: + + real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & + & tem1, tem2 + integer :: i, k + +!> - Compute layer cloud fraction. + + clwmin = 0.0 + 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) + + 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 + + end subroutine cloud_fraction_mass_flx_1 + + subroutine cloud_fraction_mass_flx_2 & + & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & cldtot ) & ! --- outputs + +! --- inputs: + integer, intent(in) :: IX, NLAY + real (kind=kind_phys), intent(in) :: xrc3 + real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & + & rhly, qstl + logical, intent(in) :: lmfdeep2 + +! --- outputs + real (kind=kind_phys), dimension(:,:), intent(inout) :: cldtot + +! --- local variables: + + real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & + & tem1, tem2 + integer :: i, k + +!> - Compute layer cloud fraction. + + clwmin = 0.0 + do k = 1, NLAY-1 + do i = 1, IX + clwt = 1.0e-10 * (plyr(i,k)*0.001) + + if (clwf(i,k) > clwt) then + if(rhly(i,k) > 0.99) then + cldtot(i,k) = 1. + else + 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 + else + cldtot(i,k) = 0.0 + endif + enddo + enddo + + end subroutine cloud_fraction_mass_flx_2 !........................................! end module module_radiation_clouds !! @} diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index 95bc0b059..6d4f5750d 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -2082,7 +2082,7 @@ subroutine mcica_subcol & ! ! NOTE: The code below is identical for case (4) and (5) because the ! distinction in the vertical correlation between EXP and ER is already -! built into the specification of alpha (in subroutine get_alpha_exp). +! built into the specification of alpha (in subroutine get_alpha_exper). ! --- setup 2 sets of random numbers diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index d09f586a3..4067dd0ec 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -2197,7 +2197,7 @@ subroutine mcica_subcol & ! ! NOTE: The code below is identical for case (4) and (5) because the ! distinction in the vertical correlation between EXP and ER is already -! built into the specification of alpha (in subroutine get_alpha_exp). +! built into the specification of alpha (in subroutine get_alpha_exper). ! --- setup 2 sets of random numbers