share/fftpack5/fortran/sintb1.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 SINTB1(N,INC,X,WSAVE,XH,WORK,IER)
  12       REAL       X(INC,*)       ,WSAVE(*)   ,XH(*)
  13       DOUBLE PRECISION           DSUM
  14       IER = 0
  15       IF (N-2) 200,102,103
  16   102 SRT3S2 = SQRT(3.)/2.
  17       XHOLD = SRT3S2*(X(1,1)+X(1,2))
  18       X(1,2) = SRT3S2*(X(1,1)-X(1,2))
  19       X(1,1) = XHOLD
  20       GO TO 200
  21   103 NP1 = N+1
  22       NS2 = N/2
  23       DO 104 K=1,NS2
  24          KC = NP1-K
  25          T1 = X(1,K)-X(1,KC)
  26          T2 = WSAVE(K)*(X(1,K)+X(1,KC))
  27          XH(K+1) = T1+T2
  28          XH(KC+1) = T2-T1
  29   104 CONTINUE
  30       MODN = MOD(N,2)
  31       IF (MODN .EQ. 0) GO TO 124
  32       XH(NS2+2) = 4.*X(1,NS2+1)
  33   124 XH(1) = 0.
  34       LNXH = NP1
  35       LNSV = NP1 + INT(LOG(REAL(NP1))/LOG(2.)) + 4
  36       LNWK = NP1
  37 C
  38       CALL RFFT1F(NP1,1,XH,LNXH,WSAVE(NS2+1),LNSV,WORK,LNWK,IER1)
  39       IF (IER1 .NE. 0) THEN
  40         IER = 20
  41         CALL XERFFT ('SINTB1',-5)
  42         GO TO 200
  43       ENDIF
  44 C
  45       IF(MOD(NP1,2) .NE. 0) GO TO 30
  46       XH(NP1) = XH(NP1)+XH(NP1)
  47  30   FNP1S4 = FLOAT(NP1)/4.
  48          X(1,1) = FNP1S4*XH(1)
  49          DSUM = X(1,1)
  50       DO 105 I=3,N,2
  51             X(1,I-1) = FNP1S4*XH(I)
  52             DSUM = DSUM+FNP1S4*XH(I-1)
  53             X(1,I) = DSUM
  54   105 CONTINUE
  55       IF (MODN .NE. 0) GO TO 200
  56          X(1,N) = FNP1S4*XH(N+1)
  57 C
  58   200 CONTINUE
  59       RETURN
  60       END