relibc_openlibm/slatec/qc25f.f

*DECK QC25F
      SUBROUTINE QC25F (F, A, B, OMEGA, INTEGR, NRMOM, MAXP1, KSAVE,
     +   RESULT, ABSERR, NEVAL, RESABS, RESASC, MOMCOM, CHEBMO)
C***BEGIN PROLOGUE  QC25F
C***PURPOSE  To compute the integral I=Integral of F(X) over (A,B)
C            Where W(X) = COS(OMEGA*X) Or (WX)=SIN(OMEGA*X)
C            and to compute J=Integral of ABS(F) over (A,B). For small
C            value of OMEGA or small intervals (A,B) 15-point GAUSS-
C            KRONROD Rule used. Otherwise generalized CLENSHAW-CURTIS us
C***LIBRARY   SLATEC (QUADPACK)
C***CATEGORY  H2A2A2
C***TYPE      SINGLE PRECISION (QC25F-S, DQC25F-D)
C***KEYWORDS  CLENSHAW-CURTIS METHOD, GAUSS-KRONROD RULES,
C             INTEGRATION RULES FOR FUNCTIONS WITH COS OR SIN FACTOR,
C             QUADPACK, QUADRATURE
C***AUTHOR  Piessens, Robert
C             Applied Mathematics and Programming Division
C             K. U. Leuven
C           de Doncker, Elise
C             Applied Mathematics and Programming Division
C             K. U. Leuven
C***DESCRIPTION
C
C        Integration rules for functions with COS or SIN factor
C        Standard fortran subroutine
C        Real version
C
C        PARAMETERS
C         ON ENTRY
C           F      - Real
C                    Function subprogram defining the integrand
C                    function F(X). The actual name for F needs to
C                    be declared E X T E R N A L in the calling program.
C
C           A      - Real
C                    Lower limit of integration
C
C           B      - Real
C                    Upper limit of integration
C
C           OMEGA  - Real
C                    Parameter in the WEIGHT function
C
C           INTEGR - Integer
C                    Indicates which WEIGHT function is to be used
C                       INTEGR = 1   W(X) = COS(OMEGA*X)
C                       INTEGR = 2   W(X) = SIN(OMEGA*X)
C
C           NRMOM  - Integer
C                    The length of interval (A,B) is equal to the length
C                    of the original integration interval divided by
C                    2**NRMOM (we suppose that the routine is used in an
C                    adaptive integration process, otherwise set
C                    NRMOM = 0). NRMOM must be zero at the first call.
C
C           MAXP1  - Integer
C                    Gives an upper bound on the number of Chebyshev
C                    moments which can be stored, i.e. for the
C                    intervals of lengths ABS(BB-AA)*2**(-L),
C                    L = 0,1,2, ..., MAXP1-2.
C
C           KSAVE  - Integer
C                    Key which is one when the moments for the
C                    current interval have been computed
C
C         ON RETURN
C           RESULT - Real
C                    Approximation to the integral I
C
C           ABSERR - Real
C                    Estimate of the modulus of the absolute
C                    error, which should equal or exceed ABS(I-RESULT)
C
C           NEVAL  - Integer
C                    Number of integrand evaluations
C
C           RESABS - Real
C                    Approximation to the integral J
C
C           RESASC - Real
C                    Approximation to the integral of ABS(F-I/(B-A))
C
C         ON ENTRY AND RETURN
C           MOMCOM - Integer
C                    For each interval length we need to compute the
C                    Chebyshev moments. MOMCOM counts the number of
C                    intervals for which these moments have already been
C                    computed. If NRMOM.LT.MOMCOM or KSAVE = 1, the
C                    Chebyshev moments for the interval (A,B) have
C                    already been computed and stored, otherwise we
C                    compute them and we increase MOMCOM.
C
C           CHEBMO - Real
C                    Array of dimension at least (MAXP1,25) containing
C                    the modified Chebyshev moments for the first MOMCOM
C                    MOMCOM interval lengths
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  QCHEB, QK15W, QWGTF, R1MACH, SGTSL
C***REVISION HISTORY  (YYMMDD)
C   810101  DATE WRITTEN
C   861211  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C***END PROLOGUE  QC25F
C
      REAL A,ABSERR,AC,AN,AN2,AS,ASAP,ASS,B,CENTR,CHEBMO,
     1  CHEB12,CHEB24,CONC,CONS,COSPAR,D,QWGTF,
     2  D1,R1MACH,D2,ESTC,ESTS,F,FVAL,HLGTH,OFLOW,OMEGA,PARINT,PAR2,
     3  PAR22,P2,P3,P4,RESABS,RESASC,RESC12,RESC24,RESS12,RESS24,
     4  RESULT,SINPAR,V,X
      INTEGER I,IERS,INTEGR,ISYM,J,K,KSAVE,M,MAXP1,MOMCOM,NEVAL,
     1  NOEQU,NOEQ1,NRMOM
