      SUBROUTINE STAF (F,S,LSR,LM,LA,ILH,ILEV,ALP)
C
C     * JUL 22/94 - F.MAJAESS(ABORT IF ILH<LM AND ILEV > 1)
C     * JUL 14/92 - E. CHAN    (ADD REAL*8 DECLARATIONS)
C     * NOV 28/91 - M.LAZARE. - ACTIVATE OLD FORTRAN CODE FOR SX3. 
C     * JUL 19/83 - R.LAPRISE.

C     * DO A LEGENDRE TRANSFORM ON SPERICAL HARMONIC COEFFICIENTS (S) 
C     * TO GET FOURIER COEFFICIENTS (F) FOR ALL LEVELS AT THIS
C     * LATITUDE. 
C     * ALP = VALUE OF THE LEGENDRE POLYNOMIALS AT THIS LATITUDE. 
C     * LSR(1,M) = START OF ROW M OF S. 
C     * LSR(2,M) = START OF ROW M OF ALP. 
C     * LSR DIMENSIONNED (2,LM+1).
C     * LM  = NUMBER OF ROWS IN ARRAYS S,F AND ALP,  (M=1,LM) 
C     * LA  = FIRST DIMENSION OF COMPLEX S. 
C     * ILH = FIRST DIMENSION OF COMPLEX F. 
C     * REAL S(2,LA,ILEV),F(2,ILH,ILEV)
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      COMPLEX S(LA,ILEV),F(ILH,ILEV)
      REAL*8 ALP(1)
      INTEGER LSR(2,1)
C-----------------------------------------------------------------------
C     * OLD CRAY CODE USING THEIR "MXMA" ROUTINE.
C     ****** "S" AND "F" SHOULD BE DEFINED AS REAL ..(2,...) IF USING
C     *      THIS CODE **********  
C
C     DO 300 M=1,LM 
C       NA = LSR(2,M) 
C       NL = LSR(1,M) 
C       LEN= LSR(1,M+1)-NL
C       CALL MXMA( S(1,NL,1), 2*LA , 2, 
C    1           ALP(NA)  , 1    , 1, 
C    2           F(1,M,1) , 2*ILH, 1, 
C    3           ILEV     , LEN  , 1) 
C       CALL MXMA( S(2,NL,1), 2*LA , 2, 
C    1           ALP(NA)  , 1    , 1, 
C    2           F(2,M,1) , 2*ILH, 1, 
C    3           ILEV     , LEN  , 1) 
C 300 CONTINUE
C     RETURN
C-----------------------------------------------------------------------
C     * FORTRAN CODE TO DO THE LM MATRIX MULTIPLIES.
C 
      IF ( ILH.LT.LM .AND. ILEV.GT.1) THEN
       WRITE(6,6000) ILEV,ILH,LM
       CALL                 XIT('STAF',-1)
      ENDIF
      DO 300 M=1,LM
         NA = LSR(2,M) 
         NL = LSR(1,M) 
         NR = LSR(1,M+1)-1 
C 
         DO 050 L=1,ILEV 
  050    F(M,L)=CMPLX(0.E0,0.E0) 
C  
         DO 200 N=NL,NR
            DO 100 L=1,ILEV
            F(M,L) = F(M,L)
CNEC 1      +CMPLX(ALP(NA)* REAL(S(N,L)),ALP(NA)*AIMAG(S(N,L)))
     1             + ALP(NA)*S(N,L)
  100       CONTINUE 
C 
         NA=NA+1 
  200    CONTINUE
C 
  300 CONTINUE 
      RETURN 
C-----------------------------------------------------------------------
 6000 FORMAT(' FOURIER TRANSFORM CODE REQUIRES ILEV=',I3,
     1        ', BE 1 WHENEVER ILH=,',I3,' < LM=',I3)
C-----------------------------------------------------------------------
      END
