vertdif.F90

! Include shortname defintions, so that the F77 code does not have to be modified to
! reference the CARMA structure.
#include "carma_globaer.h"

!! This routine calculates vertrical transport rates.
!! Currently treats diffusion only.
!! Not necessarily generalized for irregular grid.
!!
!! @author Eric Jensen
!! @version Dec-1996
subroutine vertdif(carma, cstate, igroup, ibin, itbnd, ibbnd, vertdifu, vertdifd, rc)

  ! types
  use carma_precision_mod
  use carma_enums_mod
  use carma_constants_mod
  use carma_types_mod
  use carmastate_mod
  use carma_mod

  implicit none

  type(carma_type), intent(in)         :: carma           !! the carma object
  type(carmastate_type), intent(inout) :: cstate          !! the carma state object
  integer, intent(in)                  :: igroup          !! particle group index
  integer, intent(in)                  :: ibin            !! particle bin index
  integer, intent(in)                  :: itbnd           !! top boundary condition
  integer, intent(in)                  :: ibbnd           !! bottom boundary condition
  real(kind=f), intent(out)            :: vertdifu(NZP1)  !! upward vertical diffusion rate into level k from level k-1 [cm/s]
  real(kind=f), intent(out)            :: vertdifd(NZP1)  !! downward vertical diffusion rate into level k from level k-1 [cm/s]
  integer, intent(inout)               :: rc              !! return code, negative indicates failure
  
  ! Local Variables
  integer      :: k
  integer      :: nzm1
  integer      :: itwo
  real(kind=f) :: dz_avg
  real(kind=f) :: rhofact
  real(kind=f) :: xex
  real(kind=f) :: ttheta


  ! Set some constants
  nzm1 = max( 1, NZ-1 )
  itwo = min( 2, NZ   )

  !  Loop over vertical levels.
  do k = 2, NZ

    dz_avg = dz(k)                            ! layer thickness

    !  Check the vertical coordinate

    if( igridv .eq. I_CART ) then
      rhofact = log(  rhoa(k)/rhoa(k-1) &
                    * zmet(k-1)/zmet(k) )
      xex = rhoa(k-1)/rhoa(k) * &
            zmet(k)/zmet(k-1)
      vertdifu(k) = ( rhofact * dkz(k, ibin, igroup) / dz_avg ) / ( 1._f - xex )

      vertdifd(k) = vertdifu(k) * xex


    !  ...else you're in sigma or hybrid coordinates...
    elseif(( igridv .eq. I_SIG ) .or. ( igridv .eq. I_HYBRID )) then
      vertdifu(k) = dkz(k, ibin, igroup) / dz_avg
      vertdifd(k) = dkz(k, ibin, igroup) / dz_avg

    !  ...else write an error (maybe redundant)...
    else
      if (do_print) write(LUNOPRT,*) 'vertdif::ERROR - Invalid vertical grid type (', igridv, ').'
      rc = -1
      return
    endif
  enddo

  ! Fluxes at boundaries specified by user
  if( ibbnd .eq. I_FLUX_SPEC ) then
    vertdifu(1) = 0._f
    vertdifd(1) = 0._f
  endif

  if( itbnd .eq. I_FLUX_SPEC ) then
    vertdifu(NZ+1) = 0._f
    vertdifd(NZ+1) = 0._f
  endif

  ! Diffusion across boundaries using fixed boundary concentration:
  if( ibbnd .eq. I_FIXED_CONC ) then
    dz_avg = dz(1)                            ! layer thickness
    rhofact = log( rhoa(itwo)/rhoa(1) )
    ttheta = rhofact
    if( ttheta .ge. 0._f ) then
      ttheta = min(ttheta,POWMAX)
    else
      ttheta = max(ttheta,-POWMAX)
    endif

    xex = exp(-ttheta)
    if( abs(ONE - xex) .lt. ALMOST_ZERO ) xex = ALMOST_ONE

    vertdifu(1) = ( rhofact * dkz(1, ibin, igroup) / dz_avg ) / ( 1._f - xex )
    vertdifd(1) = vertdifu(1) * xex
  endif

  if( itbnd .eq. I_FIXED_CONC ) then
    dz_avg = dz(NZ)                            ! layer thickness
    rhofact = log( rhoa(NZ)/rhoa(nzm1) )
    ttheta = rhofact
    if( ttheta .ge. 0._f ) then
      ttheta = min(ttheta,POWMAX)
    else
      ttheta = max(ttheta,-POWMAX)
    endif

    xex = exp(-ttheta)
    if( abs(ONE - xex) .lt. ALMOST_ZERO ) xex = ALMOST_ONE

    vertdifu(NZ+1) = ( rhofact * dkz(NZ+1, ibin, igroup) / dz_avg ) / ( 1._f - xex )
    vertdifd(NZ+1) = vertdifu(NZ+1) * xex
  endif

  ! Return to caller with vertical diffusion rates.
  return
end