1 SUBROUTINE dqk15i(F,BOUN,INF,A,B,RESULT,ABSERR,RESABS,RESASC,
72 DOUBLE PRECISION A,ABSC,ABSC1,ABSC2,ABSERR,B,BOUN,CENTR,DABS,DINF,
73 * dmax1,dmin1,d1mach,epmach,fc,fsum,fval1,fval2,fv1,fv2,hlgth,
74 * resabs,resasc,resg,resk,reskh,result,tabsc1,tabsc2,
uflow,wg,wgk,
79 dimension fv1(7),fv2(7),xgk(8),wgk(8),wg(8)
98 DATA wg(2) / 0.1294849661 6886969327 0611432679 082d0 /
100 DATA wg(4) / 0.2797053914 8927666790 1467771423 780d0 /
102 DATA wg(6) / 0.3818300505 0511894495 0369775488 975d0 /
104 DATA wg(8) / 0.4179591836 7346938775 5102040816 327d0 /
106 DATA xgk(1) / 0.9914553711 2081263920 6854697526 329d0 /
107 DATA xgk(2) / 0.9491079123 4275852452 6189684047 851d0 /
108 DATA xgk(3) / 0.8648644233 5976907278 9712788640 926d0 /
109 DATA xgk(4) / 0.7415311855 9939443986 3864773280 788d0 /
110 DATA xgk(5) / 0.5860872354 6769113029 4144838258 730d0 /
111 DATA xgk(6) / 0.4058451513 7739716690 6606412076 961d0 /
112 DATA xgk(7) / 0.2077849550 0789846760 0689403773 245d0 /
113 DATA xgk(8) / 0.0000000000 0000000000 0000000000 000d0 /
115 DATA wgk(1) / 0.0229353220 1052922496 3732008058 970d0 /
116 DATA wgk(2) / 0.0630920926 2997855329 0700663189 204d0 /
117 DATA wgk(3) / 0.1047900103 2225018383 9876322541 518d0 /
118 DATA wgk(4) / 0.1406532597 1552591874 5189590510 238d0 /
119 DATA wgk(5) / 0.1690047266 3926790282 6583426598 550d0 /
120 DATA wgk(6) / 0.1903505780 6478540991 3256402421 014d0 /
121 DATA wgk(7) / 0.2044329400 7529889241 4161999234 649d0 /
122 DATA wgk(8) / 0.2094821410 8472782801 2999174891 714d0 /
149 centr = 0.5d+00*(a+b)
150 hlgth = 0.5d+00*(b-a)
151 tabsc1 = boun+dinf*(0.1d+01-centr)/centr
153 CALL f(tabsc1,ierr,fval1)
154 IF (ierr .LT. 0)
RETURN
156 CALL f(-tabsc1,ierr,fvalt)
157 IF (ierr .LT. 0)
RETURN
160 fc = (fval1/centr)/centr
172 tabsc1 = boun+dinf*(0.1d+01-absc1)/absc1
173 tabsc2 = boun+dinf*(0.1d+01-absc2)/absc2
174 CALL f(tabsc1,ierr,fval1)
175 IF (ierr .LT. 0)
RETURN
176 CALL f(tabsc2,ierr,fval2)
177 IF (ierr .LT. 0)
RETURN
179 CALL f(-tabsc1,ierr,fvalt)
180 IF (ierr .LT. 0)
RETURN
184 CALL f(-tabsc2,ierr,fvalt)
185 IF (ierr .LT. 0)
RETURN
188 fval1 = (fval1/absc1)/absc1
189 fval2 = (fval2/absc2)/absc2
193 resg = resg+wg(j)*fsum
194 resk = resk+wgk(j)*fsum
195 resabs = resabs+wgk(j)*(dabs(fval1)+dabs(fval2))
198 resasc = wgk(8)*dabs(fc-reskh)
200 resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
203 resasc = resasc*hlgth
204 resabs = resabs*hlgth
205 abserr = dabs((resk-resg)*hlgth)
206 IF(resasc.NE.0.0d+00.AND.abserr.NE.0.d0) abserr = resasc*
207 * dmin1(0.1d+01,(0.2d+03*abserr/resasc)**1.5d+00)
208 IF(resabs.GT.
uflow/(0.5d+02*epmach)) abserr = dmax1
209 * ((epmach*0.5d+02)*resabs,abserr)
std::string dimension(void) const
subroutine dqk15i(F, BOUN, INF, A, B, RESULT, ABSERR, RESABS, RESASC, IERR)