Line data    Source code

       1             : ! Include shortname defintions, so that the F77 code does not have to be modified to
       2             : ! reference the CARMA structure.
       3             : #include "carma_globaer.h"
       4             : 
       5             : !! This routine calculates particle source terms <evappe> due to
       6             : !! total evaporation into a polydisperse CN distribution by assuming
       7             : !! that the pdf of core mass is log-normal skewed by mass raised to
       8             : !! the -3/2 power (which guarantees average core mass from pdf is the
       9             : !! same as average core mass).
      10             : !!
      11             : !! Distinct evaporation of cores has not been treated.
      12             : !!
      13             : !! @author Andy Ackerman
      14             : !! @version Aug-2001
      15           0 : subroutine evap_poly(carma,cstate,iz,ibin,ig,iavg,ieto,igto,rc)
      16             : 
      17             :         ! types
      18             :   use carma_precision_mod
      19             :   use carma_enums_mod
      20             :   use carma_constants_mod
      21             :   use carma_types_mod
      22             :   use carmastate_mod
      23             :   use carma_mod
      24             : 
      25             :         implicit none
      26             : 
      27             :   type(carma_type), intent(in)         :: carma   !! the carma object
      28             :   type(carmastate_type), intent(inout) :: cstate  !! the carma state object
      29             :   integer, intent(in)                  :: iz      !! z index
      30             :   integer, intent(in)                  :: ibin    !! bin index
      31             :   integer, intent(in)                  :: ig      !! group index
      32             :   integer, intent(in)                  :: iavg
      33             :   integer, intent(in)                  :: ieto
      34             :   integer, intent(in)                  :: igto
      35             :   integer, intent(inout)               :: rc      !! return code, negative indicates failure
      36             : 
      37             :   ! Local declarations
      38             :   integer                              :: ic  
      39             :   integer                              :: ito  
      40             :   integer                              :: kount_s
      41             :   integer                              :: kount_l
      42             :   integer                              :: iecore
      43             :   integer                              :: ie2cn
      44           0 :   real(kind=f)                         :: prob(NBIN)
      45             :   real(kind=f)                         :: rn_norms
      46             :   real(kind=f)                         :: rn_norml
      47             :   real(kind=f)                         :: rm_norms
      48             :   real(kind=f)                         :: rm_norml
      49             :   real(kind=f)                         :: expon
      50             :   real(kind=f)                         :: rmassto
      51             :   real(kind=f)                         :: dmto
      52             :   real(kind=f)                         :: weightl
      53             :   real(kind=f)                         :: weights
      54             : 
      55             : 
      56             :   ! Treat total evaporation from a polydisperse core mass distribution:
      57             :   ! assume a log-normal CN size distribution and conserve number and mass as
      58             :   ! described by Turco (NASA Technical Paper 1362).
      59             :   !  
      60             :   ! Set automatic flag for total evaporation used in gasexchange()
      61           0 :   totevap(ibin,ig) = .true.
      62             :   
      63             :   ! Calculate number <rn_norms,rn_norml> and mass <rm_norms,rm_norml>
      64             :   ! normalization factors for cores smaller and larger than <rmass(m,igto)>.
      65           0 :   rn_norms = 0._f
      66           0 :   rn_norml = 0._f
      67           0 :   rm_norms = 0._f
      68           0 :   rm_norml = 0._f
      69           0 :   kount_s = 0
      70           0 :   kount_l = 0
      71             : 
      72           0 :   do ito = 1, NBIN
      73             : 
      74           0 :     rmassto = rmass(ito,igto)           
      75           0 :     dmto = dm(ito,igto)
      76             : 
      77             :     ! <prob> is probability that core mass is in CN bin <ito>.
      78           0 :     if( coreavg .gt. 0._f .and. coresig .gt. 0._f )then
      79           0 :        expon = -log( rmassto/coreavg )**2 / ( 2._f*coresig )
      80           0 :        expon = max(-POWMAX, expon)
      81             :     else
      82             :       expon = 0._f
      83             :     endif
      84             :         
      85           0 :     prob(ito) = rmassto**(-1.5_f) * exp( expon )
      86             : 
      87           0 :     if( ito .lt. iavg )then
      88           0 :       rn_norms = rn_norms + prob(ito)*dmto
      89           0 :       rm_norms = rm_norms + prob(ito)*dmto*rmassto
      90           0 :       kount_s = kount_s + 1
      91             :     else
      92           0 :       rn_norml = rn_norml + prob(ito)*dmto
      93           0 :       rm_norml = rm_norml + prob(ito)*dmto*rmassto
      94           0 :       kount_l = kount_l + 1
      95             :     endif
      96             :   enddo
      97             :   
      98             :   ! Calculate mass weighting factors <weights,weightl> for small and
      99             :   ! large cores.
     100           0 :   if( kount_s .eq. 0 )then
     101             :     weightl = ONE
     102           0 :   elseif( kount_l .eq. 0 )then
     103             :     weightl = 0._f
     104             :   else
     105           0 :     rm_norms = rm_norms/rn_norms
     106           0 :     rm_norml = rm_norml/rn_norml
     107           0 :     weightl = (coreavg - rm_norms) / (rm_norml - rm_norms)
     108           0 :     if( weightl .gt. ALMOST_ONE )then
     109             :       weightl = ONE
     110           0 :     elseif( weightl .lt. ALMOST_ZERO )then
     111           0 :       weightl = 0._f
     112             :     endif
     113             :   endif
     114             :   
     115           0 :   weights = ONE - weightl
     116             : 
     117             :   ! Renormalize probability distribution function and evaluate the CN
     118             :   ! evaporation source term <evappe>.
     119           0 :   do ito = 1, NBIN
     120             : 
     121             : !    if( ito .le. iavg )then
     122           0 :     if( ito .lt. iavg )then      ! Kevin M
     123           0 :       prob(ito) = prob(ito)*weights/rn_norms
     124             :     else
     125           0 :       prob(ito) = prob(ito)*weightl/rn_norml
     126             :     endif
     127             :     
     128             :     ! First the CN number concentration element
     129           0 :     evappe(ito,ieto) = evappe(ito,ieto) + evdrop*prob(ito)*dm(ito,igto)
     130             :   
     131             :     ! Now the CN core elements
     132           0 :     do ic = 2, ncore(ig)
     133           0 :       iecore = icorelem(ic,ig)
     134           0 :       ie2cn  = ievp2elem(iecore)
     135             : 
     136             :       ! It is possible to have coremasses in the particle
     137             :       ! that don't participate in nucleation. If there is no
     138             :       ! evp2elem defined, then skip this part.
     139           0 :       if (ie2cn .gt. 0) then
     140           0 :         evappe(ito,ie2cn) = evappe(ito,ie2cn) + &
     141           0 :           rmass(ito,igto)*evcore(ic)*prob(ito)*dm(ito,igto)
     142             :       end if
     143             :     enddo
     144             :   enddo
     145             :  
     146           0 :   return
     147           0 : end