share/fftpack5/fortran/r1fgkb.f

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 C
   3 C   FFTPACK 5.0
   4 C
   5 C   Authors:  Paul N. Swarztrauber and Richard A. Valent
   6 C
   7 C   $Id$
   8 C
   9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10
  11       SUBROUTINE R1FGKB (IDO,IP,L1,IDL1,CC,C1,C2,IN1,
  12      1          CH,CH2,IN2,WA)
  13       REAL      CH(IN2,IDO,L1,IP)    ,CC(IN1,IDO,IP,L1) ,
  14      1          C1(IN1,IDO,L1,IP)    ,C2(IN1,IDL1,IP),
  15      2          CH2(IN2,IDL1,IP)     ,WA(IDO)
  16 C
  17       TPI=2.*4.*ATAN(1.0)
  18       ARG = TPI/FLOAT(IP)
  19       DCP = COS(ARG)
  20       DSP = SIN(ARG)
  21       IDP2 = IDO+2
  22       NBD = (IDO-1)/2
  23       IPP2 = IP+2
  24       IPPH = (IP+1)/2
  25       IF (IDO .LT. L1) GO TO 103
  26       DO 102 K=1,L1
  27          DO 101 I=1,IDO
  28             CH(1,I,K,1) = CC(1,I,1,K)
  29   101    CONTINUE
  30   102 CONTINUE
  31       GO TO 106
  32   103 DO 105 I=1,IDO
  33          DO 104 K=1,L1
  34             CH(1,I,K,1) = CC(1,I,1,K)
  35   104    CONTINUE
  36   105 CONTINUE
  37   106 DO 108 J=2,IPPH
  38          JC = IPP2-J
  39          J2 = J+J
  40          DO 107 K=1,L1
  41             CH(1,1,K,J) = CC(1,IDO,J2-2,K)+CC(1,IDO,J2-2,K)
  42             CH(1,1,K,JC) = CC(1,1,J2-1,K)+CC(1,1,J2-1,K)
  43  1007       CONTINUE
  44   107    CONTINUE
  45   108 CONTINUE
  46       IF (IDO .EQ. 1) GO TO 116
  47       IF (NBD .LT. L1) GO TO 112
  48       DO 111 J=2,IPPH
  49          JC = IPP2-J
  50          DO 110 K=1,L1
  51             DO 109 I=3,IDO,2
  52                IC = IDP2-I
  53                CH(1,I-1,K,J) = CC(1,I-1,2*J-1,K)+CC(1,IC-1,2*J-2,K)
  54                CH(1,I-1,K,JC) = CC(1,I-1,2*J-1,K)-CC(1,IC-1,2*J-2,K)
  55                CH(1,I,K,J) = CC(1,I,2*J-1,K)-CC(1,IC,2*J-2,K)
  56                CH(1,I,K,JC) = CC(1,I,2*J-1,K)+CC(1,IC,2*J-2,K)
  57   109       CONTINUE
  58   110    CONTINUE
  59   111 CONTINUE
  60       GO TO 116
  61   112 DO 115 J=2,IPPH
  62          JC = IPP2-J
  63          DO 114 I=3,IDO,2
  64             IC = IDP2-I
  65             DO 113 K=1,L1
  66                CH(1,I-1,K,J) = CC(1,I-1,2*J-1,K)+CC(1,IC-1,2*J-2,K)
  67                CH(1,I-1,K,JC) = CC(1,I-1,2*J-1,K)-CC(1,IC-1,2*J-2,K)
  68                CH(1,I,K,J) = CC(1,I,2*J-1,K)-CC(1,IC,2*J-2,K)
  69                CH(1,I,K,JC) = CC(1,I,2*J-1,K)+CC(1,IC,2*J-2,K)
  70   113       CONTINUE
  71   114    CONTINUE
  72   115 CONTINUE
  73   116 AR1 = 1.
  74       AI1 = 0.
  75       DO 120 L=2,IPPH
  76          LC = IPP2-L
  77          AR1H = DCP*AR1-DSP*AI1
  78          AI1 = DCP*AI1+DSP*AR1
  79          AR1 = AR1H
  80          DO 117 IK=1,IDL1
  81             C2(1,IK,L) = CH2(1,IK,1)+AR1*CH2(1,IK,2)
  82             C2(1,IK,LC) = AI1*CH2(1,IK,IP)
  83   117    CONTINUE
  84          DC2 = AR1
  85          DS2 = AI1
  86          AR2 = AR1
  87          AI2 = AI1
  88          DO 119 J=3,IPPH
  89             JC = IPP2-J
  90             AR2H = DC2*AR2-DS2*AI2
  91             AI2 = DC2*AI2+DS2*AR2
  92             AR2 = AR2H
  93             DO 118 IK=1,IDL1
  94                C2(1,IK,L) = C2(1,IK,L)+AR2*CH2(1,IK,J)
  95                C2(1,IK,LC) = C2(1,IK,LC)+AI2*CH2(1,IK,JC)
  96   118       CONTINUE
  97   119    CONTINUE
  98   120 CONTINUE
  99       DO 122 J=2,IPPH
 100          DO 121 IK=1,IDL1
 101             CH2(1,IK,1) = CH2(1,IK,1)+CH2(1,IK,J)
 102   121    CONTINUE
 103   122 CONTINUE
 104       DO 124 J=2,IPPH
 105          JC = IPP2-J
 106          DO 123 K=1,L1
 107             CH(1,1,K,J) = C1(1,1,K,J)-C1(1,1,K,JC)
 108             CH(1,1,K,JC) = C1(1,1,K,J)+C1(1,1,K,JC)
 109   123    CONTINUE
 110   124 CONTINUE
 111       IF (IDO .EQ. 1) GO TO 132
 112       IF (NBD .LT. L1) GO TO 128
 113       DO 127 J=2,IPPH
 114          JC = IPP2-J
 115          DO 126 K=1,L1
 116             DO 125 I=3,IDO,2
 117                CH(1,I-1,K,J) = C1(1,I-1,K,J)-C1(1,I,K,JC)
 118                CH(1,I-1,K,JC) = C1(1,I-1,K,J)+C1(1,I,K,JC)
 119                CH(1,I,K,J) = C1(1,I,K,J)+C1(1,I-1,K,JC)
 120                CH(1,I,K,JC) = C1(1,I,K,J)-C1(1,I-1,K,JC)
 121   125       CONTINUE
 122   126    CONTINUE
 123   127 CONTINUE
 124       GO TO 132
 125   128 DO 131 J=2,IPPH
 126          JC = IPP2-J
 127          DO 130 I=3,IDO,2
 128             DO 129 K=1,L1
 129                CH(1,I-1,K,J) = C1(1,I-1,K,J)-C1(1,I,K,JC)
 130                CH(1,I-1,K,JC) = C1(1,I-1,K,J)+C1(1,I,K,JC)
 131                CH(1,I,K,J) = C1(1,I,K,J)+C1(1,I-1,K,JC)
 132                CH(1,I,K,JC) = C1(1,I,K,J)-C1(1,I-1,K,JC)
 133   129       CONTINUE
 134   130    CONTINUE
 135   131 CONTINUE
 136   132 CONTINUE
 137       IF (IDO .EQ. 1) RETURN
 138       DO 133 IK=1,IDL1
 139          C2(1,IK,1) = CH2(1,IK,1)
 140   133 CONTINUE
 141       DO 135 J=2,IP
 142          DO 134 K=1,L1
 143             C1(1,1,K,J) = CH(1,1,K,J)
 144   134    CONTINUE
 145   135 CONTINUE
 146       IF (NBD .GT. L1) GO TO 139
 147       IS = -IDO
 148       DO 138 J=2,IP
 149          IS = IS+IDO
 150          IDIJ = IS
 151          DO 137 I=3,IDO,2
 152             IDIJ = IDIJ+2
 153             DO 136 K=1,L1
 154                C1(1,I-1,K,J) = WA(IDIJ-1)*CH(1,I-1,K,J)-WA(IDIJ)*
 155      1          CH(1,I,K,J)
 156                C1(1,I,K,J) = WA(IDIJ-1)*CH(1,I,K,J)+WA(IDIJ)*
 157      1          CH(1,I-1,K,J)
 158   136       CONTINUE
 159   137    CONTINUE
 160   138 CONTINUE
 161       GO TO 143
 162   139 IS = -IDO
 163       DO 142 J=2,IP
 164          IS = IS+IDO
 165          DO 141 K=1,L1
 166             IDIJ = IS
 167             DO 140 I=3,IDO,2
 168                IDIJ = IDIJ+2
 169                C1(1,I-1,K,J) = WA(IDIJ-1)*CH(1,I-1,K,J)-WA(IDIJ)*
 170      1          CH(1,I,K,J)
 171                C1(1,I,K,J) = WA(IDIJ-1)*CH(1,I,K,J)+WA(IDIJ)*
 172      1          CH(1,I-1,K,J)
 173   140       CONTINUE
 174   141    CONTINUE
 175   142 CONTINUE
 176   143 RETURN
 177       END