← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dqc25f.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/dqc25f.f
 
1
*DECK DQC25F
 
2
      SUBROUTINE DQC25F (F, A, B, OMEGA, INTEGR, NRMOM, MAXP1, KSAVE,
 
3
     +   RESULT, ABSERR, NEVAL, RESABS, RESASC, MOMCOM, CHEBMO)
 
4
C***BEGIN PROLOGUE  DQC25F
 
5
C***PURPOSE  To compute the integral I=Integral of F(X) over (A,B)
 
6
C            Where W(X) = COS(OMEGA*X) or W(X)=SIN(OMEGA*X) and to
 
7
C            compute J = Integral of ABS(F) over (A,B). For small value
 
8
C            of OMEGA or small intervals (A,B) the 15-point GAUSS-KRONRO
 
9
C            Rule is used. Otherwise a generalized CLENSHAW-CURTIS
 
10
C            method is used.
 
11
C***LIBRARY   SLATEC (QUADPACK)
 
12
C***CATEGORY  H2A2A2
 
13
C***TYPE      DOUBLE PRECISION (QC25F-S, DQC25F-D)
 
14
C***KEYWORDS  CLENSHAW-CURTIS METHOD, GAUSS-KRONROD RULES,
 
15
C             INTEGRATION RULES FOR FUNCTIONS WITH COS OR SIN FACTOR,
 
16
C             QUADPACK, QUADRATURE
 
17
C***AUTHOR  Piessens, Robert
 
18
C             Applied Mathematics and Programming Division
 
19
C             K. U. Leuven
 
20
C           de Doncker, Elise
 
21
C             Applied Mathematics and Programming Division
 
22
C             K. U. Leuven
 
23
C***DESCRIPTION
 
24
C
 
25
C        Integration rules for functions with COS or SIN factor
 
26
C        Standard fortran subroutine
 
27
C        Double precision version
 
28
C
 
29
C        PARAMETERS
 
30
C         ON ENTRY
 
31
C           F      - Double precision
 
32
C                    Function subprogram defining the integrand
 
33
C                    function F(X). The actual name for F needs to
 
34
C                    be declared E X T E R N A L in the calling program.
 
35
C
 
36
C           A      - Double precision
 
37
C                    Lower limit of integration
 
38
C
 
39
C           B      - Double precision
 
40
C                    Upper limit of integration
 
41
C
 
42
C           OMEGA  - Double precision
 
43
C                    Parameter in the WEIGHT function
 
44
C
 
45
C           INTEGR - Integer
 
46
C                    Indicates which WEIGHT function is to be used
 
47
C                       INTEGR = 1   W(X) = COS(OMEGA*X)
 
48
C                       INTEGR = 2   W(X) = SIN(OMEGA*X)
 
49
C
 
50
C           NRMOM  - Integer
 
51
C                    The length of interval (A,B) is equal to the length
 
52
C                    of the original integration interval divided by
 
53
C                    2**NRMOM (we suppose that the routine is used in an
 
54
C                    adaptive integration process, otherwise set
 
55
C                    NRMOM = 0). NRMOM must be zero at the first call.
 
56
C
 
57
C           MAXP1  - Integer
 
58
C                    Gives an upper bound on the number of Chebyshev
 
59
C                    moments which can be stored, i.e. for the
 
60
C                    intervals of lengths ABS(BB-AA)*2**(-L),
 
61
C                    L = 0,1,2, ..., MAXP1-2.
 
62
C
 
63
C           KSAVE  - Integer
 
64
C                    Key which is one when the moments for the
 
65
C                    current interval have been computed
 
66
C
 
67
C         ON RETURN
 
68
C           RESULT - Double precision
 
69
C                    Approximation to the integral I
 
70
C
 
71
C           ABSERR - Double precision
 
72
C                    Estimate of the modulus of the absolute
 
73
C                    error, which should equal or exceed ABS(I-RESULT)
 
74
C
 
75
C           NEVAL  - Integer
 
76
C                    Number of integrand evaluations
 
77
C
 
78
C           RESABS - Double precision
 
79
C                    Approximation to the integral J
 
80
C
 
81
C           RESASC - Double precision
 
82
C                    Approximation to the integral of ABS(F-I/(B-A))
 
83
C
 
84
C         ON ENTRY AND RETURN
 
85
C           MOMCOM - Integer
 
86
C                    For each interval length we need to compute the
 
87
C                    Chebyshev moments. MOMCOM counts the number of
 
88
C                    intervals for which these moments have already been
 
89
C                    computed. If NRMOM.LT.MOMCOM or KSAVE = 1, the
 
