share/fftpack5/fortran/c1fm1f.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 C1FM1F (N,INC,C,CH,WA,FNF,FAC)
  12       COMPLEX       C(*)
  13       REAL       CH(*),     WA(*),      FAC(*)
  14 C
  15 C FFTPACK 5.0 auxiliary routine
  16 C
  17       INC2 = INC+INC
  18       NF = FNF
  19       NA = 0
  20       L1 = 1
  21       IW = 1
  22       DO 125 K1=1,NF
  23          IP = FAC(K1)
  24          L2 = IP*L1
  25          IDO = N/L2
  26          LID = L1*IDO
  27          NBR = 1+NA+2*MIN(IP-2,4)
  28 c         write(*,*) wa(iw),wa(iw+1)
  29          GO TO (52,62,53,63,54,64,55,65,56,66),NBR
  30    52    CALL C1F2KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  31          GO TO 120
  32    62    CALL C1F2KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  33          GO TO 120
  34    53    CALL C1F3KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  35          GO TO 120
  36    63    CALL C1F3KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  37          GO TO 120
  38    54    CALL C1F4KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  39          GO TO 120
  40    64    CALL C1F4KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  41          GO TO 120
  42    55    CALL C1F5KF (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  43          GO TO 120
  44    65    CALL C1F5KF (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  45          GO TO 120
  46    56    CALL C1FGKF (IDO,IP,L1,LID,NA,C,C,INC2,CH,CH,
  47      1     2,WA(IW))
  48          GO TO 120
  49    66    CALL C1FGKF (IDO,IP,L1,LID,NA,CH,CH,2,C,C,
  50      1     INC2,WA(IW))
  51   120    L1 = L2
  52          IW = IW+(IP-1)*(IDO+IDO)
  53          IF(IP .LE. 5) NA = 1-NA
  54   125 CONTINUE
  55       RETURN
  56       END