Last change
on this file 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
|
Line | |
---|
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.