wrfv2_fire/external/fftpack/fftpack5/c1fm1b.F

   1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 !
   3 !   FFTPACK 5.0
   4 !   Copyright (C) 1995-2004, Scientific Computing Division,
   5 !   University Corporation for Atmospheric Research
   6 !   Licensed under the GNU General Public License (GPL)
   7 !
   8 !   Authors:  Paul N. Swarztrauber and Richard A. Valent
   9 !
  10 !   $Id: c1fm1b.f,v 1.2 2004/06/15 21:08:32 rodney Exp $
  11 !
  12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13
  14       SUBROUTINE C1FM1B (N,INC,C,CH,WA,FNF,FAC)
  15       COMPLEX       C(*)
  16       REAL       CH(*),     WA(*),     FAC(*)
  17 !
  18 ! FFTPACK 5.0 auxiliary routine
  19 !
  20       INC2 = INC+INC
  21       NF = FNF
  22       NA = 0
  23       L1 = 1
  24       IW = 1
  25       DO 125 K1=1,NF
  26          IP = FAC(K1)
  27          L2 = IP*L1
  28          IDO = N/L2
  29          LID = L1*IDO
  30          NBR = 1+NA+2*MIN(IP-2,4)
  31          GO TO (52,62,53,63,54,64,55,65,56,66),NBR
  32    52    CALL C1F2KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  33          GO TO 120
  34    62    CALL C1F2KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  35          GO TO 120
  36    53    CALL C1F3KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  37          GO TO 120
  38    63    CALL C1F3KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  39          GO TO 120
  40    54    CALL C1F4KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  41          GO TO 120
  42    64    CALL C1F4KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  43          GO TO 120
  44    55    CALL C1F5KB (IDO,L1,NA,C,INC2,CH,2,WA(IW))
  45          GO TO 120
  46    65    CALL C1F5KB (IDO,L1,NA,CH,2,C,INC2,WA(IW))
  47          GO TO 120
  48    56    CALL C1FGKB (IDO,IP,L1,LID,NA,C,C,INC2,CH,CH,2,                &
  49      &     WA(IW))
  50          GO TO 120
  51    66    CALL C1FGKB (IDO,IP,L1,LID,NA,CH,CH,2,C,C,                     &
  52      &     INC2,WA(IW))
  53   120    L1 = L2
  54          IW = IW+(IP-1)*(IDO+IDO)
  55          IF(IP .LE. 5) NA = 1-NA
  56   125 END DO
  57       RETURN
  58       END