C
      DIMENSION CHEBMO(MAXP1,25),CHEB12(13),CHEB24(25),D(25),D1(25),
     1  D2(25),FVAL(25),V(28),X(11)
C
      EXTERNAL F, QWGTF
C
C           THE VECTOR X CONTAINS THE VALUES COS(K*PI/24)
C           K = 1, ...,11, TO BE USED FOR THE CHEBYSHEV EXPANSION OF F
C
      SAVE X
      DATA X(1),X(2),X(3),X(4),X(5),X(6),X(7),X(8),X(9),
     1  X(10),X(11)/
     2     0.9914448613738104E+00,     0.9659258262890683E+00,
     3     0.9238795325112868E+00,     0.8660254037844386E+00,
     4     0.7933533402912352E+00,     0.7071067811865475E+00,
     5     0.6087614290087206E+00,     0.5000000000000000E+00,
     6     0.3826834323650898E+00,     0.2588190451025208E+00,
     7     0.1305261922200516E+00/
C
C           LIST OF MAJOR VARIABLES
C           -----------------------
C
C           CENTR  - MID POINT OF THE INTEGRATION INTERVAL
C           HLGTH  - HALF-LENGTH OF THE INTEGRATION INTERVAL
C           FVAL   - VALUE OF THE FUNCTION F AT THE POINTS
C                    (B-A)*0.5*COS(K*PI/12) + (B+A)*0.5,
C                    K = 0, ..., 24
C           CHEB12 - COEFFICIENTS OF THE CHEBYSHEV SERIES EXPANSION
C                    OF DEGREE 12, FOR THE FUNCTION F, IN THE
C                    INTERVAL (A,B)
C           CHEB24 - COEFFICIENTS OF THE CHEBYSHEV SERIES EXPANSION
C                    OF DEGREE 24, FOR THE FUNCTION F, IN THE
C                    INTERVAL (A,B)
C           RESC12 - APPROXIMATION TO THE INTEGRAL OF
C                    COS(0.5*(B-A)*OMEGA*X)*F(0.5*(B-A)*X+0.5*(B+A))
C                    OVER (-1,+1), USING THE CHEBYSHEV SERIES
C                    EXPANSION OF DEGREE 12
C           RESC24 - APPROXIMATION TO THE SAME INTEGRAL, USING THE
C                    CHEBYSHEV SERIES EXPANSION OF DEGREE 24
C           RESS12 - THE ANALOGUE OF RESC12 FOR THE SINE
C           RESS24 - THE ANALOGUE OF RESC24 FOR THE SINE
C
C
C           MACHINE DEPENDENT CONSTANT
C           --------------------------
C
C           OFLOW IS THE LARGEST POSITIVE MAGNITUDE.
C
C***FIRST EXECUTABLE STATEMENT  QC25F
      OFLOW = R1MACH(2)
C
      CENTR = 0.5E+00*(B+A)
      HLGTH = 0.5E+00*(B-A)
      PARINT = OMEGA*HLGTH
C
C           COMPUTE THE INTEGRAL USING THE 15-POINT GAUSS-KRONROD
C           FORMULA IF THE VALUE OF THE PARAMETER IN THE INTEGRAND
C           IS SMALL.
C
      IF(ABS(PARINT).GT.0.2E+01) GO TO 10
      CALL QK15W(F,QWGTF,OMEGA,P2,P3,P4,INTEGR,A,B,RESULT,
     1  ABSERR,RESABS,RESASC)
      NEVAL = 15
      GO TO 170
C
C           COMPUTE THE INTEGRAL USING THE GENERALIZED CLENSHAW-
C           CURTIS METHOD.
C
   10 CONC = HLGTH*COS(CENTR*OMEGA)
      CONS = HLGTH*SIN(CENTR*OMEGA)
      RESASC = OFLOW
      NEVAL = 25
C
C           CHECK WHETHER THE CHEBYSHEV MOMENTS FOR THIS INTERVAL
C           HAVE ALREADY BEEN COMPUTED.
C
      IF(NRMOM.LT.MOMCOM.OR.KSAVE.EQ.1) GO TO 120
C
C           COMPUTE A NEW SET OF CHEBYSHEV MOMENTS.
C
      M = MOMCOM+1
      PAR2 = PARINT*PARINT
      PAR22 = PAR2+0.2E+01
      SINPAR = SIN(PARINT)
      COSPAR = COS(PARINT)
