LCOV - code coverage report
Current view: top level - atmos_phys/schemes/rasch_kristjansson - rk_stratiform.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 128 172 74.4 %
Date: 2025-04-28 18:57:11 Functions: 8 9 88.9 %

          Line data    Source code
       1             : ! Rasch and Kristjansson prognostic cloud microphysics and CAM4 macrophysics
       2             : ! CCPP-ized: Haipeng Lin, January 2025
       3             : module rk_stratiform
       4             :   use ccpp_kinds, only: kind_phys
       5             : 
       6             :   implicit none
       7             :   private
       8             :   save
       9             : 
      10             :   ! public CCPP-compliant subroutines
      11             :   !   note: cloud_fraction_perturbation_run calls the compute_cloud_fraction
      12             :   !         scheme run phase for perturbation with a modified rhpert_flag = .true.
      13             :   !
      14             :   ! refer to test SDF suite_rasch_kristjansson.xml for total order of operations,
      15             :   ! as the full RK-stratiform requires other schemes not included in this module.
      16             :   public :: rk_stratiform_check_qtlcwat_run
      17             :   ! -- cloud_particle_sedimentation --
      18             :   public :: rk_stratiform_sedimentation_run
      19             :   public :: rk_stratiform_detrain_convective_condensate_run
      20             :   public :: rk_stratiform_cloud_fraction_perturbation_run         ! see note.
      21             :   public :: rk_stratiform_external_forcings_run
      22             :   public :: rk_stratiform_condensate_repartioning_run
      23             :   ! -- prognostic_cloud_water --
      24             :   public :: rk_stratiform_prognostic_cloud_water_tendencies_run
      25             :   public :: rk_stratiform_cloud_optical_properties_run
      26             :   public :: rk_stratiform_save_qtlcwat_run
      27             : 
      28             :   !
      29             : 
      30             : contains
      31             : 
      32             : !> \section arg_table_rk_stratiform_check_qtlcwat_run Argument Table
      33             : !! \htmlinclude arg_table_rk_stratiform_check_qtlcwat_run.html
      34           0 :   subroutine rk_stratiform_check_qtlcwat_run( &
      35             :     ncol, pver, &
      36           0 :     t, q_wv, cldice, cldliq, &
      37           0 :     qcwat, tcwat, lcwat, &  ! from end of last microphysics/macrophysics call.
      38           0 :     errmsg, errflg)
      39             : 
      40             :     ! Input arguments
      41             :     integer,            intent(in)    :: ncol
      42             :     integer,            intent(in)    :: pver
      43             :     real(kind_phys),    intent(in)    :: t(:,:)         ! air_temperature [K]
      44             :     real(kind_phys),    intent(in)    :: q_wv(:, :)     ! adv: water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
      45             :     real(kind_phys),    intent(in)    :: cldice(:,:)    ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
      46             :     real(kind_phys),    intent(in)    :: cldliq(:,:)    ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
      47             : 
      48             :     ! Input/output arguments
      49             :     real(kind_phys),    intent(inout) :: qcwat(:,:)     ! [kg kg-1]
      50             :     real(kind_phys),    intent(inout) :: tcwat(:,:)     ! [K]
      51             :     real(kind_phys),    intent(inout) :: lcwat(:,:)     ! [kg kg-1]
      52             : 
      53             :     ! Output arguments
      54             :     character(len=512), intent(out)   :: errmsg         ! error message
      55             :     integer,            intent(out)   :: errflg         ! error flag
      56             : 
      57           0 :     errmsg = ''
      58           0 :     errflg = 0
      59             : 
      60             :     ! Check that qcwat and tcwat were initialized - if not then initialize
      61             :     ! this is made as a separate "run" scheme so it does not have to be used in current CAM
      62             : 
      63             :     ! lcwat is initialized from initial conditions of cldice, cldliq
      64             :     ! TODO: check if this is always done (appears to be from physpkg.F90) or should be read from snapshot.
      65           0 :     if(qcwat(1,1) < 0._kind_phys .or. tcwat(1,1) < 0._kind_phys) then
      66           0 :       lcwat(:ncol,:) = cldice(:ncol,:) + cldliq(:ncol,:)
      67             :     endif
      68             : 
      69             :     ! The registry will set default negative values if not read from snapshot.
      70           0 :     if(qcwat(1,1) < 0._kind_phys) then
      71           0 :       qcwat(:ncol,:) = q_wv(:ncol,:)
      72             :     endif
      73             : 
      74           0 :     if(tcwat(1,1) < 0._kind_phys) then
      75           0 :       tcwat(:ncol,:) = t(:ncol,:)
      76             :     endif
      77             : 
      78           0 :   end subroutine rk_stratiform_check_qtlcwat_run
      79             : 
      80             : !> \section arg_table_rk_stratiform_sedimentation_run Argument Table
      81             : !! \htmlinclude arg_table_rk_stratiform_sedimentation_run.html
      82       70392 :   subroutine rk_stratiform_sedimentation_run( &
      83             :     ncol, &
      84       70392 :     sfliq, snow_sed, &
      85       70392 :     prec_sed, &
      86       70392 :     prec_str, snow_str, &
      87       70392 :     errmsg, errflg)
      88             : 
      89             :     ! Input arguments
      90             :     integer,            intent(in)    :: ncol
      91             :     real(kind_phys),    intent(in)    :: sfliq(:)        ! stratiform_rain_flux_at_surface_due_to_sedimentation [kg m-2 s-1]
      92             :     real(kind_phys),    intent(in)    :: snow_sed(:)     ! sfice = lwe_cloud_ice_sedimentation_rate_at_surface_due_to_microphysics [m s-1]
      93             : 
      94             :     ! Output arguments
      95             :     real(kind_phys),    intent(out)   :: prec_sed(:)     ! stratiform_cloud_water_surface_flux_due_to_sedimentation [m s-1]
      96             :     real(kind_phys),    intent(out)   :: prec_str(:)     ! lwe_large_scale_precipitation_rate_at_surface [m s-1]
      97             :     real(kind_phys),    intent(out)   :: snow_str(:)     ! lwe_snow_and_cloud_ice_precipitation_rate_at_surface_due_to_microphysics [m s-1]
      98             :     character(len=512), intent(out)   :: errmsg         ! error message
      99             :     integer,            intent(out)   :: errflg         ! error flag
     100             : 
     101       70392 :     errmsg = ''
     102       70392 :     errflg = 0
     103             : 
     104             :     ! Convert rain flux to precip units from mass units
     105             :     ! and create cloud water surface flux (rain + snow)
     106     1090992 :     prec_sed(:ncol) = sfliq(:ncol)/1000._kind_phys + snow_sed(:ncol)
     107             : 
     108             :     ! Start accumulation of precipitation and snow flux [m s-1]
     109     1090992 :     prec_str(:ncol) = 0._kind_phys + prec_sed(:ncol)
     110     1090992 :     snow_str(:ncol) = 0._kind_phys + snow_sed(:ncol)
     111             : 
     112       70392 :   end subroutine rk_stratiform_sedimentation_run
     113             : 
     114             : !> \section arg_table_rk_stratiform_detrain_convective_condensate_run Argument Table
     115             : !! \htmlinclude arg_table_rk_stratiform_detrain_convective_condensate_run.html
     116       70392 :   subroutine rk_stratiform_detrain_convective_condensate_run( &
     117             :     ncol, &
     118       70392 :     dlf, &
     119       70392 :     rliq, &
     120       70392 :     prec_str, &
     121       70392 :     tend_cldliq, &
     122       70392 :     errmsg, errflg)
     123             : 
     124             :     ! Input arguments
     125             :     integer,            intent(in)    :: ncol
     126             :     real(kind_phys),    intent(in)    :: dlf(:,:)       ! detrainment_of_cloud_liquid_water_wrt_moist_air_and_condensed_water_due_to_all_convection [kg kg-1 s-1]
     127             :     real(kind_phys),    intent(in)    :: rliq(:)        ! vertically_integrated_cloud_liquid_water_tendency_due_to_all_convection_to_be_applied_later_in_time_loop [m s-1]
     128             : 
     129             :     ! Input/output arguments
     130             :     real(kind_phys),    intent(inout) :: prec_str(:)     ! lwe_large_scale_precipitation_rate_at_surface [m s-1]
     131             : 
     132             :     ! Output arguments
     133             :     real(kind_phys),    intent(out)   :: tend_cldliq(:,:) ! tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1]
     134             :     character(len=512), intent(out)   :: errmsg         ! error message
     135             :     integer,            intent(out)   :: errflg         ! error flag
     136             : 
     137       70392 :     errmsg = ''
     138       70392 :     errflg = 0
     139             : 
     140             :     ! Apply detrainment tendency to cloud liquid water
     141    28436184 :     tend_cldliq(:ncol,:) = dlf(:ncol,:)
     142             : 
     143             :     ! Accumulate precipitation and snow after
     144             :     ! reserved liquid (vertical integral) has now been used
     145             :     ! (snow contribution is zero)
     146     1090992 :     prec_str(:ncol) = prec_str(:ncol) - rliq(:ncol)
     147             : 
     148       70392 :   end subroutine rk_stratiform_detrain_convective_condensate_run
     149             : 
     150             :   ! Call perturbed cloud fraction and compute perturbation threshold criteria
     151             :   ! necessary for prognostic_cloud_water scheme
     152             : !> \section arg_table_rk_stratiform_cloud_fraction_perturbation_run Argument Table
     153             : !! \htmlinclude arg_table_rk_stratiform_cloud_fraction_perturbation_run.html
     154       70392 :   subroutine rk_stratiform_cloud_fraction_perturbation_run( &
     155             :     ncol, pver, &
     156             :     cappa, gravit, rair, tmelt, pref, lapse_rate, &
     157             :     top_lev_cloudphys, &
     158       70392 :     pmid, ps, temp, sst, &
     159       70392 :     q_wv, cldice, &
     160       70392 :     phis, &
     161       70392 :     shallowcu, deepcu, concld, & ! inputs from convective_cloud_cover
     162       70392 :     landfrac, ocnfrac, snowh, &
     163      140784 :     cloud, relhum, rhu00, & ! inputs from unperturbed compute_cloud_fraction
     164       70392 :     rhdfda, & ! output for prognostic_cloud_water
     165           0 :     errmsg, errflg)
     166             : 
     167             :     ! Dependency: compute_cloud_fraction CCPPized scheme run phase.
     168             :     ! this scheme is called with an altered rhpert_flag = .true.
     169             :     ! then the outputs are combined with the "regular" output of the compute_cloud_fraction
     170             :     ! CCPP scheme to get the perturbed quantities for prognostic_cloud_water.
     171             :     use compute_cloud_fraction, only: compute_cloud_fraction_run
     172             : 
     173             :     ! Input arguments
     174             :     integer,         intent(in) :: ncol
     175             :     integer,         intent(in) :: pver
     176             :     real(kind_phys), intent(in) :: cappa
     177             :     real(kind_phys), intent(in) :: gravit
     178             :     real(kind_phys), intent(in) :: rair
     179             :     real(kind_phys), intent(in) :: tmelt
     180             :     real(kind_phys), intent(in) :: pref
     181             :     real(kind_phys), intent(in) :: lapse_rate
     182             :     integer,         intent(in) :: top_lev_cloudphys ! vertical_layer_index_of_cloud_fraction_top [index]
     183             :     real(kind_phys), intent(in) :: pmid(:, :)        ! air_pressure [Pa]
     184             :     real(kind_phys), intent(in) :: ps(:)             ! surface_air_pressure [Pa]
     185             :     real(kind_phys), intent(in) :: temp(:, :)        ! air_temperature [K]
     186             :     real(kind_phys), intent(in) :: sst(:)            ! sea_surface_temperature [K]
     187             :     real(kind_phys), intent(in) :: q_wv(:, :)        ! adv: water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     188             :     real(kind_phys), intent(in) :: cldice(:, :)      ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     189             :     real(kind_phys), intent(in) :: phis(:)           ! surface_geopotential [m2 s-2]
     190             :     real(kind_phys), intent(in) :: shallowcu(:, :)   ! shallow convective cloud fraction
     191             :     real(kind_phys), intent(in) :: deepcu(:, :)      ! deep convective cloud fraction
     192             :     real(kind_phys), intent(in) :: concld(:, :)      ! convective_cloud_area_fraction [fraction]
     193             :     real(kind_phys), intent(in) :: landfrac(:)       ! land_area_fraction [fraction]
     194             :     real(kind_phys), intent(in) :: ocnfrac(:)        ! ocean_area_fraction [fraction]
     195             :     real(kind_phys), intent(in) :: snowh(:)          ! lwe_surface_snow_depth_over_land [m]
     196             : 
     197             :     real(kind_phys), intent(in) :: cloud(:, :)       ! cloud_area_fraction [fraction]
     198             :     real(kind_phys), intent(in) :: relhum(:, :)      ! RH for prognostic cldwat [percent]
     199             : 
     200             :     ! Input/output arguments
     201             :     ! Note: CAM4 intentionally mutates the top level of rhu00 so this is inout here.
     202             :     real(kind_phys),  intent(inout) :: rhu00(:, :)      ! RH threshold for cloud [fraction]
     203             : 
     204             :     ! Output arguments
     205             :     real(kind_phys),    intent(out) :: rhdfda(:, :)     ! derivative of RH w.r.t. cloud fraction for prognostic cloud water [percent]
     206             :     character(len=512), intent(out) :: errmsg           ! error message
     207             :     integer,            intent(out) :: errflg           ! error flag
     208             : 
     209             :     ! Local variables
     210             :     integer :: i, k
     211             : 
     212             :     ! Local variables (outputs from perturbed compute_cloud_fraction)
     213      140784 :     real(kind_phys)  :: cloud2(ncol, pver)
     214             : 
     215             :     ! Dummy outputs (unused)
     216      140784 :     real(kind_phys)  :: rhcloud2(ncol, pver)
     217      140784 :     real(kind_phys)  :: cldst2(ncol, pver)
     218      140784 :     real(kind_phys)  :: rhu002(ncol, pver)
     219      140784 :     real(kind_phys)  :: icecldf2(ncol, pver)
     220      140784 :     real(kind_phys)  :: liqcldf2(ncol, pver)
     221       70392 :     real(kind_phys)  :: relhum2(ncol, pver)
     222             : 
     223       70392 :     errmsg = ''
     224       70392 :     errflg = 0
     225             : 
     226             :     ! Call perturbed version of compute_cloud_fraction scheme
     227             :     call compute_cloud_fraction_run( &
     228             :       ncol              = ncol,                 &
     229             :       pver              = pver,                 &
     230             :       cappa             = cappa,                &
     231             :       gravit            = gravit,               &
     232             :       rair              = rair,                 &
     233             :       tmelt             = tmelt,                &
     234             :       pref              = pref,                 &
     235             :       lapse_rate        = lapse_rate,           &
     236             :       top_lev_cloudphys = top_lev_cloudphys,    & ! CAM4 macrophysics - top lev is 1
     237           0 :       pmid              = pmid(:ncol,:),        &
     238           0 :       ps                = ps(:ncol),            &
     239           0 :       temp              = temp(:ncol,:),        &
     240           0 :       sst               = sst(:ncol),           &
     241           0 :       q                 = q_wv(:ncol,:),        &
     242           0 :       cldice            = cldice(:ncol,:),      &
     243           0 :       phis              = phis(:ncol),          &
     244           0 :       shallowcu         = shallowcu(:ncol,:),   &
     245           0 :       deepcu            = deepcu(:ncol,:),      &
     246           0 :       concld            = concld(:ncol,:),      &
     247           0 :       landfrac          = landfrac(:ncol),      &
     248           0 :       ocnfrac           = ocnfrac(:ncol),       &
     249           0 :       snowh             = snowh(:ncol),         &
     250             :       rhpert_flag       = .true.,               & ! ** apply perturbation here **
     251           0 :       cloud             = cloud2(:ncol, :),     &
     252           0 :       rhcloud           = rhcloud2(:ncol, :),   &
     253           0 :       cldst             = cldst2(:ncol,:),      &
     254           0 :       rhu00             = rhu002(:ncol,:),      &
     255           0 :       icecldf           = icecldf2(:ncol,:),    &
     256           0 :       liqcldf           = liqcldf2(:ncol,:),    &
     257           0 :       relhum            = relhum2(:ncol,:),     &
     258             :       errmsg            = errmsg,               &
     259       70392 :       errflg            = errflg)
     260             : 
     261             :     ! Compute rhdfda (derivative of RH w.r.t. cloud fraction)
     262             :     ! for use in the prognostic_cloud_water scheme.
     263     1090992 :     rhu00(:ncol,1) = 2.0_kind_phys   ! arbitrary number larger than 1 (100%)
     264     1900584 :     do k = 1, pver
     265    28436184 :       do i = 1, ncol
     266    28365792 :          if( relhum(i,k) < rhu00(i,k) ) then
     267    22032453 :             rhdfda(i,k) = 0.0_kind_phys
     268     4503147 :          elseif( relhum(i,k) >= 1.0_kind_phys ) then
     269      587914 :             rhdfda(i,k) = 0.0_kind_phys
     270             :          else
     271             :             ! Under certain circumstances, rh+ cause cld not to changed
     272             :             ! when at an upper limit, or w/ strong subsidence
     273     3915233 :             if( ( cloud2(i,k) - cloud(i,k) ) < 1.e-4_kind_phys ) then
     274      186247 :                rhdfda(i,k) = 0.01_kind_phys*relhum(i,k)*1.e+4_kind_phys
     275             :             else
     276     3728986 :                rhdfda(i,k) = 0.01_kind_phys*relhum(i,k)/(cloud2(i,k)-cloud(i,k))
     277             :             endif
     278             :          endif
     279             :       enddo
     280             :     enddo
     281             : 
     282       70392 :   end subroutine rk_stratiform_cloud_fraction_perturbation_run
     283             : 
     284             : 
     285             :   ! Compute non-micro and non-macrophysical external forcings
     286             :   ! for computing of net condensation rate.
     287             :   ! Note: advective forcing of condensate is aggregated into liquid phase.
     288             : !> \section arg_table_rk_stratiform_external_forcings_run Argument Table
     289             : !! \htmlinclude arg_table_rk_stratiform_external_forcings_run.html
     290       70392 :   subroutine rk_stratiform_external_forcings_run( &
     291             :     ncol, pver, &
     292             :     dtime, &
     293       70392 :     t, &
     294      140784 :     q_wv, cldice, cldliq, &
     295      211176 :     qcwat, tcwat, lcwat, &  ! from end of last physics timestep.
     296      211176 :     qtend, ttend, ltend, &  ! output for prognostic_cloud_water
     297           0 :     errmsg, errflg)
     298             : 
     299             :     ! Input arguments
     300             :     integer,            intent(in)    :: ncol
     301             :     integer,            intent(in)    :: pver
     302             :     real(kind_phys),    intent(in)    :: dtime
     303             :     real(kind_phys),    intent(in)    :: t(:,:)         ! air_temperature [K]
     304             :     real(kind_phys),    intent(in)    :: q_wv(:,:)      ! adv: water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     305             :     real(kind_phys),    intent(in)    :: cldice(:,:)    ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     306             :     real(kind_phys),    intent(in)    :: cldliq(:,:)    ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     307             : 
     308             :     real(kind_phys),    intent(in)    :: qcwat(:,:)     ! [kg kg-1]
     309             :     real(kind_phys),    intent(in)    :: tcwat(:,:)     ! [K]
     310             :     real(kind_phys),    intent(in)    :: lcwat(:,:)     ! [kg kg-1]
     311             : 
     312             :     ! Output arguments (for prognostic_cloud_water)
     313             :     real(kind_phys),    intent(out)   :: qtend(:,:)     ! not due to micro/macrophysics [kg kg-1 s-1]
     314             :     real(kind_phys),    intent(out)   :: ttend(:,:)     ! not due to micro/macrophysics [K s-1]
     315             :     real(kind_phys),    intent(out)   :: ltend(:,:)     ! not due to micro/macrophysics [kg kg-1 s-1]
     316             :     character(len=512), intent(out)   :: errmsg         ! error message
     317             :     integer,            intent(out)   :: errflg         ! error flag
     318             : 
     319             :     ! Local arguments
     320       70392 :     real(kind_phys)  :: totcw(ncol, pver)
     321             : 
     322       70392 :     errmsg = ''
     323       70392 :     errflg = 0
     324             : 
     325    28436184 :     totcw(:ncol,:)     = cldice(:ncol,:) + cldliq(:ncol,:)
     326             : 
     327    28436184 :     qtend(:ncol,:pver) = 1.0_kind_phys / dtime * (q_wv  (:ncol,:pver) - qcwat(:ncol,:pver))
     328    28436184 :     ttend(:ncol,:pver) = 1.0_kind_phys / dtime * (t     (:ncol,:pver) - tcwat(:ncol,:pver))
     329    28436184 :     ltend(:ncol,:pver) = 1.0_kind_phys / dtime * (totcw (:ncol,:pver) - lcwat(:ncol,:pver))
     330             : 
     331       70392 :   end subroutine rk_stratiform_external_forcings_run
     332             : 
     333             :   ! Repartitioning of stratiform condensate,
     334             :   ! and compute repartition heating from change in cloud ice
     335             : !> \section arg_table_rk_stratiform_condensate_repartioning_run Argument Table
     336             : !! \htmlinclude arg_table_rk_stratiform_condensate_repartioning_run.html
     337       70392 :   subroutine rk_stratiform_condensate_repartioning_run( &
     338             :     ncol, pver, &
     339             :     dtime, &
     340             :     latice, &
     341       70392 :     cldice, cldliq, &
     342       70392 :     fice, &   ! from cloud_fraction_fice
     343       70392 :     repartht, &
     344       70392 :     tend_cldice, &
     345       70392 :     tend_cldliq, &
     346           0 :     errmsg, errflg)
     347             : 
     348             :     ! Input arguments
     349             :     integer,            intent(in)    :: ncol
     350             :     integer,            intent(in)    :: pver
     351             :     real(kind_phys),    intent(in)    :: dtime
     352             :     real(kind_phys),    intent(in)    :: latice
     353             :     real(kind_phys),    intent(in)    :: cldice(:,:)    ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     354             :     real(kind_phys),    intent(in)    :: cldliq(:,:)    ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     355             :     real(kind_phys),    intent(in)    :: fice(:,:)      ! mass_fraction_of_ice_content_within_stratiform_cloud [fraction]
     356             : 
     357             :     ! Input/output arguments
     358             : 
     359             :     ! Output arguments
     360             :     real(kind_phys),    intent(out)   :: repartht(:,:)     ! [J kg-1 s-1]
     361             :     real(kind_phys),    intent(out)   :: tend_cldice(:,:)  ! tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1]
     362             :     real(kind_phys),    intent(out)   :: tend_cldliq(:,:)  ! tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1]
     363             :     character(len=512), intent(out)   :: errmsg            ! error message
     364             :     integer,            intent(out)   :: errflg            ! error flag
     365             : 
     366             :     ! Local arguments
     367       70392 :     real(kind_phys)  :: totcw(ncol, pver)
     368             : 
     369       70392 :     errmsg = ''
     370       70392 :     errflg = 0
     371             : 
     372    28436184 :     totcw(:ncol,:) = cldice(:ncol,:) + cldliq(:ncol,:)
     373    28436184 :     tend_cldice(:ncol,:) = 1.0_kind_phys / dtime * ( totcw(:ncol,:)*fice(:ncol,:)                 - cldice(:ncol,:) )
     374    28436184 :     tend_cldliq(:ncol,:) = 1.0_kind_phys / dtime * ( totcw(:ncol,:)*(1.0_kind_phys-fice(:ncol,:)) - cldliq(:ncol,:) )
     375             : 
     376    28436184 :     repartht(:ncol,:pver) = latice * tend_cldice(:ncol,:pver)
     377             : 
     378       70392 :   end subroutine rk_stratiform_condensate_repartioning_run
     379             : 
     380             :   ! Determine tendencies from prognostic cloud water
     381             : !> \section arg_table_rk_stratiform_prognostic_cloud_water_tendencies_run Argument Table
     382             : !! \htmlinclude arg_table_rk_stratiform_prognostic_cloud_water_tendencies_run.html
     383       70392 :   subroutine rk_stratiform_prognostic_cloud_water_tendencies_run( &
     384             :     ncol, pver, &
     385             :     dtime, &
     386             :     latvap, latice, &
     387       70392 :     qme, fice, &
     388       70392 :     evapheat, prfzheat, meltheat, &
     389       70392 :     repartht, &
     390       70392 :     evapprec, &
     391      140784 :     ice2pr, liq2pr, &
     392      140784 :     prec_pcw, snow_pcw, &
     393      140784 :     prec_str, snow_str, &
     394      140784 :     cmeheat, cmeice, cmeliq, &
     395       70392 :     tend_s, &
     396       70392 :     tend_q, &
     397       70392 :     tend_cldice, &
     398       70392 :     tend_cldliq, &
     399       70392 :     errmsg, errflg)
     400             : 
     401             :     ! Input arguments
     402             :     integer,            intent(in)    :: ncol
     403             :     integer,            intent(in)    :: pver
     404             :     real(kind_phys),    intent(in)    :: dtime
     405             :     real(kind_phys),    intent(in)    :: latvap
     406             :     real(kind_phys),    intent(in)    :: latice
     407             :     real(kind_phys),    intent(in)    :: qme(:,:)          ! net_condensation_rate_due_to_microphysics [s-1]
     408             :     real(kind_phys),    intent(in)    :: fice(:,:)         ! mass_fraction_of_ice_content_within_stratiform_cloud [fraction]
     409             :     real(kind_phys),    intent(in)    :: evapheat(:,:)     !
     410             :     real(kind_phys),    intent(in)    :: prfzheat(:,:)     !
     411             :     real(kind_phys),    intent(in)    :: meltheat(:,:)     !
     412             :     real(kind_phys),    intent(in)    :: repartht(:,:)     ! (from microphysical tend)
     413             :     real(kind_phys),    intent(in)    :: evapprec(:,:)     !
     414             :     real(kind_phys),    intent(in)    :: ice2pr(:,:)       !
     415             :     real(kind_phys),    intent(in)    :: liq2pr(:,:)       !
     416             :     real(kind_phys),    intent(in)    :: prec_pcw(:)       ! lwe_stratiform_precipitation_rate_at_surface [m s-1]
     417             :     real(kind_phys),    intent(in)    :: snow_pcw(:)       ! lwe_snow_precipitation_rate_at_surface_due_to_microphysics [m s-1]
     418             : 
     419             :     ! Input/output arguments
     420             :     real(kind_phys),    intent(inout) :: prec_str(:)    ! lwe_large_scale_precipitation_rate_at_surface [m s-1]
     421             :     real(kind_phys),    intent(inout) :: snow_str(:)    ! lwe_snow_and_cloud_ice_precipitation_rate_at_surface_due_to_microphysics [m s-1]
     422             : 
     423             :     ! Output arguments
     424             :     real(kind_phys),    intent(out)   :: cmeheat(:,:)      ! ... [J kg-1 s-1]
     425             :     real(kind_phys),    intent(out)   :: cmeice(:,:)       ! ... [kg kg-1 s-1]
     426             :     real(kind_phys),    intent(out)   :: cmeliq(:,:)       ! ... [kg kg-1 s-1]
     427             :     real(kind_phys),    intent(out)   :: tend_s(:,:)       ! tendency_of_dry_air_enthalpy_at_constant_pressure [J kg-1 s-1]
     428             :     real(kind_phys),    intent(out)   :: tend_q(:,:)       ! tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1]
     429             :     real(kind_phys),    intent(out)   :: tend_cldice(:,:)  ! tendency_of_cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1]
     430             :     real(kind_phys),    intent(out)   :: tend_cldliq(:,:)  ! tendency_of_cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1 s-1]
     431             :     character(len=512), intent(out)   :: errmsg            ! error message
     432             :     integer,            intent(out)   :: errflg            ! error flag
     433             : 
     434             :     integer :: i, k
     435       70392 :     errmsg = ''
     436       70392 :     errflg = 0
     437             : 
     438     1900584 :     do k = 1, pver
     439    28436184 :       do i = 1, ncol
     440             :         ! Heating from cond-evap within the cloud [J kg-1 s-1]
     441    26535600 :         cmeheat(i,k)     =   qme(i,k)*(latvap + latice*fice(i,k))
     442             : 
     443             :         ! Rate of cond-evap of ice within the cloud [kg kg-1 s-1]
     444    26535600 :         cmeice(i,k)      =   qme(i,k)*fice(i,k)
     445             : 
     446             :         ! Rate of cond-evap of liq within the cloud [kg kg-1 s-1]
     447    26535600 :         cmeliq(i,k)      =   qme(i,k)*(1._kind_phys-fice(i,k))
     448             : 
     449             :         ! Tendencies from after prognostic_cloud_water...
     450   106142400 :         tend_s(i,k)      =   cmeheat(i,k) + &
     451   132678000 :                                       evapheat(i,k) + prfzheat(i,k) + meltheat(i,k) + repartht(i,k)
     452    26535600 :         tend_q(i,k)      = - qme(i,k) + evapprec(i,k)
     453    26535600 :         tend_cldice(i,k) =   cmeice(i,k) - ice2pr(i,k)
     454    28365792 :         tend_cldliq(i,k) =   cmeliq(i,k) - liq2pr(i,k)
     455             :       end do
     456             :    end do
     457             : 
     458     1090992 :    prec_str(:ncol) = prec_str(:ncol) + prec_pcw(:ncol)
     459     1090992 :    snow_str(:ncol) = snow_str(:ncol) + snow_pcw(:ncol)
     460             : 
     461       70392 :   end subroutine rk_stratiform_prognostic_cloud_water_tendencies_run
     462             : 
     463             :   ! Save Q, T, cloud water at end of stratiform microphysics for use in next timestep
     464             :   ! to determine non-microphysical/macrophysical tendencies
     465             : !> \section arg_table_rk_stratiform_save_qtlcwat_run Argument Table
     466             : !! \htmlinclude arg_table_rk_stratiform_save_qtlcwat_run.html
     467       70392 :   subroutine rk_stratiform_save_qtlcwat_run( &
     468             :     ncol, pver, &
     469       70392 :     t, &
     470      140784 :     q_wv, cldice, cldliq, &
     471      211176 :     qcwat, tcwat, lcwat, &
     472       70392 :     errmsg, errflg)
     473             : 
     474             :     ! Input arguments
     475             :     integer,            intent(in)    :: ncol
     476             :     integer,            intent(in)    :: pver
     477             : 
     478             :     real(kind_phys),    intent(in)    :: t(:,:)         ! air_temperature [K]
     479             :     real(kind_phys),    intent(in)    :: q_wv(:, :)     ! adv: water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     480             :     real(kind_phys),    intent(in)    :: cldice(:,:)    ! adv: cloud_ice_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     481             :     real(kind_phys),    intent(in)    :: cldliq(:,:)    ! adv: cloud_liquid_water_mixing_ratio_wrt_moist_air_and_condensed_water [kg kg-1]
     482             : 
     483             :     ! Output arguments
     484             :     real(kind_phys),    intent(out)   :: qcwat(:,:)     ! [kg kg-1]
     485             :     real(kind_phys),    intent(out)   :: tcwat(:,:)     ! [K]
     486             :     real(kind_phys),    intent(out)   :: lcwat(:,:)     ! [kg kg-1]
     487             :     character(len=512), intent(out)   :: errmsg         ! error message
     488             :     integer,            intent(out)   :: errflg         ! error flag
     489             : 
     490             :     ! Local variables
     491             :     integer :: k
     492             : 
     493       70392 :     errmsg = ''
     494       70392 :     errflg = 0
     495             : 
     496     1900584 :     do k = 1, pver
     497    28365792 :       qcwat(:ncol,k) = q_wv(:ncol,k)
     498    28365792 :       tcwat(:ncol,k) = t(:ncol,k)
     499    28436184 :       lcwat(:ncol,k) = cldice(:ncol,k) + cldliq(:ncol,k)
     500             :     enddo
     501             : 
     502       70392 :   end subroutine rk_stratiform_save_qtlcwat_run
     503             : 
     504             :   ! Compute and save cloud water and ice particle sizes for radiation
     505             : !> \section arg_table_rk_stratiform_cloud_optical_properties_run Argument Table
     506             : !! \htmlinclude arg_table_rk_stratiform_cloud_optical_properties_run.html
     507       70392 :   subroutine rk_stratiform_cloud_optical_properties_run( &
     508             :     ncol, pver, &
     509             :     tmelt, &
     510       70392 :     landfrac, icefrac, snowh, landm, &
     511       70392 :     t, ps, pmid, &
     512       70392 :     rel, rei, &
     513       70392 :     errmsg, errflg)
     514             : 
     515             :     ! Dependency: to_be_ccppized
     516             :     use cloud_optical_properties, only: cldefr
     517             : 
     518             :     ! Input arguments
     519             :     integer,            intent(in)    :: ncol
     520             :     integer,            intent(in)    :: pver
     521             : 
     522             :     real(kind_phys),    intent(in)    :: tmelt
     523             :     real(kind_phys),    intent(in)    :: landfrac(:)    ! land_area_fraction [fraction]
     524             :     real(kind_phys),    intent(in)    :: icefrac(:)     ! sea_ice_area_fraction [fraction]
     525             :     real(kind_phys),    intent(in)    :: snowh(:)       ! lwe_surface_snow_depth_over_land [m]
     526             :     real(kind_phys),    intent(in)    :: landm(:)       ! smoothed_land_area_fraction [fraction]
     527             :     real(kind_phys),    intent(in)    :: t(:,:)         ! air_temperature [K]
     528             :     real(kind_phys),    intent(in)    :: ps(:)          ! surface_air_pressure [Pa]
     529             :     real(kind_phys),    intent(in)    :: pmid(:,:)      ! air_pressure [Pa]
     530             : 
     531             :     ! Output arguments
     532             :     real(kind_phys),    intent(out)   :: rel(:,:)       ! effective_radius_of_stratiform_cloud_liquid_water_particle [um]
     533             :     real(kind_phys),    intent(out)   :: rei(:,:)       ! effective_radius_of_stratiform_cloud_ice_particle [um]
     534             :     character(len=512), intent(out)   :: errmsg         ! error message
     535             :     integer,            intent(out)   :: errflg         ! error flag
     536             : 
     537       70392 :     errmsg = ''
     538       70392 :     errflg = 0
     539             : 
     540             :     call cldefr( &
     541             :       ncol = ncol, &
     542             :       pver = pver, &
     543             :       tmelt = tmelt, &
     544           0 :       landfrac = landfrac(:ncol), &
     545           0 :       icefrac = icefrac(:ncol), &
     546           0 :       snowh = snowh(:ncol), &
     547           0 :       landm = landm(:ncol), &
     548           0 :       t = t(:ncol,:), &
     549           0 :       ps = ps(:ncol), &
     550           0 :       pmid = pmid(:ncol,:), & ! below output:
     551           0 :       rel = rel(:ncol,:), &
     552       70392 :       rei = rei(:ncol,:))
     553             : 
     554       70392 :   end subroutine rk_stratiform_cloud_optical_properties_run
     555             : 
     556             : end module rk_stratiform

Generated by: LCOV version 1.14