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