share/fftpack5/fortran/r1fgkf.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 R1FGKF (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       IPPH = (IP+1)/2
  22       IPP2 = IP+2
  23       IDP2 = IDO+2
  24       NBD = (IDO-1)/2
  25       IF (IDO .EQ. 1) GO TO 119
  26       DO 101 IK=1,IDL1
  27          CH2(1,IK,1) = C2(1,IK,1)
  28   101 CONTINUE
  29       DO 103 J=2,IP
  30          DO 102 K=1,L1
  31             CH(1,1,K,J) = C1(1,1,K,J)
  32   102    CONTINUE
  33   103 CONTINUE
  34       IF (NBD .GT. L1) GO TO 107
  35       IS = -IDO
  36       DO 106 J=2,IP
  37          IS = IS+IDO
  38          IDIJ = IS
  39          DO 105 I=3,IDO,2
  40             IDIJ = IDIJ+2
  41             DO 104 K=1,L1
  42                CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J)+WA(IDIJ)
  43      1           *C1(1,I,K,J)
  44                CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J)-WA(IDIJ)
  45      1           *C1(1,I-1,K,J)
  46   104       CONTINUE
  47   105    CONTINUE
  48   106 CONTINUE
  49       GO TO 111
  50   107 IS = -IDO
  51       DO 110 J=2,IP
  52          IS = IS+IDO
  53          DO 109 K=1,L1
  54             IDIJ = IS
  55             DO 108 I=3,IDO,2
  56                IDIJ = IDIJ+2
  57                CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J)+WA(IDIJ)
  58      1           *C1(1,I,K,J)
  59                CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J)-WA(IDIJ)
  60      1           *C1(1,I-1,K,J)
  61   108       CONTINUE
  62   109    CONTINUE
  63   110 CONTINUE
  64   111 IF (NBD .LT. L1) GO TO 115
  65       DO 114 J=2,IPPH
  66          JC = IPP2-J
  67          DO 113 K=1,L1
  68             DO 112 I=3,IDO,2
  69                C1(1,I-1,K,J) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
  70                C1(1,I-1,K,JC) = CH(1,I,K,J)-CH(1,I,K,JC)
  71                C1(1,I,K,J) = CH(1,I,K,J)+CH(1,I,K,JC)
  72                C1(1,I,K,JC) = CH(1,I-1,K,JC)-CH(1,I-1,K,J)
  73   112       CONTINUE
  74   113    CONTINUE
  75   114 CONTINUE
  76       GO TO 121
  77   115 DO 118 J=2,IPPH
  78          JC = IPP2-J
  79          DO 117 I=3,IDO,2
  80             DO 116 K=1,L1
  81                C1(1,I-1,K,J) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
  82                C1(1,I-1,K,JC) = CH(1,I,K,J)-CH(1,I,K,JC)
  83                C1(1,I,K,J) = CH(1,I,K,J)+CH(1,I,K,JC)
  84                C1(1,I,K,JC) = CH(1,I-1,K,JC)-CH(1,I-1,K,J)
  85   116       CONTINUE
  86   117    CONTINUE
  87   118 CONTINUE
  88       GO TO 121
  89   119 DO 120 IK=1,IDL1
  90          C2(1,IK,1) = CH2(1,IK,1)
  91   120 CONTINUE
  92   121 DO 123 J=2,IPPH
  93          JC = IPP2-J
  94          DO 122 K=1,L1
  95             C1(1,1,K,J) = CH(1,1,K,J)+CH(1,1,K,JC)
  96             C1(1,1,K,JC) = CH(1,1,K,JC)-CH(1,1,K,J)
  97   122    CONTINUE
  98   123 CONTINUE
  99 C
 100       AR1 = 1.
 101       AI1 = 0.
 102       DO 127 L=2,IPPH
 103          LC = IPP2-L
 104          AR1H = DCP*AR1-DSP*AI1
 105          AI1 = DCP*AI1+DSP*AR1
 106          AR1 = AR1H
 107          DO 124 IK=1,IDL1
 108             CH2(1,IK,L) = C2(1,IK,1)+AR1*C2(1,IK,2)
 109             CH2(1,IK,LC) = AI1*C2(1,IK,IP)
 110   124    CONTINUE
 111          DC2 = AR1
 112          DS2 = AI1
 113          AR2 = AR1
 114          AI2 = AI1
 115          DO 126 J=3,IPPH
 116             JC = IPP2-J
 117             AR2H = DC2*AR2-DS2*AI2
 118             AI2 = DC2*AI2+DS2*AR2
 119             AR2 = AR2H
 120             DO 125 IK=1,IDL1
 121                CH2(1,IK,L) = CH2(1,IK,L)+AR2*C2(1,IK,J)
 122                CH2(1,IK,LC) = CH2(1,IK,LC)+AI2*C2(1,IK,JC)
 123   125       CONTINUE
 124   126    CONTINUE
 125   127 CONTINUE
 126       DO 129 J=2,IPPH
 127          DO 128 IK=1,IDL1
 128             CH2(1,IK,1) = CH2(1,IK,1)+C2(1,IK,J)
 129   128    CONTINUE
 130   129 CONTINUE
 131 C
 132       IF (IDO .LT. L1) GO TO 132
 133       DO 131 K=1,L1
 134          DO 130 I=1,IDO
 135             CC(1,I,1,K) = CH(1,I,K,1)
 136   130    CONTINUE
 137   131 CONTINUE
 138       GO TO 135
 139   132 DO 134 I=1,IDO
 140          DO 133 K=1,L1
 141             CC(1,I,1,K) = CH(1,I,K,1)
 142   133    CONTINUE
 143   134 CONTINUE
 144   135 DO 137 J=2,IPPH
 145          JC = IPP2-J
 146          J2 = J+J
 147          DO 136 K=1,L1
 148             CC(1,IDO,J2-2,K) = CH(1,1,K,J)
 149             CC(1,1,J2-1,K) = CH(1,1,K,JC)
 150   136    CONTINUE
 151   137 CONTINUE
 152       IF (IDO .EQ. 1) RETURN
 153       IF (NBD .LT. L1) GO TO 141
 154       DO 140 J=2,IPPH
 155          JC = IPP2-J
 156          J2 = J+J
 157          DO 139 K=1,L1
 158             DO 138 I=3,IDO,2
 159                IC = IDP2-I
 160                CC(1,I-1,J2-1,K) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
 161                CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J)-CH(1,I-1,K,JC)
 162                CC(1,I,J2-1,K) = CH(1,I,K,J)+CH(1,I,K,JC)
 163                CC(1,IC,J2-2,K) = CH(1,I,K,JC)-CH(1,I,K,J)
 164   138       CONTINUE
 165   139    CONTINUE
 166   140 CONTINUE
 167       RETURN
 168   141 DO 144 J=2,IPPH
 169          JC = IPP2-J
 170          J2 = J+J
 171          DO 143 I=3,IDO,2
 172             IC = IDP2-I
 173             DO 142 K=1,L1
 174                CC(1,I-1,J2-1,K) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
 175                CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J)-CH(1,I-1,K,JC)
 176                CC(1,I,J2-1,K) = CH(1,I,K,J)+CH(1,I,K,JC)
 177                CC(1,IC,J2-2,K) = CH(1,I,K,JC)-CH(1,I,K,J)
 178   142       CONTINUE
 179   143    CONTINUE
 180   144 CONTINUE
 181       RETURN
 182       END