1;;; Compiled by f2cl version: 2;;; ("f2cl1.l,v 2edcbd958861 2012/05/30 03:34:52 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 3fe93de3be82 2012/05/06 02:17:14 toy $" 7;;; "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $" 8;;; "macros.l,v 3fe93de3be82 2012/05/06 02:17:14 toy $") 9 10;;; Using Lisp CMU Common Lisp 20d (20D 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 :lapack) 18 19 20(let* ((ntiny 11) 21 (kexnw 5) 22 (kexsh 6) 23 (wilk1 0.75) 24 (zero (f2cl-lib:cmplx 0.0 0.0)) 25 (one (f2cl-lib:cmplx 1.0 0.0)) 26 (two 2.0)) 27 (declare (type (f2cl-lib:integer4 11 11) ntiny) 28 (type (f2cl-lib:integer4 5 5) kexnw) 29 (type (f2cl-lib:integer4 6 6) kexsh) 30 (type (double-float 0.75 0.75) wilk1) 31 (type (f2cl-lib:complex16) zero) 32 (type (f2cl-lib:complex16) one) 33 (type (double-float 2.0 2.0) two) 34 (ignorable ntiny kexnw kexsh wilk1 zero one two)) 35 (defun zlaqr0 (wantt wantz n ilo ihi h ldh w iloz ihiz z ldz work lwork info) 36 (declare (type (array f2cl-lib:complex16 (*)) work z w h) 37 (type (f2cl-lib:integer4) info lwork ldz ihiz iloz ldh ihi ilo n) 38 (type f2cl-lib:logical wantz wantt)) 39 (f2cl-lib:with-multi-array-data 40 ((h f2cl-lib:complex16 h-%data% h-%offset%) 41 (w f2cl-lib:complex16 w-%data% w-%offset%) 42 (z f2cl-lib:complex16 z-%data% z-%offset%) 43 (work f2cl-lib:complex16 work-%data% work-%offset%)) 44 (labels ((cabs1 (cdum) 45 (+ (abs (f2cl-lib:dble cdum)) (abs (f2cl-lib:dimag cdum))))) 46 (declare (ftype (function (f2cl-lib:complex16) 47 (values double-float &rest t)) 48 cabs1)) 49 (prog ((zdum (make-array 1 :element-type 'f2cl-lib:complex16)) 50 (jbcmpz 51 (make-array '(2) 52 :element-type 'character 53 :initial-element #\ )) 54 (sorted nil) (i 0) (inf 0) (it 0) (itmax 0) (k 0) (kacc22 0) 55 (kbot 0) (kdu 0) (ks 0) (kt 0) (ktop 0) (ku 0) (kv 0) (kwh 0) 56 (kwtop 0) (kwv 0) (ld 0) (ls 0) (lwkopt 0) (ndec 0) (ndfl 0) 57 (nh 0) (nho 0) (nibble 0) (nmin 0) (ns 0) (nsmax 0) (nsr 0) 58 (nve 0) (nw 0) (nwmax 0) (nwr 0) (nwupbd 0) (s 0.0) 59 (aa #C(0.0 0.0)) (bb #C(0.0 0.0)) (cc #C(0.0 0.0)) 60 (cdum #C(0.0 0.0)) (dd #C(0.0 0.0)) (det #C(0.0 0.0)) 61 (rtdisc #C(0.0 0.0)) (swap #C(0.0 0.0)) (tr2 #C(0.0 0.0))) 62 (declare (type (array f2cl-lib:complex16 (1)) zdum) 63 (type (simple-string 2) jbcmpz) 64 (type f2cl-lib:logical sorted) 65 (type (f2cl-lib:integer4) i inf it itmax k kacc22 kbot kdu 66 ks kt ktop ku kv kwh kwtop kwv ld 67 ls lwkopt ndec ndfl nh nho nibble 68 nmin ns nsmax nsr nve nw nwmax nwr 69 nwupbd) 70 (type (double-float) s) 71 (type (f2cl-lib:complex16) aa bb cc cdum dd det rtdisc swap 72 tr2)) 73 (setf info 0) 74 (cond 75 ((= n 0) 76 (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) one) 77 (go end_label))) 78 (cond 79 ((<= n ntiny) 80 (setf lwkopt 1) 81 (if (/= lwork -1) 82 (multiple-value-bind 83 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 84 var-9 var-10 var-11 var-12) 85 (zlahqr wantt wantz n ilo ihi h ldh w iloz ihiz z ldz 86 info) 87 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 88 var-7 var-8 var-9 var-10 var-11)) 89 (setf info var-12)))) 90 (t 91 (tagbody 92 (setf info 0) 93 (cond 94 (wantt 95 (f2cl-lib:fset-string (f2cl-lib:fref-string jbcmpz (1 1)) 96 "S")) 97 (t 98 (f2cl-lib:fset-string (f2cl-lib:fref-string jbcmpz (1 1)) 99 "E"))) 100 (cond 101 (wantz 102 (f2cl-lib:fset-string (f2cl-lib:fref-string jbcmpz (2 2)) 103 "V")) 104 (t 105 (f2cl-lib:fset-string (f2cl-lib:fref-string jbcmpz (2 2)) 106 "N"))) 107 (setf nwr (ilaenv 13 "ZLAQR0" jbcmpz n ilo ihi lwork)) 108 (setf nwr 109 (max (the f2cl-lib:integer4 2) 110 (the f2cl-lib:integer4 nwr))) 111 (setf nwr 112 (min (f2cl-lib:int-add (f2cl-lib:int-sub ihi ilo) 1) 113 (the f2cl-lib:integer4 (truncate (- n 1) 3)) 114 nwr)) 115 (setf nsr (ilaenv 15 "ZLAQR0" jbcmpz n ilo ihi lwork)) 116 (setf nsr 117 (min nsr 118 (the f2cl-lib:integer4 (truncate (+ n 6) 9)) 119 (f2cl-lib:int-sub ihi ilo))) 120 (setf nsr 121 (max (the f2cl-lib:integer4 2) 122 (the f2cl-lib:integer4 123 (f2cl-lib:int-sub nsr (mod nsr 2))))) 124 (multiple-value-bind 125 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 126 var-9 var-10 var-11 var-12 var-13 var-14 var-15 var-16 127 var-17 var-18 var-19 var-20 var-21 var-22 var-23 var-24) 128 (zlaqr3 wantt wantz n ilo ihi (f2cl-lib:int-add nwr 1) h ldh 129 iloz ihiz z ldz ls ld w h ldh n h ldh n h ldh work -1) 130 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 131 var-7 var-8 var-9 var-10 var-11 var-14 var-15 132 var-16 var-17 var-18 var-19 var-20 var-21 133 var-22 var-23 var-24)) 134 (setf ls var-12) 135 (setf ld var-13)) 136 (setf lwkopt 137 (max (the f2cl-lib:integer4 (truncate (* 3 nsr) 2)) 138 (f2cl-lib:int 139 (f2cl-lib:fref work-%data% 140 (1) 141 ((1 *)) 142 work-%offset%)))) 143 (cond 144 ((= lwork (f2cl-lib:int-sub 1)) 145 (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) 146 (f2cl-lib:dcmplx lwkopt 0)) 147 (go end_label))) 148 (setf nmin (ilaenv 12 "ZLAQR0" jbcmpz n ilo ihi lwork)) 149 (setf nmin 150 (max (the f2cl-lib:integer4 ntiny) 151 (the f2cl-lib:integer4 nmin))) 152 (setf nibble (ilaenv 14 "ZLAQR0" jbcmpz n ilo ihi lwork)) 153 (setf nibble 154 (max (the f2cl-lib:integer4 0) 155 (the f2cl-lib:integer4 nibble))) 156 (setf kacc22 (ilaenv 16 "ZLAQR0" jbcmpz n ilo ihi lwork)) 157 (setf kacc22 158 (max (the f2cl-lib:integer4 0) 159 (the f2cl-lib:integer4 kacc22))) 160 (setf kacc22 161 (min (the f2cl-lib:integer4 2) 162 (the f2cl-lib:integer4 kacc22))) 163 (setf nwmax 164 (min (the f2cl-lib:integer4 (truncate (- n 1) 3)) 165 (the f2cl-lib:integer4 (truncate lwork 2)))) 166 (setf nw nwmax) 167 (setf nsmax 168 (min (the f2cl-lib:integer4 (truncate (+ n 6) 9)) 169 (the f2cl-lib:integer4 (truncate (* 2 lwork) 3)))) 170 (setf nsmax (f2cl-lib:int-sub nsmax (mod nsmax 2))) 171 (setf ndfl 1) 172 (setf itmax 173 (f2cl-lib:int-mul 174 (max (the f2cl-lib:integer4 30) 175 (the f2cl-lib:integer4 176 (f2cl-lib:int-mul 2 kexsh))) 177 (max (the f2cl-lib:integer4 10) 178 (the f2cl-lib:integer4 179 (f2cl-lib:int-add (f2cl-lib:int-sub ihi ilo) 180 1))))) 181 (setf kbot ihi) 182 (f2cl-lib:fdo (it 1 (f2cl-lib:int-add it 1)) 183 ((> it itmax) nil) 184 (tagbody 185 (if (< kbot ilo) (go label80)) 186 (f2cl-lib:fdo (k kbot 187 (f2cl-lib:int-add k (f2cl-lib:int-sub 1))) 188 ((> k (f2cl-lib:int-add ilo 1)) nil) 189 (tagbody 190 (if 191 (= 192 (f2cl-lib:fref h-%data% 193 (k (f2cl-lib:int-sub k 1)) 194 ((1 ldh) (1 *)) 195 h-%offset%) 196 zero) 197 (go label20)) 198 label10)) 199 (setf k ilo) 200 label20 201 (setf ktop k) 202 (setf nh (f2cl-lib:int-add (f2cl-lib:int-sub kbot ktop) 1)) 203 (setf nwupbd 204 (min (the f2cl-lib:integer4 nh) 205 (the f2cl-lib:integer4 nwmax))) 206 (cond 207 ((< ndfl kexnw) 208 (setf nw 209 (min (the f2cl-lib:integer4 nwupbd) 210 (the f2cl-lib:integer4 nwr)))) 211 (t 212 (setf nw 213 (min (the f2cl-lib:integer4 nwupbd) 214 (the f2cl-lib:integer4 215 (f2cl-lib:int-mul 2 nw)))))) 216 (cond 217 ((< nw nwmax) 218 (cond 219 ((>= nw (f2cl-lib:int-add nh (f2cl-lib:int-sub 1))) 220 (setf nw nh)) 221 (t 222 (setf kwtop 223 (f2cl-lib:int-add (f2cl-lib:int-sub kbot nw) 224 1)) 225 (if 226 (> 227 (cabs1 228 (f2cl-lib:fref h-%data% 229 (kwtop (f2cl-lib:int-sub kwtop 1)) 230 ((1 ldh) (1 *)) 231 h-%offset%)) 232 (cabs1 233 (f2cl-lib:fref h-%data% 234 ((f2cl-lib:int-sub kwtop 1) 235 (f2cl-lib:int-sub kwtop 2)) 236 ((1 ldh) (1 *)) 237 h-%offset%))) 238 (setf nw (f2cl-lib:int-add nw 1))))))) 239 (cond 240 ((< ndfl kexnw) 241 (setf ndec -1)) 242 ((or (>= ndec 0) (>= nw nwupbd)) 243 (setf ndec (f2cl-lib:int-add ndec 1)) 244 (if (< (f2cl-lib:int-sub nw ndec) 2) (setf ndec 0)) 245 (setf nw (f2cl-lib:int-sub nw ndec)))) 246 (setf kv (f2cl-lib:int-add (f2cl-lib:int-sub n nw) 1)) 247 (setf kt (f2cl-lib:int-add nw 1)) 248 (setf nho (f2cl-lib:int-add (f2cl-lib:int-sub n nw 1 kt) 1)) 249 (setf kwv (f2cl-lib:int-add nw 2)) 250 (setf nve (f2cl-lib:int-add (f2cl-lib:int-sub n nw kwv) 1)) 251 (multiple-value-bind 252 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8 253 var-9 var-10 var-11 var-12 var-13 var-14 var-15 254 var-16 var-17 var-18 var-19 var-20 var-21 var-22 255 var-23 var-24) 256 (zlaqr3 wantt wantz n ktop kbot nw h ldh iloz ihiz z ldz 257 ls ld w 258 (f2cl-lib:array-slice h-%data% 259 f2cl-lib:complex16 260 (kv 1) 261 ((1 ldh) (1 *)) 262 h-%offset%) 263 ldh nho 264 (f2cl-lib:array-slice h-%data% 265 f2cl-lib:complex16 266 (kv kt) 267 ((1 ldh) (1 *)) 268 h-%offset%) 269 ldh nve 270 (f2cl-lib:array-slice h-%data% 271 f2cl-lib:complex16 272 (kwv 1) 273 ((1 ldh) (1 *)) 274 h-%offset%) 275 ldh work lwork) 276 (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6 277 var-7 var-8 var-9 var-10 var-11 var-14 278 var-15 var-16 var-17 var-18 var-19 var-20 279 var-21 var-22 var-23 var-24)) 280 (setf ls var-12) 281 (setf ld var-13)) 282 (setf kbot (f2cl-lib:int-sub kbot ld)) 283 (setf ks (f2cl-lib:int-add (f2cl-lib:int-sub kbot ls) 1)) 284 (cond 285 ((or (= ld 0) 286 (and 287 (<= (f2cl-lib:int-mul 100 ld) 288 (f2cl-lib:int-mul nw nibble)) 289 (> (f2cl-lib:int-add kbot (f2cl-lib:int-sub ktop) 1) 290 (min (the f2cl-lib:integer4 nmin) 291 (the f2cl-lib:integer4 nwmax))))) 292 (setf ns 293 (min (the f2cl-lib:integer4 nsmax) 294 (the f2cl-lib:integer4 nsr) 295 (the f2cl-lib:integer4 296 (max (the f2cl-lib:integer4 2) 297 (the f2cl-lib:integer4 298 (f2cl-lib:int-sub kbot 299 ktop)))))) 300 (setf ns (f2cl-lib:int-sub ns (mod ns 2))) 301 (cond 302 ((= (mod ndfl kexsh) 0) 303 (setf ks 304 (f2cl-lib:int-add (f2cl-lib:int-sub kbot ns) 305 1)) 306 (f2cl-lib:fdo (i kbot 307 (f2cl-lib:int-add i 308 (f2cl-lib:int-sub 2))) 309 ((> i (f2cl-lib:int-add ks 1)) nil) 310 (tagbody 311 (setf (f2cl-lib:fref w-%data% 312 (i) 313 ((1 *)) 314 w-%offset%) 315 (+ 316 (f2cl-lib:fref h-%data% 317 (i i) 318 ((1 ldh) (1 *)) 319 h-%offset%) 320 (* wilk1 321 (cabs1 322 (f2cl-lib:fref h-%data% 323 (i 324 (f2cl-lib:int-sub i 325 1)) 326 ((1 ldh) (1 *)) 327 h-%offset%))))) 328 (setf (f2cl-lib:fref w-%data% 329 ((f2cl-lib:int-sub i 1)) 330 ((1 *)) 331 w-%offset%) 332 (f2cl-lib:fref w-%data% 333 (i) 334 ((1 *)) 335 w-%offset%)) 336 label30))) 337 (t 338 (cond 339 ((<= (f2cl-lib:int-add kbot (f2cl-lib:int-sub ks) 1) 340 (f2cl-lib:f2cl/ ns 2)) 341 (setf ks 342 (f2cl-lib:int-add 343 (f2cl-lib:int-sub kbot ns) 344 1)) 345 (setf kt 346 (f2cl-lib:int-add (f2cl-lib:int-sub n ns) 347 1)) 348 (zlacpy "A" ns ns 349 (f2cl-lib:array-slice h-%data% 350 f2cl-lib:complex16 351 (ks ks) 352 ((1 ldh) (1 *)) 353 h-%offset%) 354 ldh 355 (f2cl-lib:array-slice h-%data% 356 f2cl-lib:complex16 357 (kt 1) 358 ((1 ldh) (1 *)) 359 h-%offset%) 360 ldh) 361 (cond 362 ((> ns nmin) 363 (multiple-value-bind 364 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 365 var-7 var-8 var-9 var-10 var-11 var-12 366 var-13 var-14) 367 (zlaqr4 f2cl-lib:%false% f2cl-lib:%false% ns 368 1 ns 369 (f2cl-lib:array-slice h-%data% 370 f2cl-lib:complex16 371 (kt 1) 372 ((1 ldh) (1 *)) 373 h-%offset%) 374 ldh 375 (f2cl-lib:array-slice w-%data% 376 f2cl-lib:complex16 377 (ks) 378 ((1 *)) 379 w-%offset%) 380 1 1 zdum 1 work lwork inf) 381 (declare (ignore var-0 var-1 var-2 var-3 var-4 382 var-5 var-6 var-7 var-8 var-9 383 var-10 var-11 var-12 var-13)) 384 (setf inf var-14))) 385 (t 386 (multiple-value-bind 387 (var-0 var-1 var-2 var-3 var-4 var-5 var-6 388 var-7 var-8 var-9 var-10 var-11 var-12) 389 (zlahqr f2cl-lib:%false% f2cl-lib:%false% ns 390 1 ns 391 (f2cl-lib:array-slice h-%data% 392 f2cl-lib:complex16 393 (kt 1) 394 ((1 ldh) (1 *)) 395 h-%offset%) 396 ldh 397 (f2cl-lib:array-slice w-%data% 398 f2cl-lib:complex16 399 (ks) 400 ((1 *)) 401 w-%offset%) 402 1 1 zdum 1 inf) 403 (declare (ignore var-0 var-1 var-2 var-3 var-4 404 var-5 var-6 var-7 var-8 var-9 405 var-10 var-11)) 406 (setf inf var-12)))) 407 (setf ks (f2cl-lib:int-add ks inf)) 408 (cond 409 ((>= ks kbot) 410 (setf s 411 (+ 412 (cabs1 413 (f2cl-lib:fref h-%data% 414 ((f2cl-lib:int-sub kbot 415 1) 416 (f2cl-lib:int-sub kbot 417 1)) 418 ((1 ldh) (1 *)) 419 h-%offset%)) 420 (cabs1 421 (f2cl-lib:fref h-%data% 422 (kbot 423 (f2cl-lib:int-sub kbot 424 1)) 425 ((1 ldh) (1 *)) 426 h-%offset%)) 427 (cabs1 428 (f2cl-lib:fref h-%data% 429 ((f2cl-lib:int-sub kbot 430 1) 431 kbot) 432 ((1 ldh) (1 *)) 433 h-%offset%)) 434 (cabs1 435 (f2cl-lib:fref h-%data% 436 (kbot kbot) 437 ((1 ldh) (1 *)) 438 h-%offset%)))) 439 (setf aa 440 (/ 441 (f2cl-lib:fref h-%data% 442 ((f2cl-lib:int-sub kbot 443 1) 444 (f2cl-lib:int-sub kbot 445 1)) 446 ((1 ldh) (1 *)) 447 h-%offset%) 448 s)) 449 (setf cc 450 (/ 451 (f2cl-lib:fref h-%data% 452 (kbot 453 (f2cl-lib:int-sub kbot 454 1)) 455 ((1 ldh) (1 *)) 456 h-%offset%) 457 s)) 458 (setf bb 459 (/ 460 (f2cl-lib:fref h-%data% 461 ((f2cl-lib:int-sub kbot 462 1) 463 kbot) 464 ((1 ldh) (1 *)) 465 h-%offset%) 466 s)) 467 (setf dd 468 (/ 469 (f2cl-lib:fref h-%data% 470 (kbot kbot) 471 ((1 ldh) (1 *)) 472 h-%offset%) 473 s)) 474 (setf tr2 (/ (+ aa dd) two)) 475 (setf det 476 (- (* (- aa tr2) (- dd tr2)) (* bb cc))) 477 (setf rtdisc (f2cl-lib:fsqrt (- det))) 478 (setf (f2cl-lib:fref w-%data% 479 ((f2cl-lib:int-sub kbot 1)) 480 ((1 *)) 481 w-%offset%) 482 (* (+ tr2 rtdisc) s)) 483 (setf (f2cl-lib:fref w-%data% 484 (kbot) 485 ((1 *)) 486 w-%offset%) 487 (* (- tr2 rtdisc) s)) 488 (setf ks (f2cl-lib:int-sub kbot 1)))))) 489 (cond 490 ((> (f2cl-lib:int-add kbot (f2cl-lib:int-sub ks) 1) 491 ns) 492 (tagbody 493 (setf sorted f2cl-lib:%false%) 494 (f2cl-lib:fdo (k kbot 495 (f2cl-lib:int-add k 496 (f2cl-lib:int-sub 497 1))) 498 ((> k (f2cl-lib:int-add ks 1)) nil) 499 (tagbody 500 (if sorted (go label60)) 501 (setf sorted f2cl-lib:%true%) 502 (f2cl-lib:fdo (i ks (f2cl-lib:int-add i 1)) 503 ((> i 504 (f2cl-lib:int-add k 505 (f2cl-lib:int-sub 506 1))) 507 nil) 508 (tagbody 509 (cond 510 ((< 511 (cabs1 (f2cl-lib:fref w (i) ((1 *)))) 512 (cabs1 513 (f2cl-lib:fref w 514 ((f2cl-lib:int-add i 515 1)) 516 ((1 *))))) 517 (setf sorted f2cl-lib:%false%) 518 (setf swap 519 (f2cl-lib:fref w-%data% 520 (i) 521 ((1 *)) 522 w-%offset%)) 523 (setf (f2cl-lib:fref w-%data% 524 (i) 525 ((1 *)) 526 w-%offset%) 527 (f2cl-lib:fref w-%data% 528 ((f2cl-lib:int-add 529 i 530 1)) 531 ((1 *)) 532 w-%offset%)) 533 (setf (f2cl-lib:fref w-%data% 534 ((f2cl-lib:int-add 535 i 536 1)) 537 ((1 *)) 538 w-%offset%) 539 swap))) 540 label40)) 541 label50)) 542 label60))))) 543 (cond 544 ((= (f2cl-lib:int-add kbot (f2cl-lib:int-sub ks) 1) 2) 545 (cond 546 ((< 547 (cabs1 548 (+ (f2cl-lib:fref w (kbot) ((1 *))) 549 (- 550 (f2cl-lib:fref h 551 (kbot kbot) 552 ((1 ldh) (1 *)))))) 553 (cabs1 554 (+ 555 (f2cl-lib:fref w 556 ((f2cl-lib:int-add kbot 557 (f2cl-lib:int-sub 558 1))) 559 ((1 *))) 560 (- 561 (f2cl-lib:fref h 562 (kbot kbot) 563 ((1 ldh) (1 *))))))) 564 (setf (f2cl-lib:fref w-%data% 565 ((f2cl-lib:int-sub kbot 1)) 566 ((1 *)) 567 w-%offset%) 568 (f2cl-lib:fref w-%data% 569 (kbot) 570 ((1 *)) 571 w-%offset%))) 572 (t 573 (setf (f2cl-lib:fref w-%data% 574 (kbot) 575 ((1 *)) 576 w-%offset%) 577 (f2cl-lib:fref w-%data% 578 ((f2cl-lib:int-sub kbot 1)) 579 ((1 *)) 580 w-%offset%)))))) 581 (setf ns 582 (min (the f2cl-lib:integer4 ns) 583 (the f2cl-lib:integer4 584 (f2cl-lib:int-add 585 (f2cl-lib:int-sub kbot ks) 586 1)))) 587 (setf ns (f2cl-lib:int-sub ns (mod ns 2))) 588 (setf ks (f2cl-lib:int-add (f2cl-lib:int-sub kbot ns) 1)) 589 (setf kdu (f2cl-lib:int-sub (f2cl-lib:int-mul 3 ns) 3)) 590 (setf ku (f2cl-lib:int-add (f2cl-lib:int-sub n kdu) 1)) 591 (setf kwh (f2cl-lib:int-add kdu 1)) 592 (setf nho 593 (f2cl-lib:int-add 594 (f2cl-lib:int-sub 595 (f2cl-lib:int-add (f2cl-lib:int-sub n kdu) 1) 596 4 597 (f2cl-lib:int-add kdu 1)) 598 1)) 599 (setf kwv (f2cl-lib:int-add kdu 4)) 600 (setf nve 601 (f2cl-lib:int-add (f2cl-lib:int-sub n kdu kwv) 1)) 602 (zlaqr5 wantt wantz kacc22 n ktop kbot ns 603 (f2cl-lib:array-slice w-%data% 604 f2cl-lib:complex16 605 (ks) 606 ((1 *)) 607 w-%offset%) 608 h ldh iloz ihiz z ldz work 3 609 (f2cl-lib:array-slice h-%data% 610 f2cl-lib:complex16 611 (ku 1) 612 ((1 ldh) (1 *)) 613 h-%offset%) 614 ldh nve 615 (f2cl-lib:array-slice h-%data% 616 f2cl-lib:complex16 617 (kwv 1) 618 ((1 ldh) (1 *)) 619 h-%offset%) 620 ldh nho 621 (f2cl-lib:array-slice h-%data% 622 f2cl-lib:complex16 623 (ku kwh) 624 ((1 ldh) (1 *)) 625 h-%offset%) 626 ldh))) 627 (cond 628 ((> ld 0) 629 (setf ndfl 1)) 630 (t 631 (setf ndfl (f2cl-lib:int-add ndfl 1)))) 632 label70)) 633 (setf info kbot) 634 label80))) 635 (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) 636 (f2cl-lib:dcmplx lwkopt 0)) 637 end_label 638 (return 639 (values nil 640 nil 641 nil 642 nil 643 nil 644 nil 645 nil 646 nil 647 nil 648 nil 649 nil 650 nil 651 nil 652 nil 653 info))))))) 654 655(in-package #-gcl #:cl-user #+gcl "CL-USER") 656#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) 657(eval-when (:load-toplevel :compile-toplevel :execute) 658 (setf (gethash 'fortran-to-lisp::zlaqr0 659 fortran-to-lisp::*f2cl-function-info*) 660 (fortran-to-lisp::make-f2cl-finfo 661 :arg-types '(fortran-to-lisp::logical fortran-to-lisp::logical 662 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4) 663 (fortran-to-lisp::integer4) 664 (array fortran-to-lisp::complex16 (*)) 665 (fortran-to-lisp::integer4) 666 (array fortran-to-lisp::complex16 (*)) 667 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4) 668 (array fortran-to-lisp::complex16 (*)) 669 (fortran-to-lisp::integer4) 670 (array fortran-to-lisp::complex16 (*)) 671 (fortran-to-lisp::integer4) 672 (fortran-to-lisp::integer4)) 673 :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil 674 nil fortran-to-lisp::info) 675 :calls '(fortran-to-lisp::zlaqr5 fortran-to-lisp::zlaqr4 676 fortran-to-lisp::zlacpy fortran-to-lisp::zlaqr3 677 fortran-to-lisp::ilaenv fortran-to-lisp::zlahqr)))) 678 679