      SUBROUTINE DCFFTF(N,C,WSAVE)  
C***BEGIN PROLOGUE  DCFFTF
C***DATE WRITTEN   790601   (YYMMDD)    
C***REVISION DATE  860115   (YYMMDD)    
C***CATEGORY NO.  J1A2   
C***KEYWORDS  FOURIER TRANSFORM    
C***AUTHOR  SWARZTRAUBER, P. N., (NCAR) 
C***PURPOSE  Forward transform of a complex, periodic sequence.  
C***DESCRIPTION
C           From the book, "Numerical Methods and Software" by
C                D. Kahaner, C. Moler, S. Nash
C                Prentice Hall, 1988
C    
C  Subroutine DCFFTF computes the forward complex discrete Fourier
C  transform (the Fourier analysis).  Equivalently, DCFFTF computes    
C  the Fourier coefficients of a complex periodic sequence. 
C  The transform is defined below at output parameter C.    
C    
C  The transform is not normalized.  To obtain a normalized transform 
C  the output must be divided by N.  Otherwise a call of DCFFTF   
C  followed by a call of DCFFTB will multiply the sequence by N.  
C    
C  The array WSAVE which is used by subroutine DCFFTF must be
C  initialized by calling subroutine DCFFTI(N,WSAVE).   
C    
C  Input Parameters 
C    
C    
C  N      the length of the complex sequence C.  The method is   
C         more efficient when N is the product of small primes.  
C    
C  C      a complex array of length N which contains the sequence
C    
C  WSAVE   a d.p. work array which must be dimensioned at least 4*N+15
C          in the program that calls DCFFTF.  The WSAVE array must be  
C          initialized by calling subroutine DCFFTI(N,WSAVE), and a    
C          different WSAVE array must be used for each different 
C          value of N.  This initialization does not have to be  
C          repeated so long as N remains unchanged.  Thus subsequent  
C          transforms can be obtained faster than the first.
C          The same WSAVE array can be used by DCFFTF and DCFFTB.  
C    
C  Output Parameters
C    
C  C      for J=1,...,N  
C    
C             C(J)=the sum from K=1,...,N of 
C    
C                   C(K)*EXP(-I*J*K*2*PI/N)  
C    
C                         where I=SQRT(-1)   
C    
C  WSAVE   contains initialization calculations which must not be
C          destroyed between calls of subroutine DCFFTF or DCFFTB  
C    
C  *   References                                                      *   
C  *                                                                   *   
C  *   1. P.N. Swarztrauber, Vectorizing the FFTs, in Parallel         *   
C  *      Computations (G. Rodrigue, ed.), Academic Press, 1982,       *   
C  *      pp. 51-83.                                                   *   
C  *   2. B.L. Buzbee, The SLATEC Common Math Library, in Sources      *   
C  *      and Development of Mathematical Software (W. Cowell, ed.),   *   
C  *      Prentice-Hall, 1984, pp. 302-318.                            *   
C  *                                                                   *   
C  *********************************************************************   
C    
C***REFERENCES  (NONE)   
C***ROUTINES CALLED  DCFTF1   
C***END PROLOGUE  DCFFTF  
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       C(*)       ,WSAVE(*)   
C***FIRST EXECUTABLE STATEMENT  DCFFTF   
      IF (N .EQ. 1) RETURN    
      IW1 = N+N+1   
      IW2 = IW1+N+N 
      CALL DCFTF1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))    
      RETURN   
      END 
      SUBROUTINE DCFTF1(N,C,CH,WA,IFAC) 