C
C           COMPUTE THE CHEBYSHEV MOMENTS WITH RESPECT TO COSINE.
C
      V(1) = 0.2E+01*SINPAR/PARINT
      V(2) = (0.8E+01*COSPAR+(PAR2+PAR2-0.8E+01)*SINPAR/
     1  PARINT)/PAR2
      V(3) = (0.32E+02*(PAR2-0.12E+02)*COSPAR+(0.2E+01*
     1  ((PAR2-0.80E+02)*PAR2+0.192E+03)*SINPAR)/
     2  PARINT)/(PAR2*PAR2)
      AC = 0.8E+01*COSPAR
      AS = 0.24E+02*PARINT*SINPAR
      IF(ABS(PARINT).GT.0.24E+02) GO TO 30
C
C           COMPUTE THE CHEBYSHEV MOMENTS AS THE
C           SOLUTIONS OF A BOUNDARY VALUE PROBLEM WITH 1
C           INITIAL VALUE (V(3)) AND 1 END VALUE (COMPUTED
C           USING AN ASYMPTOTIC FORMULA).
C
      NOEQU = 25
      NOEQ1 = NOEQU-1
      AN = 0.6E+01
      DO 20 K = 1,NOEQ1
        AN2 = AN*AN
        D(K) = -0.2E+01*(AN2-0.4E+01)*(PAR22-AN2-AN2)
        D2(K) = (AN-0.1E+01)*(AN-0.2E+01)*PAR2
        D1(K+1) = (AN+0.3E+01)*(AN+0.4E+01)*PAR2
        V(K+3) = AS-(AN2-0.4E+01)*AC
        AN = AN+0.2E+01
   20 CONTINUE
      AN2 = AN*AN
      D(NOEQU) = -0.2E+01*(AN2-0.4E+01)*(PAR22-AN2-AN2)
      V(NOEQU+3) = AS-(AN2-0.4E+01)*AC
      V(4) = V(4)-0.56E+02*PAR2*V(3)
      ASS = PARINT*SINPAR
      ASAP = (((((0.210E+03*PAR2-0.1E+01)*COSPAR-(0.105E+03*PAR2
     1  -0.63E+02)*ASS)/AN2-(0.1E+01-0.15E+02*PAR2)*COSPAR
     2  +0.15E+02*ASS)/AN2-COSPAR+0.3E+01*ASS)/AN2-COSPAR)/AN2
      V(NOEQU+3) = V(NOEQU+3)-0.2E+01*ASAP*PAR2*(AN-0.1E+01)*
     1   (AN-0.2E+01)
C
C           SOLVE THE TRIDIAGONAL SYSTEM BY MEANS OF GAUSSIAN
C           ELIMINATION WITH PARTIAL PIVOTING.
C
      CALL SGTSL(NOEQU,D1,D,D2,V(4),IERS)
      GO TO 50
C
C           COMPUTE THE CHEBYSHEV MOMENTS BY MEANS OF FORWARD
C           RECURSION.
C
   30 AN = 0.4E+01
      DO 40 I = 4,13
        AN2 = AN*AN
        V(I) = ((AN2-0.4E+01)*(0.2E+01*(PAR22-AN2-AN2)*V(I-1)-AC)
     1  +AS-PAR2*(AN+0.1E+01)*(AN+0.2E+01)*V(I-2))/
     2  (PAR2*(AN-0.1E+01)*(AN-0.2E+01))
        AN = AN+0.2E+01
   40 CONTINUE
   50 DO 60 J = 1,13
        CHEBMO(M,2*J-1) = V(J)
   60 CONTINUE
C
C           COMPUTE THE CHEBYSHEV MOMENTS WITH RESPECT TO SINE.
C
      V(1) = 0.2E+01*(SINPAR-PARINT*COSPAR)/PAR2
      V(2) = (0.18E+02-0.48E+02/PAR2)*SINPAR/PAR2
     1  +(-0.2E+01+0.48E+02/PAR2)*COSPAR/PARINT
      AC = -0.24E+02*PARINT*COSPAR
      AS = -0.8E+01*SINPAR
      IF(ABS(PARINT).GT.0.24E+02) GO TO 80
