Context Navigation

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

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