source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/cfft2f.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.8 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: cfft2f.f,v 1.2 2004/06/15 21:08:32 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE CFFT2F (LDIM, L, M, C, WSAVE, LENSAV,                  &
12     &                     WORK, LENWRK, IER)                           
13      INTEGER L, M, LDIM, LENSAV, LENWRK, IER
14      COMPLEX C(LDIM,M)
15      REAL WSAVE(LENSAV), WORK(LENWRK)
16!                                                                       
17! Initialize error return                                               
18!                                                                       
19      IER = 0
20!                                                                       
21      IF (L .GT. LDIM) THEN
22        IER = 5
23        CALL XERFFT ('CFFT2F', -2)
24        GO TO 100
25      ELSEIF (LENSAV .LT. 2*L + INT(LOG(REAL(L))) +                     &
26     &                    2*M + INT(LOG(REAL(M))) +8) THEN             
27        IER = 2
28        CALL XERFFT ('CFFT2F', 6)
29        GO TO 100
30      ELSEIF (LENWRK .LT. 2*L*M) THEN
31        IER = 3
32        CALL XERFFT ('CFFT2F', 8)
33        GO TO 100
34      ENDIF
35!                                                                       
36! Transform X lines of C array                                         
37      IW = 2*L+INT(LOG(REAL(L))*LOG(2.)) + 3
38      CALL CFFTMF(L, 1, M, LDIM, C, (L-1) + LDIM*(M-1) +1,              &
39     &     WSAVE(IW), 2*M + INT(LOG(REAL(M))) + 4,                      &
40     &     WORK, 2*L*M, IER1)                                           
41      IF (IER1 .NE. 0) THEN
42        IER = 20
43        CALL XERFFT ('CFFT2F',-5)
44        GO TO 100
45      ENDIF
46!                                                                       
47! Transform Y lines of C array                                         
48      IW = 1
49      CALL CFFTMF (M, LDIM, L, 1, C, (M-1)*LDIM + L,                    &
50     &     WSAVE(IW), 2*L + INT(LOG(REAL(L))) + 4,                      &
51     &     WORK, 2*M*L, IER1)                                           
52      IF (IER1 .NE. 0) THEN
53        IER = 20
54        CALL XERFFT ('CFFT2F',-5)
55      ENDIF
56!                                                                       
57  100 CONTINUE
58      RETURN
59      END                                           
Note: See TracBrowser for help on using the repository browser.