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 evaluates particle loss rates due to nucleation <rnuclg>:
       6             : !! droplet activation only.
       7             : !!  
       8             : !! The loss rates for all particle elements in a particle group are equal.
       9             : !!
      10             : !! To avoid nucleation into an evaporating bin, this subroutine must
      11             : !! be called after growp, which evaluates evaporation loss rates <evaplg>.
      12             : !!
      13             : !! @author Andy Ackerman
      14             : !! @version Dec-1995
      15   213271518 : subroutine actdropl(carma, cstate, iz, 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(inout)               :: rc      !! return code, negative indicates failure
      31             : 
      32             :   !  Local declarations
      33             :   integer                              :: igas    !! gas index
      34             :   integer                              :: igroup  !! group index
      35             :   integer                              :: ibin    !! bin index
      36             :   integer                              :: iepart  !! element for condensing group index
      37             :   integer                              :: inuc    !! nucleating element index
      38             :   integer                              :: ienucto !! index of target nucleation element
      39             :   integer                              :: ignucto !! index of target nucleation group
      40             :   integer                              :: inucto  !! index of target nucleation bin
      41             :   logical                              :: evapfrom_nucto !! .true. when target droplets are evaporating
      42             :   
      43             : 
      44             :   ! This calculation is only necessary for temperatures greater
      45             :   ! than -40C.
      46   213271518 :   if( t(iz) .ge. (T0 - 40._f) ) then
      47             : 
      48             :     ! Loop over particle groups.
      49   286895976 :     do igroup = 1,NGROUP
      50             :   
      51             :       ! Bypass calculation if few particles are present
      52   286895976 :       if( pconmax(iz,igroup) .gt. FEW_PC )then
      53             :   
      54   187538177 :         igas = inucgas(igroup)                ! condensing gas
      55   187538177 :         iepart = ienconc( igroup )            ! particle number density element
      56             :   
      57   187538177 :         if( igas .ne. 0 )then
      58             :   
      59             :           ! Calculate nucleation loss rates.  Do not allow nucleation into
      60             :           ! an evaporating bin.
      61   185507546 :           do inuc = 1,nnuc2elem(iepart)
      62             :           
      63    92753773 :             ienucto = inuc2elem(inuc,iepart)
      64    92753773 :             if( ienucto .ne. 0 )then
      65    92753773 :               ignucto = igelem( ienucto )
      66             :             else
      67             :               ignucto = 0
      68             :             endif
      69             :       
      70             :             ! Only compute nucleation rate for droplet activation
      71   185507546 :             if( inucproc(iepart,ienucto) .eq. I_DROPACT ) then
      72             :       
      73             :               ! Loop over particle bins.  Loop from largest to smallest for 
      74             :               ! evaluation of index of smallest bin nucleated during time step <inucstep>.
      75           0 :               do ibin = NBIN, 1, -1
      76             :       
      77           0 :                 if( ignucto .ne. 0 )then
      78           0 :                   inucto = inuc2bin(ibin,igroup,ignucto)
      79             :                 else
      80             :                   inucto = 0
      81             :                 endif
      82             :       
      83             :                 ! Set <evapfrom_nucto> to .true. when target droplets are evaporating
      84           0 :                 if( inucto .ne. 0 )then
      85           0 :                  evapfrom_nucto = evaplg(inucto,ignucto) .gt. 0._f
      86             :                 else
      87             :                  evapfrom_nucto = .false.
      88             :                 endif
      89             :                   
      90           0 :                 if( (supsatl(iz,igas) .gt. scrit(iz,ibin,igroup)) .and. &
      91           0 :                     (.not. evapfrom_nucto) .and. &
      92           0 :                     (pc(iz,ibin,iepart) .gt. SMALL_PC) )then
      93             :       
      94           0 :                   rnuclg(ibin,igroup,ignucto) = 1.e3_f
      95             :                 endif
      96             :               enddo   ! ibin = 1,NBIN
      97             :             endif    ! inucproc(iepart,ienucto) .eq. I_DROPACT
      98             :           enddo     ! inuc = 1,nnuc2elem(iepart)
      99             :         endif      ! (igas = inucgas(igroup)) .ne. 0 
     100             :       endif       ! pconmax(iz,igroup) .gt. FEW_PC
     101             :     enddo        ! igroup = 1,NGROUP
     102             :   endif         ! t(iz) .ge. T0-40.
     103             : 
     104             :   ! Return to caller with particle loss rates due to nucleation evaluated.
     105   213271518 :   return
     106   213271518 : end