nunv1.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <params.h>
subroutine nunv1(lam     ,phi     ,lamdp   ,phidp   ,ud      , &
                 vd      ,coslat  ,grfu    ,grfv    ,grfulat , &
                 grfvlat ,nlon    )
!
!-----------------------------------------------------------------------
!
!  Purpose:
!  
!  Advection of vector terms (u/v prognostic eqn)
!  NOTE:  "gamma" factor is used to renormalize the length of the
!         arrival point vector
!
! Author:  J. Olson
!
!-----------------------------------------------------------------------
!
! $Id: nunv1.F90,v 1.2.42.1 2002/02/01 00:00:57 olson Exp $
! $Author: olson $
!
!-----------------------------------------------------------------------

  use precision
  use pmgrid
  implicit none

!------------------------------Arguments--------------------------------
!
  real(r8), intent(in)   :: lam    (plon)        ! vector of arrival point longitudes
  real(r8), intent(in)   :: phi                  ! arrival point latitude
  real(r8), intent(in)   :: lamdp  (plon,plev)   ! endpoint longitude coordinates
  real(r8), intent(in)   :: phidp  (plon,plev)   ! endpoint latitude  coordinates
  real(r8), intent(in)   :: ud     (plon,plev)   ! U(-) evaluated at departure point
  real(r8), intent(in)   :: vd     (plon,plev)   ! V(-) evaluated at departure point
  real(r8), intent(in)   :: coslat               ! cosine of latitude slice
  real(r8), intent(in)   :: grfu   (plond,plev)  ! Nu
  real(r8), intent(in)   :: grfv   (plond,plev)  ! Nv
  real(r8), intent(out)  :: grfulat(plond,plev)  ! Nu
  real(r8), intent(out)  :: grfvlat(plond,plev)  ! Nv
  integer , intent(in)   :: nlon                 ! number of longitudes for this latitude
!
!---------------------------Local workspace-----------------------------
!
  integer i,k                   ! indices
  real(r8) dl                   ! lam+ - lam-
  real(r8) sindl                ! sin (lam+ - lam-)
  real(r8) cosdl                ! cos (lam+ - lam-)
  real(r8) sinpa                ! sin (phi+)
  real(r8) sinpd                ! sin (phi-)
  real(r8) cospa                ! cos (phi+)
  real(r8) cospd                ! cos (phi-)
  real(r8) alphud               ! tmp space
  real(r8) alphvd               ! tmp space
  real(r8) betaud               ! tmp space
  real(r8) betavd               ! tmp space
  real(r8) termu                ! tmp space
  real(r8) termv                ! tmp space
  real(r8) gamma                ! tmp space
!
!-----------------------------------------------------------------------
!
  sinpa  = sin(phi)
  cospa  = cos(phi)
!
  do k = 1,plev
     do i = 1,nlon
        dl     = lam(i) - lamdp(i,k)
        sindl  = sin( dl )
        cosdl  = cos( dl )
        sinpd  = sin( phidp(i,k) )
        cospd  = cos( phidp(i,k) )
        alphud = cosdl
        alphvd = sinpd*sindl
        betaud = -sinpa*sindl
        betavd = cospd*cospa + sinpd*sinpa*cosdl
        termu  = alphud*ud(i,k) + alphvd*vd(i,k)
        termv  = betaud*ud(i,k) + betavd*vd(i,k)
        gamma  = (ud(i,k)*ud(i,k) + vd(i,k)*vd(i,k))/(termu*termu + termv*termv)
        gamma  = gamma**0.5
        grfulat(i,k) = grfu(i,k) + gamma*termu*coslat
        grfvlat(i,k) = grfv(i,k) + gamma*termv*coslat
     end do
  end do
!
  return
end subroutine nunv1