src/numerical/slatec/dqagpe.lisp

   1 ;;; Compiled by f2cl version:
   2 ;;; ("f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $"
   3 ;;;  "f2cl2.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
   4 ;;;  "f2cl3.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
   5 ;;;  "f2cl4.l,v 96616d88fb7e 2008/02/22 22:19:34 rtoy $"
   6 ;;;  "f2cl5.l,v 46c1f6a93b0d 2012/05/03 04:40:28 toy $"
   7 ;;;  "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $"
   8 ;;;  "macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $")
   9
  10 ;;; Using Lisp CMU Common Lisp snapshot-2012-04 (20C Unicode)
  11 ;;;
  12 ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
  13 ;;;           (:coerce-assigns :as-needed) (:array-type ':array)
  14 ;;;           (:array-slicing t) (:declare-common nil)
  15 ;;;           (:float-format double-float))
  16
  17 (in-package :slatec)
  18
  19
  20 (defun dqagpe
  21        (f a b npts2 points epsabs epsrel limit result abserr neval ier alist
  22         blist rlist elist pts iord level ndin last$)
  23   (declare (type (array f2cl-lib:integer4 (*)) ndin level iord)
  24            (type (array double-float (*)) pts elist rlist blist alist points)
  25            (type (f2cl-lib:integer4) last$ ier neval limit npts2)
  26            (type (double-float) abserr result epsrel epsabs b a))
  27   (f2cl-lib:with-multi-array-data
  28       ((points double-float points-%data% points-%offset%)
  29        (alist double-float alist-%data% alist-%offset%)
  30        (blist double-float blist-%data% blist-%offset%)
  31        (rlist double-float rlist-%data% rlist-%offset%)
  32        (elist double-float elist-%data% elist-%offset%)
  33        (pts double-float pts-%data% pts-%offset%)
  34        (iord f2cl-lib:integer4 iord-%data% iord-%offset%)
  35        (level f2cl-lib:integer4 level-%data% level-%offset%)
  36        (ndin f2cl-lib:integer4 ndin-%data% ndin-%offset%))
  37     (prog ((res3la (make-array 3 :element-type 'double-float))
  38            (rlist2 (make-array 52 :element-type 'double-float)) (extrap nil)
  39            (noext nil) (i 0) (id 0) (ierro 0) (ind1 0) (ind2 0) (ip1 0)
  40            (iroff1 0) (iroff2 0) (iroff3 0) (j 0) (jlow 0) (jupbnd 0) (k 0)
  41            (ksgn 0) (ktmin 0) (levcur 0) (levmax 0) (maxerr 0) (nintp1 0)
  42            (npts 0) (nres 0) (nrmax 0) (numrl2 0) (abseps 0.0) (area 0.0)
  43            (area1 0.0) (area12 0.0) (area2 0.0) (a1 0.0) (a2 0.0) (b1 0.0)
  44            (b2 0.0) (correc 0.0) (defabs 0.0) (defab1 0.0) (defab2 0.0)
  45            (dres 0.0) (epmach 0.0) (erlarg 0.0) (erlast 0.0) (errbnd 0.0)
  46            (errmax 0.0) (error1 0.0) (erro12 0.0) (error2 0.0) (errsum 0.0)
  47            (ertest 0.0) (oflow 0.0) (resa 0.0) (resabs 0.0) (reseps 0.0)
  48            (sign$ 0.0) (temp 0.0) (uflow 0.0) (nint$ 0))
  49       (declare (type (array double-float (52)) rlist2)
  50                (type (array double-float (3)) res3la)
  51                (type (double-float) uflow temp sign$ reseps resabs resa oflow
  52                                     ertest errsum error2 erro12 error1 errmax
  53                                     errbnd erlast erlarg epmach dres defab2
  54                                     defab1 defabs correc b2 b1 a2 a1 area2
  55                                     area12 area1 area abseps)
  56                (type (f2cl-lib:integer4) nint$ numrl2 nrmax nres npts nintp1
  57                                          maxerr levmax levcur ktmin ksgn k
  58                                          jupbnd jlow j iroff3 iroff2 iroff1 ip1
  59                                          ind2 ind1 ierro id i)
  60                (type f2cl-lib:logical noext extrap))
  61       (setf epmach (f2cl-lib:d1mach 4))
  62       (setf ier 0)
  63       (setf neval 0)
  64       (setf last$ 0)
  65       (setf result 0.0)
  66       (setf abserr 0.0)
  67       (setf (f2cl-lib:fref alist-%data% (1) ((1 *)) alist-%offset%) a)
  68       (setf (f2cl-lib:fref blist-%data% (1) ((1 *)) blist-%offset%) b)
  69       (setf (f2cl-lib:fref rlist-%data% (1) ((1 *)) rlist-%offset%) 0.0)
  70       (setf (f2cl-lib:fref elist-%data% (1) ((1 *)) elist-%offset%) 0.0)
  71       (setf (f2cl-lib:fref iord-%data% (1) ((1 *)) iord-%offset%) 0)
  72       (setf (f2cl-lib:fref level-%data% (1) ((1 *)) level-%offset%) 0)
  73       (setf npts (f2cl-lib:int-sub npts2 2))
  74       (if
  75        (or (< npts2 2)
  76            (<= limit npts)
  77            (and (<= epsabs 0.0) (< epsrel (max (* 50.0 epmach) 5.0e-29))))
  78        (setf ier 6))
  79       (if (= ier 6) (go label999))
  80       (setf sign$ 1.0)
  81       (if (> a b) (setf sign$ -1.0))
  82       (setf (f2cl-lib:fref pts-%data% (1) ((1 *)) pts-%offset%) (min a b))
  83       (if (= npts 0) (go label15))
  84       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
  85                     ((> i npts) nil)
  86         (tagbody
  87           (setf (f2cl-lib:fref pts-%data%
  88                                ((f2cl-lib:int-add i 1))
  89                                ((1 *))
  90                                pts-%offset%)
  91                   (f2cl-lib:fref points-%data% (i) ((1 *)) points-%offset%))
  92          label10))
  93      label15
  94       (setf (f2cl-lib:fref pts-%data%
  95                            ((f2cl-lib:int-add npts 2))
  96                            ((1 *))
  97                            pts-%offset%)
  98               (max a b))
  99       (setf nint$ (f2cl-lib:int-add npts 1))
 100       (setf a1 (f2cl-lib:fref pts-%data% (1) ((1 *)) pts-%offset%))
 101       (if (= npts 0) (go label40))
 102       (setf nintp1 (f2cl-lib:int-add nint$ 1))
 103       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 104                     ((> i nint$) nil)
 105         (tagbody
 106           (setf ip1 (f2cl-lib:int-add i 1))
 107           (f2cl-lib:fdo (j ip1 (f2cl-lib:int-add j 1))
 108                         ((> j nintp1) nil)
 109             (tagbody
 110               (if
 111                (<= (f2cl-lib:fref pts-%data% (i) ((1 *)) pts-%offset%)
 112                    (f2cl-lib:fref pts-%data% (j) ((1 *)) pts-%offset%))
 113                (go label20))
 114               (setf temp (f2cl-lib:fref pts-%data% (i) ((1 *)) pts-%offset%))
 115               (setf (f2cl-lib:fref pts-%data% (i) ((1 *)) pts-%offset%)
 116                       (f2cl-lib:fref pts-%data% (j) ((1 *)) pts-%offset%))
 117               (setf (f2cl-lib:fref pts-%data% (j) ((1 *)) pts-%offset%) temp)
 118              label20))))
 119      label20
 120       (if
 121        (or (/= (f2cl-lib:fref pts-%data% (1) ((1 *)) pts-%offset%) (min a b))
 122            (/= (f2cl-lib:fref pts-%data% (nintp1) ((1 *)) pts-%offset%)
 123                (max a b)))
 124        (setf ier 6))
 125       (if (= ier 6) (go label999))
 126      label40
 127       (setf resabs 0.0)
 128       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 129                     ((> i nint$) nil)
 130         (tagbody
 131           (setf b1
 132                   (f2cl-lib:fref pts-%data%
 133                                  ((f2cl-lib:int-add i 1))
 134                                  ((1 *))
 135                                  pts-%offset%))
 136           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
 137               (dqk21 f a1 b1 area1 error1 defabs resa)
 138             (declare (ignore var-0 var-1 var-2))
 139             (setf area1 var-3)
 140             (setf error1 var-4)
 141             (setf defabs var-5)
 142             (setf resa var-6))
 143           (setf abserr (+ abserr error1))
 144           (setf result (+ result area1))
 145           (setf (f2cl-lib:fref ndin-%data% (i) ((1 *)) ndin-%offset%) 0)
 146           (if (and (= error1 resa) (/= error1 0.0))
 147               (setf (f2cl-lib:fref ndin-%data% (i) ((1 *)) ndin-%offset%) 1))
 148           (setf resabs (+ resabs defabs))
 149           (setf (f2cl-lib:fref level-%data% (i) ((1 *)) level-%offset%) 0)
 150           (setf (f2cl-lib:fref elist-%data% (i) ((1 *)) elist-%offset%) error1)
 151           (setf (f2cl-lib:fref alist-%data% (i) ((1 *)) alist-%offset%) a1)
 152           (setf (f2cl-lib:fref blist-%data% (i) ((1 *)) blist-%offset%) b1)
 153           (setf (f2cl-lib:fref rlist-%data% (i) ((1 *)) rlist-%offset%) area1)
 154           (setf (f2cl-lib:fref iord-%data% (i) ((1 *)) iord-%offset%) i)
 155           (setf a1 b1)
 156          label50))
 157       (setf errsum 0.0)
 158       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 159                     ((> i nint$) nil)
 160         (tagbody
 161           (if (= (f2cl-lib:fref ndin-%data% (i) ((1 *)) ndin-%offset%) 1)
 162               (setf (f2cl-lib:fref elist-%data% (i) ((1 *)) elist-%offset%)
 163                       abserr))
 164           (setf errsum
 165                   (+ errsum
 166                      (f2cl-lib:fref elist-%data% (i) ((1 *)) elist-%offset%)))
 167          label55))
 168       (setf last$ nint$)
 169       (setf neval (f2cl-lib:int-mul 21 nint$))
 170       (setf dres (abs result))
 171       (setf errbnd (max epsabs (* epsrel dres)))
 172       (if (and (<= abserr (* 100.0 epmach resabs)) (> abserr errbnd))
 173           (setf ier 2))
 174       (if (= nint$ 1) (go label80))
 175       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 176                     ((> i npts) nil)
 177         (tagbody
 178           (setf jlow (f2cl-lib:int-add i 1))
 179           (setf ind1 (f2cl-lib:fref iord-%data% (i) ((1 *)) iord-%offset%))
 180           (f2cl-lib:fdo (j jlow (f2cl-lib:int-add j 1))
 181                         ((> j nint$) nil)
 182             (tagbody
 183               (setf ind2 (f2cl-lib:fref iord-%data% (j) ((1 *)) iord-%offset%))
 184               (if
 185                (> (f2cl-lib:fref elist-%data% (ind1) ((1 *)) elist-%offset%)
 186                   (f2cl-lib:fref elist-%data% (ind2) ((1 *)) elist-%offset%))
 187                (go label60))
 188               (setf ind1 ind2)
 189               (setf k j)
 190              label60))
 191           (if (= ind1 (f2cl-lib:fref iord-%data% (i) ((1 *)) iord-%offset%))
 192               (go label70))
 193           (setf (f2cl-lib:fref iord-%data% (k) ((1 *)) iord-%offset%)
 194                   (f2cl-lib:fref iord-%data% (i) ((1 *)) iord-%offset%))
 195           (setf (f2cl-lib:fref iord-%data% (i) ((1 *)) iord-%offset%) ind1)
 196          label70))
 197       (if (< limit npts2) (setf ier 1))
 198      label80
 199       (if (or (/= ier 0) (<= abserr errbnd)) (go label999))
 200       (setf (f2cl-lib:fref rlist2 (1) ((1 52))) result)
 201       (setf maxerr (f2cl-lib:fref iord-%data% (1) ((1 *)) iord-%offset%))
 202       (setf errmax
 203               (f2cl-lib:fref elist-%data% (maxerr) ((1 *)) elist-%offset%))
 204       (setf area result)
 205       (setf nrmax 1)
 206       (setf nres 0)
 207       (setf numrl2 1)
 208       (setf ktmin 0)
 209       (setf extrap f2cl-lib:%false%)
 210       (setf noext f2cl-lib:%false%)
 211       (setf erlarg errsum)
 212       (setf ertest errbnd)
 213       (setf levmax 1)
 214       (setf iroff1 0)
 215       (setf iroff2 0)
 216       (setf iroff3 0)
 217       (setf ierro 0)
 218       (setf uflow (f2cl-lib:d1mach 1))
 219       (setf oflow (f2cl-lib:d1mach 2))
 220       (setf abserr oflow)
 221       (setf ksgn -1)
 222       (if (>= dres (* (- 1.0 (* 50.0 epmach)) resabs)) (setf ksgn 1))
 223       (f2cl-lib:fdo (last$ npts2 (f2cl-lib:int-add last$ 1))
 224                     ((> last$ limit) nil)
 225         (tagbody
 226           (setf levcur
 227                   (f2cl-lib:int-add
 228                    (f2cl-lib:fref level-%data% (maxerr) ((1 *)) level-%offset%)
 229                    1))
 230           (setf a1
 231                   (f2cl-lib:fref alist-%data% (maxerr) ((1 *)) alist-%offset%))
 232           (setf b1
 233                   (* 0.5
 234                      (+
 235                       (f2cl-lib:fref alist-%data%
 236                                      (maxerr)
 237                                      ((1 *))
 238                                      alist-%offset%)
 239                       (f2cl-lib:fref blist-%data%
 240                                      (maxerr)
 241                                      ((1 *))
 242                                      blist-%offset%))))
 243           (setf a2 b1)
 244           (setf b2
 245                   (f2cl-lib:fref blist-%data% (maxerr) ((1 *)) blist-%offset%))
 246           (setf erlast errmax)
 247           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
 248               (dqk21 f a1 b1 area1 error1 resa defab1)
 249             (declare (ignore var-0 var-1 var-2))
 250             (setf area1 var-3)
 251             (setf error1 var-4)
 252             (setf resa var-5)
 253             (setf defab1 var-6))
 254           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
 255               (dqk21 f a2 b2 area2 error2 resa defab2)
 256             (declare (ignore var-0 var-1 var-2))
 257             (setf area2 var-3)
 258             (setf error2 var-4)
 259             (setf resa var-5)
 260             (setf defab2 var-6))
 261           (setf neval (f2cl-lib:int-add neval 42))
 262           (setf area12 (+ area1 area2))
 263           (setf erro12 (+ error1 error2))
 264           (setf errsum (- (+ errsum erro12) errmax))
 265           (setf area
 266                   (- (+ area area12)
 267                      (f2cl-lib:fref rlist-%data%
 268                                     (maxerr)
 269                                     ((1 *))
 270                                     rlist-%offset%)))
 271           (if (or (= defab1 error1) (= defab2 error2)) (go label95))
 272           (if
 273            (or
 274             (>
 275              (abs
 276               (- (f2cl-lib:fref rlist-%data% (maxerr) ((1 *)) rlist-%offset%)
 277                  area12))
 278              (* 1.0e-5 (abs area12)))
 279             (< erro12 (* 0.99 errmax)))
 280            (go label90))
 281           (if extrap (setf iroff2 (f2cl-lib:int-add iroff2 1)))
 282           (if (not extrap) (setf iroff1 (f2cl-lib:int-add iroff1 1)))
 283          label90
 284           (if (and (> last$ 10) (> erro12 errmax))
 285               (setf iroff3 (f2cl-lib:int-add iroff3 1)))
 286          label95
 287           (setf (f2cl-lib:fref level-%data% (maxerr) ((1 *)) level-%offset%)
 288                   levcur)
 289           (setf (f2cl-lib:fref level-%data% (last$) ((1 *)) level-%offset%)
 290                   levcur)
 291           (setf (f2cl-lib:fref rlist-%data% (maxerr) ((1 *)) rlist-%offset%)
 292                   area1)
 293           (setf (f2cl-lib:fref rlist-%data% (last$) ((1 *)) rlist-%offset%)
 294                   area2)
 295           (setf errbnd (max epsabs (* epsrel (abs area))))
 296           (if (or (>= (f2cl-lib:int-add iroff1 iroff2) 10) (>= iroff3 20))
 297               (setf ier 2))
 298           (if (>= iroff2 5) (setf ierro 3))
 299           (if (= last$ limit) (setf ier 1))
 300           (if
 301            (<= (max (abs a1) (abs b2))
 302                (* (+ 1.0 (* 100.0 epmach)) (+ (abs a2) (* 1000.0 uflow))))
 303            (setf ier 4))
 304           (if (> error2 error1) (go label100))
 305           (setf (f2cl-lib:fref alist-%data% (last$) ((1 *)) alist-%offset%) a2)
 306           (setf (f2cl-lib:fref blist-%data% (maxerr) ((1 *)) blist-%offset%)
 307                   b1)
 308           (setf (f2cl-lib:fref blist-%data% (last$) ((1 *)) blist-%offset%) b2)
 309           (setf (f2cl-lib:fref elist-%data% (maxerr) ((1 *)) elist-%offset%)
 310                   error1)
 311           (setf (f2cl-lib:fref elist-%data% (last$) ((1 *)) elist-%offset%)
 312                   error2)
 313           (go label110)
 314          label100
 315           (setf (f2cl-lib:fref alist-%data% (maxerr) ((1 *)) alist-%offset%)
 316                   a2)
 317           (setf (f2cl-lib:fref alist-%data% (last$) ((1 *)) alist-%offset%) a1)
 318           (setf (f2cl-lib:fref blist-%data% (last$) ((1 *)) blist-%offset%) b1)
 319           (setf (f2cl-lib:fref rlist-%data% (maxerr) ((1 *)) rlist-%offset%)
 320                   area2)
 321           (setf (f2cl-lib:fref rlist-%data% (last$) ((1 *)) rlist-%offset%)
 322                   area1)
 323           (setf (f2cl-lib:fref elist-%data% (maxerr) ((1 *)) elist-%offset%)
 324                   error2)
 325           (setf (f2cl-lib:fref elist-%data% (last$) ((1 *)) elist-%offset%)
 326                   error1)
 327          label110
 328           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6)
 329               (dqpsrt limit last$ maxerr errmax elist iord nrmax)
 330             (declare (ignore var-0 var-1 var-4 var-5))
 331             (setf maxerr var-2)
 332             (setf errmax var-3)
 333             (setf nrmax var-6))
 334           (if (<= errsum errbnd) (go label190))
 335           (if (/= ier 0) (go label170))
 336           (if noext (go label160))
 337           (setf erlarg (- erlarg erlast))
 338           (if (<= (f2cl-lib:int-add levcur 1) levmax)
 339               (setf erlarg (+ erlarg erro12)))
 340           (if extrap (go label120))
 341           (if
 342            (<=
 343             (f2cl-lib:int-add
 344              (f2cl-lib:fref level-%data% (maxerr) ((1 *)) level-%offset%)
 345              1)
 346             levmax)
 347            (go label160))
 348           (setf extrap f2cl-lib:%true%)
 349           (setf nrmax 2)
 350          label120
 351           (if (or (= ierro 3) (<= erlarg ertest)) (go label140))
 352           (setf id nrmax)
 353           (setf jupbnd last$)
 354           (if (> last$ (+ 2 (the f2cl-lib:integer4 (truncate limit 2))))
 355               (setf jupbnd
 356                       (f2cl-lib:int-sub (f2cl-lib:int-add limit 3) last$)))
 357           (f2cl-lib:fdo (k id (f2cl-lib:int-add k 1))
 358                         ((> k jupbnd) nil)
 359             (tagbody
 360               (setf maxerr
 361                       (f2cl-lib:fref iord-%data%
 362                                      (nrmax)
 363                                      ((1 *))
 364                                      iord-%offset%))
 365               (setf errmax
 366                       (f2cl-lib:fref elist-%data%
 367                                      (maxerr)
 368                                      ((1 *))
 369                                      elist-%offset%))
 370               (if
 371                (<=
 372                 (f2cl-lib:int-add
 373                  (f2cl-lib:fref level-%data% (maxerr) ((1 *)) level-%offset%)
 374                  1)
 375                 levmax)
 376                (go label160))
 377               (setf nrmax (f2cl-lib:int-add nrmax 1))
 378              label130))
 379          label140
 380           (setf numrl2 (f2cl-lib:int-add numrl2 1))
 381           (setf (f2cl-lib:fref rlist2 (numrl2) ((1 52))) area)
 382           (if (<= numrl2 2) (go label155))
 383           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 384               (dqelg numrl2 rlist2 reseps abseps res3la nres)
 385             (declare (ignore var-1 var-4))
 386             (setf numrl2 var-0)
 387             (setf reseps var-2)
 388             (setf abseps var-3)
 389             (setf nres var-5))
 390           (setf ktmin (f2cl-lib:int-add ktmin 1))
 391           (if (and (> ktmin 5) (< abserr (* 0.001 errsum))) (setf ier 5))
 392           (if (>= abseps abserr) (go label150))
 393           (setf ktmin 0)
 394           (setf abserr abseps)
 395           (setf result reseps)
 396           (setf correc erlarg)
 397           (setf ertest (max epsabs (* epsrel (abs reseps))))
 398           (if (< abserr ertest) (go label170))
 399          label150
 400           (if (= numrl2 1) (setf noext f2cl-lib:%true%))
 401           (if (>= ier 5) (go label170))
 402          label155
 403           (setf maxerr (f2cl-lib:fref iord-%data% (1) ((1 *)) iord-%offset%))
 404           (setf errmax
 405                   (f2cl-lib:fref elist-%data% (maxerr) ((1 *)) elist-%offset%))
 406           (setf nrmax 1)
 407           (setf extrap f2cl-lib:%false%)
 408           (setf levmax (f2cl-lib:int-add levmax 1))
 409           (setf erlarg errsum)
 410          label160))
 411      label170
 412       (if (= abserr oflow) (go label190))
 413       (if (= (f2cl-lib:int-add ier ierro) 0) (go label180))
 414       (if (= ierro 3) (setf abserr (+ abserr correc)))
 415       (if (= ier 0) (setf ier 3))
 416       (if (and (/= result 0.0) (/= area 0.0)) (go label175))
 417       (if (> abserr errsum) (go label190))
 418       (if (= area 0.0) (go label210))
 419       (go label180)
 420      label175
 421       (if (> (/ abserr (abs result)) (/ errsum (abs area))) (go label190))
 422      label180
 423       (if (and (= ksgn -1) (<= (max (abs result) (abs area)) (* resabs 0.01)))
 424           (go label210))
 425       (if
 426        (or (> 0.01 (/ result area))
 427            (> (/ result area) 100.0)
 428            (> errsum (abs area)))
 429        (setf ier 6))
 430       (go label210)
 431      label190
 432       (setf result 0.0)
 433       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 434                     ((> k last$) nil)
 435         (tagbody
 436           (setf result
 437                   (+ result
 438                      (f2cl-lib:fref rlist-%data% (k) ((1 *)) rlist-%offset%)))
 439          label200))
 440       (setf abserr errsum)
 441      label210
 442       (if (> ier 2) (setf ier (f2cl-lib:int-sub ier 1)))
 443       (setf result (* result sign$))
 444      label999
 445       (go end_label)
 446      end_label
 447       (return
 448        (values nil
 449                nil
 450                nil
 451                nil
 452                nil
 453                nil
 454                nil
 455                nil
 456                result
 457                abserr
 458                neval
 459                ier
 460                nil
 461                nil
 462                nil
 463                nil
 464                nil
 465                nil
 466                nil
 467                nil
 468                last$)))))
 469
 470 (in-package #:cl-user)
 471 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 472 (eval-when (:load-toplevel :compile-toplevel :execute)
 473   (setf (gethash 'fortran-to-lisp::dqagpe
 474                  fortran-to-lisp::*f2cl-function-info*)
 475           (fortran-to-lisp::make-f2cl-finfo
 476            :arg-types '(t (double-float) (double-float)
 477                         (fortran-to-lisp::integer4) (array double-float (*))
 478                         (double-float) (double-float)
 479                         (fortran-to-lisp::integer4) (double-float)
 480                         (double-float) (fortran-to-lisp::integer4)
 481                         (fortran-to-lisp::integer4) (array double-float (*))
 482                         (array double-float (*)) (array double-float (*))
 483                         (array double-float (*)) (array double-float (*))
 484                         (array fortran-to-lisp::integer4 (*))
 485                         (array fortran-to-lisp::integer4 (*))
 486                         (array fortran-to-lisp::integer4 (*))
 487                         (fortran-to-lisp::integer4))
 488            :return-values '(nil nil nil nil nil nil nil nil
 489                             fortran-to-lisp::result fortran-to-lisp::abserr
 490                             fortran-to-lisp::neval fortran-to-lisp::ier nil nil
 491                             nil nil nil nil nil nil fortran-to-lisp::last$)
 492            :calls '(fortran-to-lisp::dqelg fortran-to-lisp::dqpsrt
 493                     fortran-to-lisp::dqk21 fortran-to-lisp::d1mach))))
 494