#include <misc.h>#include <params.h>subroutine extyv(pkcnst  ,pkdim   ,coslam  ,sinlam  ,ub      , &                 vb      )!----------------------------------------------------------------------- ! ! Purpose: ! Fill latitude extensions of a vector component extended array.! ! Method: ! This is done in 2 steps:! 1) interpolate to the pole points;!    use coefficients for zonal wave number 1 on the Gaussian!    latitude closest to the pole.! 2) add latitude lines beyond the poles.! ! Author: J. Olson! !-----------------------------------------------------------------------!! $Id: extyv.F90,v 1.1 2001/11/06 18:42:48 erik Exp $! $Author: erik $!!-----------------------------------------------------------------------  use precision  use pmgrid  use rgrid  implicit none!------------------------------Parameters-------------------------------  integer, parameter :: istart = nxpt+1           ! index to start computation  integer, parameter :: js = 1    + nxpt + jintmx ! index of southernmost model lat  integer, parameter :: jn = plat + nxpt + jintmx ! index of northernmost model lat!-----------------------------------------------------------------------!------------------------------Arguments--------------------------------!! Input arguments!  integer , intent(in) :: pkcnst              ! dimensioning construct for 3-D arrays  integer , intent(in) :: pkdim               ! vertical dimension  real(r8), intent(in) :: coslam(plond,platd) ! Cos of long at x-grid points (global grid)  real(r8), intent(in) :: sinlam(plond,platd) ! Sin of long at x-grid points (global grid)  real(r8), intent(inout):: ub(plond,pkdim*pkcnst,beglatex:endlatex) ! U-wind with extents  real(r8), intent(inout):: vb(plond,pkdim*pkcnst,beglatex:endlatex) ! V-wind with extents!!-----------------------------------------------------------------------!---------------------------Local variables-----------------------------  integer i                 ! index  integer ig                ! index  integer j                 ! index  integer k                 ! index  integer nlon2             ! half the number of real longitudes  integer istop             ! index to stop  computation  real(r8) zavecv           ! accumulator for wavenumber 1 of v  real(r8) zavesv           ! accumulator for wavenumber 1 of v  real(r8) zavecu           ! accumulator for wavenumber 1 of u  real(r8) zavesu           ! accumulator for wavenumber 1 of u  real(r8) zaucvs           ! used to couple u and v (wavenumber 1)  real(r8) zavcus           ! used to couple u and v (wavenumber 1)!-----------------------------------------------------------------------!! Fill north pole line.!#if ( defined SPMD )  if (jn+1<=endlatex) then   ! north pole is on-processor#endif     do k = 1,pkdim        zavecv = 0.0        zavesv = 0.0        zavecu = 0.0        zavesu = 0.0        ig     = 0        istop  = nxpt + nlonex(jn)        do i = istart,istop           ig     = ig + 1           zavecv = zavecv + vb(i,k,jn  )*coslam(ig,jn)           zavesv = zavesv + vb(i,k,jn  )*sinlam(ig,jn)           zavecu = zavecu + ub(i,k,jn  )*coslam(ig,jn)           zavesu = zavesu + ub(i,k,jn  )*sinlam(ig,jn)        end do        zavcus = (zavecv + zavesu)/nlonex(jn)        zaucvs = (zavecu - zavesv)/nlonex(jn)        ig     = 0        istop  = nxpt + nlonex(jn+1)        do i = istart,istop           ig           = ig + 1           vb(i,k,jn+1) = zavcus*coslam(ig,jn+1) - zaucvs*sinlam(ig,jn+1)           ub(i,k,jn+1) = zaucvs*coslam(ig,jn+1) + zavcus*sinlam(ig,jn+1)        end do     end do#if ( defined SPMD )  end if#endif!! Fill northern lines beyond pole line.!  if( jn+2 <= platd )then     do j = jn+2,platd#if ( defined SPMD )        if (j<=endlatex) then#endif           nlon2 = nlonex(j)/2           do k = 1,pkdim!CDIR$ IVDEP              do i = istart,istart+nlon2-1                 vb(      i,k,j) = -vb(nlon2+i,k,2*jn+2-j)                 vb(nlon2+i,k,j) = -vb(      i,k,2*jn+2-j)                 ub(      i,k,j) = -ub(nlon2+i,k,2*jn+2-j)                 ub(nlon2+i,k,j) = -ub(      i,k,2*jn+2-j)              end do           end do#if ( defined SPMD )        end if#endif     end do  end if! ! Fill south pole line.!#if ( defined SPMD )  if (js-1>=beglatex) then   ! south pole is on-processor#endif     do k = 1,pkdim        zavecv = 0.0        zavesv = 0.0        zavecu = 0.0        zavesu = 0.0        ig     = 0        istop  = nxpt + nlonex(js)        do i = istart,istop           ig     = ig + 1           zavecv = zavecv + vb(i,k,js  )*coslam(ig,js)           zavesv = zavesv + vb(i,k,js  )*sinlam(ig,js)           zavecu = zavecu + ub(i,k,js  )*coslam(ig,js)           zavesu = zavesu + ub(i,k,js  )*sinlam(ig,js)        end do        zavcus = (zavecv - zavesu)/nlonex(js)        zaucvs = (zavecu + zavesv)/nlonex(js)        ig     = 0        istop  = nxpt + nlonex(js-1)        do i = istart,istop           ig           = ig + 1           vb(i,k,js-1) = zavcus*coslam(ig,js-1) + zaucvs*sinlam(ig,js-1)           ub(i,k,js-1) = zaucvs*coslam(ig,js-1) - zavcus*sinlam(ig,js-1)        end do     end do#if ( defined SPMD )  end if#endif!! Fill southern lines beyond pole line.!  if( js-2 >= 1 )then     do j = 1,js-2#if ( defined SPMD )        if (j>=beglatex) then#endif           nlon2 = nlonex(j)/2           do k = 1,pkdim!CDIR$ IVDEP              do i = istart,istart+nlon2-1                 vb(      i,k,j) = -vb(nlon2+i,k,2*js-2-j)                 vb(nlon2+i,k,j) = -vb(      i,k,2*js-2-j)                 ub(      i,k,j) = -ub(nlon2+i,k,2*js-2-j)                 ub(nlon2+i,k,j) = -ub(      i,k,2*js-2-j)              end do           end do#if ( defined SPMD )        end if#endif     end do  end if!  returnend subroutine extyv