source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/costf1.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 2.5 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: costf1.f,v 1.2 2004/06/15 21:14:57 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE COSTF1(N,INC,X,WSAVE,WORK,IER)
12      REAL       X(INC,*)       ,WSAVE(*)
13      DOUBLE PRECISION           DSUM
14      IER = 0
15      NM1 = N-1
16      NP1 = N+1
17      NS2 = N/2
18      IF (N-2) 200,101,102
19  101 X1H = X(1,1)+X(1,2)
20      X(1,2) = .5*(X(1,1)-X(1,2))
21      X(1,1) = .5*X1H
22      GO TO 200
23  102 IF (N .GT. 3) GO TO 103
24      X1P3 = X(1,1)+X(1,3)
25      TX2 = X(1,2)+X(1,2)
26      X(1,2) = .5*(X(1,1)-X(1,3))
27      X(1,1) = .25*(X1P3+TX2)
28      X(1,3) = .25*(X1P3-TX2)
29      GO TO 200
30  103 DSUM = X(1,1)-X(1,N)
31      X(1,1) = X(1,1)+X(1,N)
32      DO 104 K=2,NS2
33         KC = NP1-K
34         T1 = X(1,K)+X(1,KC)
35         T2 = X(1,K)-X(1,KC)
36         DSUM = DSUM+WSAVE(KC)*T2
37         T2 = WSAVE(K)*T2
38         X(1,K) = T1-T2
39         X(1,KC) = T1+T2
40  104 END DO
41      MODN = MOD(N,2)
42      IF (MODN .EQ. 0) GO TO 124
43      X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+1)
44  124 LENX = INC*(NM1-1)  + 1
45      LNSV = NM1 + INT(LOG(REAL(NM1))) + 4
46      LNWK = NM1
47!                                                                       
48      CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,                  &
49     &            LNWK,IER1)                                           
50      IF (IER1 .NE. 0) THEN
51        IER = 20
52        CALL XERFFT ('COSTF1',-5)
53        GO TO 200
54      ENDIF
55!                                                                       
56      SNM1 = 1./FLOAT(NM1)
57      DSUM = SNM1*DSUM
58      IF(MOD(NM1,2) .NE. 0) GO TO 30
59      X(1,NM1) = X(1,NM1)+X(1,NM1)
60   30 DO 105 I=3,N,2
61         XI = .5*X(1,I)
62         X(1,I) = .5*X(1,I-1)
63         X(1,I-1) = DSUM
64         DSUM = DSUM+XI
65  105 END DO
66      IF (MODN .NE. 0) GO TO 117
67      X(1,N) = DSUM
68  117 X(1,1) = .5*X(1,1)
69      X(1,N) = .5*X(1,N)
70  200 RETURN
71      END                                           
Note: See TracBrowser for help on using the repository browser.