C***BEGIN PROLOGUE  DCFTF1    
C***REFER TO  DCFFTF 
C***ROUTINES CALLED  DPASSF,DPASF2,DPASF3,DPASF4,DPASF5 
C***END PROLOGUE  DCFTF1 
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
C***FIRST EXECUTABLE STATEMENT  DCFTF1  
      NF = IFAC(2)  
      NA = 0   
      L1 = 1   
      IW = 1   
      DO 116 K1=1,NF
         IP = IFAC(K1+2) 
         L2 = IP*L1 
         IDO = N/L2 
         IDOT = IDO+IDO  
         IDL1 = IDOT*L1  
         IF (IP .NE. 4) GO TO 103  
         IX2 = IW+IDOT   
         IX3 = IX2+IDOT  
         IF (NA .NE. 0) GO TO 101  
         CALL DPASF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))  
         GO TO 102  
  101    CALL DPASF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))  
  102    NA = 1-NA  
         GO TO 115  
  103    IF (IP .NE. 2) GO TO 106  
         IF (NA .NE. 0) GO TO 104  
         CALL DPASF2 (IDOT,L1,C,CH,WA(IW))   
         GO TO 105  
  104    CALL DPASF2 (IDOT,L1,CH,C,WA(IW))   
  105    NA = 1-NA  
         GO TO 115  
  106    IF (IP .NE. 3) GO TO 109  
         IX2 = IW+IDOT   
         IF (NA .NE. 0) GO TO 107  
         CALL DPASF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108  
  107    CALL DPASF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA  
         GO TO 115  
  109    IF (IP .NE. 5) GO TO 112  
         IX2 = IW+IDOT   
         IX3 = IX2+IDOT  
         IX4 = IX3+IDOT  
         IF (NA .NE. 0) GO TO 110  
         CALL DPASF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))    
         GO TO 111  
  110    CALL DPASF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))    
  111    NA = 1-NA  
         GO TO 115  
  112    IF (NA .NE. 0) GO TO 113  
         CALL DPASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114  
  113    CALL DPASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))    
  114    IF (NAC .NE. 0) NA = 1-NA 
  115    L1 = L2    
         IW = IW+(IP-1)*IDOT  
  116 CONTINUE 
      IF (NA .EQ. 0) RETURN   
      N2 = N+N 
      DO 117 I=1,N2 
         C(I) = CH(I)    
  117 CONTINUE 
      RETURN   
      END 
      SUBROUTINE DPASSF(NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)    
C***BEGIN PROLOGUE  DPASSF
C***REFER TO  DCFFTF 
C***ROUTINES CALLED  (NONE)   
C***END PROLOGUE  DPASSF  
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,WA(*)      ,C2(IDL1,IP),
     2                CH2(IDL1,IP) 
C***FIRST EXECUTABLE STATEMENT  DPASSF   
      IDOT = IDO/2  
      IPP2 = IP+2   
      IPPH = (IP+1)/2    
      IDP = IP*IDO  
C    
      IF (IDO .LT. L1) GO TO 106   
      DO 103 J=2,IPPH    
         JC = IPP2-J
         DO 102 K=1,L1   
CDIR$ IVDEP    
            DO 101 I=1,IDO    
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)   
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)  
  101       CONTINUE
  102    CONTINUE   
  103 CONTINUE 
      DO 105 K=1,L1 
CDIR$ IVDEP    
         DO 104 I=1,IDO  
            CH(I,K,1) = CC(I,1,K)  
  104    CONTINUE   
  105 CONTINUE 
      GO TO 112
  106 DO 109 J=2,IPPH    
         JC = IPP2-J
         DO 108 I=1,IDO  
CDIR$ IVDEP    
            DO 107 K=1,L1
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)   
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)  
  107       CONTINUE
  108    CONTINUE   
  109 CONTINUE 
      DO 111 I=1,IDO
CDIR$ IVDEP    
         DO 110 K=1,L1   
            CH(I,K,1) = CC(I,1,K)  
  110    CONTINUE   
  111 CONTINUE 
  112 IDL = 2-IDO   
      INC = 0  
      DO 116 L=2,IPPH    
         LC = IPP2-L
         IDL = IDL+IDO   
CDIR$ IVDEP    
         DO 113 IK=1,IDL1
            C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2)   
            C2(IK,LC) = -WA(IDL)*CH2(IK,IP)  
  113    CONTINUE   
         IDLJ = IDL 
         INC = INC+IDO   
         DO 115 J=3,IPPH 
            JC = IPP2-J  
            IDLJ = IDLJ+INC   
            IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP    
            WAR = WA(IDLJ-1)  
            WAI = WA(IDLJ)    
