LCOV - code coverage report
Current view: top level - atmos_phys/schemes/zhang_mcfarlane - zm_conv_evap.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 58 58 100.0 %
Date: 2025-03-13 19:18:33 Functions: 1 1 100.0 %

          Line data    Source code
       1             : module zm_conv_evap
       2             : 
       3             :   use ccpp_kinds, only:  kind_phys
       4             : 
       5             :   implicit none
       6             : 
       7             :   save
       8             :   private                         ! Make default type private to the module
       9             : !
      10             : ! PUBLIC: interfaces
      11             : !
      12             :   public zm_conv_evap_run         ! evaporation of precip from ZM schemea
      13             : 
      14             : contains
      15             : 
      16             : 
      17             : !===============================================================================
      18             : !> \section arg_table_zm_conv_evap_run Argument Table
      19             : !! \htmlinclude zm_conv_evap_run.html
      20             : !!
      21       99072 : subroutine zm_conv_evap_run(ncol, pver, pverp, &
      22             :      gravit, latice, latvap, tmelt, &
      23             :      cpres, ke, ke_lnd, &
      24      198144 :      t,pmid,pdel,q, &
      25             :      landfrac, &
      26       99072 :      tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, &
      27       99072 :      prdprec_gen, cldfrc, deltat,  &
      28      495360 :      prec_gen, snow, ntprprd, ntsnprd, fsnow_conv, flxprec, flxsnow, scheme_name, errmsg, errflg)
      29             : 
      30             : !-----------------------------------------------------------------------
      31             : ! Compute tendencies due to evaporation of rain from ZM scheme
      32             : !--
      33             : ! Compute the total precipitation and snow fluxes at the surface.
      34             : ! Add in the latent heat of fusion for snow formation and melt, since it not dealt with
      35             : ! in the Zhang-MacFarlane parameterization.
      36             : ! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm
      37             : !-----------------------------------------------------------------------
      38             : 
      39             :     use wv_saturation,  only: qsat
      40             : 
      41             : !------------------------------Arguments--------------------------------
      42             :     integer,intent(in) :: ncol                               ! number of columns
      43             :     integer,intent(in) :: pver, pverp
      44             :     real(kind_phys),intent(in) :: gravit                     ! gravitational acceleration (m s-2)
      45             :     real(kind_phys),intent(in) :: latice                     ! Latent heat of fusion (J kg-1)
      46             :     real(kind_phys),intent(in) :: latvap                     ! Latent heat of vaporization (J kg-1)
      47             :     real(kind_phys),intent(in) :: tmelt                      ! Freezing point of water (K)
      48             :     real(kind_phys), intent(in) :: cpres      ! specific heat at constant pressure in j/kg-degk.
      49             :     real(kind_phys), intent(in) :: ke           ! Tunable evaporation efficiency set from namelist input zmconv_ke
      50             :     real(kind_phys), intent(in) :: ke_lnd
      51             :     real(kind_phys),intent(in), dimension(:,:) :: t          ! temperature (K)                              (ncol,pver)
      52             :     real(kind_phys),intent(in), dimension(:,:) :: pmid       ! midpoint pressure (Pa)                       (ncol,pver)
      53             :     real(kind_phys),intent(in), dimension(:,:) :: pdel       ! layer thickness (Pa)                         (ncol,pver)
      54             :     real(kind_phys),intent(in), dimension(:,:) :: q          ! water vapor (kg/kg)                          (ncol,pver)
      55             :     real(kind_phys),intent(in), dimension(:) :: landfrac     ! land fraction                                (ncol)
      56             : 
      57             :     real(kind_phys),intent(out), dimension(:,:) :: tend_s     ! heating rate (J/kg/s)                     (ncol,pver)
      58             :     real(kind_phys),intent(out), dimension(:,:) :: tend_q     ! water vapor tendency (kg/kg/s)            (ncol,pver)
      59             :     real(kind_phys),intent(out), dimension(:,:) :: tend_s_snwprd ! Heating rate of snow production        (ncol,pver)
      60             :     real(kind_phys),intent(out), dimension(:,:) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow (ncol,pver)
      61             : 
      62             :     real(kind_phys), intent(in   ) :: prdprec_gen(:,:)! precipitation production (kg/ks/s)                      (ncol,pver)
      63             :     real(kind_phys), intent(in   ) :: cldfrc(:,:) ! cloud fraction                                          (ncol,pver)
      64             :     real(kind_phys), intent(in   ) :: deltat             ! time step
      65             :     real(kind_phys), intent(in   ) :: fsnow_conv(:,:) ! snow fraction in precip production
      66             : 
      67             :     real(kind_phys), intent(inout) :: prec_gen(:)        ! Convective-scale preciptn rate                       (ncol)
      68             :     real(kind_phys), intent(out)   :: snow(:)        ! Convective-scale snowfall rate                       (ncol)
      69             : 
      70             : !
      71             : !---------------------------Local storage-------------------------------
      72             :     real(kind_phys), parameter :: density_fresh_water=1000._kind_phys
      73             : 
      74      198144 :     real(kind_phys) :: es   (ncol,pver)    ! Saturation vapor pressure
      75      198144 :     real(kind_phys) :: qs   (ncol,pver)    ! saturation specific humidity
      76             :     real(kind_phys),intent(out) :: flxprec(:,:)   ! Convective-scale flux of precip at interfaces (kg/m2/s) ! (ncol,pverp)
      77             :     real(kind_phys),intent(out) :: flxsnow(:,:)   ! Convective-scale flux of snow   at interfaces (kg/m2/s) ! (ncol,pverp)
      78             :     real(kind_phys),intent(out) :: ntprprd(:,:)   ! net precip production in layer                          ! (ncol,pver)
      79             :     real(kind_phys),intent(out) :: ntsnprd(:,:)   ! net snow production in layer                            ! (ncol,pver)
      80             : 
      81             :     character(len=512), intent(out) :: errmsg
      82             :     integer,            intent(out) :: errflg
      83             :     character(len=40),  intent(out) :: scheme_name
      84             : 
      85             :     real(kind_phys) :: work1                  ! temp variable (pjr)
      86             :     real(kind_phys) :: work2                  ! temp variable (pjr)
      87             : 
      88      198144 :     real(kind_phys) :: evpvint(ncol)         ! vertical integral of evaporation
      89      198144 :     real(kind_phys) :: evpprec(ncol)         ! evaporation of precipitation (kg/kg/s)
      90      198144 :     real(kind_phys) :: evpsnow(ncol)         ! evaporation of snowfall (kg/kg/s)
      91      198144 :     real(kind_phys) :: snowmlt(ncol)         ! snow melt tendency in layer
      92       99072 :     real(kind_phys) :: flxsntm(ncol)         ! flux of snow into layer, after melting
      93             : 
      94             :     real(kind_phys) :: kemask
      95             :     real(kind_phys) :: evplimit               ! temp variable for evaporation limits
      96             :     real(kind_phys) :: rlat(ncol)
      97             :     real(kind_phys) :: dum
      98             :     real(kind_phys) :: omsm
      99             : 
     100             :     integer :: i,k                     ! longitude,level indices
     101             :     logical :: old_snow
     102             : 
     103             : 
     104             : !-----------------------------------------------------------------------
     105       99072 :     scheme_name = "zm_conv_evap_run"
     106       99072 :     errmsg = ''
     107       99072 :     errflg = 0
     108             : 
     109       99072 :     old_snow=.true.
     110             : 
     111             : ! convert input precip to kg/m2/s
     112     1654272 :     prec_gen(:ncol) = prec_gen(:ncol)* density_fresh_water
     113             : 
     114             : ! determine saturation vapor pressure
     115     9312768 :     do k = 1,pver
     116     9312768 :        call qsat(t(1:ncol,k), pmid(1:ncol,k), es(1:ncol,k), qs(1:ncol,k), ncol)
     117             :     end do
     118             : 
     119             : ! zero the flux integrals on the top boundary
     120     1654272 :     flxprec(:ncol,1) = 0._kind_phys
     121     1654272 :     flxsnow(:ncol,1) = 0._kind_phys
     122     1654272 :     evpvint(:ncol)   = 0._kind_phys
     123             :     omsm=0.9999_kind_phys
     124             : 
     125     9312768 :     do k = 1, pver
     126   153946368 :        do i = 1, ncol
     127             : 
     128             : ! Melt snow falling into layer, if necessary.
     129             :          if( old_snow ) then
     130   144633600 :           if (t(i,k) > tmelt) then
     131    25835582 :              flxsntm(i) = 0._kind_phys
     132    25835582 :              snowmlt(i) = flxsnow(i,k) * gravit/ pdel(i,k)
     133             :           else
     134   118798018 :              flxsntm(i) = flxsnow(i,k)
     135   118798018 :              snowmlt(i) = 0._kind_phys
     136             :           end if
     137             :         else
     138             :           ! make sure melting snow doesn't reduce temperature below threshold
     139             :           if (t(i,k) > tmelt) then
     140             :               dum = -latice/cpres*flxsnow(i,k)*gravit/pdel(i,k)*deltat
     141             :               if (t(i,k) + dum .le. tmelt) then
     142             :                 dum = (t(i,k)-tmelt)*cpres/latice/deltat
     143             :                 dum = dum/(flxsnow(i,k)*gravit/pdel(i,k))
     144             :                 dum = max(0._kind_phys,dum)
     145             :                 dum = min(1._kind_phys,dum)
     146             :               else
     147             :                 dum = 1._kind_phys
     148             :               end if
     149             :               dum = dum*omsm
     150             :               flxsntm(i) = flxsnow(i,k)*(1.0_kind_phys-dum)
     151             :               snowmlt(i) = dum*flxsnow(i,k)*gravit/ pdel(i,k)
     152             :           else
     153             :              flxsntm(i) = flxsnow(i,k)
     154             :              snowmlt(i) = 0._kind_phys
     155             :           end if
     156             :         end if
     157             : 
     158             : ! relative humidity depression must be > 0 for evaporation
     159   144633600 :           evplimit = max(1._kind_phys - q(i,k)/qs(i,k), 0._kind_phys)
     160             : 
     161   144633600 :           kemask = ke
     162             : 
     163             : ! total evaporation depends on flux in the top of the layer
     164             : ! flux prec is the net production above layer minus evaporation into environmet
     165   144633600 :           evpprec(i) = kemask * (1._kind_phys - cldfrc(i,k)) * evplimit * sqrt(flxprec(i,k))
     166             : 
     167             : ! Don't let evaporation supersaturate layer (approx). Layer may already be saturated.
     168             : ! Currently does not include heating/cooling change to qs
     169   144633600 :           evplimit   = max(0._kind_phys, (qs(i,k)-q(i,k)) / deltat)
     170             : 
     171             : ! Don't evaporate more than is falling into the layer - do not evaporate rain formed
     172             : ! in this layer but if precip production is negative, remove from the available precip
     173             : ! Negative precip production occurs because of evaporation in downdrafts.
     174   144633600 :           evplimit   = min(evplimit, flxprec(i,k) * gravit / pdel(i,k))
     175             : 
     176             : ! Total evaporation cannot exceed input precipitation
     177   144633600 :           evplimit   = min(evplimit, (prec_gen(i) - evpvint(i)) * gravit / pdel(i,k))
     178             : 
     179   144633600 :           evpprec(i) = min(evplimit, evpprec(i))
     180             :           if( .not.old_snow ) then
     181             :             evpprec(i) = max(0._kind_phys, evpprec(i))
     182             :             evpprec(i) = evpprec(i)*omsm
     183             :           end if
     184             : 
     185             : 
     186             : ! evaporation of snow depends on snow fraction of total precipitation in the top after melting
     187   144633600 :           if (flxprec(i,k) > 0._kind_phys) then
     188             : !            prevent roundoff problems
     189     4763630 :              work1 = min(max(0._kind_phys,flxsntm(i)/flxprec(i,k)),1._kind_phys)
     190     4763630 :              evpsnow(i) = evpprec(i) * work1
     191             :           else
     192   139869970 :              evpsnow(i) = 0._kind_phys
     193             :           end if
     194             : 
     195             : ! vertically integrated evaporation
     196   144633600 :           evpvint(i) = evpvint(i) + evpprec(i) * pdel(i,k)/gravit
     197             : 
     198             : ! net precip production is production - evaporation
     199   144633600 :           ntprprd(i,k) = prdprec_gen(i,k) - evpprec(i)
     200             : ! net snow production is precip production * ice fraction - evaporation - melting
     201             : ! the small amount added to flxprec in the work1 expression has been increased from
     202             : ! 1e-36 to 8.64e-11 (1e-5 mm/day).  This causes the temperature based partitioning
     203             : ! scheme to be used for small flxprec amounts.  This is to address error growth problems.
     204             : 
     205             :       if( old_snow ) then
     206   144633600 :           if (flxprec(i,k).gt.0._kind_phys) then
     207     4763630 :              work1 = min(max(0._kind_phys,flxsnow(i,k)/flxprec(i,k)),1._kind_phys)
     208             :           else
     209             :              work1 = 0._kind_phys
     210             :           endif
     211             : 
     212   144633600 :           work2 = max(fsnow_conv(i,k), work1)
     213   144633600 :           if (snowmlt(i).gt.0._kind_phys) work2 = 0._kind_phys
     214   144633600 :           ntsnprd(i,k) = prdprec_gen(i,k)*work2 - evpsnow(i) - snowmlt(i)
     215   144633600 :           tend_s_snwprd  (i,k) = prdprec_gen(i,k)*work2*latice
     216   144633600 :           tend_s_snwevmlt(i,k) = - ( evpsnow(i) + snowmlt(i) )*latice
     217             :       end if
     218             : 
     219             : ! precipitation fluxes
     220   144633600 :           flxprec(i,k+1) = flxprec(i,k) + ntprprd(i,k) * pdel(i,k)/gravit
     221   144633600 :           flxsnow(i,k+1) = flxsnow(i,k) + ntsnprd(i,k) * pdel(i,k)/gravit
     222             : 
     223             : ! protect against rounding error
     224   144633600 :           flxprec(i,k+1) = max(flxprec(i,k+1), 0._kind_phys)
     225   144633600 :           flxsnow(i,k+1) = max(flxsnow(i,k+1), 0._kind_phys)
     226             : 
     227             : ! heating (cooling) and moistening due to evaporation
     228             : ! - latent heat of vaporization for precip production has already been accounted for
     229             : ! - snow is contained in prec
     230             :           if( old_snow ) then
     231   144633600 :              tend_s(i,k)   =-evpprec(i)*latvap + ntsnprd(i,k)*latice
     232             :           else
     233             :              tend_s(i,k)   =-evpprec(i)*latvap + tend_s_snwevmlt(i,k)
     234             :           end if
     235   153847296 :           tend_q(i,k) = evpprec(i)
     236             :        end do
     237             :     end do
     238             : 
     239             : ! set output precipitation rates (m/s)
     240             : ! convert from 'kg m-2 s-1' to 'm s-1'
     241     1654272 :     prec_gen(:ncol) = flxprec(:ncol,pverp) / density_fresh_water
     242     1654272 :     snow(:ncol) = flxsnow(:ncol,pverp) / density_fresh_water
     243             : 
     244       99072 :   end subroutine zm_conv_evap_run
     245             : 
     246             : 
     247             : end module zm_conv_evap

Generated by: LCOV version 1.14