share/fftpack5/fortran/c1fm1b.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 C1FM1B (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          GO TO (52,62,53,63,54,64,55,65,56,66),NBR
  29    52    CALL C1F2KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  30          GO TO 120
  31    62    CALL C1F2KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  32          GO TO 120
  33    53    CALL C1F3KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  34          GO TO 120
  35    63    CALL C1F3KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  36          GO TO 120
  37    54    CALL C1F4KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  38          GO TO 120
  39    64    CALL C1F4KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  40          GO TO 120
  41    55    CALL C1F5KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  42          GO TO 120
  43    65    CALL C1F5KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  44          GO TO 120
  45    56    CALL C1FGKB (IDO,IP,L1,LID,NA,C,C,INC2,CH,CH,2,
  46      1     WA(IW))
  47          GO TO 120
  48    66    CALL C1FGKB (IDO,IP,L1,LID,NA,CH,CH,2,C,C,
  49      1     INC2,WA(IW))
  50   120    L1 = L2
  51          IW = IW+(IP-1)*(IDO+IDO)
  52          IF(IP .LE. 5) NA = 1-NA
  53   125 CONTINUE
  54       RETURN
  55       END