CDIR$ IVDEP    
            DO 114 IK=1,IDL1  
               C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J)  
               C2(IK,LC) = C2(IK,LC)-WAI*CH2(IK,JC)    
  114       CONTINUE
  115    CONTINUE   
  116 CONTINUE 
      DO 118 J=2,IPPH    
CDIR$ IVDEP    
         DO 117 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)  
  117    CONTINUE   
  118 CONTINUE 
      DO 120 J=2,IPPH    
         JC = IPP2-J
CDIR$ IVDEP    
         DO 119 IK=2,IDL1,2   
            CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC)    
            CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC)   
            CH2(IK,J) = C2(IK,J)+C2(IK-1,JC) 
            CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC)
  119    CONTINUE   
  120 CONTINUE 
      NAC = 1  
      IF (IDO .EQ. 2) RETURN  
      NAC = 0  
CDIR$ IVDEP    
      DO 121 IK=1,IDL1   
         C2(IK,1) = CH2(IK,1) 
  121 CONTINUE 
      DO 123 J=2,IP 
CDIR$ IVDEP    
         DO 122 K=1,L1   
            C1(1,K,J) = CH(1,K,J)  
            C1(2,K,J) = CH(2,K,J)  
  122    CONTINUE   
  123 CONTINUE 
      IF (IDOT .GT. L1) GO TO 127  
      IDIJ = 0 
      DO 126 J=2,IP 
         IDIJ = IDIJ+2   
         DO 125 I=4,IDO,2
            IDIJ = IDIJ+2
CDIR$ IVDEP    
            DO 124 K=1,L1
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)  
  124       CONTINUE
  125    CONTINUE   
  126 CONTINUE 
      RETURN   
  127 IDJ = 2-IDO   
      DO 130 J=2,IP 
         IDJ = IDJ+IDO   
         DO 129 K=1,L1   
            IDIJ = IDJ   
CDIR$ IVDEP    
            DO 128 I=4,IDO,2  
               IDIJ = IDIJ+2  
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)  
  128       CONTINUE
  129    CONTINUE   
  130 CONTINUE 
      RETURN   
      END 
      SUBROUTINE DPASF2(IDO,L1,CC,CH,WA1)    
C***BEGIN PROLOGUE  DPASF2    
C***REFER TO  DCFFTF 
C***ROUTINES CALLED  (NONE)   
C***END PROLOGUE  DPASF2 
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(*)  
C***FIRST EXECUTABLE STATEMENT  DPASF2  
      IF (IDO .GT. 2) GO TO 102    
      DO 101 K=1,L1 
         CH(1,K,1) = CC(1,1,K)+CC(1,2,K)
         CH(1,K,2) = CC(1,1,K)-CC(1,2,K)
         CH(2,K,1) = CC(2,1,K)+CC(2,2,K)
         CH(2,K,2) = CC(2,1,K)-CC(2,2,K)
  101 CONTINUE 
      RETURN   
  102 IF(IDO/2.LT.L1) GO TO 105    
      DO 104 K=1,L1 
CDIR$ IVDEP    
         DO 103 I=2,IDO,2
            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K) 
            TR2 = CC(I-1,1,K)-CC(I-1,2,K)    
            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)  
            TI2 = CC(I,1,K)-CC(I,2,K)   
            CH(I,K,2) = WA1(I-1)*TI2-WA1(I)*TR2   
            CH(I-1,K,2) = WA1(I-1)*TR2+WA1(I)*TI2 
  103    CONTINUE   
  104 CONTINUE 
      RETURN   
  105 DO 107 I=2,IDO,2   
CDIR$ IVDEP    
      DO 106 K=1,L1 
            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K) 
            TR2 = CC(I-1,1,K)-CC(I-1,2,K)    
            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)  
            TI2 = CC(I,1,K)-CC(I,2,K)   
            CH(I,K,2) = WA1(I-1)*TI2-WA1(I)*TR2   
            CH(I-1,K,2) = WA1(I-1)*TR2+WA1(I)*TI2 
  106    CONTINUE   
  107 CONTINUE 
      RETURN   
      END 
      SUBROUTINE DPASF3(IDO,L1,CC,CH,WA1,WA2)