C
C           COMPUTE THE CHEBYSHEV MOMENTS AS THE
C           SOLUTIONS OF A BOUNDARY VALUE PROBLEM WITH 1
C           INITIAL VALUE (V(2)) AND 1 END VALUE (COMPUTED
C           USING AN ASYMPTOTIC FORMULA).
C
      AN = 0.5E+01
      DO 70 K = 1,NOEQ1
        AN2 = AN*AN
        D(K) = -0.2E+01*(AN2-0.4E+01)*(PAR22-AN2-AN2)
        D2(K) = (AN-0.1E+01)*(AN-0.2E+01)*PAR2
        D1(K+1) = (AN+0.3E+01)*(AN+0.4E+01)*PAR2
        V(K+2) = AC+(AN2-0.4E+01)*AS
        AN = AN+0.2E+01
   70 CONTINUE
      AN2 = AN*AN
      D(NOEQU) = -0.2E+01*(AN2-0.4E+01)*(PAR22-AN2-AN2)
      V(NOEQU+2) = AC+(AN2-0.4E+01)*AS
      V(3) = V(3)-0.42E+02*PAR2*V(2)
      ASS = PARINT*COSPAR
      ASAP = (((((0.105E+03*PAR2-0.63E+02)*ASS+(0.210E+03*PAR2
     1  -0.1E+01)*SINPAR)/AN2+(0.15E+02*PAR2-0.1E+01)*SINPAR-
     2  0.15E+02*ASS)/AN2-0.3E+01*ASS-SINPAR)/AN2-SINPAR)/AN2
      V(NOEQU+2) = V(NOEQU+2)-0.2E+01*ASAP*PAR2*(AN-0.1E+01)
     1  *(AN-0.2E+01)
C
C           SOLVE THE TRIDIAGONAL SYSTEM BY MEANS OF GAUSSIAN
C           ELIMINATION WITH PARTIAL PIVOTING.
C
      CALL SGTSL(NOEQU,D1,D,D2,V(3),IERS)
      GO TO 100
C
C           COMPUTE THE CHEBYSHEV MOMENTS BY MEANS OF
C           FORWARD RECURSION.
C
   80 AN = 0.3E+01
      DO 90 I = 3,12
        AN2 = AN*AN
        V(I) = ((AN2-0.4E+01)*(0.2E+01*(PAR22-AN2-AN2)*V(I-1)+AS)
     1  +AC-PAR2*(AN+0.1E+01)*(AN+0.2E+01)*V(I-2))
     2  /(PAR2*(AN-0.1E+01)*(AN-0.2E+01))
        AN = AN+0.2E+01
   90 CONTINUE
  100 DO 110 J = 1,12
        CHEBMO(M,2*J) = V(J)
  110 CONTINUE
  120 IF (NRMOM.LT.MOMCOM) M = NRMOM+1
       IF (MOMCOM.LT.MAXP1-1.AND.NRMOM.GE.MOMCOM) MOMCOM = MOMCOM+1
C
C           COMPUTE THE COEFFICIENTS OF THE CHEBYSHEV EXPANSIONS
C           OF DEGREES 12 AND 24 OF THE FUNCTION F.
C
      FVAL(1) = 0.5E+00*F(CENTR+HLGTH)
      FVAL(13) = F(CENTR)
      FVAL(25) = 0.5E+00*F(CENTR-HLGTH)
      DO 130 I = 2,12
        ISYM = 26-I
        FVAL(I) = F(HLGTH*X(I-1)+CENTR)
        FVAL(ISYM) = F(CENTR-HLGTH*X(I-1))
  130 CONTINUE
      CALL QCHEB(X,FVAL,CHEB12,CHEB24)
C
C           COMPUTE THE INTEGRAL AND ERROR ESTIMATES.
C
      RESC12 = CHEB12(13)*CHEBMO(M,13)
      RESS12 = 0.0E+00
      K = 11
      DO 140 J = 1,6
        RESC12 = RESC12+CHEB12(K)*CHEBMO(M,K)
        RESS12 = RESS12+CHEB12(K+1)*CHEBMO(M,K+1)
        K = K-2
  140 CONTINUE
      RESC24 = CHEB24(25)*CHEBMO(M,25)
      RESS24 = 0.0E+00
      RESABS = ABS(CHEB24(25))
      K = 23
      DO 150 J = 1,12
        RESC24 = RESC24+CHEB24(K)*CHEBMO(M,K)
        RESS24 = RESS24+CHEB24(K+1)*CHEBMO(M,K+1)
        RESABS = ABS(CHEB24(K))+ABS(CHEB24(K+1))
        K = K-2
  150 CONTINUE
      ESTC = ABS(RESC24-RESC12)
      ESTS = ABS(RESS24-RESS12)
      RESABS = RESABS*ABS(HLGTH)
      IF(INTEGR.EQ.2) GO TO 160
      RESULT = CONC*RESC24-CONS*RESS24
      ABSERR = ABS(CONC*ESTC)+ABS(CONS*ESTS)
      GO TO 170
  160 RESULT = CONC*RESS24+CONS*RESC24
      ABSERR = ABS(CONC*ESTS)+ABS(CONS*ESTC)
  170 RETURN
      END