wrfv2_fire/external/fftpack/fftpack5/mcfti1.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: mcfti1.f,v 1.2 2004/06/15 21:29:19 rodney Exp $
  11 !
  12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13
  14       SUBROUTINE MCFTI1 (N,WA,FNF,FAC)
  15       REAL            WA(*),FAC(*)
  16 !
  17       CALL FACTOR (N,NF,FAC)
  18       FNF = NF
  19       IW = 1
  20       L1 = 1
  21       DO 110 K1=1,NF
  22          IP = FAC(K1)
  23          L2 = L1*IP
  24          IDO = N/L2
  25          CALL TABLES (IDO,IP,WA(IW))
  26          IW = IW+(IP-1)*(IDO+IDO)
  27          L1 = L2
  28   110 END DO
  29       RETURN
  30       END