C***BEGIN PROLOGUE  DPASF3    
C***REFER TO  DCFFTF 
C***ROUTINES CALLED  (NONE)   
C***END PROLOGUE  DPASF3 
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(*)     ,WA2(*)
C***FIRST EXECUTABLE STATEMENT  DPASF3  
      TAUR = -.5D0    
      TAUI = -.5D0*SQRT(3.0D0)
      IF (IDO .NE. 2) GO TO 102    
      DO 101 K=1,L1 
         TR2 = CC(1,2,K)+CC(1,3,K) 
         CR2 = CC(1,1,K)+TAUR*TR2  
         CH(1,K,1) = CC(1,1,K)+TR2 
         TI2 = CC(2,2,K)+CC(2,3,K) 
         CI2 = CC(2,1,K)+TAUR*TI2  
         CH(2,K,1) = CC(2,1,K)+TI2 
         CR3 = TAUI*(CC(1,2,K)-CC(1,3,K))    
         CI3 = TAUI*(CC(2,2,K)-CC(2,3,K))    
         CH(1,K,2) = CR2-CI3  
         CH(1,K,3) = CR2+CI3  
         CH(2,K,2) = CI2+CR3  
         CH(2,K,3) = CI2-CR3  
  101 CONTINUE 
      RETURN   
  102 IF(IDO/2.LT.L1) GO TO 105    
      DO 104 K=1,L1 
CDIR$ IVDEP    
         DO 103 I=2,IDO,2
            TR2 = CC(I-1,2,K)+CC(I-1,3,K)    
            CR2 = CC(I-1,1,K)+TAUR*TR2  
            CH(I-1,K,1) = CC(I-1,1,K)+TR2    
            TI2 = CC(I,2,K)+CC(I,3,K)   
            CI2 = CC(I,1,K)+TAUR*TI2    
            CH(I,K,1) = CC(I,1,K)+TI2   
            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))  
            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K)) 
            DR2 = CR2-CI3
            DR3 = CR2+CI3
            DI2 = CI2+CR3
            DI3 = CI2-CR3
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2   
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2 
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3   
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3 
  103    CONTINUE   
  104 CONTINUE 
      RETURN   
  105 DO 107 I=2,IDO,2   
CDIR$ IVDEP    
         DO 106 K=1,L1   
            TR2 = CC(I-1,2,K)+CC(I-1,3,K)    
            CR2 = CC(I-1,1,K)+TAUR*TR2  
            CH(I-1,K,1) = CC(I-1,1,K)+TR2    
            TI2 = CC(I,2,K)+CC(I,3,K)   
            CI2 = CC(I,1,K)+TAUR*TI2    
            CH(I,K,1) = CC(I,1,K)+TI2   
            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))  
            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K)) 
            DR2 = CR2-CI3
            DR3 = CR2+CI3
            DI2 = CI2+CR3
            DI3 = CI2-CR3
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2   
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2 
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3   
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3 
  106    CONTINUE   
  107 CONTINUE 
      RETURN   
      END 
      SUBROUTINE DPASF4(IDO,L1,CC,CH,WA1,WA2,WA3) 
C***BEGIN PROLOGUE  DPASF4    
C***REFER TO  DCFFTF 
C***ROUTINES CALLED  (NONE)   
C***END PROLOGUE  DPASF4 
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(*)     ,WA2(*)     ,WA3(*)   
C***FIRST EXECUTABLE STATEMENT  DPASF4  
      IF (IDO .NE. 2) GO TO 102    
      DO 101 K=1,L1 
         TI1 = CC(2,1,K)-CC(2,3,K) 
         TI2 = CC(2,1,K)+CC(2,3,K) 
         TR4 = CC(2,2,K)-CC(2,4,K) 
         TI3 = CC(2,2,K)+CC(2,4,K) 
         TR1 = CC(1,1,K)-CC(1,3,K) 
         TR2 = CC(1,1,K)+CC(1,3,K) 
         TI4 = CC(1,4,K)-CC(1,2,K) 
         TR3 = CC(1,2,K)+CC(1,4,K) 
         CH(1,K,1) = TR2+TR3  
         CH(1,K,3) = TR2-TR3  
         CH(2,K,1) = TI2+TI3  
         CH(2,K,3) = TI2-TI3  
         CH(1,K,2) = TR1+TR4  
         CH(1,K,4) = TR1-TR4  
         CH(2,K,2) = TI1+TI4  
         CH(2,K,4) = TI1-TI4  
  101 CONTINUE 
      RETURN   
  102 IF(IDO/2.LT.L1) GO TO 105    
      DO 104 K=1,L1 