90
C                    Chebyshev moments for the interval (A,B) have
 
91
C                    already been computed and stored, otherwise we
 
92
C                    compute them and we increase MOMCOM.
 
93
C
 
94
C           CHEBMO - Double precision
 
95
C                    Array of dimension at least (MAXP1,25) containing
 
96
C                    the modified Chebyshev moments for the first MOMCOM
 
97
C                    MOMCOM interval lengths
 
98
C
 
99
C ......................................................................
 
100
C
 
101
C***REFERENCES  (NONE)
 
102
C***ROUTINES CALLED  D1MACH, DGTSL, DQCHEB, DQK15W, DQWGTF
 
103
C***REVISION HISTORY  (YYMMDD)
 
104
C   810101  DATE WRITTEN
 
105
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
106
C   890531  REVISION DATE from Version 3.2
 
107
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
108
C***END PROLOGUE  DQC25F
 
109
C
 
110
      DOUBLE PRECISION A,ABSERR,AC,AN,AN2,AS,ASAP,ASS,B,CENTR,CHEBMO,
 
111
     1  CHEB12,CHEB24,CONC,CONS,COSPAR,D,DQWGTF,D1,
 
112
     2  D1MACH,D2,ESTC,ESTS,F,FVAL,HLGTH,OFLOW,OMEGA,PARINT,PAR2,PAR22,
 
113
     3  P2,P3,P4,RESABS,RESASC,RESC12,RESC24,RESS12,RESS24,RESULT,
 
114
     4  SINPAR,V,X
 
115
      INTEGER I,IERS,INTEGR,ISYM,J,K,KSAVE,M,MOMCOM,NEVAL,MAXP1,
 
116
     1  NOEQU,NOEQ1,NRMOM
 
117
C
 
118
      DIMENSION CHEBMO(MAXP1,25),CHEB12(13),CHEB24(25),D(25),D1(25),
 
119
     1  D2(25),FVAL(25),V(28),X(11)
 
120
C
 
121
      EXTERNAL F, DQWGTF
 
122
C
 
123
C           THE VECTOR X CONTAINS THE VALUES COS(K*PI/24)
 
124
C           K = 1, ...,11, TO BE USED FOR THE CHEBYSHEV EXPANSION OF F
 
125
C
 
126
      SAVE X
 
127
      DATA X(1),X(2),X(3),X(4),X(5),X(6),X(7),X(8),X(9),X(10),X(11)/
 
128
     1     0.9914448613738104D+00,     0.9659258262890683D+00,
 
129
     2     0.9238795325112868D+00,     0.8660254037844386D+00,
 
130
     3     0.7933533402912352D+00,     0.7071067811865475D+00,
 
131
     4     0.6087614290087206D+00,     0.5000000000000000D+00,
 
132
     5     0.3826834323650898D+00,     0.2588190451025208D+00,
 
133
     6     0.1305261922200516D+00/
 
134
C
 
135
C           LIST OF MAJOR VARIABLES
 
136
C           -----------------------
 
137
C
 
138
C           CENTR  - MID POINT OF THE INTEGRATION INTERVAL
 
139
C           HLGTH  - HALF-LENGTH OF THE INTEGRATION INTERVAL
 
140
C           FVAL   - VALUE OF THE FUNCTION F AT THE POINTS
 
141
C                    (B-A)*0.5*COS(K*PI/12) + (B+A)*0.5, K = 0, ..., 24
 
142
C           CHEB12 - COEFFICIENTS OF THE CHEBYSHEV SERIES EXPANSION
 
143
C                    OF DEGREE 12, FOR THE FUNCTION F, IN THE
 
144
C                    INTERVAL (A,B)
 
145
C           CHEB24 - COEFFICIENTS OF THE CHEBYSHEV SERIES EXPANSION
 
146
C                    OF DEGREE 24, FOR THE FUNCTION F, IN THE
 
147
C                    INTERVAL (A,B)
 
148
C           RESC12 - APPROXIMATION TO THE INTEGRAL OF
 
149
C                    COS(0.5*(B-A)*OMEGA*X)*F(0.5*(B-A)*X+0.5*(B+A))
 
150
C                    OVER (-1,+1), USING THE CHEBYSHEV SERIES
 
151
C                    EXPANSION OF DEGREE 12
 
152
C           RESC24 - APPROXIMATION TO THE SAME INTEGRAL, USING THE
 
153
C                    CHEBYSHEV SERIES EXPANSION OF DEGREE 24
 
154
C           RESS12 - THE ANALOGUE OF RESC12 FOR THE SINE
 
