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 dqawf
21       (f a omega integr epsabs result abserr neval ier limlst lst leniw maxp1
22        lenw iwork work)
23  (declare (type (array double-float (*)) work)
24           (type (array f2cl-lib:integer4 (*)) iwork)
25           (type (f2cl-lib:integer4) lenw maxp1 leniw lst limlst ier neval
26                                     integr)
27           (type (double-float) abserr result epsabs omega a))
28  (f2cl-lib:with-multi-array-data
29      ((iwork f2cl-lib:integer4 iwork-%data% iwork-%offset%)
30       (work double-float work-%data% work-%offset%))
31    (prog ((limit 0) (ll2 0) (lvl 0) (l1 0) (l2 0) (l3 0) (l4 0) (l5 0) (l6 0))
32      (declare (type (f2cl-lib:integer4) l6 l5 l4 l3 l2 l1 lvl ll2 limit))
33      (setf ier 6)
34      (setf neval 0)
35      (setf result 0.0)
36      (setf abserr 0.0)
37      (if
38       (or (< limlst 3)
39           (< leniw (f2cl-lib:int-add limlst 2))
40           (< maxp1 1)
41           (< lenw
42              (f2cl-lib:int-add (f2cl-lib:int-mul leniw 2)
43                                (f2cl-lib:int-mul maxp1 25))))
44       (go label10))
45      (setf limit (the f2cl-lib:integer4 (truncate (- leniw limlst) 2)))
46      (setf l1 (f2cl-lib:int-add limlst 1))
47      (setf l2 (f2cl-lib:int-add limlst l1))
48      (setf l3 (f2cl-lib:int-add limit l2))
49      (setf l4 (f2cl-lib:int-add limit l3))
50      (setf l5 (f2cl-lib:int-add limit l4))
51      (setf l6 (f2cl-lib:int-add limit l5))
52      (setf ll2 (f2cl-lib:int-add limit l1))
53      (multiple-value-bind
54            (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 var-9 var-10
55             var-11 var-12 var-13 var-14 var-15 var-16 var-17 var-18 var-19
56             var-20 var-21 var-22)
57          (dqawfe f a omega integr epsabs limlst limit maxp1 result abserr
58           neval ier
59           (f2cl-lib:array-slice work-%data%
60                                 double-float
61                                 (1)
62                                 ((1 *))
63                                 work-%offset%)
64           (f2cl-lib:array-slice work-%data%
65                                 double-float
66                                 (l1)
67                                 ((1 *))
68                                 work-%offset%)
69           (f2cl-lib:array-slice iwork-%data%
70                                 f2cl-lib:integer4
71                                 (1)
72                                 ((1 *))
73                                 iwork-%offset%)
74           lst
75           (f2cl-lib:array-slice work-%data%
76                                 double-float
77                                 (l2)
78                                 ((1 *))
79                                 work-%offset%)
80           (f2cl-lib:array-slice work-%data%
81                                 double-float
82                                 (l3)
83                                 ((1 *))
84                                 work-%offset%)
85           (f2cl-lib:array-slice work-%data%
86                                 double-float
87                                 (l4)
88                                 ((1 *))
89                                 work-%offset%)
90           (f2cl-lib:array-slice work-%data%
91                                 double-float
92                                 (l5)
93                                 ((1 *))
94                                 work-%offset%)
95           (f2cl-lib:array-slice iwork-%data%
96                                 f2cl-lib:integer4
97                                 (l1)
98                                 ((1 *))
99                                 iwork-%offset%)
100           (f2cl-lib:array-slice iwork-%data%
101                                 f2cl-lib:integer4
102                                 (ll2)
103                                 ((1 *))
104                                 iwork-%offset%)
105           (f2cl-lib:array-slice work-%data%
106                                 double-float
107                                 (l6)
108                                 ((1 *))
109                                 work-%offset%))
110        (declare (ignore var-0 var-1 var-2 var-4 var-5 var-6 var-7 var-12
111                         var-13 var-14 var-16 var-17 var-18 var-19 var-20
112                         var-21 var-22))
113        (setf integr var-3)
114        (setf result var-8)
115        (setf abserr var-9)
116        (setf neval var-10)
117        (setf ier var-11)
118        (setf lst var-15))
119      (setf lvl 0)
120     label10
121      (if (= ier 6) (setf lvl 1))
122      (if (/= ier 0) (xermsg "SLATEC" "DQAWF" "ABNORMAL RETURN" ier lvl))
123      (go end_label)
124     end_label
125      (return
126       (values nil
127               nil
128               nil
129               integr
130               nil
131               result
132               abserr
133               neval
134               ier
135               nil
136               lst
137               nil
138               nil
139               nil
140               nil
141               nil)))))
142
143(in-package #-gcl #:cl-user #+gcl "CL-USER")
144#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
145(eval-when (:load-toplevel :compile-toplevel :execute)
146  (setf (gethash 'fortran-to-lisp::dqawf fortran-to-lisp::*f2cl-function-info*)
147          (fortran-to-lisp::make-f2cl-finfo
148           :arg-types '(t (double-float) (double-float)
149                        (fortran-to-lisp::integer4) (double-float)
150                        (double-float) (double-float)
151                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
152                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
153                        (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
154                        (fortran-to-lisp::integer4)
155                        (array fortran-to-lisp::integer4 (*))
156                        (array double-float (*)))
157           :return-values '(nil nil nil fortran-to-lisp::integr nil
158                            fortran-to-lisp::result fortran-to-lisp::abserr
159                            fortran-to-lisp::neval fortran-to-lisp::ier nil
160                            fortran-to-lisp::lst nil nil nil nil nil)
161           :calls '(fortran-to-lisp::xermsg fortran-to-lisp::dqawfe))))
162
163