share/fftpack5/fortran/cmf5kf.f

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 C                                                                      C
   3 C                Copyright (C)  1995                                   C
   4 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   5 C
   6 C      File:           cmf5kf.f
   7 C
   8 C      Library:        FFTPACK 5.0
   9 C
  10 C      Authors:        Paul N. Swarztrauber and Richard A. Valent
  11 C                      National Center for Atmospheric Research
  12 C                      PO 3000, Boulder, Colorado
  13 C
  14 C      Date:           Wed Mar 29 18:31:13 MST 1995
  15 C
  16 C      Description:    Lower-level auxiliary routine
  17 C
  18       SUBROUTINE CMF5KF (LOT,IDO,L1,NA,CC,IM1,IN1,CH,IM2,IN2,WA)
  19       REAL  CC(2,IN1,L1,IDO,5),CH(2,IN2,L1,5,IDO),WA(IDO,4,2)
  20       DATA TR11,TI11,TR12,TI12 /.3090169943749474,-.9510565162951536,
  21      1-.8090169943749474,-.5877852522924731/
  22 C
  23 C FFTPACK 5.0 auxiliary routine
  24 C
  25       M1D = (LOT-1)*IM1+1
  26       M2S = 1-IM2
  27       IF (IDO .GT. 1) GO TO 102
  28       SN = 1./REAL(5*L1)
  29       IF (NA .EQ. 1) GO TO 106
  30       DO 101 K=1,L1
  31          DO 101 M1=1,M1D,IM1
  32          TI5 = CC(2,M1,K,1,2)-CC(2,M1,K,1,5)
  33          TI2 = CC(2,M1,K,1,2)+CC(2,M1,K,1,5)
  34          TI4 = CC(2,M1,K,1,3)-CC(2,M1,K,1,4)
  35          TI3 = CC(2,M1,K,1,3)+CC(2,M1,K,1,4)
  36          TR5 = CC(1,M1,K,1,2)-CC(1,M1,K,1,5)
  37          TR2 = CC(1,M1,K,1,2)+CC(1,M1,K,1,5)
  38          TR4 = CC(1,M1,K,1,3)-CC(1,M1,K,1,4)
  39          TR3 = CC(1,M1,K,1,3)+CC(1,M1,K,1,4)
  40          CHOLD1 = SN*(CC(1,M1,K,1,1)+TR2+TR3)
  41          CHOLD2 = SN*(CC(2,M1,K,1,1)+TI2+TI3)
  42          CR2 = CC(1,M1,K,1,1)+TR11*TR2+TR12*TR3
  43          CI2 = CC(2,M1,K,1,1)+TR11*TI2+TR12*TI3
  44          CR3 = CC(1,M1,K,1,1)+TR12*TR2+TR11*TR3
  45          CI3 = CC(2,M1,K,1,1)+TR12*TI2+TR11*TI3
  46          CC(1,M1,K,1,1) = CHOLD1
  47          CC(2,M1,K,1,1) = CHOLD2
  48          CR5 = TI11*TR5+TI12*TR4
  49          CI5 = TI11*TI5+TI12*TI4
  50          CR4 = TI12*TR5-TI11*TR4
  51          CI4 = TI12*TI5-TI11*TI4
  52          CC(1,M1,K,1,2) = SN*(CR2-CI5)
  53          CC(1,M1,K,1,5) = SN*(CR2+CI5)
  54          CC(2,M1,K,1,2) = SN*(CI2+CR5)
  55          CC(2,M1,K,1,3) = SN*(CI3+CR4)
  56          CC(1,M1,K,1,3) = SN*(CR3-CI4)
  57          CC(1,M1,K,1,4) = SN*(CR3+CI4)
  58          CC(2,M1,K,1,4) = SN*(CI3-CR4)
  59          CC(2,M1,K,1,5) = SN*(CI2-CR5)
  60   101 CONTINUE
  61       RETURN
  62   106 DO 107 K=1,L1
  63          M2 = M2S
  64          DO 107 M1=1,M1D,IM1
  65          M2 = M2+IM2
  66          TI5 = CC(2,M1,K,1,2)-CC(2,M1,K,1,5)
  67          TI2 = CC(2,M1,K,1,2)+CC(2,M1,K,1,5)
  68          TI4 = CC(2,M1,K,1,3)-CC(2,M1,K,1,4)
  69          TI3 = CC(2,M1,K,1,3)+CC(2,M1,K,1,4)
  70          TR5 = CC(1,M1,K,1,2)-CC(1,M1,K,1,5)
  71          TR2 = CC(1,M1,K,1,2)+CC(1,M1,K,1,5)
  72          TR4 = CC(1,M1,K,1,3)-CC(1,M1,K,1,4)
  73          TR3 = CC(1,M1,K,1,3)+CC(1,M1,K,1,4)
  74          CH(1,M2,K,1,1) = SN*(CC(1,M1,K,1,1)+TR2+TR3)
  75          CH(2,M2,K,1,1) = SN*(CC(2,M1,K,1,1)+TI2+TI3)
  76          CR2 = CC(1,M1,K,1,1)+TR11*TR2+TR12*TR3
  77          CI2 = CC(2,M1,K,1,1)+TR11*TI2+TR12*TI3
  78          CR3 = CC(1,M1,K,1,1)+TR12*TR2+TR11*TR3
  79          CI3 = CC(2,M1,K,1,1)+TR12*TI2+TR11*TI3
  80          CR5 = TI11*TR5+TI12*TR4
  81          CI5 = TI11*TI5+TI12*TI4
  82          CR4 = TI12*TR5-TI11*TR4
  83          CI4 = TI12*TI5-TI11*TI4
  84          CH(1,M2,K,2,1) = SN*(CR2-CI5)
  85          CH(1,M2,K,5,1) = SN*(CR2+CI5)
  86          CH(2,M2,K,2,1) = SN*(CI2+CR5)
  87          CH(2,M2,K,3,1) = SN*(CI3+CR4)
  88          CH(1,M2,K,3,1) = SN*(CR3-CI4)
  89          CH(1,M2,K,4,1) = SN*(CR3+CI4)
  90          CH(2,M2,K,4,1) = SN*(CI3-CR4)
  91          CH(2,M2,K,5,1) = SN*(CI2-CR5)
  92   107 CONTINUE
  93       RETURN
  94   102 DO 103 K=1,L1
  95          M2 = M2S
  96          DO 103 M1=1,M1D,IM1
  97          M2 = M2+IM2
  98          TI5 = CC(2,M1,K,1,2)-CC(2,M1,K,1,5)
  99          TI2 = CC(2,M1,K,1,2)+CC(2,M1,K,1,5)
 100          TI4 = CC(2,M1,K,1,3)-CC(2,M1,K,1,4)
 101          TI3 = CC(2,M1,K,1,3)+CC(2,M1,K,1,4)
 102          TR5 = CC(1,M1,K,1,2)-CC(1,M1,K,1,5)
 103          TR2 = CC(1,M1,K,1,2)+CC(1,M1,K,1,5)
 104          TR4 = CC(1,M1,K,1,3)-CC(1,M1,K,1,4)
 105          TR3 = CC(1,M1,K,1,3)+CC(1,M1,K,1,4)
 106          CH(1,M2,K,1,1) = CC(1,M1,K,1,1)+TR2+TR3
 107          CH(2,M2,K,1,1) = CC(2,M1,K,1,1)+TI2+TI3
 108          CR2 = CC(1,M1,K,1,1)+TR11*TR2+TR12*TR3
 109          CI2 = CC(2,M1,K,1,1)+TR11*TI2+TR12*TI3
 110          CR3 = CC(1,M1,K,1,1)+TR12*TR2+TR11*TR3
 111          CI3 = CC(2,M1,K,1,1)+TR12*TI2+TR11*TI3
 112          CR5 = TI11*TR5+TI12*TR4
 113          CI5 = TI11*TI5+TI12*TI4
 114          CR4 = TI12*TR5-TI11*TR4
 115          CI4 = TI12*TI5-TI11*TI4
 116          CH(1,M2,K,2,1) = CR2-CI5
 117          CH(1,M2,K,5,1) = CR2+CI5
 118          CH(2,M2,K,2,1) = CI2+CR5
 119          CH(2,M2,K,3,1) = CI3+CR4
 120          CH(1,M2,K,3,1) = CR3-CI4
 121          CH(1,M2,K,4,1) = CR3+CI4
 122          CH(2,M2,K,4,1) = CI3-CR4
 123          CH(2,M2,K,5,1) = CI2-CR5
 124   103 CONTINUE
 125       DO 105 I=2,IDO
 126          DO 104 K=1,L1
 127          M2 = M2S
 128          DO 104 M1=1,M1D,IM1
 129          M2 = M2+IM2
 130             TI5 = CC(2,M1,K,I,2)-CC(2,M1,K,I,5)
 131             TI2 = CC(2,M1,K,I,2)+CC(2,M1,K,I,5)
 132             TI4 = CC(2,M1,K,I,3)-CC(2,M1,K,I,4)
 133             TI3 = CC(2,M1,K,I,3)+CC(2,M1,K,I,4)
 134             TR5 = CC(1,M1,K,I,2)-CC(1,M1,K,I,5)
 135             TR2 = CC(1,M1,K,I,2)+CC(1,M1,K,I,5)
 136             TR4 = CC(1,M1,K,I,3)-CC(1,M1,K,I,4)
 137             TR3 = CC(1,M1,K,I,3)+CC(1,M1,K,I,4)
 138             CH(1,M2,K,1,I) = CC(1,M1,K,I,1)+TR2+TR3
 139             CH(2,M2,K,1,I) = CC(2,M1,K,I,1)+TI2+TI3
 140             CR2 = CC(1,M1,K,I,1)+TR11*TR2+TR12*TR3
 141             CI2 = CC(2,M1,K,I,1)+TR11*TI2+TR12*TI3
 142             CR3 = CC(1,M1,K,I,1)+TR12*TR2+TR11*TR3
 143             CI3 = CC(2,M1,K,I,1)+TR12*TI2+TR11*TI3
 144             CR5 = TI11*TR5+TI12*TR4
 145             CI5 = TI11*TI5+TI12*TI4
 146             CR4 = TI12*TR5-TI11*TR4
 147             CI4 = TI12*TI5-TI11*TI4
 148             DR3 = CR3-CI4
 149             DR4 = CR3+CI4
 150             DI3 = CI3+CR4
 151             DI4 = CI3-CR4
 152             DR5 = CR2+CI5
 153             DR2 = CR2-CI5
 154             DI5 = CI2-CR5
 155             DI2 = CI2+CR5
 156             CH(1,M2,K,2,I) = WA(I,1,1)*DR2+WA(I,1,2)*DI2
 157             CH(2,M2,K,2,I) = WA(I,1,1)*DI2-WA(I,1,2)*DR2
 158             CH(1,M2,K,3,I) = WA(I,2,1)*DR3+WA(I,2,2)*DI3
 159             CH(2,M2,K,3,I) = WA(I,2,1)*DI3-WA(I,2,2)*DR3
 160             CH(1,M2,K,4,I) = WA(I,3,1)*DR4+WA(I,3,2)*DI4
 161             CH(2,M2,K,4,I) = WA(I,3,1)*DI4-WA(I,3,2)*DR4
 162             CH(1,M2,K,5,I) = WA(I,4,1)*DR5+WA(I,4,2)*DI5
 163             CH(2,M2,K,5,I) = WA(I,4,1)*DI5-WA(I,4,2)*DR5
 164   104    CONTINUE
 165   105 CONTINUE
 166       RETURN
 167       END