155
C           RESS24 - THE ANALOGUE OF RESC24 FOR THE SINE
 
156
C
 
157
C
 
158
C           MACHINE DEPENDENT CONSTANT
 
159
C           --------------------------
 
160
C
 
161
C           OFLOW IS THE LARGEST POSITIVE MAGNITUDE.
 
162
C
 
163
C***FIRST EXECUTABLE STATEMENT  DQC25F
 
164
      OFLOW = D1MACH(2)
 
165
C
 
166
      CENTR = 0.5D+00*(B+A)
 
167
      HLGTH = 0.5D+00*(B-A)
 
168
      PARINT = OMEGA*HLGTH
 
169
C
 
170
C           COMPUTE THE INTEGRAL USING THE 15-POINT GAUSS-KRONROD
 
171
C           FORMULA IF THE VALUE OF THE PARAMETER IN THE INTEGRAND
 
172
C           IS SMALL.
 
173
C
 
174
      IF(ABS(PARINT).GT.0.2D+01) GO TO 10
 
175
      CALL DQK15W(F,DQWGTF,OMEGA,P2,P3,P4,INTEGR,A,B,RESULT,
 
176
     1  ABSERR,RESABS,RESASC)
 
177
      NEVAL = 15
 
178
      GO TO 170
 
179
C
 
180
C           COMPUTE THE INTEGRAL USING THE GENERALIZED CLENSHAW-
 
181
C           CURTIS METHOD.
 
182
C
 
183
   10 CONC = HLGTH*COS(CENTR*OMEGA)
 
184
      CONS = HLGTH*SIN(CENTR*OMEGA)
 
185
      RESASC = OFLOW
 
186
      NEVAL = 25
 
187
C
 
188
C           CHECK WHETHER THE CHEBYSHEV MOMENTS FOR THIS INTERVAL
 
189
C           HAVE ALREADY BEEN COMPUTED.
 
190
C
 
191
      IF(NRMOM.LT.MOMCOM.OR.KSAVE.EQ.1) GO TO 120
 
192
C
 
193
C           COMPUTE A NEW SET OF CHEBYSHEV MOMENTS.
 
194
C
 
195
      M = MOMCOM+1
 
196
      PAR2 = PARINT*PARINT
 
197
      PAR22 = PAR2+0.2D+01
 
198
      SINPAR = SIN(PARINT)
 
199
      COSPAR = COS(PARINT)
 
200
C
 
201
C           COMPUTE THE CHEBYSHEV MOMENTS WITH RESPECT TO COSINE.
 
202
C
 
203
      V(1) = 0.2D+01*SINPAR/PARINT
 
204
      V(2) = (0.8D+01*COSPAR+(PAR2+PAR2-0.8D+01)*SINPAR/PARINT)/PAR2
 
205
      V(3) = (0.32D+02*(PAR2-0.12D+02)*COSPAR+(0.2D+01*
 
206
     1  ((PAR2-0.80D+02)*PAR2+0.192D+03)*SINPAR)/PARINT)/(PAR2*PAR2)
 
207
      AC = 0.8D+01*COSPAR
 
208
      AS = 0.24D+02*PARINT*SINPAR
 
209
      IF(ABS(PARINT).GT.0.24D+02) GO TO 30
 
210
C
 
211
C           COMPUTE THE CHEBYSHEV MOMENTS AS THE SOLUTIONS OF A
 
212
C           BOUNDARY VALUE PROBLEM WITH 1 INITIAL VALUE (V(3)) AND 1
 
213
C           END VALUE (COMPUTED USING AN ASYMPTOTIC FORMULA).
 
214
C
 
215
      NOEQU = 25
 
216
      NOEQ1 = NOEQU-1
 
217
      AN = 0.6D+01
 
218
      DO 20 K = 1,NOEQ1
 
219
        AN2 = AN*AN
 
220
        D(K) = -0.2D+01*(AN2-0.4D+01)*(PAR22-AN2-AN2)
 
221
        D2(K) = (AN-0.1D+01)*(AN-0.2D+01)*PAR2
 
222
        D1(K+1) = (AN+0.3D+01)*(AN+0.4D+01)*PAR2
 
223
        V(K+3) = AS-(AN2-0.4D+01)*AC
 
224
        AN = AN+0.2D+01
 
225
   20 CONTINUE
 
226
      AN2 = AN*AN
 
227
      D(NOEQU) = -0.2D+01*(AN2-0.4D+01)*(PAR22-AN2-AN2)
 
228
      V(NOEQU+3) = AS-(AN2-0.4D+01)*AC
 
