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 derived mapping arrays and calculates the critical
       6             : !! supersaturation <scrit> used to nucleate dry particles (CN) to droplets.
       7             : !!
       8             : !! This routine requires that array <akelvin> is defined.
       9             : !! (i.e., setupgkern.f must be called before this)
      10             : !!
      11             : !! NOTE: Most of the code from this routine has been moced to CARMA_InitializeGrowth
      12             : !! because it does not rely upon the model's state and thus can be called one during
      13             : !! CARMA_Initialize rather than being called every timestep if left in this routine.
      14             : !!
      15             : !! @author Andy Ackerman
      16             : !! @version Dec-1995
      17     1050624 : subroutine setupnuc(carma, cstate, rc)
      18             : 
      19             :   ! types
      20             :   use carma_precision_mod
      21             :   use carma_enums_mod
      22             :   use carma_constants_mod
      23             :   use carma_types_mod
      24             :   use carmastate_mod
      25             :   use carma_mod
      26             : 
      27             :   implicit none
      28             : 
      29             :   type(carma_type), intent(in)         :: carma   !! the carma object
      30             :   type(carmastate_type), intent(inout) :: cstate  !! the carma state object
      31             :   integer, intent(inout)               :: rc       !! return code, negative indicates failure
      32             : 
      33             :   ! Local declarations
      34             :   integer                        :: igroup   ! group index
      35             :   integer                        :: igas     ! gas index
      36             :   integer                        :: isol     ! solute index
      37             :   integer                        :: ibin     ! bin index
      38             :   integer                        :: k        ! z index
      39             :   real(kind=f)                   :: bsol
      40             :   integer                        :: i
      41             : 
      42             :   ! Define formats
      43             :   3 format(a,a)
      44             :   6 format(i4,5x,1p2e11.3)
      45             :   8 format(/,'Critical supersaturations for ',a,//, '   i        r [cm]     scrit',/)
      46             : 
      47             : 
      48             :   ! Define critical supersaturation and target bin for each (dry) particle
      49             :   ! size bin that is subject to nucleation.
      50             :   ! (only for CN groups subject to nucleation)
      51     3151872 :   do igroup = 1,NGROUP
      52             : 
      53     2101248 :     igas = inucgas(igroup)
      54             : 
      55     3151872 :     if( igas .ne. 0 .and. itype( ienconc( igroup ) ) .eq. I_INVOLATILE )then
      56             : 
      57           0 :       isol = isolelem( ienconc( igroup ) )
      58             :       
      59             :       ! If here is no solute are specified, then no scrit value is defined.
      60           0 :       if (isol .ne. 0) then
      61             : 
      62           0 :         do ibin = 1,NBIN
      63             :         
      64             :           ! This is term "B" in Pruppacher and Klett's eqn. 6-28.
      65           0 :           bsol = 3._f*sol_ions(isol)*rmass(ibin,igroup)*gwtmol(igas) &
      66           0 :                   / ( 4._f*PI*solwtmol(isol)*RHO_W )
      67             :   
      68             :           ! Loop over vertical grid layers because of temperature dependence
      69             :           ! in solute term.
      70           0 :           do k = 1,NZ
      71           0 :              scrit(k,ibin,igroup) = sqrt( 4._f * akelvin(k,igas)**3 / ( 27._f * bsol ) )
      72             :           enddo
      73             :         enddo
      74             :       endif
      75             :     endif
      76             :   enddo
      77             : 
      78             : #ifdef CARMA_DEBUG
      79             :   if (do_print_init) then
      80             :     do isol = 1,NSOLUTE
      81             :   
      82             :       write(LUNOPRT,3) 'solute name:    ',solname(isol)
      83             :   
      84             :       do igroup = 1,NGROUP
      85             :         if( isol .eq. isolelem(ienconc(igroup)) )then
      86             :           write(LUNOPRT,8) groupname(igroup)
      87             :           write(LUNOPRT,6) (i,r(i,igroup),scrit(1,i,igroup),i=1,NBIN)
      88             :         endif
      89             :       enddo
      90             :           enddo
      91             :         endif
      92             : #endif
      93             : 
      94             :   ! Return to caller with nucleation mapping arrays and critical
      95             :   ! supersaturations defined.
      96     1050624 :   return
      97     1050624 : end