Context Navigation

cosq1b.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago

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: cosq1b.f,v 1.2 2004/06/15 21:08:32 rodney Exp $
8	!
9	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10
11	SUBROUTINE COSQ1B (N, INC, X, LENX, WSAVE, LENSAV, &
12	& WORK, LENWRK, IER)
13	INTEGER N, INC, LENX, LENSAV, LENWRK, IER
14	REAL X(INC,*), WSAVE(LENSAV), WORK(LENWRK)
15	!
16	IER = 0
17	!
18	IF (LENX .LT. INC*(N-1) + 1) THEN
19	IER = 1
20	CALL XERFFT ('COSQ1B', 6)
21	GO TO 300
22	ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN
23	IER = 2
24	CALL XERFFT ('COSQ1B', 8)
25	GO TO 300
26	ELSEIF (LENWRK .LT. N) THEN
27	IER = 3
28	CALL XERFFT ('COSQ1B', 10)
29	GO TO 300
30	ENDIF
31	!
32	IF (N-2) 300,102,103
33	102 SSQRT2 = 1./SQRT(2.)
34	X1 = X(1,1)+X(1,2)
35	X(1,2) = SSQRT2*(X(1,1)-X(1,2))
36	X(1,1) = X1
37	RETURN
38	103 CALL COSQB1 (N,INC,X,WSAVE,WORK,IER1)
39	IF (IER1 .NE. 0) THEN
40	IER = 20
41	CALL XERFFT ('COSQ1B',-5)
42	ENDIF
43	!
44	300 RETURN
45	END

Note: See TracBrowser for help on using the repository browser.