share/fftpack5/fortran/cfft2b.f

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 C
   3 C   FFTPACK 5.0
   4 C
   5 C   Authors:  Paul N. Swarztrauber and Richard A. Valent
   6 C
   7 C   $Id$
   8 C
   9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10
  11       SUBROUTINE CFFT2B (LDIM, L, M, C, WSAVE, LENSAV,
  12      1                     WORK, LENWRK, IER)
  13       INTEGER L, M, LDIM, LENSAV, LENWRK, IER
  14       COMPLEX C(LDIM,M)
  15       REAL WSAVE(LENSAV), WORK(LENWRK)
  16 C
  17 C Initialize error return
  18 C
  19       IER = 0
  20 C
  21       IF (L .GT. LDIM) THEN
  22         IER = 5
  23         CALL XERFFT ('CFFT2B', -2)
  24         GO TO 100
  25       ELSEIF (LENSAV .LT. 2*L + INT(LOG(REAL(L))/LOG(2.)) +
  26      1                    2*M + INT(LOG(REAL(M))/LOG(2.)) +8) THEN
  27         IER = 2
  28         CALL XERFFT ('CFFT2B', 6)
  29         GO TO 100
  30       ELSEIF (LENWRK .LT. 2*L*M) THEN
  31         IER = 3
  32         CALL XERFFT ('CFFT2B', 8)
  33         GO TO 100
  34       ENDIF
  35 C
  36 C Transform X lines of C array
  37       IW = 2*L+INT(LOG(REAL(L))/LOG(2.)) + 3
  38       CALL CFFTMB(L, 1, M, LDIM, C, (L-1) + LDIM*(M-1) +1,
  39      1     WSAVE(IW), 2*M + INT(LOG(REAL(M))/LOG(2.)) + 4,
  40      2     WORK, 2*L*M, IER1)
  41       IF (IER1 .NE. 0) THEN
  42         IER = 20
  43         CALL XERFFT ('CFFT2B',-5)
  44         GO TO 100
  45       ENDIF
  46 C
  47 C Transform Y lines of C array
  48       IW = 1
  49       CALL CFFTMB (M, LDIM, L, 1, C, (M-1)*LDIM + L,
  50      1     WSAVE(IW), 2*L + INT(LOG(REAL(L))/LOG(2.)) + 4,
  51      2     WORK, 2*M*L, IER1)
  52       IF (IER1 .NE. 0) THEN
  53         IER = 20
  54         CALL XERFFT ('CFFT2B',-5)
  55       ENDIF
  56 C
  57   100 CONTINUE
  58       RETURN
  59       END