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 freezing only.
       7             : !! 
       8             : !! The loss rates for all particle elements in a particle group are equal.
       9             : !!
      10             : !! @author Eric Jensen, Chuck Bardeen
      11             : !! @version Jan-2000, Nov-2009
      12  1418703438 : subroutine freezdropl(carma, cstate, iz, rc)
      13             : 
      14             :   ! types
      15             :   use carma_precision_mod
      16             :   use carma_enums_mod
      17             :   use carma_constants_mod
      18             :   use carma_types_mod
      19             :   use carmastate_mod
      20             :   use carma_mod
      21             : 
      22             :   implicit none
      23             : 
      24             :   type(carma_type), intent(in)         :: carma   !! the carma object
      25             :   type(carmastate_type), intent(inout) :: cstate  !! the carma state object
      26             :   integer, intent(in)                  :: iz      !! z index
      27             :   integer, intent(inout)               :: rc      !! return code, negative indicates failure
      28             : 
      29             :   !  Local declarations
      30             :   integer                              :: igroup  !! group index
      31             :   integer                              :: ibin    !! bin index
      32             :   integer                              :: iepart  !! element for condensing group index
      33             :   integer                              :: inuc    !! nucleating element index
      34             :   integer                              :: ienucto !! index of target nucleation element
      35             :   integer                              :: ignucto !! index of target nucleation group
      36             : 
      37             : 
      38             :   ! Loop over particle groups.
      39  4256110314 :   do igroup = 1,NGROUP
      40             :   
      41  2837406876 :     iepart = ienconc( igroup )            ! particle number density element
      42             :   
      43             :     ! Calculate nucleation loss rates.
      44  5674813752 :     do inuc = 1,nnuc2elem(iepart)
      45             :     
      46  1418703438 :       ienucto = inuc2elem(inuc,iepart)
      47             :       
      48  4256110314 :       if( ienucto .ne. 0 )then
      49  1418703438 :         ignucto = igelem( ienucto )
      50             :   
      51             :         ! Only compute nucleation rate for droplet freezing
      52  1418703438 :         if( inucproc(iepart,ienucto) .eq. I_DROPFREEZE ) then
      53             :     
      54             :           ! Loop over particle bins.  
      55           0 :           do ibin = 1,NBIN
      56             :       
      57             :             ! Bypass calculation if few particles are present 
      58           0 :             if( pc(iz,ibin,iepart) .gt. FEW_PC )then
      59             :       
      60             :               ! Temporary simple kludge: Set <rnuclg> to 1.e2 if T < -40C
      61           0 :               if( t(iz) .lt. T0-40._f ) then
      62           0 :                 rnuclg(ibin,igroup,ignucto) = 1.e2_f
      63             :               endif
      64             :       
      65             :             endif     ! pc(source particles) .gt. FEW_PC
      66             :           enddo      ! ibin = 1,NBIN
      67             :         endif       ! inucproc(iepart,ienucto) .eq. I_DROPFREEZE
      68             :       endif
      69             :     enddo        ! inuc = 1,nnuc2elem(iepart)
      70             :   enddo         ! igroup = 1,NGROUP
      71             : 
      72             :   ! Return to caller with particle loss rates due to nucleation evaluated.
      73  1418703438 :   return
      74  1418703438 : end