229
      V(4) = V(4)-0.56D+02*PAR2*V(3)
 
230
      ASS = PARINT*SINPAR
 
231
      ASAP = (((((0.210D+03*PAR2-0.1D+01)*COSPAR-(0.105D+03*PAR2
 
232
     1  -0.63D+02)*ASS)/AN2-(0.1D+01-0.15D+02*PAR2)*COSPAR
 
233
     2  +0.15D+02*ASS)/AN2-COSPAR+0.3D+01*ASS)/AN2-COSPAR)/AN2
 
234
      V(NOEQU+3) = V(NOEQU+3)-0.2D+01*ASAP*PAR2*(AN-0.1D+01)*
 
235
     1   (AN-0.2D+01)
 
236
C
 
237
C           SOLVE THE TRIDIAGONAL SYSTEM BY MEANS OF GAUSSIAN
 
238
C           ELIMINATION WITH PARTIAL PIVOTING.
 
239
C
 
240
C ***       CALL TO DGTSL MUST BE REPLACED BY CALL TO
 
241
C ***       DOUBLE PRECISION VERSION OF LINPACK ROUTINE SGTSL
 
242
C
 
243
      CALL DGTSL(NOEQU,D1,D,D2,V(4),IERS)
 
244
      GO TO 50
 
245
C
 
246
C           COMPUTE THE CHEBYSHEV MOMENTS BY MEANS OF FORWARD
 
247
C           RECURSION.
 
248
C
 
249
   30 AN = 0.4D+01
 
250
      DO 40 I = 4,13
 
251
        AN2 = AN*AN
 
252
        V(I) = ((AN2-0.4D+01)*(0.2D+01*(PAR22-AN2-AN2)*V(I-1)-AC)
 
253
     1  +AS-PAR2*(AN+0.1D+01)*(AN+0.2D+01)*V(I-2))/
 
254
     2  (PAR2*(AN-0.1D+01)*(AN-0.2D+01))
 
255
        AN = AN+0.2D+01
 
256
   40 CONTINUE
 
257
   50 DO 60 J = 1,13
 
258
        CHEBMO(M,2*J-1) = V(J)
 
259
   60 CONTINUE
 
260
C
 
261
C           COMPUTE THE CHEBYSHEV MOMENTS WITH RESPECT TO SINE.
 
262
C
 
263
      V(1) = 0.2D+01*(SINPAR-PARINT*COSPAR)/PAR2
 
264
      V(2) = (0.18D+02-0.48D+02/PAR2)*SINPAR/PAR2
 
265
     1  +(-0.2D+01+0.48D+02/PAR2)*COSPAR/PARINT
 
266
      AC = -0.24D+02*PARINT*COSPAR
 
267
      AS = -0.8D+01*SINPAR
 
268
      IF(ABS(PARINT).GT.0.24D+02) GO TO 80
 
269
C
 
270
C           COMPUTE THE CHEBYSHEV MOMENTS AS THE SOLUTIONS OF A BOUNDARY
 
271
C           VALUE PROBLEM WITH 1 INITIAL VALUE (V(2)) AND 1 END VALUE
 
272
C           (COMPUTED USING AN ASYMPTOTIC FORMULA).
 
273
C
 
274
      AN = 0.5D+01
 
275
      DO 70 K = 1,NOEQ1
 
276
        AN2 = AN*AN
 
277
        D(K) = -0.2D+01*(AN2-0.4D+01)*(PAR22-AN2-AN2)
 
278
        D2(K) = (AN-0.1D+01)*(AN-0.2D+01)*PAR2
 
279
        D1(K+1) = (AN+0.3D+01)*(AN+0.4D+01)*PAR2
 
280
        V(K+2) = AC+(AN2-0.4D+01)*AS
 
281
        AN = AN+0.2D+01
 
282
   70 CONTINUE
 
283
      AN2 = AN*AN
 
284
      D(NOEQU) = -0.2D+01*(AN2-0.4D+01)*(PAR22-AN2-AN2)
 
285
      V(NOEQU+2) = AC+(AN2-0.4D+01)*AS
 
286
      V(3) = V(3)-0.42D+02*PAR2*V(2)
 
287
      ASS = PARINT*COSPAR
 
288
      ASAP = (((((0.105D+03*PAR2-0.63D+02)*ASS+(0.210D+03*PAR2
 
289
     1  -0.1D+01)*SINPAR)/AN2+(0.15D+02*PAR2-0.1D+01)*SINPAR-
 
290
     2  0.15D+02*ASS)/AN2-0.3D+01*ASS-SINPAR)/AN2-SINPAR)/AN2
 
