wrfv2_fire/external/fftpack/fftpack5/factor.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: factor.f,v 1.2 2004/06/15 21:29:19 rodney Exp $
  11 !
  12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13
  14       SUBROUTINE FACTOR (N,NF,FAC)
  15       REAL FAC(*)
  16       INTEGER NTRYH(4)
  17       DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
  18 !
  19       NL = N
  20       NF = 0
  21       J = 0
  22   101 J = J+1
  23       IF (J-4) 102,102,103
  24   102 NTRY = NTRYH(J)
  25       GO TO 104
  26   103 NTRY = NTRY+2
  27   104 NQ = NL/NTRY
  28       NR = NL-NTRY*NQ
  29       IF (NR) 101,105,101
  30   105 NF = NF+1
  31       FAC(NF) = NTRY
  32       NL = NQ
  33       IF (NL .NE. 1) GO TO 104
  34       RETURN
  35       END