Rename *ll* and *ul* to ll and ul in in-interval
[maxima.git] / share / fftpack5 / fortran / rfft2f.f
blob3e5679fa64e504288ba78378b11de1a05ef6698d
1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3 C FFTPACK 5.0
5 C Authors: Paul N. Swarztrauber and Richard A. Valent
7 C $Id$
9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
11 SUBROUTINE RFFT2F (LDIM, L, M, R, WSAVE, LENSAV, WORK,
12 1 LENWRK, IER)
13 INTEGER LDIM, L, M, LENSAV, LENWRK, IER
14 REAL R(LDIM,M), WSAVE(LENSAV), WORK(LENWRK)
17 C Initialize IER
19 IER = 0
21 C Verify LENSAV
23 LWSAV = L + INT(LOG (REAL(L))) +4
24 MWSAV = 2*M + INT(LOG (REAL(M))) +4
25 IF (LENSAV .LT. LWSAV+MWSAV) THEN
26 IER = 2
27 CALL XERFFT ('RFFT2F', 6)
28 GO TO 100
29 ENDIF
31 C Verify LENWRK
33 IF (LENWRK .LT. 2*(L/2+1)*M) THEN
34 IER = 3
35 CALL XERFFT ('RFFT2F', 8)
36 GO TO 100
37 ENDIF
39 C Verify LDIM is as big as L
41 IF (LDIM .LT. 2*(L/2+1)) THEN
42 IER = 5
43 CALL XERFFT ('RFFT2F', -6)
44 GO TO 100
45 ENDIF
47 C Transform first dimension of array
49 CALL RFFTMF(M,LDIM,L,1,R,M*LDIM,WSAVE(1),
50 . L+INT(LOG(REAL(L)))+4,WORK,2*(L/2+1)*M,IER1)
51 IF(IER1.NE.0) THEN
52 IER=20
53 CALL XERFFT('RFFT2F',-5)
54 GO TO 100
55 ENDIF
57 C reshuffle to add in nyquist imaginary components
59 DO J=1,M
60 IF(MOD(L,2).EQ.0) R(L+2,J)=0.0
61 DO I=L,2,-1
62 R(I+1,J)=R(I,J)
63 ENDDO
64 R(2,J)=0.0
65 ENDDO
67 C transform second dimension of array
69 CALL CFFTMF(L/2+1,1,M,LDIM/2,R,M*LDIM/2,
70 . WSAVE(L+INT(LOG(REAL(L)))+5),
71 . 2*M+INT(LOG(REAL(M)))+4,WORK,2*(L/2+1)*M,IER1)
72 IF(IER1.NE.0) THEN
73 IER=20
74 CALL XERFFT('RFFT2F',-5)
75 GO TO 100
76 ENDIF
78 100 CONTINUE
80 RETURN
81 END