share/fftpack5/fortran/sintf1.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 SINTF1(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 SSQRT3 = 1./SQRT(3.)
  17       XHOLD = SSQRT3*(X(1,1)+X(1,2))
  18       X(1,2) = SSQRT3*(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,
  39      1            LNWK,IER1)
  40       IF (IER1 .NE. 0) THEN
  41         IER = 20
  42         CALL XERFFT ('SINTF1',-5)
  43         GO TO 200
  44       ENDIF
  45 C
  46       IF(MOD(NP1,2) .NE. 0) GO TO 30
  47       XH(NP1) = XH(NP1)+XH(NP1)
  48    30 SFNP1 = 1./FLOAT(NP1)
  49          X(1,1) = .5*XH(1)
  50          DSUM = X(1,1)
  51       DO 105 I=3,N,2
  52             X(1,I-1) = .5*XH(I)
  53             DSUM = DSUM+.5*XH(I-1)
  54             X(1,I) = DSUM
  55   105 CONTINUE
  56       IF (MODN .NE. 0) GO TO 200
  57       X(1,N) = .5*XH(N+1)
  58   200 RETURN
  59       END