CDIR$ IVDEP    
         DO 103 I=2,IDO,2
            TI1 = CC(I,1,K)-CC(I,3,K)   
            TI2 = CC(I,1,K)+CC(I,3,K)   
            TI3 = CC(I,2,K)+CC(I,4,K)   
            TR4 = CC(I,2,K)-CC(I,4,K)   
            TR1 = CC(I-1,1,K)-CC(I-1,3,K)    
            TR2 = CC(I-1,1,K)+CC(I-1,3,K)    
            TI4 = CC(I-1,4,K)-CC(I-1,2,K)    
            TR3 = CC(I-1,2,K)+CC(I-1,4,K)    
            CH(I-1,K,1) = TR2+TR3  
            CR3 = TR2-TR3
            CH(I,K,1) = TI2+TI3    
            CI3 = TI2-TI3
            CR2 = TR1+TR4
            CR4 = TR1-TR4
            CI2 = TI1+TI4
            CI4 = TI1-TI4
            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2 
            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2   
            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3 
            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3   
            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4 
            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4   
  103    CONTINUE   
  104 CONTINUE 
      RETURN   
  105 DO 107 I=2,IDO,2   
CDIR$ IVDEP    
         DO 106 K=1,L1   
            TI1 = CC(I,1,K)-CC(I,3,K)   
            TI2 = CC(I,1,K)+CC(I,3,K)   
            TI3 = CC(I,2,K)+CC(I,4,K)   
            TR4 = CC(I,2,K)-CC(I,4,K)   
            TR1 = CC(I-1,1,K)-CC(I-1,3,K)    
            TR2 = CC(I-1,1,K)+CC(I-1,3,K)    
            TI4 = CC(I-1,4,K)-CC(I-1,2,K)    
            TR3 = CC(I-1,2,K)+CC(I-1,4,K)    
            CH(I-1,K,1) = TR2+TR3  
            CR3 = TR2-TR3
            CH(I,K,1) = TI2+TI3    
            CI3 = TI2-TI3
            CR2 = TR1+TR4
            CR4 = TR1-TR4
            CI2 = TI1+TI4
            CI4 = TI1-TI4
            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2 
            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2   
            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3 
            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3   
            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4 
            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4   
  106    CONTINUE   
  107 CONTINUE 
      RETURN   
      END 
      SUBROUTINE DPASF5(IDO,L1,CC,CH,WA1,WA2,WA3,WA4)  
