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 dqcheb (x fval cheb12 cheb24) 21 (declare (type (array double-float (*)) cheb12) 22 (type (array double-float (*)) cheb24 fval) 23 (type (array double-float (*)) x)) 24 (f2cl-lib:with-multi-array-data 25 ((x double-float x-%data% x-%offset%) 26 (fval double-float fval-%data% fval-%offset%) 27 (cheb24 double-float cheb24-%data% cheb24-%offset%) 28 (cheb12 double-float cheb12-%data% cheb12-%offset%)) 29 (prog ((v (make-array 12 :element-type 'double-float)) (i 0) (j 0) 30 (alam 0.0) (alam1 0.0) (alam2 0.0) (part1 0.0) (part2 0.0) 31 (part3 0.0)) 32 (declare (type (array double-float (12)) v) 33 (type (double-float) part3 part2 part1 alam2 alam1 alam) 34 (type (f2cl-lib:integer4) j i)) 35 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 36 ((> i 12) nil) 37 (tagbody 38 (setf j (f2cl-lib:int-sub 26 i)) 39 (setf (f2cl-lib:fref v (i) ((1 12))) 40 (- (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 41 (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%))) 42 (setf (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 43 (+ (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 44 (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%))) 45 label10)) 46 (setf alam1 47 (- (f2cl-lib:fref v (1) ((1 12))) 48 (f2cl-lib:fref v (9) ((1 12))))) 49 (setf alam2 50 (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%) 51 (- (f2cl-lib:fref v (3) ((1 12))) 52 (f2cl-lib:fref v (7) ((1 12))) 53 (f2cl-lib:fref v (11) ((1 12)))))) 54 (setf (f2cl-lib:fref cheb12-%data% (4) ((1 13)) cheb12-%offset%) 55 (+ alam1 alam2)) 56 (setf (f2cl-lib:fref cheb12-%data% (10) ((1 13)) cheb12-%offset%) 57 (- alam1 alam2)) 58 (setf alam1 59 (- (f2cl-lib:fref v (2) ((1 12))) 60 (f2cl-lib:fref v (8) ((1 12))) 61 (f2cl-lib:fref v (10) ((1 12))))) 62 (setf alam2 63 (- (f2cl-lib:fref v (4) ((1 12))) 64 (f2cl-lib:fref v (6) ((1 12))) 65 (f2cl-lib:fref v (12) ((1 12))))) 66 (setf alam 67 (+ (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) alam1) 68 (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) alam2))) 69 (setf (f2cl-lib:fref cheb24-%data% (4) ((1 25)) cheb24-%offset%) 70 (+ (f2cl-lib:fref cheb12-%data% (4) ((1 13)) cheb12-%offset%) 71 alam)) 72 (setf (f2cl-lib:fref cheb24-%data% (22) ((1 25)) cheb24-%offset%) 73 (- (f2cl-lib:fref cheb12-%data% (4) ((1 13)) cheb12-%offset%) 74 alam)) 75 (setf alam 76 (- (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) alam1) 77 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) alam2))) 78 (setf (f2cl-lib:fref cheb24-%data% (10) ((1 25)) cheb24-%offset%) 79 (+ (f2cl-lib:fref cheb12-%data% (10) ((1 13)) cheb12-%offset%) 80 alam)) 81 (setf (f2cl-lib:fref cheb24-%data% (16) ((1 25)) cheb24-%offset%) 82 (- (f2cl-lib:fref cheb12-%data% (10) ((1 13)) cheb12-%offset%) 83 alam)) 84 (setf part1 85 (* (f2cl-lib:fref x-%data% (4) ((1 11)) x-%offset%) 86 (f2cl-lib:fref v (5) ((1 12))))) 87 (setf part2 88 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%) 89 (f2cl-lib:fref v (9) ((1 12))))) 90 (setf part3 91 (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%) 92 (f2cl-lib:fref v (7) ((1 12))))) 93 (setf alam1 (+ (f2cl-lib:fref v (1) ((1 12))) part1 part2)) 94 (setf alam2 95 (+ 96 (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%) 97 (f2cl-lib:fref v (3) ((1 12)))) 98 part3 99 (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%) 100 (f2cl-lib:fref v (11) ((1 12)))))) 101 (setf (f2cl-lib:fref cheb12-%data% (2) ((1 13)) cheb12-%offset%) 102 (+ alam1 alam2)) 103 (setf (f2cl-lib:fref cheb12-%data% (12) ((1 13)) cheb12-%offset%) 104 (- alam1 alam2)) 105 (setf alam 106 (+ 107 (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%) 108 (f2cl-lib:fref v (2) ((1 12)))) 109 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) 110 (f2cl-lib:fref v (4) ((1 12)))) 111 (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%) 112 (f2cl-lib:fref v (6) ((1 12)))) 113 (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%) 114 (f2cl-lib:fref v (8) ((1 12)))) 115 (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) 116 (f2cl-lib:fref v (10) ((1 12)))) 117 (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%) 118 (f2cl-lib:fref v (12) ((1 12)))))) 119 (setf (f2cl-lib:fref cheb24-%data% (2) ((1 25)) cheb24-%offset%) 120 (+ (f2cl-lib:fref cheb12-%data% (2) ((1 13)) cheb12-%offset%) 121 alam)) 122 (setf (f2cl-lib:fref cheb24-%data% (24) ((1 25)) cheb24-%offset%) 123 (- (f2cl-lib:fref cheb12-%data% (2) ((1 13)) cheb12-%offset%) 124 alam)) 125 (setf alam 126 (- 127 (+ 128 (- 129 (+ 130 (- 131 (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%) 132 (f2cl-lib:fref v (2) ((1 12)))) 133 (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) 134 (f2cl-lib:fref v (4) ((1 12))))) 135 (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%) 136 (f2cl-lib:fref v (6) ((1 12))))) 137 (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%) 138 (f2cl-lib:fref v (8) ((1 12))))) 139 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) 140 (f2cl-lib:fref v (10) ((1 12))))) 141 (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%) 142 (f2cl-lib:fref v (12) ((1 12)))))) 143 (setf (f2cl-lib:fref cheb24-%data% (12) ((1 25)) cheb24-%offset%) 144 (+ (f2cl-lib:fref cheb12-%data% (12) ((1 13)) cheb12-%offset%) 145 alam)) 146 (setf (f2cl-lib:fref cheb24-%data% (14) ((1 25)) cheb24-%offset%) 147 (- (f2cl-lib:fref cheb12-%data% (12) ((1 13)) cheb12-%offset%) 148 alam)) 149 (setf alam1 (+ (- (f2cl-lib:fref v (1) ((1 12))) part1) part2)) 150 (setf alam2 151 (+ 152 (- 153 (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%) 154 (f2cl-lib:fref v (3) ((1 12)))) 155 part3) 156 (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%) 157 (f2cl-lib:fref v (11) ((1 12)))))) 158 (setf (f2cl-lib:fref cheb12-%data% (6) ((1 13)) cheb12-%offset%) 159 (+ alam1 alam2)) 160 (setf (f2cl-lib:fref cheb12-%data% (8) ((1 13)) cheb12-%offset%) 161 (- alam1 alam2)) 162 (setf alam 163 (+ 164 (- 165 (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%) 166 (f2cl-lib:fref v (2) ((1 12)))) 167 (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) 168 (f2cl-lib:fref v (4) ((1 12)))) 169 (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%) 170 (f2cl-lib:fref v (6) ((1 12)))) 171 (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%) 172 (f2cl-lib:fref v (8) ((1 12))))) 173 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) 174 (f2cl-lib:fref v (10) ((1 12)))) 175 (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%) 176 (f2cl-lib:fref v (12) ((1 12)))))) 177 (setf (f2cl-lib:fref cheb24-%data% (6) ((1 25)) cheb24-%offset%) 178 (+ (f2cl-lib:fref cheb12-%data% (6) ((1 13)) cheb12-%offset%) 179 alam)) 180 (setf (f2cl-lib:fref cheb24-%data% (20) ((1 25)) cheb24-%offset%) 181 (- (f2cl-lib:fref cheb12-%data% (6) ((1 13)) cheb12-%offset%) 182 alam)) 183 (setf alam 184 (- 185 (+ 186 (- 187 (* (f2cl-lib:fref x-%data% (7) ((1 11)) x-%offset%) 188 (f2cl-lib:fref v (2) ((1 12)))) 189 (* (f2cl-lib:fref x-%data% (3) ((1 11)) x-%offset%) 190 (f2cl-lib:fref v (4) ((1 12)))) 191 (* (f2cl-lib:fref x-%data% (11) ((1 11)) x-%offset%) 192 (f2cl-lib:fref v (6) ((1 12))))) 193 (* (f2cl-lib:fref x-%data% (1) ((1 11)) x-%offset%) 194 (f2cl-lib:fref v (8) ((1 12))))) 195 (* (f2cl-lib:fref x-%data% (9) ((1 11)) x-%offset%) 196 (f2cl-lib:fref v (10) ((1 12)))) 197 (* (f2cl-lib:fref x-%data% (5) ((1 11)) x-%offset%) 198 (f2cl-lib:fref v (12) ((1 12)))))) 199 (setf (f2cl-lib:fref cheb24-%data% (8) ((1 25)) cheb24-%offset%) 200 (+ (f2cl-lib:fref cheb12-%data% (8) ((1 13)) cheb12-%offset%) 201 alam)) 202 (setf (f2cl-lib:fref cheb24-%data% (18) ((1 25)) cheb24-%offset%) 203 (- (f2cl-lib:fref cheb12-%data% (8) ((1 13)) cheb12-%offset%) 204 alam)) 205 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 206 ((> i 6) nil) 207 (tagbody 208 (setf j (f2cl-lib:int-sub 14 i)) 209 (setf (f2cl-lib:fref v (i) ((1 12))) 210 (- (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 211 (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%))) 212 (setf (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 213 (+ (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 214 (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%))) 215 label20)) 216 (setf alam1 217 (+ (f2cl-lib:fref v (1) ((1 12))) 218 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%) 219 (f2cl-lib:fref v (5) ((1 12)))))) 220 (setf alam2 221 (* (f2cl-lib:fref x-%data% (4) ((1 11)) x-%offset%) 222 (f2cl-lib:fref v (3) ((1 12))))) 223 (setf (f2cl-lib:fref cheb12-%data% (3) ((1 13)) cheb12-%offset%) 224 (+ alam1 alam2)) 225 (setf (f2cl-lib:fref cheb12-%data% (11) ((1 13)) cheb12-%offset%) 226 (- alam1 alam2)) 227 (setf (f2cl-lib:fref cheb12-%data% (7) ((1 13)) cheb12-%offset%) 228 (- (f2cl-lib:fref v (1) ((1 12))) 229 (f2cl-lib:fref v (5) ((1 12))))) 230 (setf alam 231 (+ 232 (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%) 233 (f2cl-lib:fref v (2) ((1 12)))) 234 (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%) 235 (f2cl-lib:fref v (4) ((1 12)))) 236 (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%) 237 (f2cl-lib:fref v (6) ((1 12)))))) 238 (setf (f2cl-lib:fref cheb24-%data% (3) ((1 25)) cheb24-%offset%) 239 (+ (f2cl-lib:fref cheb12-%data% (3) ((1 13)) cheb12-%offset%) 240 alam)) 241 (setf (f2cl-lib:fref cheb24-%data% (23) ((1 25)) cheb24-%offset%) 242 (- (f2cl-lib:fref cheb12-%data% (3) ((1 13)) cheb12-%offset%) 243 alam)) 244 (setf alam 245 (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%) 246 (- (f2cl-lib:fref v (2) ((1 12))) 247 (f2cl-lib:fref v (4) ((1 12))) 248 (f2cl-lib:fref v (6) ((1 12)))))) 249 (setf (f2cl-lib:fref cheb24-%data% (7) ((1 25)) cheb24-%offset%) 250 (+ (f2cl-lib:fref cheb12-%data% (7) ((1 13)) cheb12-%offset%) 251 alam)) 252 (setf (f2cl-lib:fref cheb24-%data% (19) ((1 25)) cheb24-%offset%) 253 (- (f2cl-lib:fref cheb12-%data% (7) ((1 13)) cheb12-%offset%) 254 alam)) 255 (setf alam 256 (+ 257 (- 258 (* (f2cl-lib:fref x-%data% (10) ((1 11)) x-%offset%) 259 (f2cl-lib:fref v (2) ((1 12)))) 260 (* (f2cl-lib:fref x-%data% (6) ((1 11)) x-%offset%) 261 (f2cl-lib:fref v (4) ((1 12))))) 262 (* (f2cl-lib:fref x-%data% (2) ((1 11)) x-%offset%) 263 (f2cl-lib:fref v (6) ((1 12)))))) 264 (setf (f2cl-lib:fref cheb24-%data% (11) ((1 25)) cheb24-%offset%) 265 (+ (f2cl-lib:fref cheb12-%data% (11) ((1 13)) cheb12-%offset%) 266 alam)) 267 (setf (f2cl-lib:fref cheb24-%data% (15) ((1 25)) cheb24-%offset%) 268 (- (f2cl-lib:fref cheb12-%data% (11) ((1 13)) cheb12-%offset%) 269 alam)) 270 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 271 ((> i 3) nil) 272 (tagbody 273 (setf j (f2cl-lib:int-sub 8 i)) 274 (setf (f2cl-lib:fref v (i) ((1 12))) 275 (- (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 276 (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%))) 277 (setf (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 278 (+ (f2cl-lib:fref fval-%data% (i) ((1 25)) fval-%offset%) 279 (f2cl-lib:fref fval-%data% (j) ((1 25)) fval-%offset%))) 280 label30)) 281 (setf (f2cl-lib:fref cheb12-%data% (5) ((1 13)) cheb12-%offset%) 282 (+ (f2cl-lib:fref v (1) ((1 12))) 283 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%) 284 (f2cl-lib:fref v (3) ((1 12)))))) 285 (setf (f2cl-lib:fref cheb12-%data% (9) ((1 13)) cheb12-%offset%) 286 (- (f2cl-lib:fref fval-%data% (1) ((1 25)) fval-%offset%) 287 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%) 288 (f2cl-lib:fref fval-%data% (3) ((1 25)) fval-%offset%)))) 289 (setf alam 290 (* (f2cl-lib:fref x-%data% (4) ((1 11)) x-%offset%) 291 (f2cl-lib:fref v (2) ((1 12))))) 292 (setf (f2cl-lib:fref cheb24-%data% (5) ((1 25)) cheb24-%offset%) 293 (+ (f2cl-lib:fref cheb12-%data% (5) ((1 13)) cheb12-%offset%) 294 alam)) 295 (setf (f2cl-lib:fref cheb24-%data% (21) ((1 25)) cheb24-%offset%) 296 (- (f2cl-lib:fref cheb12-%data% (5) ((1 13)) cheb12-%offset%) 297 alam)) 298 (setf alam 299 (- 300 (* (f2cl-lib:fref x-%data% (8) ((1 11)) x-%offset%) 301 (f2cl-lib:fref fval-%data% (2) ((1 25)) fval-%offset%)) 302 (f2cl-lib:fref fval-%data% (4) ((1 25)) fval-%offset%))) 303 (setf (f2cl-lib:fref cheb24-%data% (9) ((1 25)) cheb24-%offset%) 304 (+ (f2cl-lib:fref cheb12-%data% (9) ((1 13)) cheb12-%offset%) 305 alam)) 306 (setf (f2cl-lib:fref cheb24-%data% (17) ((1 25)) cheb24-%offset%) 307 (- (f2cl-lib:fref cheb12-%data% (9) ((1 13)) cheb12-%offset%) 308 alam)) 309 (setf (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%) 310 (+ (f2cl-lib:fref fval-%data% (1) ((1 25)) fval-%offset%) 311 (f2cl-lib:fref fval-%data% (3) ((1 25)) fval-%offset%))) 312 (setf alam 313 (+ (f2cl-lib:fref fval-%data% (2) ((1 25)) fval-%offset%) 314 (f2cl-lib:fref fval-%data% (4) ((1 25)) fval-%offset%))) 315 (setf (f2cl-lib:fref cheb24-%data% (1) ((1 25)) cheb24-%offset%) 316 (+ (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%) 317 alam)) 318 (setf (f2cl-lib:fref cheb24-%data% (25) ((1 25)) cheb24-%offset%) 319 (- (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%) 320 alam)) 321 (setf (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%) 322 (- (f2cl-lib:fref v (1) ((1 12))) 323 (f2cl-lib:fref v (3) ((1 12))))) 324 (setf (f2cl-lib:fref cheb24-%data% (13) ((1 25)) cheb24-%offset%) 325 (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%)) 326 (setf alam (/ 1.0 6.0)) 327 (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1)) 328 ((> i 12) nil) 329 (tagbody 330 (setf (f2cl-lib:fref cheb12-%data% (i) ((1 13)) cheb12-%offset%) 331 (* (f2cl-lib:fref cheb12-%data% (i) ((1 13)) cheb12-%offset%) 332 alam)) 333 label40)) 334 (setf alam (* 0.5 alam)) 335 (setf (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%) 336 (* (f2cl-lib:fref cheb12-%data% (1) ((1 13)) cheb12-%offset%) 337 alam)) 338 (setf (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%) 339 (* (f2cl-lib:fref cheb12-%data% (13) ((1 13)) cheb12-%offset%) 340 alam)) 341 (f2cl-lib:fdo (i 2 (f2cl-lib:int-add i 1)) 342 ((> i 24) nil) 343 (tagbody 344 (setf (f2cl-lib:fref cheb24-%data% (i) ((1 25)) cheb24-%offset%) 345 (* (f2cl-lib:fref cheb24-%data% (i) ((1 25)) cheb24-%offset%) 346 alam)) 347 label50)) 348 (setf (f2cl-lib:fref cheb24-%data% (1) ((1 25)) cheb24-%offset%) 349 (* 0.5 350 alam 351 (f2cl-lib:fref cheb24-%data% (1) ((1 25)) cheb24-%offset%))) 352 (setf (f2cl-lib:fref cheb24-%data% (25) ((1 25)) cheb24-%offset%) 353 (* 0.5 354 alam 355 (f2cl-lib:fref cheb24-%data% (25) ((1 25)) cheb24-%offset%))) 356 (go end_label) 357 end_label 358 (return (values nil nil nil nil))))) 359 360(in-package #-gcl #:cl-user #+gcl "CL-USER") 361#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) 362(eval-when (:load-toplevel :compile-toplevel :execute) 363 (setf (gethash 'fortran-to-lisp::dqcheb 364 fortran-to-lisp::*f2cl-function-info*) 365 (fortran-to-lisp::make-f2cl-finfo 366 :arg-types '((array double-float (*)) (array double-float (*)) 367 (array double-float (*)) (array double-float (*))) 368 :return-values '(nil nil nil nil) 369 :calls 'nil))) 370 371