      SUBROUTINE SUMVHS (VLN,AP,QLN,N,ihem)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    SUMVHS      PRODUCES VECTOR FOURIER COEFFICIENTS.
C   PRGMMR: JOSEPH SELA      ORG: W/NMC23    DATE: 88-04-04
C
C ABSTRACT: USES SPHERICAL HARMONICS OF A PSEUDO VECTOR TO PRODUCE
C   THE FOURIER COEFFICIENTS OF THE FIELDS ON THE NORTHERN
C   OR SOUTHERN HEMISPHERE LATITUDE CIRCLES FOR WHICH
C   THE INPUT LEGENDRE FUNCTIONS APPLY.
C
C PROGRAM HISTORY LOG:
C   88-04-04  JOSEPH SELA
c   90-05-23  Hua-Lu Pan
C
C USAGE:    CALL SUMVHS (VLN, AP, QLN, N, ihem)
C   INPUT ARGUMENT LIST:
C     VLN      - ARRAY OF SPHERICAL HARMONICS.
C     QLN      - ARRAY OF ASSOCIATED LEGENDRE FUNCTIONS.
C     N        - NUMBER OF FIELDS IN VLN AND AP ARRAYS.
c     ihem     - +1 for n. hemisphere and -1 for southern
C
C   OUTPUT ARGUMENT LIST:
C     AP       - ARRAY OF FOURIER REPRESENTATIONS OF FIELDS ON
C                NORTHERN AND SOUTHERN HEMISPHERE LATITUDE CIRCLES.
C
C  NOTE:  parameter IMXFRM must be greater than or equal to 
C            254 for the T126 resolution
C
C ATTRIBUTES:
C   LANGUAGE: standard FORTRAN 
C   MACHINE:  CRAY 
C
C$$$
Chou  including more parameters in order to remove the hardwiring of
Chou  spectral coefficients
      INCLUDE "parmanl"
Chou

      SAVE
      DIMENSION AP( 720 ,N),
     1 QLN( NCOEF2 ), VLN( NCOEF2 ,N)
      dimension       S( NCOEF2 ), SEV( JCAP12 ), SOD( JCAP12 )
CC
      NPAIR = ( JCAP+2 -2)/2
cmic$ do all private(s,sev,sod) autoscope
      DO 2 K=1,N
      DO 100 I=1, NCOEF2
      S(I) = QLN(I) * VLN(I,K)
  100 CONTINUE
      DO 200 I=1, JCAP12
      SEV(I) = S(I)
      SOD(I) = S(I+ JCAP12 )
  200 CONTINUE
      IPLUS =  JCAP12 *2
      LEN   =  JCAP12 -2
CC
      DO 600 J=1,NPAIR
      DO 400 I=1,LEN
      SEV(I) = SEV(I) + S(I+IPLUS)
  400 CONTINUE
      IPLUS = IPLUS + LEN
      LEN = LEN - 2
CC
      DO 500 I=1,LEN
      SOD(I) = SOD(I) + S(I+IPLUS)
  500 CONTINUE
      IPLUS = IPLUS + LEN
      LEN = LEN - 2
  600 CONTINUE
CC
      DO 800 I=1, JCAP12
      AP(I      ,K) = SEV(I) + ihem * SOD(I)
  800 CONTINUE
    2 CONTINUE
      RETURN
      END
