* PACKAGE UFFTP  !" ＦＦＴ( NAKAMURA ) 
*
*"  [HIS]  90/08/31(numaguti)
*
*
**********************************************************************
*"           << FFT を呼ぶ >>
**********************************************************************
      SUBROUTINE FFT99X
     M         ( G     ,
     M           Z     ,
     C           TRIGS , IFAX  ,
     C           INC   , JUMP  , N     , LOT  , ISIGN  )
*
      REAL       G ( JUMP, * )               !" 格子データ
      REAL       Z ( JUMP, * )               !" スペクトル
*
      REAL       TRIGS ( * )                 !" 三角関数表
      INTEGER    IFAX  ( * )                 !" 因数分解(ダミー)
      INTEGER    INC                         !" 配列のつめかた
      INTEGER    ISIGN                       !" 0 :正変換 1: 逆
*
      IF ( ISIGN .EQ. 0 ) THEN
*
*"           < 格子 => スペクトル >
*
         DO 1000 I = N+1, JUMP
            DO 1000 L = 1, LOT
               G( I,L ) = 0.
 1000    CONTINUE
*
*"  X(0),...,X(N-1) ===> A(0),A(1),B(1),...,A(N/2-1),B(N/2-1),A(N/2)
*
         CALL RFFTFM (N,INC,JUMP,LOT, G, TRIGS,IFAX, Z )
*
*"  A(0),A(1),B(1),... ===> A(0),B(0),A(1),B(1),...
*
*VOPTION NOFVAL
         DO 200 L = 1, LOT
            DO 200 I = 3, N
               Z( I,L ) = G( I-1,L )
  200    CONTINUE
         DO 240 L = 1, LOT
            Z( 1,L ) = G( 1,L )
            Z( 2,L ) = 0.0
  240    CONTINUE
*
         RETURN
*
      ELSE
*
*"           < スペクトル => 格子 >
*
*"   A(0),B(0),A(1),B(1),... ===> A(0),A(1),B(1),...
*
         DO 300 L = 1,LOT
            DO 300 I = 3,N
               G( I-1,L ) = Z( I,L )
  300    CONTINUE
         DO 340 L = 1,LOT
            G( 1,L ) = Z( 1,L )
            G( N,L ) = 0.0
  340    CONTINUE
*
*"   A(0),A(1),B(1)...A(N/2-1),B(N/2-1),A(N/2) ===> X(0)...X(N-1)
*
         CALL RFFTBM (N,INC,JUMP,LOT, G, TRIGS,IFAX, Z   )
*
      ENDIF
*
      RETURN
      END
************************************************************************
*"           << FFT 3角関数表作成 >>
************************************************************************
      SUBROUTINE RFFTIM
     I         ( N     ,
     O           TRIGS , IFAX  )
*
      REAL       TRIGS ( * )                 !" 三角関数表
      INTEGER    IFAX  ( * )                 !" 因数分解
*
      IF (N .EQ. 1) RETURN
      CALL RFTI1M ( N, TRIGS, IFAX )
*
      RETURN
      END
************************************************************************
      SUBROUTINE RFTI1M (N, WA,IFAC)
      DIMENSION       WA(N)      ,IFAC(*)    ,NTRYH(4)
      REAL   ARG, ARGLD, ARGH, TPI
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4) /4,2,3,5/
      DATA TPI / 6.28318530717959D0  /
          NL = N
          NF = 0
          J = 0
  101     J = J+1
      IF (J .LE. 4) THEN
          NTRY = NTRYH(J)
      ELSE
          NTRY = NTRY+2
      ENDIF
  104     NQ = NL/NTRY
          NR = NL-NTRY*NQ
      IF (NR .NE. 0) GO TO 101
          NF = NF+1
          IFAC(NF+2) = NTRY
          NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF   .EQ. 1) GO TO 107
*VOPTION NOFVAL
        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/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
            ARGLD = LD*ARGH
            IDOX = (IDO-1)/2
*VOPTION NOFVAL
          DO 108 IFI=1,IDOX
               ARG = IFI*ARGLD
               WA(2*IFI+IS-1) = COS(ARG)
               WA(2*IFI+IS  ) = SIN(ARG)
  108     CONTINUE
            IS = IS+IDO
  109   CONTINUE
          L1 = L2
  110 CONTINUE
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFFTBM (N,INC,JUMP,LOT, R, WA,IFAC, WSAVE)
      DIMENSION       R(*)       ,WSAVE(*)   ,WA(N)    ,IFAC(*)
?     REAL   CTIME1,CTIME2
?     CALL XCLOCK(CTIME1,5)
C
      IF (N .EQ. 1) RETURN
C
      IF (JUMP .NE. 1) THEN
        CALL RFTB2M (N,INC,JUMP,LOT, R, WA,IFAC, WSAVE)
      ELSE
        CALL RFTB1M (N,INC,     LOT, R, WA,IFAC, WSAVE)
      ENDIF
?     CALL XCLOCK(CTIME2,5)
?     CTIME1=CTIME2-CTIME1
?     CTIME2=1000.0*CTIME1/FLOAT(N*LOT)
?     WRITE(6,500) INC,JUMP,N,LOT, CTIME1,CTIME2
? 500 FORMAT(1H0,' RFFTBM: INC,JUMP,N,LOT =',4I6,'  TOTAL CPU =',F13.6
?    *      ,' (SEC) ;  UNIT CPU =',F13.6,' (MSEC)')
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTB2M (N,INC,JUMP,LOT, R, WA,IFAC, WSAVE)
      DIMENSION       R(*)       ,WSAVE(*)   ,WA(N)    ,IFAC(*)
C
        IF (JUMP .GT. INC) THEN
            INCN = (LOT*JUMP)/N
        ELSE
            INCN = INC
        ENDIF
          IF(MOD(INCN,16) .EQ. 0) INCN = INCN-1
          INCN = MAX(INCN,LOT)
C
            N4 = (N/4)*4
        IF (N4 .GE. 4) THEN
            IABASE = 1
            IBBASE = 1+INC
            ICBASE = 1+INC+INC
            IDBASE = 1+INC+INC+INC
            JABASE = 1
            JBBASE = 1+INCN
            JCBASE = 1+INCN+INCN
            JDBASE = 1+INCN+INCN+INCN
            INQ  = 4*INC
            INQN = 4*INCN
*VOPTION NOFVAL
        DO 102 K=1,N4,4
            IA = IABASE
            IB = IBBASE
            IC = ICBASE
            ID = IDBASE
            JA = JABASE
            JB = JBBASE
            JC = JCBASE
            JD = JDBASE
*VOPTION VEC,NOFVAL
          DO 101 L=1,LOT
            WSAVE(JA) = R(IA)
            WSAVE(JB) = R(IB)
            WSAVE(JC) = R(IC)
            WSAVE(JD) = R(ID)
            IA = IA+JUMP
            IB = IB+JUMP
            IC = IC+JUMP
            ID = ID+JUMP
            JA = JA+1
            JB = JB+1
            JC = JC+1
            JD = JD+1
  101     CONTINUE
            IABASE = IABASE+INQ
            IBBASE = IBBASE+INQ
            ICBASE = ICBASE+INQ
            IDBASE = IDBASE+INQ
            JABASE = JABASE+INQN
            JBBASE = JBBASE+INQN
            JCBASE = JCBASE+INQN
            JDBASE = JDBASE+INQN
  102   CONTINUE
      ENDIF
      IF (N4 .NE. N) THEN
            IABASE = 1+N4*INC
            JABASE = 1+N4*INCN
