dev
Last change
on this file since 4f24798 was
4f24798,
checked in by Anne Tipka <anne.tipka@…>, 23 months ago
|
elimination of emoslib in fortran code. See ticket #312
|
-
Property mode set to
100644
|
File size:
1.6 KB
|
Rev | Line | |
---|
[4f24798] | 1 | !c Copyright 1981-2016 ECMWF. |
---|
| 2 | !c |
---|
| 3 | !c This software is licensed under the terms of the Apache Licence |
---|
| 4 | !c Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. |
---|
| 5 | !c |
---|
| 6 | !c In applying this licence, ECMWF does not waive the privileges and immunities |
---|
| 7 | !c granted to it by virtue of its status as an intergovernmental organisation |
---|
| 8 | !c nor does it submit to any jurisdiction. |
---|
| 9 | !c |
---|
| 10 | |
---|
| 11 | SUBROUTINE SET99(TRIGS,IFAX,N) |
---|
| 12 | DIMENSION TRIGS(N),IFAX(*),JFAX(10),LFAX(7) |
---|
| 13 | !C |
---|
| 14 | !C SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC |
---|
| 15 | !C FUNCTIONS REQUIRED BY FFT99 & FFT991 |
---|
| 16 | !C |
---|
| 17 | DATA LFAX/6,8,5,4,3,2,1/ |
---|
| 18 | IXXX=1 |
---|
| 19 | !C |
---|
| 20 | DEL=4.0*ASIN(1.0)/FLOAT(N) |
---|
| 21 | NIL=0 |
---|
| 22 | NHL=(N/2)-1 |
---|
| 23 | DO 10 K=NIL,NHL |
---|
| 24 | ANGLE=FLOAT(K)*DEL |
---|
| 25 | TRIGS(2*K+1)=COS(ANGLE) |
---|
| 26 | TRIGS(2*K+2)=SIN(ANGLE) |
---|
| 27 | 10 CONTINUE |
---|
| 28 | !C |
---|
| 29 | !C FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) |
---|
| 30 | !C LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER |
---|
| 31 | NU=N |
---|
| 32 | IFAC=6 |
---|
| 33 | K=0 |
---|
| 34 | L=1 |
---|
| 35 | 20 CONTINUE |
---|
| 36 | IF (MOD(NU,IFAC).NE.0) GO TO 30 |
---|
| 37 | K=K+1 |
---|
| 38 | JFAX(K)=IFAC |
---|
| 39 | IF (IFAC.NE.8) GO TO 25 |
---|
| 40 | IF (K.EQ.1) GO TO 25 |
---|
| 41 | JFAX(1)=8 |
---|
| 42 | JFAX(K)=6 |
---|
| 43 | 25 CONTINUE |
---|
| 44 | NU=NU/IFAC |
---|
| 45 | IF (NU.EQ.1) GO TO 50 |
---|
| 46 | IF (IFAC.NE.8) GO TO 20 |
---|
| 47 | 30 CONTINUE |
---|
| 48 | L=L+1 |
---|
| 49 | IFAC=LFAX(L) |
---|
| 50 | IF (IFAC.GT.1) GO TO 20 |
---|
| 51 | !C |
---|
| 52 | WRITE(6,40) N |
---|
| 53 | 40 FORMAT('1N =',I4,' - CONTAINS ILLEGAL FACTORS') |
---|
| 54 | RETURN |
---|
| 55 | !C |
---|
| 56 | !C NOW REVERSE ORDER OF FACTORS |
---|
| 57 | 50 CONTINUE |
---|
| 58 | NFAX=K |
---|
| 59 | IFAX(1)=NFAX |
---|
| 60 | DO 60 I=1,NFAX |
---|
| 61 | IFAX(NFAX+2-I)=JFAX(I) |
---|
| 62 | 60 CONTINUE |
---|
| 63 | IFAX(10)=N |
---|
| 64 | RETURN |
---|
| 65 | END |
---|
Note: See
TracBrowser
for help on using the repository browser.