wrfv2_fire/external/fftpack/fftpack5/cmfm1b.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: cmfm1b.f,v 1.2 2004/06/15 21:08:32 rodney Exp $
  11 !
  12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13
  14       SUBROUTINE CMFM1B (LOT,JUMP,N,INC,C,CH,WA,FNF,FAC)
  15       COMPLEX       C(*)
  16       REAL       CH(*),     WA(*),     FAC(*)
  17 !
  18 ! FFTPACK 5.0 auxiliary routine
  19 !
  20       NF = FNF
  21       NA = 0
  22       L1 = 1
  23       IW = 1
  24       DO 125 K1=1,NF
  25          IP = FAC(K1)
  26          L2 = IP*L1
  27          IDO = N/L2
  28          LID = L1*IDO
  29          NBR = 1+NA+2*MIN(IP-2,4)
  30          GO TO (52,62,53,63,54,64,55,65,56,66),NBR
  31    52    CALL CMF2KB (LOT,IDO,L1,NA,C,JUMP,INC,CH,1,LOT,WA(IW))
  32          GO TO 120
  33    62    CALL CMF2KB (LOT,IDO,L1,NA,CH,1,LOT,C,JUMP,INC,WA(IW))
  34          GO TO 120
  35    53    CALL CMF3KB (LOT,IDO,L1,NA,C,JUMP,INC,CH,1,LOT,WA(IW))
  36          GO TO 120
  37    63    CALL CMF3KB (LOT,IDO,L1,NA,CH,1,LOT,C,JUMP,INC,WA(IW))
  38          GO TO 120
  39    54    CALL CMF4KB (LOT,IDO,L1,NA,C,JUMP,INC,CH,1,LOT,WA(IW))
  40          GO TO 120
  41    64    CALL CMF4KB (LOT,IDO,L1,NA,CH,1,LOT,C,JUMP,INC,WA(IW))
  42          GO TO 120
  43    55    CALL CMF5KB (LOT,IDO,L1,NA,C,JUMP,INC,CH,1,LOT,WA(IW))
  44          GO TO 120
  45    65    CALL CMF5KB (LOT,IDO,L1,NA,CH,1,LOT,C,JUMP,INC,WA(IW))
  46          GO TO 120
  47    56    CALL CMFGKB (LOT,IDO,IP,L1,LID,NA,C,C,JUMP,INC,CH,CH,1,        &
  48      &     LOT,WA(IW))
  49          GO TO 120
  50    66    CALL CMFGKB (LOT,IDO,IP,L1,LID,NA,CH,CH,1,LOT,C,C,             &
  51      &     JUMP,INC,WA(IW))
  52   120    L1 = L2
  53          IW = IW+(IP-1)*(IDO+IDO)
  54          IF(IP .LE. 5) NA = 1-NA
  55   125 END DO
  56       RETURN
  57       END