|
Last change
on this file since 5424 was
5390,
checked in by yann meurdesoif, 2 weeks ago
|
- Remove UTF8 character that inihibit fortran parsing with GPU morphosis
- Add missing END SUBROUTINE instead of simple END, that inhibit correct parsing with regulat expression parser (quick and dirty parsing)
YM
|
-
Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
|
|
File size:
1.3 KB
|
| Line | |
|---|
| 1 | SUBROUTINE SET99(TRIGS,IFAX,N) |
|---|
| 2 | REAL TRIGS(N) |
|---|
| 3 | INTEGER IFAX(*),JFAX(10),NLFAX(7) |
|---|
| 4 | INTEGER N, NU, IFAC, IL, IXXX, K, NIL, NHL, I, NFAX |
|---|
| 5 | REAL ANGLE, DEL |
|---|
| 6 | C |
|---|
| 7 | C SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC |
|---|
| 8 | C FUNCTIONS REQUIRED BY FFT99 & FFT991 |
|---|
| 9 | C |
|---|
| 10 | SAVE NLFAX |
|---|
| 11 | C |
|---|
| 12 | DATA NLFAX/6,8,5,4,3,2,1/ |
|---|
| 13 | C |
|---|
| 14 | IXXX=1 |
|---|
| 15 | C |
|---|
| 16 | DEL=4.0E0*ASIN(1.0E0)/FLOAT(N) |
|---|
| 17 | NIL=0 |
|---|
| 18 | NHL=(N/2)-1 |
|---|
| 19 | DO 10 K=NIL,NHL |
|---|
| 20 | ANGLE=FLOAT(K)*DEL |
|---|
| 21 | TRIGS(2*K+1)=COS(ANGLE) |
|---|
| 22 | TRIGS(2*K+2)=SIN(ANGLE) |
|---|
| 23 | 10 CONTINUE |
|---|
| 24 | C |
|---|
| 25 | C FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) |
|---|
| 26 | C LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER |
|---|
| 27 | NU=N |
|---|
| 28 | IFAC=6 |
|---|
| 29 | K=0 |
|---|
| 30 | IL=1 |
|---|
| 31 | 20 CONTINUE |
|---|
| 32 | IF (MOD(NU,IFAC).NE.0) GO TO 30 |
|---|
| 33 | K=K+1 |
|---|
| 34 | JFAX(K)=IFAC |
|---|
| 35 | IF (IFAC.NE.8) GO TO 25 |
|---|
| 36 | IF (K.EQ.1) GO TO 25 |
|---|
| 37 | JFAX(1)=8 |
|---|
| 38 | JFAX(K)=6 |
|---|
| 39 | 25 CONTINUE |
|---|
| 40 | NU=NU/IFAC |
|---|
| 41 | IF (NU.EQ.1) GO TO 50 |
|---|
| 42 | IF (IFAC.NE.8) GO TO 20 |
|---|
| 43 | 30 CONTINUE |
|---|
| 44 | IL=IL+1 |
|---|
| 45 | IFAC=NLFAX(IL) |
|---|
| 46 | IF (IFAC.GT.1) GO TO 20 |
|---|
| 47 | C |
|---|
| 48 | WRITE(6,40) N |
|---|
| 49 | 40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS) |
|---|
| 50 | RETURN |
|---|
| 51 | C |
|---|
| 52 | C NOW REVERSE ORDER OF FACTORS |
|---|
| 53 | 50 CONTINUE |
|---|
| 54 | NFAX=K |
|---|
| 55 | IFAX(1)=NFAX |
|---|
| 56 | DO 60 I=1,NFAX |
|---|
| 57 | IFAX(NFAX+2-I)=JFAX(I) |
|---|
| 58 | 60 CONTINUE |
|---|
| 59 | IFAX(10)=N |
|---|
| 60 | RETURN |
|---|
| 61 | END SUBROUTINE SET99 |
|---|
Note: See
TracBrowser
for help on using the repository browser.
