source: trunk/WRF.COMMON/WRFV3/external/fftpack/fftpack5/factor.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 1.5 KB
RevLine 
[2759]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                                           
Note: See TracBrowser for help on using the repository browser.