C***BEGIN PROLOGUE  DPASF5    
C***REFER TO  DCFFTF 
C***ROUTINES CALLED  (NONE)   
C***END PROLOGUE  DPASF5 
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*) 
C***FIRST EXECUTABLE STATEMENT  DPASF5  
      PI = 4.0D0*ATAN(1.0D0)   
      TR11 = SIN(.1D0*PI)  
      TI11 = -SIN(.4D0*PI) 
      TR12 = -SIN(.3D0*PI) 
      TI12 = -SIN(.2D0*PI) 
      IF (IDO .NE. 2) GO TO 102    
      DO 101 K=1,L1 
         TI5 = CC(2,2,K)-CC(2,5,K) 
         TI2 = CC(2,2,K)+CC(2,5,K) 
         TI4 = CC(2,3,K)-CC(2,4,K) 
         TI3 = CC(2,3,K)+CC(2,4,K) 
         TR5 = CC(1,2,K)-CC(1,5,K) 
         TR2 = CC(1,2,K)+CC(1,5,K) 
         TR4 = CC(1,3,K)-CC(1,4,K) 
         TR3 = CC(1,3,K)+CC(1,4,K) 
         CH(1,K,1) = CC(1,1,K)+TR2+TR3  
         CH(2,K,1) = CC(2,1,K)+TI2+TI3  
         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3   
         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3   
         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3   
         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3   
         CR5 = TI11*TR5+TI12*TR4   
         CI5 = TI11*TI5+TI12*TI4   
         CR4 = TI12*TR5-TI11*TR4   
         CI4 = TI12*TI5-TI11*TI4   
         CH(1,K,2) = CR2-CI5  
         CH(1,K,5) = CR2+CI5  
         CH(2,K,2) = CI2+CR5  
         CH(2,K,3) = CI3+CR4  
         CH(1,K,3) = CR3-CI4  
         CH(1,K,4) = CR3+CI4  
         CH(2,K,4) = CI3-CR4  
         CH(2,K,5) = CI2-CR5  
  101 CONTINUE 
      RETURN   
  102 IF(IDO/2.LT.L1) GO TO 105    
      DO 104 K=1,L1 
CDIR$ IVDEP    
         DO 103 I=2,IDO,2
            TI5 = CC(I,2,K)-CC(I,5,K)   
            TI2 = CC(I,2,K)+CC(I,5,K)   
            TI4 = CC(I,3,K)-CC(I,4,K)   
            TI3 = CC(I,3,K)+CC(I,4,K)   
            TR5 = CC(I-1,2,K)-CC(I-1,5,K)    
            TR2 = CC(I-1,2,K)+CC(I-1,5,K)    
            TR4 = CC(I-1,3,K)-CC(I-1,4,K)    
            TR3 = CC(I-1,3,K)+CC(I-1,4,K)    
            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
            CH(I,K,1) = CC(I,1,K)+TI2+TI3    
            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3   
            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3   
            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
            CR5 = TI11*TR5+TI12*TR4
            CI5 = TI11*TI5+TI12*TI4
            CR4 = TI12*TR5-TI11*TR4
            CI4 = TI12*TI5-TI11*TI4
            DR3 = CR3-CI4
            DR4 = CR3+CI4
            DI3 = CI3+CR4
            DI4 = CI3-CR4
            DR5 = CR2+CI5
            DR2 = CR2-CI5
            DI5 = CI2-CR5
            DI2 = CI2+CR5
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2 
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2   
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3 
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3   
            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4 
            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4   
            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5 
            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5   
  103    CONTINUE   
  104 CONTINUE 
      RETURN   
  105 DO 107 I=2,IDO,2   
CDIR$ IVDEP    
         DO 106 K=1,L1   
            TI5 = CC(I,2,K)-CC(I,5,K)   
            TI2 = CC(I,2,K)+CC(I,5,K)   
            TI4 = CC(I,3,K)-CC(I,4,K)   
            TI3 = CC(I,3,K)+CC(I,4,K)   
            TR5 = CC(I-1,2,K)-CC(I-1,5,K)    
            TR2 = CC(I-1,2,K)+CC(I-1,5,K)    
            TR4 = CC(I-1,3,K)-CC(I-1,4,K)    
            TR3 = CC(I-1,3,K)+CC(I-1,4,K)    
            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
            CH(I,K,1) = CC(I,1,K)+TI2+TI3    
            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3   
            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3   
            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
            CR5 = TI11*TR5+TI12*TR4
            CI5 = TI11*TI5+TI12*TI4
            CR4 = TI12*TR5-TI11*TR4
            CI4 = TI12*TI5-TI11*TI4
            DR3 = CR3-CI4
            DR4 = CR3+CI4
            DI3 = CI3+CR4
            DI4 = CI3-CR4
            DR5 = CR2+CI5
            DR2 = CR2-CI5
            DI5 = CI2-CR5
            DI2 = CI2+CR5
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2 
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2   
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3 
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3   
            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4 
            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4   
            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5 
            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5   
  106    CONTINUE   
  107 CONTINUE 
      RETURN   
      END 