*VOPTION NOFVAL
        DO 104 K=N4+1,N
            IA = IABASE
            JA = JABASE
*VOPTION VEC,NOFVAL
          DO 103 L=1,LOT
            WSAVE(JA) = R(IA)
            IA = IA+JUMP
            JA = JA+1
  103     CONTINUE
            IABASE = IABASE+INC
            JABASE = JABASE+INCN
  104   CONTINUE
      ENDIF
C
        CALL RFTB1M (N,INCN,LOT, WSAVE, WA,IFAC, R)
C
        IF (N4 .GE. 4) THEN
            IABASE = 1
            IBBASE = 1+INC
            ICBASE = 1+INC+INC
            IDBASE = 1+INC+INC+INC
            JABASE = 1
            JBBASE = 1+INCN
            JCBASE = 1+INCN+INCN
            JDBASE = 1+INCN+INCN+INCN
            INQ  = 4*INC
            INQN = 4*INCN
*VOPTION NOFVAL
        DO 112 K=1,N4,4
            IA = IABASE
            IB = IBBASE
            IC = ICBASE
            ID = IDBASE
            JA = JABASE
            JB = JBBASE
            JC = JCBASE
            JD = JDBASE
*VOPTION VEC,NOFVAL
          DO 111 L=1,LOT
            R(IA) = WSAVE(JA)
            R(IB) = WSAVE(JB)
            R(IC) = WSAVE(JC)
            R(ID) = WSAVE(JD)
            IA = IA+JUMP
            IB = IB+JUMP
            IC = IC+JUMP
            ID = ID+JUMP
            JA = JA+1
            JB = JB+1
            JC = JC+1
            JD = JD+1
  111     CONTINUE
            IABASE = IABASE+INQ
            IBBASE = IBBASE+INQ
            ICBASE = ICBASE+INQ
            IDBASE = IDBASE+INQ
            JABASE = JABASE+INQN
            JBBASE = JBBASE+INQN
            JCBASE = JCBASE+INQN
            JDBASE = JDBASE+INQN
  112   CONTINUE
      ENDIF
      IF (N4 .NE. N) THEN
            IABASE = 1+N4*INC
            JABASE = 1+N4*INCN
*VOPTION NOFVAL
        DO 114 K=N4+1,N
            IA = IABASE
            JA = JABASE