291
      V(NOEQU+2) = V(NOEQU+2)-0.2D+01*ASAP*PAR2*(AN-0.1D+01)
 
292
     1  *(AN-0.2D+01)
 
293
C
 
294
C           SOLVE THE TRIDIAGONAL SYSTEM BY MEANS OF GAUSSIAN
 
295
C           ELIMINATION WITH PARTIAL PIVOTING.
 
296
C
 
297
C ***       CALL TO DGTSL MUST BE REPLACED BY CALL TO
 
298
C ***       DOUBLE PRECISION VERSION OF LINPACK ROUTINE SGTSL
 
299
C
 
300
      CALL DGTSL(NOEQU,D1,D,D2,V(3),IERS)
 
301
      GO TO 100
 
302
C
 
303
C           COMPUTE THE CHEBYSHEV MOMENTS BY MEANS OF FORWARD RECURSION.
 
304
C
 
305
   80 AN = 0.3D+01
 
306
      DO 90 I = 3,12
 
307
        AN2 = AN*AN
 
308
        V(I) = ((AN2-0.4D+01)*(0.2D+01*(PAR22-AN2-AN2)*V(I-1)+AS)
 
309
     1  +AC-PAR2*(AN+0.1D+01)*(AN+0.2D+01)*V(I-2))
 
310
     2  /(PAR2*(AN-0.1D+01)*(AN-0.2D+01))
 
311
        AN = AN+0.2D+01
 
312
   90 CONTINUE
 
313
  100 DO 110 J = 1,12
 
314
        CHEBMO(M,2*J) = V(J)
 
315
  110 CONTINUE
 
316
  120 IF (NRMOM.LT.MOMCOM) M = NRMOM+1
 
317
       IF (MOMCOM.LT.(MAXP1-1).AND.NRMOM.GE.MOMCOM) MOMCOM = MOMCOM+1
 
318
C
 
319
C           COMPUTE THE COEFFICIENTS OF THE CHEBYSHEV EXPANSIONS
 
320
C           OF DEGREES 12 AND 24 OF THE FUNCTION F.
 
321
C
 
322
      FVAL(1) = 0.5D+00*F(CENTR+HLGTH)
 
323
      FVAL(13) = F(CENTR)
 
324
      FVAL(25) = 0.5D+00*F(CENTR-HLGTH)
 
325
      DO 130 I = 2,12
 
326
        ISYM = 26-I
 
327
        FVAL(I) = F(HLGTH*X(I-1)+CENTR)
 
328
        FVAL(ISYM) = F(CENTR-HLGTH*X(I-1))
 
329
  130 CONTINUE
 
330
      CALL DQCHEB(X,FVAL,CHEB12,CHEB24)
 
331
C
 
332
C           COMPUTE THE INTEGRAL AND ERROR ESTIMATES.
 
333
C
 
334
      RESC12 = CHEB12(13)*CHEBMO(M,13)
 
335
      RESS12 = 0.0D+00
 
336
      K = 11
 
337
      DO 140 J = 1,6
 
338
        RESC12 = RESC12+CHEB12(K)*CHEBMO(M,K)
 
339
        RESS12 = RESS12+CHEB12(K+1)*CHEBMO(M,K+1)
 
340
        K = K-2
 
341
  140 CONTINUE
 
342
      RESC24 = CHEB24(25)*CHEBMO(M,25)
 
343
      RESS24 = 0.0D+00
 
344
      RESABS = ABS(CHEB24(25))
 
345
      K = 23
 
346
      DO 150 J = 1,12
 
347
        RESC24 = RESC24+CHEB24(K)*CHEBMO(M,K)
 
348
        RESS24 = RESS24+CHEB24(K+1)*CHEBMO(M,K+1)
 
349
        RESABS = ABS(CHEB24(K))+ABS(CHEB24(K+1))
 
350
        K = K-2
 
351
  150 CONTINUE
 
352
      ESTC = ABS(RESC24-RESC12)
 
353
      ESTS = ABS(RESS24-RESS12)
 
354
      RESABS = RESABS*ABS(HLGTH)
 
355
      IF(INTEGR.EQ.2) GO TO 160
 
356
      RESULT = CONC*RESC24-CONS*RESS24
 
357
      ABSERR = ABS(CONC*ESTC)+ABS(CONS*ESTS)
 
358
      GO TO 170
 
359
  160 RESULT = CONC*RESS24+CONS*RESC24
 
360
      ABSERR = ABS(CONC*ESTS)+ABS(CONS*ESTC)
 
361
  170 RETURN
 
362
      END