share/fftpack5/fortran/cosqb1.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 COSQB1 (N,INC,X,WSAVE,WORK,IER)
  12       DIMENSION       X(INC,*)     ,WSAVE(*)     ,WORK(*)
  13       IER = 0
  14       NS2 = (N+1)/2
  15       NP2 = N+2
  16       DO 101 I=3,N,2
  17          XIM1 = X(1,I-1)+X(1,I)
  18          X(1,I) = .5*(X(1,I-1)-X(1,I))
  19          X(1,I-1) = .5*XIM1
  20   101 CONTINUE
  21       X(1,1) = .5*X(1,1)
  22       MODN = MOD(N,2)
  23       IF (MODN .NE. 0) GO TO 302
  24       X(1,N) = .5*X(1,N)
  25   302 LENX = INC*(N-1)  + 1
  26       LNSV = N + INT(LOG(REAL(N))/LOG(2.)) + 4
  27       LNWK = N
  28 C
  29       CALL RFFT1B(N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
  30       IF (IER1 .NE. 0) THEN
  31         IER = 20
  32         CALL XERFFT ('COSQB1',-5)
  33         GO TO 400
  34       ENDIF
  35 C
  36       DO 102 K=2,NS2
  37          KC = NP2-K
  38          WORK(K) = WSAVE(K-1)*X(1,KC)+WSAVE(KC-1)*X(1,K)
  39          WORK(KC) = WSAVE(K-1)*X(1,K)-WSAVE(KC-1)*X(1,KC)
  40   102 CONTINUE
  41       IF (MODN .NE. 0) GO TO 305
  42       X(1,NS2+1) = WSAVE(NS2)*(X(1,NS2+1)+X(1,NS2+1))
  43   305 DO 103 K=2,NS2
  44          KC = NP2-K
  45          X(1,K) = WORK(K)+WORK(KC)
  46          X(1,KC) = WORK(K)-WORK(KC)
  47   103 CONTINUE
  48       X(1,1) = X(1,1)+X(1,1)
  49   400 RETURN
  50       END