source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/cosqb1.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.0 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: cosqb1.f,v 1.2 2004/06/15 21:14:57 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE COSQB1 (N,INC,X,WSAVE,WORK,IER)
12      DIMENSION       X(INC,*)     ,WSAVE(*)     ,WORK(*)
13      IER = 0
14      NS2 = (N+1)/2
15      NP2 = N+2
16      DO 101 I=3,N,2
17         XIM1 = X(1,I-1)+X(1,I)
18         X(1,I) = .5*(X(1,I-1)-X(1,I))
19         X(1,I-1) = .5*XIM1
20  101 END DO
21      X(1,1) = .5*X(1,1)
22      MODN = MOD(N,2)
23      IF (MODN .NE. 0) GO TO 302
24      X(1,N) = .5*X(1,N)
25  302 LENX = INC*(N-1)  + 1
26      LNSV = N + INT(LOG(REAL(N))) + 4
27      LNWK = N
28!                                                                       
29      CALL RFFT1B(N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
30      IF (IER1 .NE. 0) THEN
31        IER = 20
32        CALL XERFFT ('COSQB1',-5)
33        GO TO 400
34      ENDIF
35!                                                                       
36      DO 102 K=2,NS2
37         KC = NP2-K
38         WORK(K) = WSAVE(K-1)*X(1,KC)+WSAVE(KC-1)*X(1,K)
39         WORK(KC) = WSAVE(K-1)*X(1,K)-WSAVE(KC-1)*X(1,KC)
40  102 END DO
41      IF (MODN .NE. 0) GO TO 305
42      X(1,NS2+1) = WSAVE(NS2)*(X(1,NS2+1)+X(1,NS2+1))
43  305 DO 103 K=2,NS2
44         KC = NP2-K
45         X(1,K) = WORK(K)+WORK(KC)
46         X(1,KC) = WORK(K)-WORK(KC)
47  103 END DO
48      X(1,1) = X(1,1)+X(1,1)
49  400 RETURN
50      END                                           
Note: See TracBrowser for help on using the repository browser.