*VOPTION VEC,NOFVAL
          DO 113 L=1,LOT
            R(IA) = WSAVE(JA)
            IA = IA+JUMP
            JA = JA+1
  113     CONTINUE
            IABASE = IABASE+INC
            JABASE = JABASE+INCN
  114   CONTINUE
      ENDIF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTB1M (N,INC,LOT, C, WA,IFAC, CH)
      DIMENSION       C(INC,N)   ,CH(INC,N)  ,WA(N)    ,IFAC(*)
        CALL RFTB9M (N,INC,LOT, NA,C, WA, IFAC, CH)
      IF (NA .EQ. 1) RETURN
           N4 = (N/4)*4
      IF (N4 .GE. 4) THEN
         DO 117 K=1,N4,4
         DO 117 L=1,LOT
           C(L,K  ) = CH(L,K  )
           C(L,K+1) = CH(L,K+1)
           C(L,K+2) = CH(L,K+2)
           C(L,K+3) = CH(L,K+3)
  117    CONTINUE
      ENDIF
      IF (N4 .NE. N) THEN
         DO 118 K=N4+1,N
         DO 118 L=1,LOT
           C(L,K) = CH(L,K)
  118    CONTINUE
      ENDIF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTB9M (N,INC,LOT, NA,C, WA,IFAC, CH)
      DIMENSION       C(INC,N)   ,CH(INC,N)  ,WA(N)    ,IFAC(*)
          NF = IFAC(2)
          NA = 1
          L1 = 1
          IW = 1
      DO 116 K1=1,NF
            IP = IFAC(K1+2)
            L2 = IP*L1
            IDO = N/L2
            IDL1 = IDO*L1
            NA = 1-NA
        IF (IP .EQ. 4) THEN
            IX2 = IW +IDO
            IX3 = IX2+IDO
          IF (NA .EQ. 0) THEN
            CALL RADB4M (INC,LOT,IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
          ELSE
            CALL RADB4M (INC,LOT,IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
          ENDIF
        ELSE IF (IP .EQ. 2) THEN
          IF (NA .EQ. 0) THEN
            CALL RADB2M (INC,LOT,IDO,L1,C,CH,WA(IW))
          ELSE
            CALL RADB2M (INC,LOT,IDO,L1,CH,C,WA(IW))
          ENDIF
        ELSE IF (IP .EQ. 3) THEN
            IX2 = IW +IDO
          IF (NA .EQ. 0) THEN
            CALL RADB3M (INC,LOT,IDO,L1,C,CH,WA(IW),WA(IX2))
          ELSE
            CALL RADB3M (INC,LOT,IDO,L1,CH,C,WA(IW),WA(IX2))
          ENDIF
        ELSE IF (IP .EQ. 5) THEN
            IX2 = IW +IDO
            IX3 = IX2+IDO
            IX4 = IX3+IDO
          IF (NA .EQ. 0) THEN
            CALL RADB5M (INC,LOT,IDO,L1,C,CH
     *                  ,WA(IW),WA(IX2),WA(IX3),WA(IX4))
          ELSE
            CALL RADB5M (INC,LOT,IDO,L1,CH,C
     *                  ,WA(IW),WA(IX2),WA(IX3),WA(IX4))
          ENDIF
        ELSE
  112    IF (NA .EQ. 0) THEN
           CALL RADBGM (INC,LOT,IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
           NA = 1
         ELSE
           CALL RADBGM (INC,LOT,IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
           NA = 0
         ENDIF
         IF (IDO .EQ. 1) NA = 1-NA
       ENDIF
           L1 = L2
           IW = IW+(IP-1)*IDO
  116 CONTINUE
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFFTFM (N,INC,JUMP,LOT, R, WA,IFAC, WSAVE)
      DIMENSION       R(*)       ,WSAVE(*)   ,WA(N)    ,IFAC(*)
?     REAL   CTIME1,CTIME2
?     CALL XCLOCK(CTIME1,5)
C
      IF (N .EQ. 1) RETURN
C
      IF (JUMP .NE. 1) THEN
        CALL RFTF2M (N,INC,JUMP,LOT, R, WA,IFAC, WSAVE)
      ELSE
        CALL RFTF3M (N,INC,     LOT, R, WA,IFAC, WSAVE)
      ENDIF
?     CALL XCLOCK(CTIME2,5)
?     CTIME1=CTIME2-CTIME1
?     CTIME2=1000.0*CTIME1/FLOAT(N*LOT)
?     WRITE(6,500) INC,JUMP,N,LOT, CTIME1,CTIME2
? 500 FORMAT(1H0,' RFFTBM: INC,JUMP,N,LOT =',4I6,'  TOTAL CPU =',F13.6
?    *      ,' (SEC) ;  UNIT CPU =',F13.6,' (MSEC)')
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTF2M (N,INC,JUMP,LOT, R, WA,IFAC, WSAVE)
      DIMENSION       R(*)       ,WSAVE(*)   ,WA(N)    ,IFAC(*)
C
      IF (JUMP .GT. INC) THEN
          INCN = (LOT*JUMP)/N
      ELSE
          INCN = INC
      ENDIF
          IF(MOD(INCN,16) .EQ. 0) INCN = INCN-1
          INCN = MAX(INCN,LOT)
C
            N4 = (N/4)*4
      IF (N4 .GE. 4) THEN
            IABASE = 1
            IBBASE = 1+INC
            ICBASE = 1+INC+INC
            IDBASE = 1+INC+INC+INC
            JABASE = 1
            JBBASE = 1+INCN
            JCBASE = 1+INCN+INCN
            JDBASE = 1+INCN+INCN+INCN
            INQ  = 4*INC
            INQN = 4*INCN
*VOPTION NOFVAL
        DO 102 K=1,N4,4
            IA = IABASE
            IB = IBBASE
            IC = ICBASE
            ID = IDBASE
            JA = JABASE
            JB = JBBASE
            JC = JCBASE
            JD = JDBASE
*VOPTION VEC,NOFVAL
          DO 101 L=1,LOT
            WSAVE(JA) = R(IA)
            WSAVE(JB) = R(IB)
            WSAVE(JC) = R(IC)
            WSAVE(JD) = R(ID)
            IA = IA+JUMP
            IB = IB+JUMP
            IC = IC+JUMP
            ID = ID+JUMP
            JA = JA+1
            JB = JB+1
            JC = JC+1
            JD = JD+1
  101     CONTINUE
            IABASE = IABASE+INQ
            IBBASE = IBBASE+INQ
            ICBASE = ICBASE+INQ
            IDBASE = IDBASE+INQ
            JABASE = JABASE+INQN
            JBBASE = JBBASE+INQN
            JCBASE = JCBASE+INQN
            JDBASE = JDBASE+INQN
  102   CONTINUE
      ENDIF
      IF (N4 .NE. N) THEN
            IABASE = 1+N4*INC
            JABASE = 1+N4*INCN
*VOPTION NOFVAL
        DO 104 K=N4+1,N
            IA = IABASE
            JA = JABASE
*VOPTION VEC,NOFVAL
          DO 103 L=1,LOT
            WSAVE(JA) = R(IA)
            IA = IA+JUMP
            JA = JA+1
  103     CONTINUE
            IABASE = IABASE+INC
            JABASE = JABASE+INCN
  104   CONTINUE
      ENDIF
C
        CALL RFTF1M (N,INCN,LOT, WSAVE, WA,IFAC, R)
C
          CF = 1.0/FLOAT(N)
C
      IF (N4 .GE. 4) THEN
            IABASE = 1
            IBBASE = 1+INC
            ICBASE = 1+INC+INC
            IDBASE = 1+INC+INC+INC
            JABASE = 1
            JBBASE = 1+INCN
            JCBASE = 1+INCN+INCN
            JDBASE = 1+INCN+INCN+INCN
            INQ  = 4*INC
            INQN = 4*INCN
*VOPTION NOFVAL
        DO 112 K=1,N4,4
            IA = IABASE
            IB = IBBASE
            IC = ICBASE
            ID = IDBASE
            JA = JABASE
            JB = JBBASE
            JC = JCBASE
            JD = JDBASE
*VOPTION VEC,NOFVAL
          DO 111 L=1,LOT
            R(IA) = CF*WSAVE(JA)
            R(IB) = CF*WSAVE(JB)
            R(IC) = CF*WSAVE(JC)
            R(ID) = CF*WSAVE(JD)
            IA = IA+JUMP
            IB = IB+JUMP
            IC = IC+JUMP
            ID = ID+JUMP
            JA = JA+1
            JB = JB+1
            JC = JC+1
            JD = JD+1
  111     CONTINUE
            IABASE = IABASE+INQ
            IBBASE = IBBASE+INQ
            ICBASE = ICBASE+INQ
            IDBASE = IDBASE+INQ
            JABASE = JABASE+INQN
            JBBASE = JBBASE+INQN
            JCBASE = JCBASE+INQN
            JDBASE = JDBASE+INQN
  112   CONTINUE
      ENDIF
      IF (N4 .NE. N) THEN
            IABASE = 1+N4*INC
            JABASE = 1+N4*INCN
*VOPTION NOFVAL
        DO 114 K=N4+1,N
            IA = IABASE
            JA = JABASE
*VOPTION VEC,NOFVAL
          DO 113 L=1,LOT
            R(IA) = CF*WSAVE(JA)
            IA = IA+JUMP
            JA = JA+1
  113     CONTINUE
            IABASE = IABASE+INC
            JABASE = JABASE+INCN
  114   CONTINUE
      ENDIF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTF3M (N,INC,LOT, C, WA,IFAC, CH)
      DIMENSION       C(INC,N)   ,CH(INC,N)  ,WA(N)    ,IFAC(*)
        CALL RFTF9M (N,INC,LOT, NA,C, WA, IFAC, CH)
C
           CF = 1.0/FLOAT(N)
           N4=(N/4)*4
      IF (NA .EQ. 1) THEN
        IF (N4 .GE. 4) THEN
          DO 117 K=1,N4,4
          DO 117 L=1,LOT
            C(L,K  ) = CF*C(L,K  )
            C(L,K+1) = CF*C(L,K+1)
            C(L,K+2) = CF*C(L,K+2)
            C(L,K+3) = CF*C(L,K+3)
  117     CONTINUE
        ENDIF
        IF (N4 .NE. N) THEN
          DO 118 K=N4+1,N
          DO 118 L=1,LOT
            C(L,K) = CF*C(L,K)
  118     CONTINUE
        ENDIF
      ELSE
        IF (N4 .GE. 4) THEN
          DO 119 K=1,N4,4
          DO 119 L=1,LOT
            C(L,K  ) = CF*CH(L,K  )
            C(L,K+1) = CF*CH(L,K+1)
            C(L,K+2) = CF*CH(L,K+2)
            C(L,K+3) = CF*CH(L,K+3)
  119     CONTINUE
        ENDIF
        IF (N4 .NE. N) THEN
          DO 120 K=N4+1,N
          DO 120 L=1,LOT
            C(L,K) = CF*CH(L,K)
  120     CONTINUE
        ENDIF
      ENDIF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTF1M (N,INC,LOT, C, WA,IFAC, CH)
      DIMENSION       C(INC,N)   ,CH(INC,N)  ,WA(N)    ,IFAC(*)
        CALL RFTF9M (N,INC,LOT, NA,C, WA, IFAC, CH)
      IF (NA .EQ. 1) RETURN
           N4=(N/4)*4
        IF (N4 .GE. 4) THEN
          DO 117 K=1,N4,4
          DO 117 L=1,LOT
            C(L,K  ) = CH(L,K  )
            C(L,K+1) = CH(L,K+1)
            C(L,K+2) = CH(L,K+2)
            C(L,K+3) = CH(L,K+3)
  117     CONTINUE
        ENDIF
        IF (N4 .NE. N) THEN
          DO 118 K=N4+1,N
          DO 118 L=1,LOT
            C(L,K) = CH(L,K)
  118     CONTINUE
        ENDIF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RFTF9M (N,INC,LOT, NA,C, WA,IFAC, CH)
      DIMENSION       C(INC,N)   ,CH(INC,N)  ,WA(N)    ,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 .EQ. 4) THEN
           IX2 = IW +IDO
           IX3 = IX2+IDO
         IF (NA .EQ. 0) THEN
           CALL RADF4M (INC,LOT,IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         ELSE
           CALL RADF4M (INC,LOT,IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
         ENDIF
       ELSE IF (IP .EQ. 2) THEN
         IF (NA .EQ. 0) THEN
           CALL RADF2M (INC,LOT,IDO,L1,C,CH,WA(IW))
         ELSE
           CALL RADF2M (INC,LOT,IDO,L1,CH,C,WA(IW))
         ENDIF
       ELSE IF (IP .EQ. 3) THEN
           IX2 = IW +IDO
         IF (NA .EQ. 0) THEN
           CALL RADF3M (INC,LOT,IDO,L1,C,CH,WA(IW),WA(IX2))
         ELSE
           CALL RADF3M (INC,LOT,IDO,L1,CH,C,WA(IW),WA(IX2))
         ENDIF
       ELSE IF (IP .EQ. 5) THEN
           IX2 = IW +IDO
           IX3 = IX2+IDO
           IX4 = IX3+IDO
         IF (NA .EQ. 0) THEN
           CALL RADF5M (INC,LOT,IDO,L1,C,CH
     *                 ,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         ELSE
           CALL RADF5M (INC,LOT,IDO,L1,CH,C
     *                 ,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         ENDIF
       ELSE
         IF (IDO .EQ. 1) NA = 1-NA
         IF (NA .EQ. 0) THEN
           CALL RADFGM (INC,LOT,IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
           NA = 1
         ELSE
           CALL RADFGM (INC,LOT,IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
           NA = 0
         ENDIF
       ENDIF
           L2 = L1
  111 CONTINUE
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADB2M (INC,LOT,IDO,L1,CC,CH,WA1)
      DIMENSION       CC(INC,IDO,2,L1)  ,CH(INC,IDO,L1,2)  ,WA1(*)
C
      DO 101 K=1,L1
        DO 101 L=1,LOT
          CH(L,1,K,1) = CC(L,1,1,K)+CC(L,IDO,2,K)
          CH(L,1,K,2) = CC(L,1,1,K)-CC(L,IDO,2,K)
  101   CONTINUE
      IF (MOD(IDO,2) .EQ. 0) THEN
        DO 102 K=1,L1
          DO 102 L=1,LOT
            CH(L,IDO,K,1) =   CC(L,IDO,1,K)+CC(L,IDO,1,K)
            CH(L,IDO,K,2) = -(CC(L,  1,2,K)+CC(L,  1,2,K))
  102     CONTINUE
      END IF
      IF (IDO .GT. 2) THEN
          IDP2 = IDO+2
        DO 104 K=1,L1
*VOPTION NOFVAL
        DO 104 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 103 L=1,LOT
            CH(L,I-1,K,1) = CC(L,I-1,1,K)+CC(L,IC-1,2,K)
            CH(L,I  ,K,1) = CC(L,I  ,1,K)-CC(L,IC  ,2,K)
            TR2           = CC(L,I-1,1,K)-CC(L,IC-1,2,K)
            TI2           = CC(L,I  ,1,K)+CC(L,IC  ,2,K)
            CH(L,I-1,K,2) = WA1(I-2)*TR2 -WA1(I-1)*TI2
            CH(L,I  ,K,2) = WA1(I-2)*TI2 +WA1(I-1)*TR2
  103     CONTINUE
  104   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADB3M (INC,LOT,IDO,L1,CC,CH,WA1,WA2)
      DIMENSION  CC(INC,IDO,3,L1)  ,CH(INC,IDO,L1,3)  ,WA1(*)  ,WA2(*)
      DATA TAUR,TAUI / -.5,.866025403784439D0  /
C
      DO 101 K=1,L1
*VOPTION NOFVAL
        DO 101 L=1,LOT
          TR2         = CC(L,IDO,2,K)+CC(L,IDO,2,K)
          CR2         = CC(L,  1,1,K)+TAUR*TR2
          CI3         = TAUI*(CC(L,1,3,K)+CC(L,1,3,K))
          CH(L,1,K,1) = CC(L,  1,1,K)+TR2
          CH(L,1,K,2) = CR2-CI3
          CH(L,1,K,3) = CR2+CI3
  101   CONTINUE
      IF (IDO .GT. 1) THEN
          IDP2 = IDO+2
        DO 103 K=1,L1
*VOPTION NOFVAL
        DO 103 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 102 L=1,LOT
            TR2           = CC(L,I-1,3,K)+CC(L,IC-1,2,K)
            TI2           = CC(L,I  ,3,K)-CC(L,IC  ,2,K)
            CR2           = CC(L,I-1,1,K)+TAUR*TR2
            CI2           = CC(L,I  ,1,K)+TAUR*TI2
            CR3           = TAUI*(CC(L,I-1,3,K)-CC(L,IC-1,2,K))
            CI3           = TAUI*(CC(L,I  ,3,K)+CC(L,IC  ,2,K))
            CH(L,I-1,K,1) = CC(L,I-1,1,K)+TR2
            CH(L,I  ,K,1) = CC(L,I  ,1,K)+TI2
            DR2           = CR2-CI3
            DI2           = CI2+CR3
            DR3           = CR2+CI3
            DI3           = CI2-CR3
            CH(L,I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
            CH(L,I  ,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
            CH(L,I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
            CH(L,I  ,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
  102     CONTINUE
  103   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADB4M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3)
      DIMENSION       CC(INC,IDO,4,L1)       ,CH(INC,IDO,L1,4)
     1               ,WA1(*)     ,WA2(*)     ,WA3(*)
      DATA SQRT2 / 1.414213562373095  /
C
      DO 101 K=1,L1
*VOPTION NOFVAL
        DO 101 L=1,LOT
          TR1         = CC(L,  1,1,K)-CC(L,IDO,4,K)
          TR2         = CC(L,  1,1,K)+CC(L,IDO,4,K)
          TR3         = CC(L,IDO,2,K)+CC(L,IDO,2,K)
          TR4         = CC(L,  1,3,K)+CC(L,  1,3,K)
          CH(L,1,K,1) = TR2+TR3
          CH(L,1,K,2) = TR1-TR4
          CH(L,1,K,3) = TR2-TR3
          CH(L,1,K,4) = TR1+TR4
  101   CONTINUE
      IF (MOD(IDO,2) .EQ. 0) THEN
        DO 102 K=1,L1
*VOPTION NOFVAL
          DO 102 L=1,LOT
            TR1           = CC(L,IDO,1,K)-CC(L,IDO,3,K)
            TI1           = CC(L,  1,2,K)+CC(L,  1,4,K)
            TR2           = CC(L,IDO,1,K)+CC(L,IDO,3,K)
            TI2           = CC(L,  1,4,K)-CC(L,  1,2,K)
            CH(L,IDO,K,1) =         TR2+TR2
            CH(L,IDO,K,2) =  SQRT2*(TR1-TI1)
            CH(L,IDO,K,3) =         TI2+TI2
            CH(L,IDO,K,4) = -SQRT2*(TR1+TI1)
  102     CONTINUE
      END IF
      IF (IDO .GT. 2) THEN
          IDP2 = IDO+2
        DO 104 K=1,L1
*VOPTION NOFVAL
        DO 104 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 103 L=1,LOT
            TR1           = CC(L,I-1,1,K)-CC(L,IC-1,4,K)
            TI1           = CC(L,I  ,1,K)+CC(L,IC  ,4,K)
            TR2           = CC(L,I-1,1,K)+CC(L,IC-1,4,K)
            TI2           = CC(L,I  ,1,K)-CC(L,IC  ,4,K)
            TR3           = CC(L,I-1,3,K)+CC(L,IC-1,2,K)
            TI3           = CC(L,I  ,3,K)-CC(L,IC  ,2,K)
            TI4           = CC(L,I-1,3,K)-CC(L,IC-1,2,K)
            TR4           = CC(L,I  ,3,K)+CC(L,IC  ,2,K)
            CH(L,I-1,K,1) = TR2+TR3
            CH(L,I  ,K,1) = TI2+TI3
            CR3           = TR2-TR3
            CI3           = TI2-TI3
            CR2           = TR1-TR4
            CI2           = TI1+TI4
            CR4           = TR1+TR4
            CI4           = TI1-TI4
            CH(L,I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
            CH(L,I  ,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
            CH(L,I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
            CH(L,I  ,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
            CH(L,I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
            CH(L,I  ,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
  103     CONTINUE
  104   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADB5M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
      DIMENSION       CC(INC,IDO,5,L1)       ,CH(INC,IDO,L1,5)
     1               ,WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
      DATA TR11,TI11,TR12,TI12 /.309016994374947D0,.951056516295154D0,
     1                         -.809016994374947D0,.587785252292473D0/
      DO 101 K=1,L1
*VOPTION NOFVAL
        DO 101 L=1,LOT
          TR2         = CC(L,IDO,2,K)+CC(L,IDO,2,K)
          TR3         = CC(L,IDO,4,K)+CC(L,IDO,4,K)
          TI5         = CC(L,  1,3,K)+CC(L,  1,3,K)
          TI4         = CC(L,  1,5,K)+CC(L,  1,5,K)
          CR2         = CC(L,  1,1,K)+TR11*TR2+TR12*TR3
          CI5         =               TI11*TI5+TI12*TI4
          CR3         = CC(L,  1,1,K)+TR12*TR2+TR11*TR3
          CI4         =               TI12*TI5-TI11*TI4
          CH(L,1,K,1) = CC(L,  1,1,K)+TR2+TR3
          CH(L,1,K,2) = CR2-CI5
          CH(L,1,K,3) = CR3-CI4
          CH(L,1,K,4) = CR3+CI4
          CH(L,1,K,5) = CR2+CI5
  101   CONTINUE
      IF (IDO .GT. 1) THEN
          IDP2 = IDO+2
        DO 103 K=1,L1
*VOPTION NOFVAL
        DO 103 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 102 L=1,LOT
            TR2           = CC(L,I-1,3,K)+CC(L,IC-1,2,K)
            TI2           = CC(L,I  ,3,K)-CC(L,IC  ,2,K)
            TR3           = CC(L,I-1,5,K)+CC(L,IC-1,4,K)
            TI3           = CC(L,I  ,5,K)-CC(L,IC  ,4,K)
            TR4           = CC(L,I-1,5,K)-CC(L,IC-1,4,K)
            TI4           = CC(L,I  ,5,K)+CC(L,IC  ,4,K)
            TR5           = CC(L,I-1,3,K)-CC(L,IC-1,2,K)
            TI5           = CC(L,I  ,3,K)+CC(L,IC  ,2,K)
            CR2           = CC(L,I-1,1,K)+TR11*TR2+TR12*TR3
            CI2           = CC(L,I  ,1,K)+TR11*TI2+TR12*TI3
            CR4           =               TI12*TR5-TI11*TR4
            CI4           =               TI12*TI5-TI11*TI4
            CR3           = CC(L,I-1,1,K)+TR12*TR2+TR11*TR3
            CI3           = CC(L,I  ,1,K)+TR12*TI2+TR11*TI3
            CR5           =               TI11*TR5+TI12*TR4
            CI5           =               TI11*TI5+TI12*TI4
            CH(L,I-1,K,1) = CC(L,I-1,1,K)+     TR2+     TR3
            CH(L,I  ,K,1) = CC(L,I  ,1,K)+     TI2+     TI3
            DR2           = CR2-CI5
            DI2           = CI2+CR5
            DR3           = CR3-CI4
            DI3           = CI3+CR4
            DR4           = CR3+CI4
            DI4           = CI3-CR4
            DR5           = CR2+CI5
            DI5           = CI2-CR5
            CH(L,I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
            CH(L,I  ,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
            CH(L,I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
            CH(L,I  ,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
            CH(L,I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
            CH(L,I  ,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
            CH(L,I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
            CH(L,I  ,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
  102     CONTINUE
  103   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADF2M (INC,LOT,IDO,L1,CC,CH,WA1)
      DIMENSION       CH(INC,IDO,2,L1)  ,CC(INC,IDO,L1,2)  ,WA1(*)
      DO 101 K=1,L1
        DO 101 L=1,LOT
          CH(L,  1,1,K) = CC(L,1,K,1)+CC(L,1,K,2)
          CH(L,IDO,2,K) = CC(L,1,K,1)-CC(L,1,K,2)
  101   CONTINUE
      IF (MOD(IDO,2) .EQ. 0) THEN
        DO 102 K=1,L1
          DO 102 L=1,LOT
            CH(L,  1,2,K) = -CC(L,IDO,K,2)
            CH(L,IDO,1,K) =  CC(L,IDO,K,1)
  102     CONTINUE
      END IF
      IF (IDO .GT. 2) THEN
          IDP2 = IDO+2
        DO 104 K=1,L1
*VOPTION NOFVAL
        DO 104 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 103 L=1,LOT
            TR2 = WA1(I-2)*CC(L,I-1,K,2)+WA1(I-1)*CC(L,I  ,K,2)
            TI2 = WA1(I-2)*CC(L,I  ,K,2)-WA1(I-1)*CC(L,I-1,K,2)
            CH(L,I -1,1,K) = CC(L,I-1,K,1)+TR2
            CH(L,I   ,1,K) = TI2          +CC(L,I,K,1)
            CH(L,IC-1,2,K) = CC(L,I-1,K,1)-TR2
            CH(L,IC  ,2,K) = TI2          -CC(L,I,K,1)
  103     CONTINUE
  104   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADF3M (INC,LOT,IDO,L1,CC,CH,WA1,WA2)
      DIMENSION  CH(INC,IDO,3,L1)  ,CC(INC,IDO,L1,3)  ,WA1(*)  ,WA2(*)
      DATA TAUR,TAUI /-.5,.866025403784439D0  /
      DO 101 K=1,L1
*VOPTION NOFVAL
        DO 101 L=1,LOT
          CR2           =       CC(L,1,K,2)+CC(L,1,K,3)
          CH(L,  1,1,K) =       CC(L,1,K,1)+     CR2
          CH(L,  1,3,K) = TAUI*(CC(L,1,K,3)-CC(L,1,K,2))
          CH(L,IDO,2,K) =       CC(L,1,K,1)+TAUR*CR2
  101   CONTINUE
      IF (IDO .GT. 1) THEN
          IDP2 = IDO+2
        DO 103 K=1,L1
*VOPTION NOFVAL
        DO 103 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 102 L=1,LOT
            DR2 = WA1(I-2)*CC(L,I-1,K,2)+WA1(I-1)*CC(L,I  ,K,2)
            DI2 = WA1(I-2)*CC(L,I  ,K,2)-WA1(I-1)*CC(L,I-1,K,2)
            DR3 = WA2(I-2)*CC(L,I-1,K,3)+WA2(I-1)*CC(L,I  ,K,3)
            DI3 = WA2(I-2)*CC(L,I  ,K,3)-WA2(I-1)*CC(L,I-1,K,3)
            CR2            = DR2+DR3
            CI2            = DI2+DI3
            TR2            = CC(L,I-1,K,1)+TAUR*CR2
            TI2            = CC(L,I  ,K,1)+TAUR*CI2
            TR3            = TAUI*(DI2-DI3)
            TI3            = TAUI*(DR3-DR2)
            CH(L,I -1,1,K) = CC(L,I-1,K,1)+     CR2
            CH(L,I   ,1,K) = CC(L,I  ,K,1)+     CI2
            CH(L,IC-1,2,K) = TR2-TR3
            CH(L,IC  ,2,K) = TI3-TI2
            CH(L,I -1,3,K) = TR2+TR3
            CH(L,I   ,3,K) = TI2+TI3
  102     CONTINUE
  103   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADF4M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3)
      DIMENSION       CC(INC,IDO,L1,4)       ,CH(INC,IDO,4,L1)
     1               ,WA1(*)     ,WA2(*)     ,WA3(*)
      DATA HSQT2 /.7071067811865475D0  /
      DO 101 K=1,L1
*VOPTION NOFVAL
        DO 101 L=1,LOT
          TR1           = CC(L,1,K,2)+CC(L,1,K,4)
          TR2           = CC(L,1,K,1)+CC(L,1,K,3)
          CH(L,  1,3,K) = CC(L,1,K,4)-CC(L,1,K,2)
          CH(L,  1,1,K) = TR1+TR2
          CH(L,IDO,2,K) = CC(L,1,K,1)-CC(L,1,K,3)
          CH(L,IDO,4,K) = TR2-TR1
  101   CONTINUE
      IF (MOD(IDO,2) .EQ. 0) THEN
        DO 102 K=1,L1
*VOPTION NOFVAL
          DO 102 L=1,LOT
            TR1           =  HSQT2*(CC(L,IDO,K,2)-CC(L,IDO,K,4))
            TI1           = -HSQT2*(CC(L,IDO,K,2)+CC(L,IDO,K,4))
            CH(L,IDO,1,K) = CC(L,IDO,K,1)+TR1
            CH(L,  1,2,K) = TI1          -CC(L,IDO,K,3)
            CH(L,IDO,3,K) = CC(L,IDO,K,1)-TR1
            CH(L,  1,4,K) = TI1          +CC(L,IDO,K,3)
  102     CONTINUE
      END IF
      IF (IDO .GT. 2) THEN
          IDP2 = IDO+2
        DO 104 K=1,L1
*VOPTION NOFVAL
        DO 104 I=3,IDO,2
             IC = IDP2-I
*VOPTION NOFVAL
          DO 103 L=1,LOT
            CR2 = WA1(I-2)*CC(L,I-1,K,2)+WA1(I-1)*CC(L,I  ,K,2)
            CI2 = WA1(I-2)*CC(L,I  ,K,2)-WA1(I-1)*CC(L,I-1,K,2)
            CR3 = WA2(I-2)*CC(L,I-1,K,3)+WA2(I-1)*CC(L,I  ,K,3)
            CI3 = WA2(I-2)*CC(L,I  ,K,3)-WA2(I-1)*CC(L,I-1,K,3)
            CR4 = WA3(I-2)*CC(L,I-1,K,4)+WA3(I-1)*CC(L,I  ,K,4)
            CI4 = WA3(I-2)*CC(L,I  ,K,4)-WA3(I-1)*CC(L,I-1,K,4)
            TR2            = CC(L,I-1,K,1)+CR3
            TI2            = CC(L,I  ,K,1)+CI3
            TR1            = CR2+CR4
            TI1            = CI2+CI4
            TR3            = CC(L,I-1,K,1)-CR3
            TI3            = CC(L,I  ,K,1)-CI3
            TR4            = CR4-CR2
            TI4            = CI2-CI4
            CH(L,I -1,1,K) = TR1+TR2
            CH(L,I   ,1,K) = TI1+TI2
            CH(L,IC-1,2,K) = TR3-TI4
            CH(L,IC  ,2,K) = TR4-TI3
            CH(L,I -1,3,K) = TI4+TR3
            CH(L,I   ,3,K) = TR4+TI3
            CH(L,IC-1,4,K) = TR2-TR1
            CH(L,IC  ,4,K) = TI1-TI2
  103     CONTINUE
  104   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADF5M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
      DIMENSION       CC(INC,IDO,L1,5)       ,CH(INC,IDO,5,L1)
     1               ,WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
      DATA TR11,TI11,TR12,TI12 /.309016994374947D0,.951056516295154D0,
     1                         -.809016994374947D0,.587785252292473D0/
      DO 101 K=1,L1
*VOPTION NOFVAL
        DO 101 L=1,LOT
          CR2           = CC(L,1,K,5)+CC(L,1,K,2)
          CR3           = CC(L,1,K,4)+CC(L,1,K,3)
          CI5           = CC(L,1,K,5)-CC(L,1,K,2)
          CI4           = CC(L,1,K,4)-CC(L,1,K,3)
          CH(L,  1,1,K) = CC(L,1,K,1)+     CR2+     CR3
          CH(L,  1,3,K) =             TI11*CI5+TI12*CI4
          CH(L,IDO,2,K) = CC(L,1,K,1)+TR11*CR2+TR12*CR3
          CH(L,  1,5,K) =             TI12*CI5-TI11*CI4
          CH(L,IDO,4,K) = CC(L,1,K,1)+TR12*CR2+TR11*CR3
  101   CONTINUE
      IF (IDO .GT. 1) THEN
          IDP2 = IDO+2
        DO 103 K=1,L1
*VOPTION NOFVAL
        DO 103 I=3,IDO,2
            IC = IDP2-I
*VOPTION NOFVAL
          DO 102 L=1,LOT
            CA2            = WA1(I-2)*CC(L,I-1,K,2)
            CU2            = WA1(I-2)*CC(L,I  ,K,2)
            CA3            = WA2(I-2)*CC(L,I-1,K,3)
            CU3            = WA2(I-2)*CC(L,I  ,K,3)
            CA4            = WA3(I-2)*CC(L,I-1,K,4)
            CU4            = WA3(I-2)*CC(L,I  ,K,4)
            CA5            = WA4(I-2)*CC(L,I-1,K,5)
            CU5            = WA4(I-2)*CC(L,I  ,K,5)
            CB2            = WA1(I-1)*CC(L,I-1,K,2)
            CV2            = WA1(I-1)*CC(L,I  ,K,2)
            CB3            = WA2(I-1)*CC(L,I-1,K,3)
            CV3            = WA2(I-1)*CC(L,I  ,K,3)
            CB4            = WA3(I-1)*CC(L,I-1,K,4)
            CV4            = WA3(I-1)*CC(L,I  ,K,4)
            CB5            = WA4(I-1)*CC(L,I-1,K,5)
            CV5            = WA4(I-1)*CC(L,I  ,K,5)
            CH(L,IC-1,2,K) = CA2+CV2
            CH(L,IC  ,2,K) = CU2-CB2
            CH(L,I -1,3,K) = CA3+CV3
            CH(L,I   ,3,K) = CU3-CB3
            CH(L,IC-1,4,K) = CA4+CV4
            CH(L,IC  ,4,K) = CU4-CB4
            CH(L,I -1,5,K) = CA5+CV5
            CH(L,I   ,5,K) = CU5-CB5
  102     CONTINUE
  103   CONTINUE
        DO 105 K=1,L1
*VOPTION NOFVAL
        DO 105 I=3,IDO,2
             IC = IDP2-I
          DO 104 L=1,LOT
            CC(L,I-1,K,2) = CH(L,IC-1,2,K)+CH(L,I -1,5,K)
            CC(L,I  ,K,2) = CH(L,IC  ,2,K)+CH(L,I   ,5,K)
            CC(L,I-1,K,3) = CH(L,I -1,3,K)+CH(L,IC-1,4,K)
            CC(L,I  ,K,3) = CH(L,I   ,3,K)+CH(L,IC  ,4,K)
            CC(L,I-1,K,4) = CH(L,I   ,3,K)-CH(L,IC  ,4,K)
            CC(L,I  ,K,4) = CH(L,IC-1,4,K)-CH(L,I -1,3,K)
            CC(L,I-1,K,5) = CH(L,IC  ,2,K)-CH(L,I   ,5,K)
            CC(L,I  ,K,5) = CH(L,I -1,5,K)-CH(L,IC-1,2,K)
  104     CONTINUE
  105   CONTINUE
        DO 107 K=1,L1
        DO 107 I=3,IDO,2
             IC = IDP2-I
*VOPTION NOFVAL
          DO 106 L=1,LOT
            CTR2           = TR11*CC(L,I-1,K,2)+TR12*CC(L,I-1,K,3)
            CTI2           = TR11*CC(L,I  ,K,2)+TR12*CC(L,I  ,K,3)
            CTR3           = TR12*CC(L,I-1,K,2)+TR11*CC(L,I-1,K,3)
            CTI3           = TR12*CC(L,I  ,K,2)+TR11*CC(L,I  ,K,3)
            TR2            = CTR2+CC(L,I-1,K,1)
            TI2            = CTI2+CC(L,I  ,K,1)
            TR3            = CTR3+CC(L,I-1,K,1)
            TI3            = CTI3+CC(L,I  ,K,1)
            TR4            = TI12*CC(L,I-1,K,5)-TI11*CC(L,I-1,K,4)
            TI4            = TI12*CC(L,I  ,K,5)-TI11*CC(L,I  ,K,4)
            SR23           = CC(L,I-1,K,2)+CC(L,I-1,K,3)
            SI23           = CC(L,I  ,K,2)+CC(L,I  ,K,3)
            TR5            = TI11*CC(L,I-1,K,5)+TI12*CC(L,I-1,K,4)
            TI5            = TI11*CC(L,I  ,K,5)+TI12*CC(L,I  ,K,4)
            CH(L,I -1,1,K) = CC(L,I-1,K,1)+SR23
            CH(L,I   ,1,K) = CC(L,I  ,K,1)+SI23
            CH(L,IC-1,2,K) = TR2-TR5
            CH(L,IC  ,2,K) = TI5-TI2
            CH(L,I -1,3,K) = TR2+TR5
            CH(L,I   ,3,K) = TI2+TI5
            CH(L,IC-1,4,K) = TR3-TR4
            CH(L,IC  ,4,K) = TI4-TI3
            CH(L,I -1,5,K) = TR3+TR4
            CH(L,I   ,5,K) = TI3+TI4
  106     CONTINUE
  107   CONTINUE
      END IF
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADBGM (INC,LOT,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
      DIMENSION       CH(INC,IDO,L1,IP)      ,CC(INC,IDO,IP,L1)
     1               ,C1(INC,IDO,L1,IP)      ,C2(INC,IDL1,IP)
     2               ,CH2(INC,IDL1, IP)      ,WA(*)
      REAL   ARG,DCP,DSP,AR1,AI1,AR1H,DC2,DS2,AR2,AI2,AR2H,TPI
      DATA TPI /6.28318530717959DO  /
C
      ARG = TPI/IP
      DCP = COS(ARG)
      DSP = SIN(ARG)
      IDP2 = IDO+2
      IPP2 = IP+2
      IPPH = (IP+1)/2
C     IPPHC = IPP2-IPPH
C     IPPH2 = 2*IPPH
C
      DO 102 K=1,L1
      DO 102 I=1,IDO
            DO 101 L=1,LOT
  101         CH(L,I,K,1) = CC(L,I,1,K)
  102 CONTINUE
*VOPTION NOFVAL
      DO 113 J=2,IPPH
              JC = IPP2-J
              J2 = J+J
      DO 113 K=1,L1
            DO 112 L=1,LOT
              CH(L,1,K,J ) = CC(L,IDO,J2-2,K)+CC(L,IDO,J2-2,K)
              CH(L,1,K,JC) = CC(L,  1,J2-1,K)+CC(L,  1,J2-1,K)
  112       CONTINUE
  113 CONTINUE
      IF (IDO .NE. 1) THEN
*VOPTION NOFVAL
        DO 121 J=2,IPPH
            JC = IPP2-J
          DO 120 K=1,L1
*VOPTION NOFVAL
            DO 119 I=3,IDO,2
                IC = IDP2-I
              DO 118 L=1,LOT
                CH(L,I-1,K,J ) = CC(L,I-1,2*J-1,K)+CC(L,IC-1,2*J-2,K)
                CH(L,I  ,K,J ) = CC(L,I  ,2*J-1,K)-CC(L,IC  ,2*J-2,K)
                CH(L,I-1,K,JC) = CC(L,I-1,2*J-1,K)-CC(L,IC-1,2*J-2,K)
                CH(L,I  ,K,JC) = CC(L,I  ,2*J-1,K)+CC(L,IC  ,2*J-2,K)
  118         CONTINUE
  119       CONTINUE
  120     CONTINUE
  121   CONTINUE
      ENDIF
            AR1 = 1.D0
            AI1 = 0.D0
*VOPTION NOFVAL
      DO 126 M=2,IPPH
            MC = IPP2-M
            AR1H = DCP*AR1-DSP*AI1
            AI1  = DCP*AI1+DSP*AR1
            AR1  = AR1H
        DO 123 IK=1,IDL1
          DO 123 L=1,LOT
            C2(L,IK,M ) = CH2(L,IK,1)+AR1*CH2(L,IK, 2)
            C2(L,IK,MC) =             AI1*CH2(L,IK,IP)
  123     CONTINUE
            DC2 = AR1
            DS2 = AI1
            AR2 = AR1
            AI2 = AI1
*VOPTION NOFVAL
        DO 125 J=3,IPPH
              JC = IPP2-J
              AR2H = DC2*AR2-DS2*AI2
              AI2  = DC2*AI2+DS2*AR2
              AR2  = AR2H
          DO 124 IK=1,IDL1
            DO 124 L=1,LOT
              C2(L,IK,M ) = C2(L,IK,M )+AR2*CH2(L,IK,J )
              C2(L,IK,MC) = C2(L,IK,MC)+AI2*CH2(L,IK,JC)
  124       CONTINUE
  125   CONTINUE
  126 CONTINUE
      DO 129 J=2,IPPH
      DO 129 IK=1,IDL1
          DO 128 L=1,LOT
  128       CH2(L,IK,1) = CH2(L,IK,1)+CH2(L,IK,J)
  129 CONTINUE
*VOPTION NOFVAL
      DO 141 J=2,IPPH
              JC = IPP2-J
      DO 141 K=1,L1
            DO 140 L=1,LOT
              CH(L,1,K,J ) = C1(L,1,K,J)-C1(L,1,K,JC)
              CH(L,1,K,JC) = C1(L,1,K,J)+C1(L,1,K,JC)
  140       CONTINUE
  141 CONTINUE
      IF (IDO .EQ. 1) RETURN
*VOPTION NOFVAL
      DO 150 J=2,IPPH
            JC = IPP2-J
        DO 149 K=1,L1
        DO 149 I=3,IDO,2
            DO 148 L=1,LOT
              CH(L,I-1,K,J ) = C1(L,I-1,K,J)-C1(L,I  ,K,JC)
              CH(L,I  ,K,J ) = C1(L,I  ,K,J)+C1(L,I-1,K,JC)
              CH(L,I-1,K,JC) = C1(L,I-1,K,J)+C1(L,I  ,K,JC)
              CH(L,I  ,K,JC) = C1(L,I  ,K,J)-C1(L,I-1,K,JC)
  148       CONTINUE
  149   CONTINUE
  150 CONTINUE
      DO 152 IK=1,IDL1
        DO 152 L=1,LOT
  152      C2(L,IK,1) = CH2(L,IK,1)
      DO 155 J=2,IP
        DO 155 K=1,L1
          DO 154 L=1,LOT
  154         C1(L,1,K,J) = CH(L,1,K,J)
  155     CONTINUE
          IS = -IDO
*VOPTION NOFVAL
      DO 169 J=2,IP
            IS = IS+IDO
        DO 168 K=1,L1
*VOPTION NOFVAL
          DO 167 I=3,IDO,2
              IDIJ = IS+I-1
            DO 166 L=1,LOT
              C1(L,I-1,K,J) =
     *               WA(IDIJ-1)*CH(L,I-1,K,J)-WA(IDIJ)*CH(L,I  ,K,J)
              C1(L,I  ,K,J) =
     *               WA(IDIJ-1)*CH(L,I  ,K,J)+WA(IDIJ)*CH(L,I-1,K,J)
  166       CONTINUE
  167     CONTINUE
  168   CONTINUE
  169 CONTINUE
      RETURN
      END
C***********************************************************************
      SUBROUTINE RADFGM (INC,LOT,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
      DIMENSION       CH(INC,IDO,L1,IP)        ,CC(INC,IDO,IP,L1)
     1               ,C1(INC,IDO,L1,IP)        ,C2(INC,IDL1,IP)
     2               ,CH2(INC,IDL1,IP)         ,WA(*)
      REAL   ARG,DCP,DSP,AR1,AI1,AR1H,DC2,DS2,AR2,AI2,AR2H,TPI
      DATA TPI /6.28318530717959D0  /
C
      ARG = TPI/IP
      DCP = COS(ARG)
      DSP = SIN(ARG)
      IPPH = (IP+1)/2
      IPP2 = IP+2
C     IPPHC = IPP2-IPPH
C     IPPH2= 2*IPPH
      IDP2 = IDO+2
C
      IF (IDO .EQ. 1) GO TO 1000
      DO 101 IK=1,IDL1
          DO 101 L=1,LOT
  101         CH2(L,IK,1) = C2(L,IK,1)
      DO 104 J=2,IP
      DO 104 K=1,L1
          DO 103 L=1,LOT
  103         CH(L,1,K,J) = C1(L,1,K,J)
  104 CONTINUE
          IS = -IDO
*VOPTION NOFVAL
      DO 116 J=2,IP
            IS = IS+IDO
        DO 115 K=1,L1
*VOPTION NOFVAL
          DO 114 I=3,IDO,2
              IDIJ = IS+I-1
            DO 113 L=1,LOT
              CH(L,I-1,K,J) =
     *                WA(IDIJ-1)*C1(L,I-1,K,J)+WA(IDIJ)*C1(L,I  ,K,J)
              CH(L,I  ,K,J) =
     *                WA(IDIJ-1)*C1(L,I  ,K,J)-WA(IDIJ)*C1(L,I-1,K,J)
  113       CONTINUE
  114     CONTINUE
  115   CONTINUE
  116 CONTINUE
*VOPTION NOFVAL
      DO 120 J=2,IPPH
            JC = IPP2-J
        DO 119 K=1,L1
        DO 119 I=3,IDO,2
            DO 118 L=1,LOT
              C1(L,I-1,K,J ) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
              C1(L,I  ,K,J ) = CH(L,I  ,K,J )+CH(L,I  ,K,JC)
              C1(L,I-1,K,JC) = CH(L,I  ,K,J )-CH(L,I  ,K,JC)
              C1(L,I  ,K,JC) = CH(L,I-1,K,JC)-CH(L,I-1,K,J )
  118       CONTINUE
  119   CONTINUE
  120 CONTINUE
      GO TO 2000
C
 1000 CONTINUE
      DO 122 IK=1,IDL1
        DO 122 L=1,LOT
  122    C2(L,IK,1) = CH2(L,IK,1)
C
 2000 CONTINUE
*VOPTION NOFVAL
      DO 125 J=2,IPPH
              JC = IPP2-J
        DO 124 K=1,L1
            DO 124 L=1,LOT
              C1(L,1,K,J ) = CH(L,1,K,J )+CH(L,1,K,JC)
              C1(L,1,K,JC) = CH(L,1,K,JC)-CH(L,1,K,J )
  124       CONTINUE
  125 CONTINUE
        AR1 = 1.D0
        AI1 = 0.D0  
*VOPTION NOFVAL
      DO 134 M=2,IPPH
            MC = IPP2-M
            AR1H = DCP*AR1-DSP*AI1
            AI1  = DCP*AI1+DSP*AR1
            AR1  = AR1H
        DO 131 IK=1,IDL1
          DO 131 L=1,LOT
            CH2(L,IK,M ) = C2(L,IK,1)+AR1*C2(L,IK, 2)
            CH2(L,IK,MC) =            AI1*C2(L,IK,IP)
  131     CONTINUE
            DC2 = AR1
            DS2 = AI1
            AR2 = AR1
            AI2 = AI1
*VOPTION NOFVAL
        DO 133 J=3,IPPH
              JC = IPP2-J
              AR2H = DC2*AR2-DS2*AI2
              AI2  = DC2*AI2+DS2*AR2
              AR2  = AR2H
          DO 132 IK=1,IDL1
            DO 132 L=1,LOT
              CH2(L,IK,M ) = CH2(L,IK,M )+AR2*C2(L,IK,J )
              CH2(L,IK,MC) = CH2(L,IK,MC)+AI2*C2(L,IK,JC)
  132       CONTINUE
  133   CONTINUE
  134 CONTINUE
      DO 137 J=2,IPPH
        DO 137 IK=1,IDL1
            DO 136 L=1,LOT
  136         CH2(L,IK,1) = CH2(L,IK,1)+C2(L,IK,J)
  137     CONTINUE
      DO 148 K=1,L1
        DO 148 I=1,IDO
          DO 147 L=1,LOT
  147        CC(L,I,1,K) = CH(L,I,K,1)
  148 CONTINUE
*VOPTION NOFVAL
      DO 159 J=2,IPPH
              JC = IPP2-J
              J2 = J+J
        DO 158 K=1,L1
            DO 158 L=1,LOT
              CC(L,IDO,J2-2,K) = CH(L,1,K,J )
              CC(L,  1,J2-1,K) = CH(L,1,K,JC)
  158       CONTINUE
  159 CONTINUE
      IF (IDO .EQ. 1) RETURN
*VOPTION NOFVAL
      DO 167 J=2,IPPH
            JC = IPP2-J
            J2 = J+J
        DO 166 K=1,L1
*VOPTION NOFVAL
          DO 165 I=3,IDO,2
              IC = IDP2-I
            DO 164 L=1,LOT
              CC(L,I -1,J2-1,K) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
              CC(L,I   ,J2-1,K) = CH(L,I  ,K,J )+CH(L,I  ,K,JC)
              CC(L,IC-1,J2-2,K) = CH(L,I-1,K,J )-CH(L,I-1,K,JC)
              CC(L,IC  ,J2-2,K) = CH(L,I  ,K,JC)-CH(L,I  ,K,J )
  164       CONTINUE
  165     CONTINUE
  166   CONTINUE
  167 CONTINUE
      RETURN
      END
