versub.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 solves for sedimentation using an explicit substepping approach. It
!!  is faster and handles large cfl and irregular grids better than the normal PPM
!!  solver (versol), but it is more diffusive.
!!
!! @author Andy Ackerman, Chuck Bardeen 
!! version Aug 2010
subroutine versub(carma, cstate, pcmax, cvert, itbnd, ibbnd, ftop, fbot, cvert_tbnd, cvert_bbnd, &
  vertadvu, vertadvd, 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
  real(kind=f), intent(in)             :: pcmax(NZ)       !! maximum particle concentration (#/x/y/z)
  real(kind=f), intent(inout)          :: cvert(NZ)       !! quantity being transported (#/x/y/z)
  integer, intent(in)                  :: itbnd           !! top boundary condition
  integer, intent(in)                  :: ibbnd           !! bottom boundary condition
  real(kind=f), intent(in)             :: ftop            !! flux at top boundary
  real(kind=f), intent(in)             :: fbot            !! flux at bottom boundary
  real(kind=f), intent(in)             :: cvert_tbnd      !! quantity at top boundary
  real(kind=f), intent(in)             :: cvert_bbnd      !! quantity at bottom boundary
  real(kind=f), intent(in)             :: vertadvu(NZP1)  !! upward vertical transport rate into level k from level k-1 [cm/s]
  real(kind=f), intent(in)             :: vertadvd(NZP1)  !! downward vertical transport rate into level k from level k-1 [cm/s]
  real(kind=f), intent(in)             :: vertdifu(NZP1)  !! upward vertical diffusion rate into level k from level k-1 [cm/s]
  real(kind=f), intent(in)             :: vertdifd(NZP1)  !! downward vertical diffusion rate into level k from level k-1 [cm/s]
  integer, intent(inout)               :: rc              !! return code, negative indicates failure

  !  Declare local variables
  integer                        :: iz
  integer                        :: istep
  integer                        :: nstep_sed
  real(kind=f)                   :: fvert(NZ)
  real(kind=f)                   :: up(NZP1)
  real(kind=f)                   :: dn(NZP1)
  real(kind=f)                   :: cfl_max
  real(kind=f)                   :: fvert_1
  real(kind=f)                   :: fvert_nz

  ! Determine the total upward and downward velocities.
  up(:) = vertadvu(:) + vertdifu(:)
  dn(:) = vertadvd(:) + vertdifd(:)

  ! Compute the maximum CFL for each bin that has a significant concentration
  ! of particles.
  cfl_max = 0._f

  do iz = 1, NZ
    if (pcmax(iz) > SMALL_PC) then
      cfl_max = max(cfl_max, max(abs(up(iz)), abs(up(iz+1)), abs(dn(iz)), abs(dn(iz+1))) * dtime / dz(iz))
    end if
  end do

  ! Use the maximum CFL determined above to figure out how much substepping is
  ! needed to sediment explicitly without violating the CFL anywhere in the column.
  if (cfl_max >= 0._f) then
    nstep_sed = int(1._f + cfl_max)
  else
    nstep_sed = 0
  endif
  
  ! If velocities are in both directions, then more steps are needed to make sure
  ! that no more than half of the concentration can be transported in either direction.
  if (maxval(up(:) * dn(:)) > 0._f) then
    nstep_sed = nstep_sed * 2
  end if

  ! Determine the top and bottom boundary fluxes, keeping in mind that
  ! the velocities and grid coordinates are reversed in sigma or hybrid
  ! coordinates
  if ((igridv .eq. I_SIG) .or. (igridv .eq. I_HYBRID)) then
    if (itbnd .eq. I_FLUX_SPEC) then
      fvert_nz = -fbot
    else
      fvert_nz = cvert_bbnd*dn(NZ+1)
    end if

    if (ibbnd .eq. I_FLUX_SPEC) then
      fvert_1 = -ftop
    else
      fvert_1 = cvert_tbnd*up(1)
    end if
  
  else
    if (itbnd .eq. I_FLUX_SPEC) then
      fvert_nz = ftop
    else
      fvert_nz = cvert_tbnd*dn(NZ+1)
    end if

    if (ibbnd .eq. I_FLUX_SPEC) then
      fvert_1 = fbot
    else
      fvert_1 = cvert_bbnd*up(1)
    end if
  endif

  ! Sediment the particles using multiple iterations to satisfy the CFL.
  do istep = 1, nstep_sed

    ! Determine the net particle flux at each gridbox. The first and last levels
    ! need special treatment to handle to bottom and top boundary conditions.
    fvert(1) = (-cvert(1)*dn(1) + fvert_1 + cvert(2)*dn(2) - cvert(1)*up(2))
    
    do iz = 2, NZ-1
      fvert(iz) = (-cvert(iz)*dn(iz) + cvert(iz-1)*up(iz) + cvert(iz+1)*dn(iz+1) - cvert(iz)*up(iz+1))
    end do

    fvert(NZ) = (-cvert(NZ)*dn(NZ) + cvert(NZ-1)*up(NZ) + fvert_nz - cvert(NZ)*up(NZ+1))
    
    ! Now update the actual concentrations.
    cvert(:) = cvert(:) + fvert(:) * dtime / nstep_sed / dz(:)
  enddo

  return
end subroutine versub