C
C                       FFTPACK
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C                   VERSION 4  APRIL 1985
C
C      A PACKAGE OF FORTRAN SUBPROGRAMS FOR THE FAST FOURIER
C       TRANSFORM OF PERIODIC AND OTHER SYMMETRIC SEQUENCES
C
C                          BY
C
C                   PAUL N SWARZTRAUBER
C
C   NATIONAL CENTER FOR ATMOSPHERIC RESEARCH  BOULDER,COLORADO 80307
C
C    WHICH IS SPONSORED BY THE NATIONAL SCIENCE FOUNDATION
C
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C
C THIS PACKAGE CONSISTS OF PROGRAMS WHICH PERFORM FAST FOURIER
C TRANSFORMS FOR BOTH COMPLEX AND REAL PERIODIC SEQUENCES AND
C CERTAIN OTHER SYMMETRIC SEQUENCES THAT ARE LISTED BELOW.
C
C 1.   DFFTI     INITIALIZE  DFFTF AND DFFTB
C 2.   DFFTF     FORWARD TRANSFORM OF A REAL PERIODIC SEQUENCE
C 3.   DFFTB     BACKWARD TRANSFORM OF A REAL COEFFICIENT ARRAY
C
C 4.   DZFFTI    INITIALIZE DZFFTF AND DZFFTB
C 5.   DZFFTF    A SIMPLIFIED REAL PERIODIC FORWARD TRANSFORM
C 6.   DZFFTB    A SIMPLIFIED REAL PERIODIC BACKWARD TRANSFORM
C
C 7.   DSINTI     INITIALIZE DSINT
C 8.   DSINT      SINE TRANSFORM OF A REAL ODD SEQUENCE
C
C 9.   DCOSTI     INITIALIZE DCOST
C 10.  DCOST      COSINE TRANSFORM OF A REAL EVEN SEQUENCE
C
C 11.  DSINQI     INITIALIZE DSINQF AND DSINQB
C 12.  DSINQF     FORWARD SINE TRANSFORM WITH ODD WAVE NUMBERS
C 13.  DSINQB     UNNORMALIZED INVERSE OF DSINQF
C
C 14.  DCOSQI     INITIALIZE DCOSQF AND DCOSQB
C 15.  DCOSQF     FORWARD COSINE TRANSFORM WITH ODD WAVE NUMBERS
C 16.  DCOSQB     UNNORMALIZED INVERSE OF DCOSQF
C
C 17.  ZFFTI     INITIALIZE ZFFTF AND ZFFTB
C 18.  ZFFTF     FORWARD TRANSFORM OF A COMPLEX PERIODIC SEQUENCE
C 19.  ZFFTB     UNNORMALIZED INVERSE OF ZFFTF
C
C
C ******************************************************************
C
C SUBROUTINE DFFTI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DFFTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C BOTH DFFTF AND DFFTB. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 2*N+15.
C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DFFTF AND DFFTB
C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF DFFTF OR DFFTB.
C
C ******************************************************************
C
C SUBROUTINE DFFTF(N,R,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DFFTF COMPUTES THE FOURIER COEFFICIENTS OF A REAL
C PERODIC SEQUENCE (FOURIER ANALYSIS). THE TRANSFORM IS DEFINED
C BELOW AT OUTPUT PARAMETER R.
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY R TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C         N MAY CHANGE SO LONG AS DIFFERENT WORK ARRAYS ARE PROVIDED
C
C R       A REAL ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
C         TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 2*N+15.
C         IN THE PROGRAM THAT CALLS DFFTF. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DFFTI(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 DFFTF AND DFFTB.
C
C
C OUTPUT PARAMETERS
C
C R       R(1) = THE SUM FROM I=1 TO I=N OF R(I)
C
C         IF N IS EVEN SET L =N/2   , IF N IS ODD SET L = (N+1)/2
C
C           THEN FOR K = 2,...,L
C
C              R(2*K-2) = THE SUM FROM I = 1 TO I = N OF
C
C                   R(I)*COS((K-1)*(I-1)*2*PI/N)
C
C              R(2*K-1) = THE SUM FROM I = 1 TO I = N OF
C
C                  -R(I)*SIN((K-1)*(I-1)*2*PI/N)
C
C         IF N IS EVEN
C
C              R(N) = THE SUM FROM I = 1 TO I = N OF
C
C                   (-1)**(I-1)*R(I)
C
C  *****  NOTE
C              THIS TRANSFORM IS UNNORMALIZED SINCE A CALL OF DFFTF
C              FOLLOWED BY A CALL OF DFFTB WILL MULTIPLY THE INPUT
C              SEQUENCE BY N.
C
C WSAVE   CONTAINS RESULTS WHICH MUST NOT BE DESTROYED BETWEEN
C         CALLS OF DFFTF OR DFFTB.
C
C
C ******************************************************************
C
C SUBROUTINE DFFTB(N,R,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DFFTB COMPUTES THE REAL PERODIC SEQUENCE FROM ITS
C FOURIER COEFFICIENTS (FOURIER SYNTHESIS). THE TRANSFORM IS DEFINED
C BELOW AT OUTPUT PARAMETER R.
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY R TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C         N MAY CHANGE SO LONG AS DIFFERENT WORK ARRAYS ARE PROVIDED
C
C R       A REAL ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
C         TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 2*N+15.
C         IN THE PROGRAM THAT CALLS DFFTB. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DFFTI(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 DFFTF AND DFFTB.
C
C
C OUTPUT PARAMETERS
C
C R       FOR N EVEN AND FOR I = 1,...,N
C
C              R(I) = R(1)+(-1)**(I-1)*R(N)
C
C                   PLUS THE SUM FROM K=2 TO K=N/2 OF
C
C                    2.*R(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
C
C                   -2.*R(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
C
C         FOR N ODD AND FOR I = 1,...,N
C
C              R(I) = R(1) PLUS THE SUM FROM K=2 TO K=(N+1)/2 OF
C
C                   2.*R(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
C
C                  -2.*R(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
C
C  *****  NOTE
C              THIS TRANSFORM IS UNNORMALIZED SINCE A CALL OF DFFTF
C              FOLLOWED BY A CALL OF DFFTB WILL MULTIPLY THE INPUT
C              SEQUENCE BY N.
C
C WSAVE   CONTAINS RESULTS WHICH MUST NOT BE DESTROYED BETWEEN
C         CALLS OF DFFTB OR DFFTF.
C
C
C ******************************************************************
C
C SUBROUTINE DZFFTI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DZFFTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C BOTH DZFFTF AND DZFFTB. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DZFFTF AND DZFFTB
C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
C         ARE REQUIRED FOR DIFFERENT VALUES OF N.
C
C
C ******************************************************************
C
C SUBROUTINE DZFFTF(N,R,AZERO,A,B,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DZFFTF COMPUTES THE FOURIER COEFFICIENTS OF A REAL
C PERODIC SEQUENCE (FOURIER ANALYSIS). THE TRANSFORM IS DEFINED
C BELOW AT OUTPUT PARAMETERS AZERO,A AND B. DZFFTF IS A SIMPLIFIED
C BUT SLOWER VERSION OF DFFTF.
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY R TO BE TRANSFORMED.  THE METHOD
C         IS MUST EFFICIENT WHEN N IS THE PRODUCT OF SMALL PRIMES.
C
C R       A REAL ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
C         TO BE TRANSFORMED. R IS NOT DESTROYED.
C
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         IN THE PROGRAM THAT CALLS DZFFTF. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DZFFTI(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 DZFFTF AND DZFFTB.
C
C OUTPUT PARAMETERS
C
C AZERO   THE SUM FROM I=1 TO I=N OF R(I)/N
C
C A,B     FOR N EVEN B(N/2)=0. AND A(N/2) IS THE SUM FROM I=1 TO
C         I=N OF (-1)**(I-1)*R(I)/N
C
C         FOR N EVEN DEFINE KMAX=N/2-1
C         FOR N ODD  DEFINE KMAX=(N-1)/2
C
C         THEN FOR  K=1,...,KMAX
C
C              A(K) EQUALS THE SUM FROM I=1 TO I=N OF
C
C                   2./N*R(I)*COS(K*(I-1)*2*PI/N)
C
C              B(K) EQUALS THE SUM FROM I=1 TO I=N OF
C
C                   2./N*R(I)*SIN(K*(I-1)*2*PI/N)
C
C
C ******************************************************************
C
C SUBROUTINE DZFFTB(N,R,AZERO,A,B,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DZFFTB COMPUTES A REAL PERODIC SEQUENCE FROM ITS
C FOURIER COEFFICIENTS (FOURIER SYNTHESIS). THE TRANSFORM IS
C DEFINED BELOW AT OUTPUT PARAMETER R. DZFFTB IS A SIMPLIFIED
C BUT SLOWER VERSION OF DFFTB.
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE OUTPUT ARRAY R.  THE METHOD IS MOST
C         EFFICIENT WHEN N IS THE PRODUCT OF SMALL PRIMES.
C
C AZERO   THE CONSTANT FOURIER COEFFICIENT
C
C A,B     ARRAYS WHICH CONTAIN THE REMAINING FOURIER COEFFICIENTS
C         THESE ARRAYS ARE NOT DESTROYED.
C
C         THE LENGTH OF THESE ARRAYS DEPENDS ON WHETHER N IS EVEN OR
C         ODD.
C
C         IF N IS EVEN N/2    LOCATIONS ARE REQUIRED
C         IF N IS ODD (N-1)/2 LOCATIONS ARE REQUIRED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         IN THE PROGRAM THAT CALLS DZFFTB. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DZFFTI(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 DZFFTF AND DZFFTB.
C
C
C OUTPUT PARAMETERS
C
C R       IF N IS EVEN DEFINE KMAX=N/2
C         IF N IS ODD  DEFINE KMAX=(N-1)/2
C
C         THEN FOR I=1,...,N
C
C              R(I)=AZERO PLUS THE SUM FROM K=1 TO K=KMAX OF
C
C              A(K)*COS(K*(I-1)*2*PI/N)+B(K)*SIN(K*(I-1)*2*PI/N)
C
C ********************* COMPLEX NOTATION **************************
C
C         FOR J=1,...,N
C
C         R(J) EQUALS THE SUM FROM K=-KMAX TO K=KMAX OF
C
C              C(K)*EXP(I*K*(J-1)*2*PI/N)
C
C         WHERE
C
C              C(K) = .5*CMPLX(A(K),-B(K))   FOR K=1,...,KMAX
C
C              C(-K) = CONJG(C(K))
C
C              C(0) = AZERO
C
C                   AND I=SQRT(-1)
C
C *************** AMPLITUDE - PHASE NOTATION ***********************
C
C         FOR I=1,...,N
C
C         R(I) EQUALS AZERO PLUS THE SUM FROM K=1 TO K=KMAX OF
C
C              ALPHA(K)*COS(K*(I-1)*2*PI/N+BETA(K))
C
C         WHERE
C
C              ALPHA(K) = SQRT(A(K)*A(K)+B(K)*B(K))
C
C              COS(BETA(K))=A(K)/ALPHA(K)
C
C              SIN(BETA(K))=-B(K)/ALPHA(K)
C
C ******************************************************************
C
C SUBROUTINE DSINTI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DSINTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C SUBROUTINE DSINT. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N+1 IS A PRODUCT OF SMALL PRIMES.
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WITH AT LEAST INT(2.5*N+15) LOCATIONS.
C         DIFFERENT WSAVE ARRAYS ARE REQUIRED FOR DIFFERENT VALUES
C         OF N. THE CONTENTS OF WSAVE MUST NOT BE CHANGED BETWEEN
C         CALLS OF DSINT.
C
C ******************************************************************
C
C SUBROUTINE DSINT(N,X,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DSINT COMPUTES THE DISCRETE FOURIER SINE TRANSFORM
C OF AN ODD SEQUENCE X(I). THE TRANSFORM IS DEFINED BELOW AT
C OUTPUT PARAMETER X.
C
C DSINT IS THE UNNORMALIZED INVERSE OF ITSELF SINCE A CALL OF DSINT
C FOLLOWED BY ANOTHER CALL OF DSINT WILL MULTIPLY THE INPUT SEQUENCE
C X BY 2*(N+1).
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DSINT MUST BE
C INITIALIZED BY CALLING SUBROUTINE DSINTI(N,WSAVE).
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N+1 IS THE PRODUCT OF SMALL PRIMES.
C
C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
C
C
C WSAVE   A WORK ARRAY WITH DIMENSION AT LEAST INT(2.5*N+15)
C         IN THE PROGRAM THAT CALLS DSINT. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DSINTI(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
C OUTPUT PARAMETERS
C
C X       FOR I=1,...,N
C
C              X(I)= THE SUM FROM K=1 TO K=N
C
C                   2*X(K)*SIN(K*I*PI/(N+1))
C
C              A CALL OF DSINT FOLLOWED BY ANOTHER CALL OF
C              DSINT WILL MULTIPLY THE SEQUENCE X BY 2*(N+1).
C              HENCE DSINT IS THE UNNORMALIZED INVERSE
C              OF ITSELF.
C
C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT BE
C         DESTROYED BETWEEN CALLS OF DSINT.
C
C ******************************************************************
C
C SUBROUTINE DCOSTI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DCOSTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C SUBROUTINE DCOST. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N-1 IS A PRODUCT OF SMALL PRIMES.
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         DIFFERENT WSAVE ARRAYS ARE REQUIRED FOR DIFFERENT VALUES
C         OF N. THE CONTENTS OF WSAVE MUST NOT BE CHANGED BETWEEN
C         CALLS OF DCOST.
C
C ******************************************************************
C
C SUBROUTINE DCOST(N,X,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DCOST COMPUTES THE DISCRETE FOURIER COSINE TRANSFORM
C OF AN EVEN SEQUENCE X(I). THE TRANSFORM IS DEFINED BELOW AT OUTPUT
C PARAMETER X.
C
C DCOST IS THE UNNORMALIZED INVERSE OF ITSELF SINCE A CALL OF DCOST
C FOLLOWED BY ANOTHER CALL OF DCOST WILL MULTIPLY THE INPUT SEQUENCE
C X BY 2*(N-1). THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER X
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DCOST MUST BE
C INITIALIZED BY CALLING SUBROUTINE DCOSTI(N,WSAVE).
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE SEQUENCE X. N MUST BE GREATER THAN 1.
C         THE METHOD IS MOST EFFICIENT WHEN N-1 IS A PRODUCT OF
C         SMALL PRIMES.
C
C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15
C         IN THE PROGRAM THAT CALLS DCOST. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DCOSTI(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
C OUTPUT PARAMETERS
C
C X       FOR I=1,...,N
C
C             X(I) = X(1)+(-1)**(I-1)*X(N)
C
C              + THE SUM FROM K=2 TO K=N-1
C
C                  2*X(K)*COS((K-1)*(I-1)*PI/(N-1))
C
C              A CALL OF DCOST FOLLOWED BY ANOTHER CALL OF
C              DCOST WILL MULTIPLY THE SEQUENCE X BY 2*(N-1)
C              HENCE DCOST IS THE UNNORMALIZED INVERSE
C              OF ITSELF.
C
C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT BE
C         DESTROYED BETWEEN CALLS OF DCOST.
C
C ******************************************************************
C
C SUBROUTINE DSINQI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DSINQI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C BOTH DSINQF AND DSINQB. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED. THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DSINQF AND DSINQB
C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF DSINQF OR DSINQB.
C
C ******************************************************************
C
C SUBROUTINE DSINQF(N,X,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DSINQF COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
C WAVE DATA. THAT IS , DSINQF COMPUTES THE COEFFICIENTS IN A SINE
C SERIES REPRESENTATION WITH ONLY ODD WAVE NUMBERS. THE TRANSFORM
C IS DEFINED BELOW AT OUTPUT PARAMETER X.
C
C DSINQB IS THE UNNORMALIZED INVERSE OF DSINQF SINCE A CALL OF DSINQF
C FOLLOWED BY A CALL OF DSINQB WILL MULTIPLY THE INPUT SEQUENCE X
C BY 4*N.
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DSINQF MUST BE
C INITIALIZED BY CALLING SUBROUTINE DSINQI(N,WSAVE).
C
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C
C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         IN THE PROGRAM THAT CALLS DSINQF. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DSINQI(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
C OUTPUT PARAMETERS
C
C X       FOR I=1,...,N
C
C              X(I) = (-1)**(I-1)*X(N)
C
C                 + THE SUM FROM K=1 TO K=N-1 OF
C
C                 2*X(K)*SIN((2*I-1)*K*PI/(2*N))
C
C              A CALL OF DSINQF FOLLOWED BY A CALL OF
C              DSINQB WILL MULTIPLY THE SEQUENCE X BY 4*N.
C              THEREFORE DSINQB IS THE UNNORMALIZED INVERSE
C              OF DSINQF.
C
C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
C         BE DESTROYED BETWEEN CALLS OF DSINQF OR DSINQB.
C
C ******************************************************************
C
C SUBROUTINE DSINQB(N,X,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DSINQB COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
C WAVE DATA. THAT IS , DSINQB COMPUTES A SEQUENCE FROM ITS
C REPRESENTATION IN TERMS OF A SINE SERIES WITH ODD WAVE NUMBERS.
C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER X.
C
C DSINQF IS THE UNNORMALIZED INVERSE OF DSINQB SINCE A CALL OF DSINQB
C FOLLOWED BY A CALL OF DSINQF WILL MULTIPLY THE INPUT SEQUENCE X
C BY 4*N.
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DSINQB MUST BE
C INITIALIZED BY CALLING SUBROUTINE DSINQI(N,WSAVE).
C
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C
C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         IN THE PROGRAM THAT CALLS DSINQB. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DSINQI(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
C OUTPUT PARAMETERS
C
C X       FOR I=1,...,N
C
C              X(I)= THE SUM FROM K=1 TO K=N OF
C
C                4*X(K)*SIN((2K-1)*I*PI/(2*N))
C
C              A CALL OF DSINQB FOLLOWED BY A CALL OF
C              DSINQF WILL MULTIPLY THE SEQUENCE X BY 4*N.
C              THEREFORE DSINQF IS THE UNNORMALIZED INVERSE
C              OF DSINQB.
C
C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
C         BE DESTROYED BETWEEN CALLS OF DSINQB OR DSINQF.
C
C ******************************************************************
C
C SUBROUTINE DCOSQI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DCOSQI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C BOTH DCOSQF AND DCOSQB. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE ARRAY TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DCOSQF AND DCOSQB
C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF DCOSQF OR DCOSQB.
C
C ******************************************************************
C
C SUBROUTINE DCOSQF(N,X,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DCOSQF COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
C WAVE DATA. THAT IS , DCOSQF COMPUTES THE COEFFICIENTS IN A COSINE
C SERIES REPRESENTATION WITH ONLY ODD WAVE NUMBERS. THE TRANSFORM
C IS DEFINED BELOW AT OUTPUT PARAMETER X
C
C DCOSQF IS THE UNNORMALIZED INVERSE OF DCOSQB SINCE A CALL OF DCOSQF
C FOLLOWED BY A CALL OF DCOSQB WILL MULTIPLY THE INPUT SEQUENCE X
C BY 4*N.
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DCOSQF MUST BE
C INITIALIZED BY CALLING SUBROUTINE DCOSQI(N,WSAVE).
C
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C
C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15
C         IN THE PROGRAM THAT CALLS DCOSQF. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DCOSQI(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
C OUTPUT PARAMETERS
C
C X       FOR I=1,...,N
C
C              X(I) = X(1) PLUS THE SUM FROM K=2 TO K=N OF
C
C                 2*X(K)*COS((2*I-1)*(K-1)*PI/(2*N))
C
C              A CALL OF DCOSQF FOLLOWED BY A CALL OF
C              DCOSQB WILL MULTIPLY THE SEQUENCE X BY 4*N.
C              THEREFORE DCOSQB IS THE UNNORMALIZED INVERSE
C              OF DCOSQF.
C
C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
C         BE DESTROYED BETWEEN CALLS OF DCOSQF OR DCOSQB.
C
C ******************************************************************
C
C SUBROUTINE DCOSQB(N,X,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE DCOSQB COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
C WAVE DATA. THAT IS , DCOSQB COMPUTES A SEQUENCE FROM ITS
C REPRESENTATION IN TERMS OF A COSINE SERIES WITH ODD WAVE NUMBERS.
C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER X.
C
C DCOSQB IS THE UNNORMALIZED INVERSE OF DCOSQF SINCE A CALL OF DCOSQB
C FOLLOWED BY A CALL OF DCOSQF WILL MULTIPLY THE INPUT SEQUENCE X
C BY 4*N.
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DCOSQB MUST BE
C INITIALIZED BY CALLING SUBROUTINE DCOSQI(N,WSAVE).
C
C
C INPUT PARAMETERS
C
C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
C
C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
C
C WSAVE   A WORK ARRAY THAT MUST BE DIMENSIONED AT LEAST 3*N+15
C         IN THE PROGRAM THAT CALLS DCOSQB. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE DCOSQI(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
C OUTPUT PARAMETERS
C
C X       FOR I=1,...,N
C
C              X(I)= THE SUM FROM K=1 TO K=N OF
C
C                4*X(K)*COS((2*K-1)*(I-1)*PI/(2*N))
C
C              A CALL OF DCOSQB FOLLOWED BY A CALL OF
C              DCOSQF WILL MULTIPLY THE SEQUENCE X BY 4*N.
C              THEREFORE DCOSQF IS THE UNNORMALIZED INVERSE
C              OF DCOSQB.
C
C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
C         BE DESTROYED BETWEEN CALLS OF DCOSQB OR DCOSQF.
C
C ******************************************************************
C
C SUBROUTINE ZFFTI(N,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE ZFFTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
C BOTH ZFFTF AND ZFFTB. THE PRIME FACTORIZATION OF N TOGETHER WITH
C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
C STORED IN WSAVE.
C
C INPUT PARAMETER
C
C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED
C
C OUTPUT PARAMETER
C
C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 4*N+15
C         THE SAME WORK ARRAY CAN BE USED FOR BOTH ZFFTF AND ZFFTB
C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF ZFFTF OR ZFFTB.
C
C ******************************************************************
C
C SUBROUTINE ZFFTF(N,C,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE ZFFTF COMPUTES THE FORWARD COMPLEX DISCRETE FOURIER
C TRANSFORM (THE FOURIER ANALYSIS). EQUIVALENTLY , ZFFTF 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 ZFFTF
C FOLLOWED BY A CALL OF ZFFTB WILL MULTIPLY THE SEQUENCE BY N.
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE ZFFTF MUST BE
C INITIALIZED BY CALLING SUBROUTINE ZFFTI(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. N
C
C C      A COMPLEX ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
C
C WSAVE   A REAL WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 4N+15
C         IN THE PROGRAM THAT CALLS ZFFTF. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE ZFFTI(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 ZFFTF AND ZFFTB.
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-1)*(K-1)*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 ZFFTF OR ZFFTB
C
C ******************************************************************
C
C SUBROUTINE ZFFTB(N,C,WSAVE)
C
C ******************************************************************
C
C SUBROUTINE ZFFTB COMPUTES THE BACKWARD COMPLEX DISCRETE FOURIER
C TRANSFORM (THE FOURIER SYNTHESIS). EQUIVALENTLY , ZFFTB COMPUTES
C A COMPLEX PERIODIC SEQUENCE FROM ITS FOURIER COEFFICIENTS.
C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER C.
C
C A CALL OF ZFFTF FOLLOWED BY A CALL OF ZFFTB WILL MULTIPLY THE
C SEQUENCE BY N.
C
C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE ZFFTB MUST BE
C INITIALIZED BY CALLING SUBROUTINE ZFFTI(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 REAL WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 4N+15
C         IN THE PROGRAM THAT CALLS ZFFTB. THE WSAVE ARRAY MUST BE
C         INITIALIZED BY CALLING SUBROUTINE ZFFTI(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 ZFFTF AND ZFFTB.
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-1)*(K-1)*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 ZFFTF OR ZFFTB
C
C
C
C ["SEND INDEX FOR VFFTPK" DESCRIBES A VECTORIZED VERSION OF FFTPACK]
C
C
C

      SUBROUTINE ZFFTB (N,C,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       C(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL ZFFTB1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END
      SUBROUTINE ZFFTB1 (N,C,CH,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(*)
      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 DPASSB4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL DPASSB4 (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 DPASSB2 (IDOT,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL DPASSB2 (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 DPASSB3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL DPASSB3 (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 DPASSB5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL DPASSB5 (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 DPASSB (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL DPASSB (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 ZFFTF (N,C,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       C(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL ZFFTF1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END
      SUBROUTINE ZFFTF1 (N,C,CH,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(*)
      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 DPASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL DPASSF4 (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 DPASSF2 (IDOT,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL DPASSF2 (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 DPASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL DPASSF3 (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 DPASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL DPASSF5 (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 ZFFTI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL ZFFTI1 (N,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END
      SUBROUTINE ZFFTI1 (N,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WA(1)      ,IFAC(*)    ,NTRYH(4)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/3,4,2,5/
      NL = N
      NF = 0
      J = 0
  101 J = J+1
      IF (J-4) 102,102,103
  102 NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = NTRY
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = 2
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N
      IFAC(2) = NF
      TPI = 6.2831853071795864769252867665590057D0
      ARGH = TPI/DBLE(N)
      I = 2
      L1 = 1
      DO 110 K1=1,NF
         IP = IFAC(K1+2)
         LD = 0
         L2 = L1*IP
         IDO = N/L2
         IDOT = IDO+IDO+2
         IPM = IP-1
         DO 109 J=1,IPM
            I1 = I
            WA(I-1) = 1.0D0
            WA(I) = 0.0D0
            LD = LD+L1
            FI = 0.0D0
            ARGLD = DBLE(LD)*ARGH
            DO 108 II=4,IDOT,2
               I = I+2
               FI = FI+1.0D0
               ARG = FI*ARGLD
               WA(I-1) = DCOS(ARG)
               WA(I) = DSIN(ARG)
  108       CONTINUE
            IF (IP .LE. 5) GO TO 109
            WA(I1-1) = WA(I-1)
            WA(I1) = WA(I)
  109    CONTINUE
         L1 = L2
  110 CONTINUE
      RETURN
      END
      SUBROUTINE DCOSQB (N,X,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,WSAVE(1)
      DATA TSQRT2 /2.8284271247461900976033774484193961D0/
      IF (N-2) 101,102,103
  101 X(1) = 4.0D0*X(1)
      RETURN
  102 X1 = 4.0D0*(X(1)+X(2))
      X(2) = TSQRT2*(X(1)-X(2))
      X(1) = X1
      RETURN
  103 CALL DCOSQB1 (N,X,WSAVE,WSAVE(N+1))
      RETURN
      END
      SUBROUTINE DCOSQB1 (N,X,W,XH)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,W(1)       ,XH(*)
      NS2 = (N+1)/2
      NP2 = N+2
      DO 101 I=3,N,2
         XIM1 = X(I-1)+X(I)
         X(I) = X(I)-X(I-1)
         X(I-1) = XIM1
  101 CONTINUE
      X(1) = X(1)+X(1)
      MODN = MOD(N,2)
      IF (MODN .EQ. 0) X(N) = X(N)+X(N)
      CALL DFFTB (N,X,XH)
      DO 102 K=2,NS2
         KC = NP2-K
         XH(K) = W(K-1)*X(KC)+W(KC-1)*X(K)
         XH(KC) = W(K-1)*X(K)-W(KC-1)*X(KC)
  102 CONTINUE
      IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*(X(NS2+1)+X(NS2+1))
      DO 103 K=2,NS2
         KC = NP2-K
         X(K) = XH(K)+XH(KC)
         X(KC) = XH(K)-XH(KC)
  103 CONTINUE
      X(1) = X(1)+X(1)
      RETURN
      END
      SUBROUTINE DCOSQF (N,X,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,WSAVE(1)
      DATA SQRT2 /1.4142135623730950488016887242096980D0/
      IF (N-2) 102,101,103
  101 TSQX = SQRT2*X(2)
      X(2) = X(1)-TSQX
      X(1) = X(1)+TSQX
  102 RETURN
  103 CALL DCOSQF1 (N,X,WSAVE,WSAVE(N+1))
      RETURN
      END
      SUBROUTINE DCOSQF1 (N,X,W,XH)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,W(1)       ,XH(*)
      NS2 = (N+1)/2
      NP2 = N+2
      DO 101 K=2,NS2
         KC = NP2-K
         XH(K) = X(K)+X(KC)
         XH(KC) = X(K)-X(KC)
  101 CONTINUE
      MODN = MOD(N,2)
      IF (MODN .EQ. 0) XH(NS2+1) = X(NS2+1)+X(NS2+1)
      DO 102 K=2,NS2
         KC = NP2-K
         X(K) = W(K-1)*XH(KC)+W(KC-1)*XH(K)
         X(KC) = W(K-1)*XH(K)-W(KC-1)*XH(KC)
  102 CONTINUE
      IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*XH(NS2+1)
      CALL DFFTF (N,X,XH)
      DO 103 I=3,N,2
         XIM1 = X(I-1)-X(I)
         X(I) = X(I-1)+X(I)
         X(I-1) = XIM1
  103 CONTINUE
      RETURN
      END
      SUBROUTINE DCOSQI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      DATA PIH /1.5707963267948966192313216916397514D0/
      DT = PIH/DBLE(N)
      FK = 0.0D0
      DO 101 K=1,N
         FK = FK+1.0D0
         WSAVE(K) = DCOS(FK*DT)
  101 CONTINUE
      CALL DFFTI (N,WSAVE(N+1))
      RETURN
      END
      SUBROUTINE DCOST (N,X,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,WSAVE(1)
      NM1 = N-1
      NP1 = N+1
      NS2 = N/2
      IF (N-2) 106,101,102
  101 X1H = X(1)+X(2)
      X(2) = X(1)-X(2)
      X(1) = X1H
      RETURN
  102 IF (N .GT. 3) GO TO 103
      X1P3 = X(1)+X(3)
      TX2 = X(2)+X(2)
      X(2) = X(1)-X(3)
      X(1) = X1P3+TX2
      X(3) = X1P3-TX2
      RETURN
  103 C1 = X(1)-X(N)
      X(1) = X(1)+X(N)
      DO 104 K=2,NS2
         KC = NP1-K
         T1 = X(K)+X(KC)
         T2 = X(K)-X(KC)
         C1 = C1+WSAVE(KC)*T2
         T2 = WSAVE(K)*T2
         X(K) = T1-T2
         X(KC) = T1+T2
  104 CONTINUE
      MODN = MOD(N,2)
      IF (MODN .NE. 0) X(NS2+1) = X(NS2+1)+X(NS2+1)
      CALL DFFTF (NM1,X,WSAVE(N+1))
      XIM2 = X(2)
      X(2) = C1
      DO 105 I=4,N,2
         XI = X(I)
         X(I) = X(I-2)-X(I-1)
         X(I-1) = XIM2
         XIM2 = XI
  105 CONTINUE
      IF (MODN .NE. 0) X(N) = XIM2
  106 RETURN
      END
      SUBROUTINE DCOSTI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      DATA PI /3.1415926535897932384626433832795028D0/
      IF (N .LE. 3) RETURN
      NM1 = N-1
      NP1 = N+1
      NS2 = N/2
      DT = PI/DBLE(NM1)
      FK = 0.0D0
      DO 101 K=2,NS2
         KC = NP1-K
         FK = FK+1.0D0
         WSAVE(K) = 2.0D0*DSIN(FK*DT)
         WSAVE(KC) = 2.0D0*DCOS(FK*DT)
  101 CONTINUE
      CALL DFFTI (NM1,WSAVE(N+1))
      RETURN
      END
      SUBROUTINE DZFFT1 (N,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WA(1)      ,IFAC(*)    ,NTRYH(4)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
     1    ,TPI/6.2831853071795864769252867665590057D0/
      NL = N
      NF = 0
      J = 0
  101 J = J+1
      IF (J-4) 102,102,103
  102 NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = NTRY
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = 2
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N
      IFAC(2) = NF
      ARGH = TPI/DBLE(N)
      IS = 0
      NFM1 = NF-1
      L1 = 1
      IF (NFM1 .EQ. 0) RETURN
      DO 111 K1=1,NFM1
         IP = IFAC(K1+2)
         L2 = L1*IP
         IDO = N/L2
         IPM = IP-1
         ARG1 = DBLE(L1)*ARGH
         CH1 = 1.0D0
         SH1 = 0.0D0
         DCH1 = DCOS(ARG1)
         DSH1 = DSIN(ARG1)
         DO 110 J=1,IPM
            CH1H = DCH1*CH1-DSH1*SH1
            SH1 = DCH1*SH1+DSH1*CH1
            CH1 = CH1H
            I = IS+2
            WA(I-1) = CH1
            WA(I) = SH1
            IF (IDO .LT. 5) GO TO 109
            DO 108 II=5,IDO,2
               I = I+2
               WA(I-1) = CH1*WA(I-3)-SH1*WA(I-2)
               WA(I) = CH1*WA(I-2)+SH1*WA(I-3)
  108       CONTINUE
  109       IS = IS+IDO
  110    CONTINUE
         L1 = L2
  111 CONTINUE
      RETURN
      END
      SUBROUTINE DZFFTB (N,R,AZERO,A,B,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       R(*)       ,A(1)       ,B(1)       ,WSAVE(1)
      IF (N-2) 101,102,103
  101 R(1) = AZERO
      RETURN
  102 R(1) = AZERO+A(1)
      R(2) = AZERO-A(1)
      RETURN
  103 NS2 = (N-1)/2
      DO 104 I=1,NS2
         R(2*I) = .5D0*A(I)
         R(2*I+1) = -.5D0*B(I)
  104 CONTINUE
      R(1) = AZERO
      IF (MOD(N,2) .EQ. 0) R(N) = A(NS2+1)
      CALL DFFTB (N,R,WSAVE(N+1))
      RETURN
      END
      SUBROUTINE DZFFTF (N,R,AZERO,A,B,WSAVE)
C
C                       VERSION 3  JUNE 1979
C
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       R(*)       ,A(1)       ,B(1)       ,WSAVE(1)
      IF (N-2) 101,102,103
  101 AZERO = R(1)
      RETURN
  102 AZERO = .5D0*(R(1)+R(2))
      A(1) = .5D0*(R(1)-R(2))
      RETURN
  103 DO 104 I=1,N
         WSAVE(I) = R(I)
  104 CONTINUE
      CALL DFFTF (N,WSAVE,WSAVE(N+1))
      CF = 2.0D0/DBLE(N)
      CFM = -CF
      AZERO = .5D0*CF*WSAVE(1)
      NS2 = (N+1)/2
      NS2M = NS2-1
      DO 105 I=1,NS2M
         A(I) = CF*WSAVE(2*I)
         B(I) = CFM*WSAVE(2*I+1)
  105 CONTINUE
      IF (MOD(N,2) .EQ. 1) RETURN
      A(NS2) = .5D0*CF*WSAVE(N)
      B(NS2) = 0.0D0
      RETURN
      END
      SUBROUTINE DZFFTI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL DZFFT1 (N,WSAVE(2*N+1),WSAVE(3*N+1))
      RETURN
      END
      SUBROUTINE DPASSB (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,WA(1)      ,C2(IDL1,IP),
     2                CH2(IDL1,IP)
      IDOT = IDO/2
      NT = IP*IDL1
      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
            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
         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
            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
         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
         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)
            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
         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
         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
      DO 121 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  121 CONTINUE
      DO 123 J=2,IP
         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
            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
            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 DPASSB2 (IDO,L1,CC,CH,WA1)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(1)
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DPASSB3 (IDO,L1,CC,CH,WA1,WA2)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5D0,.86602540378443864676372317075293618D0/
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DPASSB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      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,4,K)-CC(2,2,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,2,K)-CC(1,4,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 DO 104 K=1,L1
         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,4,K)-CC(I,2,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,2,K)-CC(I-1,4,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
      END
      SUBROUTINE DPASSB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /
     1   .30901699437494742410229341718281905D0,
     2   .95105651629515357211643933337938214D0,
     3  -.80901699437494742410229341718281906D0,
     4   .58778525229247312916870595463907276D0/
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DPASSF (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,WA(1)      ,C2(IDL1,IP),
     2                CH2(IDL1,IP)
      IDOT = IDO/2
      NT = IP*IDL1
      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
            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
         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
            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
         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
         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)
            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
         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
         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
      DO 121 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  121 CONTINUE
      DO 123 J=2,IP
         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
            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
            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 DPASSF2 (IDO,L1,CC,CH,WA1)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(1)
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DPASSF3 (IDO,L1,CC,CH,WA1,WA2)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5D0,-.86602540378443864676372317075293618D0/
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DPASSF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DPASSF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /
     1   .30901699437494742410229341718281905D0,
     2  -.95105651629515357211643933337938214D0,
     3  -.80901699437494742410229341718281906D0,
     4  -.58778525229247312916870595463907276D0/
      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 DO 104 K=1,L1
         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
      END
      SUBROUTINE DRADB2 (IDO,L1,CC,CH,WA1)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(1)
      DO 101 K=1,L1
         CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K)
         CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K)
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
            TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
            CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
            TI2 = CC(I,1,K)+CC(IC,2,K)
            CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
            CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 DO 106 K=1,L1
         CH(IDO,K,1) = CC(IDO,1,K)+CC(IDO,1,K)
         CH(IDO,K,2) = -(CC(1,2,K)+CC(1,2,K))
  106 CONTINUE
  107 RETURN
      END
      SUBROUTINE DRADB3 (IDO,L1,CC,CH,WA1,WA2)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5D0,.86602540378443864676372317075293618D0/
      DO 101 K=1,L1
         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
         CR2 = CC(1,1,K)+TAUR*TR2
         CH(1,K,1) = CC(1,1,K)+TR2
         CI3 = TAUI*(CC(1,3,K)+CC(1,3,K))
         CH(1,K,2) = CR2-CI3
         CH(1,K,3) = CR2+CI3
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
            CR2 = CC(I-1,1,K)+TAUR*TR2
            CH(I-1,K,1) = CC(I-1,1,K)+TR2
            TI2 = CC(I,3,K)-CC(IC,2,K)
            CI2 = CC(I,1,K)+TAUR*TI2
            CH(I,K,1) = CC(I,1,K)+TI2
            CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
            CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
            DR2 = CR2-CI3
            DR3 = CR2+CI3
            DI2 = CI2+CR3
            DI3 = CI2-CR3
            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
  102    CONTINUE
  103 CONTINUE
      RETURN
      END
      SUBROUTINE DRADB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      DATA SQRT2 /1.4142135623730950488016887242096980D0/
      DO 101 K=1,L1
         TR1 = CC(1,1,K)-CC(IDO,4,K)
         TR2 = CC(1,1,K)+CC(IDO,4,K)
         TR3 = CC(IDO,2,K)+CC(IDO,2,K)
         TR4 = CC(1,3,K)+CC(1,3,K)
         CH(1,K,1) = TR2+TR3
         CH(1,K,2) = TR1-TR4
         CH(1,K,3) = TR2-TR3
         CH(1,K,4) = TR1+TR4
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            TI1 = CC(I,1,K)+CC(IC,4,K)
            TI2 = CC(I,1,K)-CC(IC,4,K)
            TI3 = CC(I,3,K)-CC(IC,2,K)
            TR4 = CC(I,3,K)+CC(IC,2,K)
            TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
            TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
            TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
            TR3 = CC(I-1,3,K)+CC(IC-1,2,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-2)*CR2-WA1(I-1)*CI2
            CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
            CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
            CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
            CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
            CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 CONTINUE
      DO 106 K=1,L1
         TI1 = CC(1,2,K)+CC(1,4,K)
         TI2 = CC(1,4,K)-CC(1,2,K)
         TR1 = CC(IDO,1,K)-CC(IDO,3,K)
         TR2 = CC(IDO,1,K)+CC(IDO,3,K)
         CH(IDO,K,1) = TR2+TR2
         CH(IDO,K,2) = SQRT2*(TR1-TI1)
         CH(IDO,K,3) = TI2+TI2
         CH(IDO,K,4) = -SQRT2*(TR1+TI1)
  106 CONTINUE
  107 RETURN
      END
      SUBROUTINE DRADB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /
     1   .30901699437494742410229341718281905D0,
     2   .95105651629515357211643933337938214D0,
     3  -.80901699437494742410229341718281906D0,
     4   .58778525229247312916870595463907276D0/
      DO 101 K=1,L1
         TI5 = CC(1,3,K)+CC(1,3,K)
         TI4 = CC(1,5,K)+CC(1,5,K)
         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
         TR3 = CC(IDO,4,K)+CC(IDO,4,K)
         CH(1,K,1) = CC(1,1,K)+TR2+TR3
         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
         CI5 = TI11*TI5+TI12*TI4
         CI4 = TI12*TI5-TI11*TI4
         CH(1,K,2) = CR2-CI5
         CH(1,K,3) = CR3-CI4
         CH(1,K,4) = CR3+CI4
         CH(1,K,5) = CR2+CI5
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            TI5 = CC(I,3,K)+CC(IC,2,K)
            TI2 = CC(I,3,K)-CC(IC,2,K)
            TI4 = CC(I,5,K)+CC(IC,4,K)
            TI3 = CC(I,5,K)-CC(IC,4,K)
            TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
            TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
            TR3 = CC(I-1,5,K)+CC(IC-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-2)*DR2-WA1(I-1)*DI2
            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
            CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
            CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
            CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
            CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
  102    CONTINUE
  103 CONTINUE
      RETURN
      END
      SUBROUTINE DRADBG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
     2                CH2(IDL1,IP)           ,WA(1)
      DATA TPI/6.2831853071795864769252867665590057D0/
      ARG = TPI/DBLE(IP)
      DCP = DCOS(ARG)
      DSP = DSIN(ARG)
      IDP2 = IDO+2
      NBD = (IDO-1)/2
      IPP2 = IP+2
      IPPH = (IP+1)/2
      IF (IDO .LT. L1) GO TO 103
      DO 102 K=1,L1
         DO 101 I=1,IDO
            CH(I,K,1) = CC(I,1,K)
  101    CONTINUE
  102 CONTINUE
      GO TO 106
  103 DO 105 I=1,IDO
         DO 104 K=1,L1
            CH(I,K,1) = CC(I,1,K)
  104    CONTINUE
  105 CONTINUE
  106 DO 108 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 107 K=1,L1
            CH(1,K,J) = CC(IDO,J2-2,K)+CC(IDO,J2-2,K)
            CH(1,K,JC) = CC(1,J2-1,K)+CC(1,J2-1,K)
  107    CONTINUE
  108 CONTINUE
      IF (IDO .EQ. 1) GO TO 116
      IF (NBD .LT. L1) GO TO 112
      DO 111 J=2,IPPH
         JC = IPP2-J
         DO 110 K=1,L1
            DO 109 I=3,IDO,2
               IC = IDP2-I
               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
  109       CONTINUE
  110    CONTINUE
  111 CONTINUE
      GO TO 116
  112 DO 115 J=2,IPPH
         JC = IPP2-J
         DO 114 I=3,IDO,2
            IC = IDP2-I
            DO 113 K=1,L1
               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
  113       CONTINUE
  114    CONTINUE
  115 CONTINUE
  116 AR1 = 1.0D0
      AI1 = 0.0D0
      DO 120 L=2,IPPH
         LC = IPP2-L
         AR1H = DCP*AR1-DSP*AI1
         AI1 = DCP*AI1+DSP*AR1
         AR1 = AR1H
         DO 117 IK=1,IDL1
            C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2)
            C2(IK,LC) = AI1*CH2(IK,IP)
  117    CONTINUE
         DC2 = AR1
         DS2 = AI1
         AR2 = AR1
         AI2 = AI1
         DO 119 J=3,IPPH
            JC = IPP2-J
            AR2H = DC2*AR2-DS2*AI2
            AI2 = DC2*AI2+DS2*AR2
            AR2 = AR2H
            DO 118 IK=1,IDL1
               C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J)
               C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC)
  118       CONTINUE
  119    CONTINUE
  120 CONTINUE
      DO 122 J=2,IPPH
         DO 121 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
  121    CONTINUE
  122 CONTINUE
      DO 124 J=2,IPPH
         JC = IPP2-J
         DO 123 K=1,L1
            CH(1,K,J) = C1(1,K,J)-C1(1,K,JC)
            CH(1,K,JC) = C1(1,K,J)+C1(1,K,JC)
  123    CONTINUE
  124 CONTINUE
      IF (IDO .EQ. 1) GO TO 132
      IF (NBD .LT. L1) GO TO 128
      DO 127 J=2,IPPH
         JC = IPP2-J
         DO 126 K=1,L1
            DO 125 I=3,IDO,2
               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
  125       CONTINUE
  126    CONTINUE
  127 CONTINUE
      GO TO 132
  128 DO 131 J=2,IPPH
         JC = IPP2-J
         DO 130 I=3,IDO,2
            DO 129 K=1,L1
               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
  129       CONTINUE
  130    CONTINUE
  131 CONTINUE
  132 CONTINUE
      IF (IDO .EQ. 1) RETURN
      DO 133 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  133 CONTINUE
      DO 135 J=2,IP
         DO 134 K=1,L1
            C1(1,K,J) = CH(1,K,J)
  134    CONTINUE
  135 CONTINUE
      IF (NBD .GT. L1) GO TO 139
      IS = -IDO
      DO 138 J=2,IP
         IS = IS+IDO
         IDIJ = IS
         DO 137 I=3,IDO,2
            IDIJ = IDIJ+2
            DO 136 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)
  136       CONTINUE
  137    CONTINUE
  138 CONTINUE
      GO TO 143
  139 IS = -IDO
      DO 142 J=2,IP
         IS = IS+IDO
         DO 141 K=1,L1
            IDIJ = IS
            DO 140 I=3,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)
  140       CONTINUE
  141    CONTINUE
  142 CONTINUE
  143 RETURN
      END
      SUBROUTINE DRADF2 (IDO,L1,CC,CH,WA1)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,2,L1)           ,CC(IDO,L1,2)           ,
     1                WA1(1)
      DO 101 K=1,L1
         CH(1,1,K) = CC(1,K,1)+CC(1,K,2)
         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2)
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            CH(I,1,K) = CC(I,K,1)+TI2
            CH(IC,2,K) = TI2-CC(I,K,1)
            CH(I-1,1,K) = CC(I-1,K,1)+TR2
            CH(IC-1,2,K) = CC(I-1,K,1)-TR2
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 DO 106 K=1,L1
         CH(1,2,K) = -CC(IDO,K,2)
         CH(IDO,1,K) = CC(IDO,K,1)
  106 CONTINUE
  107 RETURN
      END
      SUBROUTINE DRADF3 (IDO,L1,CC,CH,WA1,WA2)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,3,L1)           ,CC(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5D0,.86602540378443864676372317075293618D0/
      DO 101 K=1,L1
         CR2 = CC(1,K,2)+CC(1,K,3)
         CH(1,1,K) = CC(1,K,1)+CR2
         CH(1,3,K) = TAUI*(CC(1,K,3)-CC(1,K,2))
         CH(IDO,2,K) = CC(1,K,1)+TAUR*CR2
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
            CR2 = DR2+DR3
            CI2 = DI2+DI3
            CH(I-1,1,K) = CC(I-1,K,1)+CR2
            CH(I,1,K) = CC(I,K,1)+CI2
            TR2 = CC(I-1,K,1)+TAUR*CR2
            TI2 = CC(I,K,1)+TAUR*CI2
            TR3 = TAUI*(DI2-DI3)
            TI3 = TAUI*(DR3-DR2)
            CH(I-1,3,K) = TR2+TR3
            CH(IC-1,2,K) = TR2-TR3
            CH(I,3,K) = TI2+TI3
            CH(IC,2,K) = TI3-TI2
  102    CONTINUE
  103 CONTINUE
      RETURN
      END
      SUBROUTINE DRADF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,L1,4)           ,CH(IDO,4,L1)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      DATA HSQT2 /0.70710678118654752440084436210484904D0/
      DO 101 K=1,L1
         TR1 = CC(1,K,2)+CC(1,K,4)
         TR2 = CC(1,K,1)+CC(1,K,3)
         CH(1,1,K) = TR1+TR2
         CH(IDO,4,K) = TR2-TR1
         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3)
         CH(1,3,K) = CC(1,K,4)-CC(1,K,2)
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
            TR1 = CR2+CR4
            TR4 = CR4-CR2
            TI1 = CI2+CI4
            TI4 = CI2-CI4
            TI2 = CC(I,K,1)+CI3
            TI3 = CC(I,K,1)-CI3
            TR2 = CC(I-1,K,1)+CR3
            TR3 = CC(I-1,K,1)-CR3
            CH(I-1,1,K) = TR1+TR2
            CH(IC-1,4,K) = TR2-TR1
            CH(I,1,K) = TI1+TI2
            CH(IC,4,K) = TI1-TI2
            CH(I-1,3,K) = TI4+TR3
            CH(IC-1,2,K) = TR3-TI4
            CH(I,3,K) = TR4+TI3
            CH(IC,2,K) = TR4-TI3
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 CONTINUE
      DO 106 K=1,L1
         TI1 = -HSQT2*(CC(IDO,K,2)+CC(IDO,K,4))
         TR1 = HSQT2*(CC(IDO,K,2)-CC(IDO,K,4))
         CH(IDO,1,K) = TR1+CC(IDO,K,1)
         CH(IDO,3,K) = CC(IDO,K,1)-TR1
         CH(1,2,K) = TI1-CC(IDO,K,3)
         CH(1,4,K) = TI1+CC(IDO,K,3)
  106 CONTINUE
  107 RETURN
      END
      SUBROUTINE DRADF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CC(IDO,L1,5)           ,CH(IDO,5,L1)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /
     1   .30901699437494742410229341718281905D0,
     2   .95105651629515357211643933337938214D0,
     3  -.80901699437494742410229341718281906D0,
     4   .58778525229247312916870595463907276D0/
      DO 101 K=1,L1
         CR2 = CC(1,K,5)+CC(1,K,2)
         CI5 = CC(1,K,5)-CC(1,K,2)
         CR3 = CC(1,K,4)+CC(1,K,3)
         CI4 = CC(1,K,4)-CC(1,K,3)
         CH(1,1,K) = CC(1,K,1)+CR2+CR3
         CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
         CH(1,3,K) = TI11*CI5+TI12*CI4
         CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
         CH(1,5,K) = TI12*CI5-TI11*CI4
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
            DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
            DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
            DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
            DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
            CR2 = DR2+DR5
            CI5 = DR5-DR2
            CR5 = DI2-DI5
            CI2 = DI2+DI5
            CR3 = DR3+DR4
            CI4 = DR4-DR3
            CR4 = DI3-DI4
            CI3 = DI3+DI4
            CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
            CH(I,1,K) = CC(I,K,1)+CI2+CI3
            TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
            TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
            TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
            TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
            TR5 = TI11*CR5+TI12*CR4
            TI5 = TI11*CI5+TI12*CI4
            TR4 = TI12*CR5-TI11*CR4
            TI4 = TI12*CI5-TI11*CI4
            CH(I-1,3,K) = TR2+TR5
            CH(IC-1,2,K) = TR2-TR5
            CH(I,3,K) = TI2+TI5
            CH(IC,2,K) = TI5-TI2
            CH(I-1,5,K) = TR3+TR4
            CH(IC-1,4,K) = TR3-TR4
            CH(I,5,K) = TI3+TI4
            CH(IC,4,K) = TI4-TI3
  102    CONTINUE
  103 CONTINUE
      RETURN
      END
      SUBROUTINE DRADFG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
     2                CH2(IDL1,IP)           ,WA(1)
      DATA TPI/6.2831853071795864769252867665590057D0/
      ARG = TPI/DBLE(IP)
      DCP = DCOS(ARG)
      DSP = DSIN(ARG)
      IPPH = (IP+1)/2
      IPP2 = IP+2
      IDP2 = IDO+2
      NBD = (IDO-1)/2
      IF (IDO .EQ. 1) GO TO 119
      DO 101 IK=1,IDL1
         CH2(IK,1) = C2(IK,1)
  101 CONTINUE
      DO 103 J=2,IP
         DO 102 K=1,L1
            CH(1,K,J) = C1(1,K,J)
  102    CONTINUE
  103 CONTINUE
      IF (NBD .GT. L1) GO TO 107
      IS = -IDO
      DO 106 J=2,IP
         IS = IS+IDO
         IDIJ = IS
         DO 105 I=3,IDO,2
            IDIJ = IDIJ+2
            DO 104 K=1,L1
               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
  104       CONTINUE
  105    CONTINUE
  106 CONTINUE
      GO TO 111
  107 IS = -IDO
      DO 110 J=2,IP
         IS = IS+IDO
         DO 109 K=1,L1
            IDIJ = IS
            DO 108 I=3,IDO,2
               IDIJ = IDIJ+2
               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
  108       CONTINUE
  109    CONTINUE
  110 CONTINUE
  111 IF (NBD .LT. L1) GO TO 115
      DO 114 J=2,IPPH
         JC = IPP2-J
         DO 113 K=1,L1
            DO 112 I=3,IDO,2
               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
  112       CONTINUE
  113    CONTINUE
  114 CONTINUE
      GO TO 121
  115 DO 118 J=2,IPPH
         JC = IPP2-J
         DO 117 I=3,IDO,2
            DO 116 K=1,L1
               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
  116       CONTINUE
  117    CONTINUE
  118 CONTINUE
      GO TO 121
  119 DO 120 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  120 CONTINUE
  121 DO 123 J=2,IPPH
         JC = IPP2-J
         DO 122 K=1,L1
            C1(1,K,J) = CH(1,K,J)+CH(1,K,JC)
            C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J)
  122    CONTINUE
  123 CONTINUE
C
      AR1 = 1.0D0
      AI1 = 0.0D0
      DO 127 L=2,IPPH
         LC = IPP2-L
         AR1H = DCP*AR1-DSP*AI1
         AI1 = DCP*AI1+DSP*AR1
         AR1 = AR1H
         DO 124 IK=1,IDL1
            CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2)
            CH2(IK,LC) = AI1*C2(IK,IP)
  124    CONTINUE
         DC2 = AR1
         DS2 = AI1
         AR2 = AR1
         AI2 = AI1
         DO 126 J=3,IPPH
            JC = IPP2-J
            AR2H = DC2*AR2-DS2*AI2
            AI2 = DC2*AI2+DS2*AR2
            AR2 = AR2H
            DO 125 IK=1,IDL1
               CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J)
               CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC)
  125       CONTINUE
  126    CONTINUE
  127 CONTINUE
      DO 129 J=2,IPPH
         DO 128 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+C2(IK,J)
  128    CONTINUE
  129 CONTINUE
C
      IF (IDO .LT. L1) GO TO 132
      DO 131 K=1,L1
         DO 130 I=1,IDO
            CC(I,1,K) = CH(I,K,1)
  130    CONTINUE
  131 CONTINUE
      GO TO 135
  132 DO 134 I=1,IDO
         DO 133 K=1,L1
            CC(I,1,K) = CH(I,K,1)
  133    CONTINUE
  134 CONTINUE
  135 DO 137 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 136 K=1,L1
            CC(IDO,J2-2,K) = CH(1,K,J)
            CC(1,J2-1,K) = CH(1,K,JC)
  136    CONTINUE
  137 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IF (NBD .LT. L1) GO TO 141
      DO 140 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 139 K=1,L1
            DO 138 I=3,IDO,2
               IC = IDP2-I
               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
  138       CONTINUE
  139    CONTINUE
  140 CONTINUE
      RETURN
  141 DO 144 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 143 I=3,IDO,2
            IC = IDP2-I
            DO 142 K=1,L1
               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
  142       CONTINUE
  143    CONTINUE
  144 CONTINUE
      RETURN
      END
      SUBROUTINE DFFTB (N,R,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       R(*)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL DFFTB1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
      RETURN
      END
      SUBROUTINE DFFTB1 (N,C,CH,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(*)
      NF = IFAC(2)
      NA = 0
      L1 = 1
      IW = 1
      DO 116 K1=1,NF
         IP = IFAC(K1+2)
         L2 = IP*L1
         IDO = N/L2
         IDL1 = IDO*L1
         IF (IP .NE. 4) GO TO 103
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IF (NA .NE. 0) GO TO 101
         CALL DRADB4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL DRADB4 (IDO,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 DRADB2 (IDO,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL DRADB2 (IDO,L1,CH,C,WA(IW))
  105    NA = 1-NA
         GO TO 115
  106    IF (IP .NE. 3) GO TO 109
         IX2 = IW+IDO
         IF (NA .NE. 0) GO TO 107
         CALL DRADB3 (IDO,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL DRADB3 (IDO,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA
         GO TO 115
  109    IF (IP .NE. 5) GO TO 112
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IX4 = IX3+IDO
         IF (NA .NE. 0) GO TO 110
         CALL DRADB5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL DRADB5 (IDO,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 DRADBG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL DRADBG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  114    IF (IDO .EQ. 1) NA = 1-NA
  115    L1 = L2
         IW = IW+(IP-1)*IDO
  116 CONTINUE
      IF (NA .EQ. 0) RETURN
      DO 117 I=1,N
         C(I) = CH(I)
  117 CONTINUE
      RETURN
      END
      SUBROUTINE DFFTF (N,R,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       R(*)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL DFFTF1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
      RETURN
      END
      SUBROUTINE DFFTF1 (N,C,CH,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(*)
      NF = IFAC(2)
      NA = 1
      L2 = N
      IW = N
      DO 111 K1=1,NF
         KH = NF-K1
         IP = IFAC(KH+3)
         L1 = L2/IP
         IDO = N/L2
         IDL1 = IDO*L1
         IW = IW-(IP-1)*IDO
         NA = 1-NA
         IF (IP .NE. 4) GO TO 102
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IF (NA .NE. 0) GO TO 101
         CALL DRADF4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 110
  101    CALL DRADF4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
         GO TO 110
  102    IF (IP .NE. 2) GO TO 104
         IF (NA .NE. 0) GO TO 103
         CALL DRADF2 (IDO,L1,C,CH,WA(IW))
         GO TO 110
  103    CALL DRADF2 (IDO,L1,CH,C,WA(IW))
         GO TO 110
  104    IF (IP .NE. 3) GO TO 106
         IX2 = IW+IDO
         IF (NA .NE. 0) GO TO 105
         CALL DRADF3 (IDO,L1,C,CH,WA(IW),WA(IX2))
         GO TO 110
  105    CALL DRADF3 (IDO,L1,CH,C,WA(IW),WA(IX2))
         GO TO 110
  106    IF (IP .NE. 5) GO TO 108
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IX4 = IX3+IDO
         IF (NA .NE. 0) GO TO 107
         CALL DRADF5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 110
  107    CALL DRADF5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 110
  108    IF (IDO .EQ. 1) NA = 1-NA
         IF (NA .NE. 0) GO TO 109
         CALL DRADFG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         NA = 1
         GO TO 110
  109    CALL DRADFG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
         NA = 0
  110    L2 = L1
  111 CONTINUE
      IF (NA .EQ. 1) RETURN
      DO 112 I=1,N
         C(I) = CH(I)
  112 CONTINUE
      RETURN
      END
      SUBROUTINE DFFTI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL DFFTI1 (N,WSAVE(N+1),WSAVE(2*N+1))
      RETURN
      END
      SUBROUTINE DFFTI1 (N,WA,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WA(1)      ,IFAC(*)    ,NTRYH(4)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
      NL = N
      NF = 0
      J = 0
  101 J = J+1
      IF (J-4) 102,102,103
  102 NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = NTRY
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = 2
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N
      IFAC(2) = NF
      TPI = 6.2831853071795864769252867665590057D0
      ARGH = TPI/DBLE(N)
      IS = 0
      NFM1 = NF-1
      L1 = 1
      IF (NFM1 .EQ. 0) RETURN
      DO 110 K1=1,NFM1
         IP = IFAC(K1+2)
         LD = 0
         L2 = L1*IP
         IDO = N/L2
         IPM = IP-1
         DO 109 J=1,IPM
            LD = LD+L1
            I = IS
            ARGLD = DBLE(LD)*ARGH
            FI = 0.0D0
            DO 108 II=3,IDO,2
               I = I+2
               FI = FI+1.0D0
               ARG = FI*ARGLD
               WA(I-1) = DCOS(ARG)
               WA(I) = DSIN(ARG)
  108       CONTINUE
            IS = IS+IDO
  109    CONTINUE
         L1 = L2
  110 CONTINUE
      RETURN
      END
      SUBROUTINE DSINQB (N,X,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,WSAVE(1)
      IF (N .GT. 1) GO TO 101
      X(1) = 4.0D0*X(1)
      RETURN
  101 NS2 = N/2
      DO 102 K=2,N,2
         X(K) = -X(K)
  102 CONTINUE
      CALL DCOSQB (N,X,WSAVE)
      DO 103 K=1,NS2
         KC = N-K
         XHOLD = X(K)
         X(K) = X(KC+1)
         X(KC+1) = XHOLD
  103 CONTINUE
      RETURN
      END
      SUBROUTINE DSINQF (N,X,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      NS2 = N/2
      DO 101 K=1,NS2
         KC = N-K
         XHOLD = X(K)
         X(K) = X(KC+1)
         X(KC+1) = XHOLD
  101 CONTINUE
      CALL DCOSQF (N,X,WSAVE)
      DO 102 K=2,N,2
         X(K) = -X(K)
  102 CONTINUE
      RETURN
      END
      SUBROUTINE DSINQI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      CALL DCOSQI (N,WSAVE)
      RETURN
      END
      SUBROUTINE DSINT (N,X,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       X(*)       ,WSAVE(1)
      NP1 = N+1
      IW1 = N/2+1
      IW2 = IW1+NP1
      IW3 = IW2+NP1
      CALL DSINT1(N,X,WSAVE,WSAVE(IW1),WSAVE(IW2),WSAVE(IW3))
      RETURN
      END
      SUBROUTINE DSINT1(N,WAR,WAS,XH,X,IFAC)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION WAR(1),WAS(1),X(*),XH(*),IFAC(*)
      DATA SQRT3 /1.7320508075688772935274463415058723D0/
      DO 100 I=1,N
      XH(I) = WAR(I)
      WAR(I) = X(I)
  100 CONTINUE
      IF (N-2) 101,102,103
  101 XH(1) = XH(1)+XH(1)
      GO TO 106
  102 XHOLD = SQRT3*(XH(1)+XH(2))
      XH(2) = SQRT3*(XH(1)-XH(2))
      XH(1) = XHOLD
      GO TO 106
  103 NP1 = N+1
      NS2 = N/2
      X(1) = 0.0D0
      DO 104 K=1,NS2
         KC = NP1-K
         T1 = XH(K)-XH(KC)
         T2 = WAS(K)*(XH(K)+XH(KC))
         X(K+1) = T1+T2
         X(KC+1) = T2-T1
  104 CONTINUE
      MODN = MOD(N,2)
      IF (MODN .NE. 0) X(NS2+2) = 4.0D0*XH(NS2+1)
      CALL DFFTF1 (NP1,X,XH,WAR,IFAC)
      XH(1) = .5D0*X(1)
      DO 105 I=3,N,2
         XH(I-1) = -X(I)
         XH(I) = XH(I-2)+X(I-1)
  105 CONTINUE
      IF (MODN .NE. 0) GO TO 106
      XH(N) = -X(N+1)
  106 DO 107 I=1,N
      X(I) = WAR(I)
      WAR(I) = XH(I)
  107 CONTINUE
      RETURN
      END
      SUBROUTINE DSINTI (N,WSAVE)
	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION       WSAVE(1)
      DATA PI /3.1415926535897932384626433832795028D0/
      IF (N .LE. 1) RETURN
      NS2 = N/2
      NP1 = N+1
      DT = PI/DBLE(NP1)
      DO 101 K=1,NS2
         WSAVE(K) = 2.0D0*DSIN(K*DT)
  101 CONTINUE
      CALL DFFTI (NP1,WSAVE(NS2+1))
      RETURN
      END


	DOUBLE PRECISION FUNCTION PHI(Z)
	USE MSIMSL
C
C-Description-----------------------------------------------------------
	IMPLICIT NONE
C
C  Function:
C	Calculate the integral from -infinity to Z of
C		exp(-z**2/2)/sqrt(2*PI)
C  Arguments:
C   i	Z	DOUBLE PRECISION
C	Upper range of integration
C  Notes:
C   .	This routine was written by Dale Plummer
C   .	This routine was designed by William Dupont
C   .	This routine calls ERF and ERFC from IMSL
C
C-Declarations----------------------------------------------------------
C
C
C  Arguments
C
	REAL Z
C
C  Locals
C
	DOUBLE PRECISION ZZ
C
C-Code------------------------------------------------------------------
C
C    Copy argument to double precision local storage.
C
	ZZ=Z
C
	IF (ZZ.GE.0) THEN
C
C      Case of ZZ >= 0
C
	    PHI=(1.+DERF(ZZ/SQRT(2.)))/2.
	ELSE
C
C      Case of ZZ < 0
C
	    PHI=DERFC(-ZZ/SQRT(2.))/2.
	END IF
C
C    Finished.
C
	RETURN
	END


program main
    ! solve the Schrodinger equation of a 1-dimension harmonic oscillator with Numerov's method

    implicit none
    integer, parameter :: dp = selected_real_kind(8)
    real(dp), parameter :: eps = 1.d-5, dE = 1.d-2

    ! local vars
    real(dp) :: Xmax
    integer :: Nx, i
    real(dp) :: E    ! trial energy
    real(dp) :: dx, ySquareSum
    real(dp), allocatable :: x(:), Vpot(:), y(:), g(:), f(:)
    logical :: yNSignChange = .false., yNSign
    integer :: looptime = 1
    real(dp) :: Eprev1, Eprev2, yprev1, yprev2

    ! executable
    Xmax = -1.d0
    do while (Xmax < 0.d0)
        write(*,*) 'Please indicate the range of x, [-Xmax, Xmax]; Xmax ='
        read(*,*) Xmax
    end do

    Nx = -1
    do while (Nx <= 0)
        write(*,*) 'Please specify the # of slices between [0,Xmax], Nx ='
        read(*,*) Nx
    end do

    write(*,*) "Please give a trial energy E0, the first allowed state with E>E0 will be calculated! E0 ="
    read(*,*) E

    write(*, '(a10,a20,a20)') 'Iteration', 'Energy', 'Boundary value'

    ! memory dynamical allocation
    allocate(x(-Nx:Nx))
    allocate(Vpot(-Nx:Nx))
    allocate(y(-Nx:Nx))
    allocate(g(-Nx:Nx))
    allocate(f(-Nx:Nx))

    dx = Xmax / dble(Nx)
    Vpot = 0.d0
    do i = -Nx, Nx
        x(i) = dx * i
        Vpot(i) = .5d0 * ((x(i)**2 - 1.d0)**2 / 4.d0 - x(i)**2)
    end do

    do while (.true.)
        ! set boundary condition at y(-Nx) and y(-Nx+1)
        y(-Nx) = 0.d0
        y(-Nx + 1) = 1.d-4

        do i = -Nx, Nx
            g(i) = 2.d0 * (E - Vpot(i))
            f(i) = 1.d0 + g(i) / 12.d0 * dx**2
        end do

        ! Numerov's method
        do i = -Nx + 1, Nx - 1
            y(i + 1) = ((12.d0 - 10.d0 * f(i)) * y(i) - f(i - 1) * y(i - 1)) / f(i + 1)
        end do

        ! renormalize y(x)
        call Simpson(2 * Nx + 1, y(-Nx:Nx), dx, ySquareSum)
        y = y / sqrt(ySquareSum)

        ! output to screen
        write(*,'(i10,2f20.8)') looptime, E, y(Nx)

        ! change E
        if (abs(y(Nx)) < eps) then    ! if precision requirement is satisfied
            ! output to file
            open(1, file = '4-wavefunction-Numerov.txt', status = 'unknown')
            do i = -Nx, Nx
                write(1, '(2f20.8)') x(i), y(i)
            end do
            close(1)
            open(2, file = '4-energy-Numerov.txt', status = 'unknown')
            write(2, *) E
            close(2)
            exit
        else
            if (.not. yNSignChange) then    ! if the sign of yN has not changed
                E = E + dE
                if (looptime == 1) then    ! if this is the first loop
                    yNSign = (y(Nx) >= 0)
                    yprev1 = y(Nx)
                else
                    if ((y(Nx) >=0) .neqv. (yNSign)) then    ! if the sign of yN changed this time
                        yNSignChange = .true.
                        E = E - dE
                        Eprev1 = E
                        Eprev2 = E - dE
                        E = E - dE / 2.d0
                    end if
                    yprev2 = yprev1
                    yprev1 = y(Nx)
                end if
            else    ! once the sign of yN has changed
                if (abs(yprev1) <= abs(yprev2)) then
                    Eprev2 = E
                    ! Eprev1 = Eprev1
                    E = (Eprev1 + Eprev2) / 2.d0
                    yprev2 = y(Nx)
                    ! yprev1 = yprev1
                else
                    ! Eprev2 = Eprev2
                    Eprev1 = E
                    E = (Eprev1 + Eprev2) / 2.d0
                    ! yprev2 = yprev2
                    yprev1 = y(Nx)
                end if
            end if
        end if

        looptime = looptime + 1
    end do
end program main

subroutine Simpson(N, y, dx, ySquareSum)
    ! calculate the integral of the square of the wavefunction from -Xmax to Xmax with compound simpson formula

    implicit none
    integer :: N
    real(8), intent(in) :: y(N), dx
    real(8), intent(out) :: ySquareSum

    ! local vars
    integer :: i
    real(8) :: Work(N)

    if (mod(N,2) == 0) then
    ! Simpson does not work for integral of array with even number of elements
        write(*, *) 'Array with even elements, Simpson does not know how to work!'
    end if

    do i = 1,N
        Work(i) = y(i)**2
    end do

    ySquareSum = Work(1) + Work(N)
    do i = 2, N - 1, 2
        ySquareSum = ySquareSum + 4.d0 * Work(i)
    end do
    do i = 3, N - 2, 2
        ySquareSum = ySquareSum + 2.d0 * Work(i)
    end do
    ySquareSum = ySquareSum * dx / 3.d0

end subroutine Simpson