      SUBROUTINE FFWFG2(FW,LFW,GR,LGR,IR,ILONG,WRKS,NL) 
C 
C     *****   FEB 1976  -  JOHN D. HENDERSON  ****
C     * NOV 24/82 - R.LAPRISE, S.J.LAMBERT. 
C 
C     * USE THE FORTRAN FAST FOURIER TRANSFORM TO 
C     * PERFORM A GRID TO WAVE FOURIER TRANSFORM OF MULTI-LEVEL FIELD.
C     *  NOTE... GR AND FW ARE GENERALLY EQUIVALENCED IN CALLING ROUTINE
C     * FW = MULTI-LEVEL COMPLEX ARRAY TO RETURN THE FOURIER AMPLITUDES 
C     * LFW = FIRST DIMENSION OF FW 
C     * GR = MULTI-LEVEL ARRAY CARRYING GRID POINT FIELDS.
C     * LGR = FIRST DIMENSION OF GR.
C     * IR = MAXIMUM E.W. WAVE NUMBER TO TRANSFORM TO.
C     * ILONG=NUMBER OF LONGITUDES ON THE TRANSFORM GRID. 
C     * WRKS=WORK FIELD.
C     * NL =   NUMBER OF VERTICAL LEVELS. 
C 
C     * LEVEL 2, FW,GR
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      COMPLEX FW(LFW,NL)
      DIMENSION GR(LGR,NL),WRKS(1)
      COMPLEX AA,BB 
C-----------------------------------------------------------------------
      IRP1=IR+1 
      IF(MOD(ILONG,3).EQ.0) GO TO 100 
C-----------------------------------------------------------------------
C     * CASE 1 - ILONG IS A POWER OF 2. 
C 
      IF(IR.GT.ILONG/2) WRITE(6,6010) IR,ILONG
      IF(IR.GT.ILONG/2) RETURN
      ILG2=ILONG+2
      FLINV=1.E0/FLOAT(ILONG) 
      WRKS(ILG2+1)=0.E0 
C 
      DO 50 L=1,NL
C 
C     * TRANSFER GR TO WRKS AND DIVIDE BY (2*ILONG).
C 
      DO 20 I=1,ILONG 
   20 WRKS(I)=GR(I,L)*FLINV 
C 
C     * PERFORM THE FAST FOURIER TRANSFORM. 
C 
      N=ILONG 
      ISIGN=-1
      NTYP=0
      CALL FOUR2(WRKS,N,1,ISIGN,0)
C 
C     * TRANSFER COMPLEX WAVES 0 TO IR FROM WRKS TO FW. 
C 
      NX=-1 
      DO 40 J=1,IRP1
      NX=NX+2 
   40 FW(J,L)=CMPLX(WRKS(NX  ),WRKS(NX+1  ))
   50 CONTINUE
      RETURN
C-----------------------------------------------------------------------
C     * CASE 2 - ILONG IS 3 TIMES A POWER OF 2. 
C     * MAX VALUE OF IR IS ILONG/3.  WRKS=(ILONG/6+1)*8 COMPLEX WORDS.
C     * THIS SECTION ADDED BY ROGER DALEY, FEB 1976.
C 
  100 FLINV = 1.E0/FLOAT(ILONG) 
      K3 = ILONG/3
      IF(IR.GT.K3) WRITE(6,6010) IR,ILONG 
      IF(IR.GT.K3) RETURN 
      K6 = K3/2 
      KP6 = K6 + 1
      WRKS(14*KP6+1) = 0.E0 
C 
      CALL PERM(WRKS(4*KP6+1),WRKS(6*KP6+1),AA,BB,KP6,K3) 
C 
      DO 150 L=1,NL 
C 
      DO 130 K=1,K3 
      KP = (K-1)*3
      WRKS(8*KP6+K) = GR(KP+1,L)*FLINV
      WRKS(10*KP6+K) = GR(KP+2,L)*FLINV 
  130 WRKS(12*KP6+K+1) = GR(KP+3,L)*FLINV 
      WRKS(12*KP6+1) = WRKS(12*KP6+K3+1)
C 
      N=K3
      ISIGN = -1
      NTYP = 0
      CALL FOUR2(WRKS( 8*KP6+1),N,1,ISIGN,0)
      CALL FOUR2(WRKS(10*KP6+1),N,1,ISIGN,0)
      CALL FOUR2(WRKS(12*KP6+1),N,1,ISIGN,0)
C 
      CALL RCOM(WRKS(4*KP6+1),WRKS(6*KP6+1),AA,BB,WRKS(8*KP6+1),
     1   WRKS(10*KP6+1),WRKS(12*KP6+1),WRKS(1),KP6,K3)
C 
      NX = -1 
      DO 160 J=1,IRP1 
      NX = NX+2 
  160 FW(J,L) = CMPLX(WRKS(NX),WRKS(NX+1))
C 
  150 CONTINUE
      RETURN
C-----------------------------------------------------------------------
 6010 FORMAT(' ILLEGAL CALL TO FFWFG2..IR,ILONG=',2I8) 
      END
