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 :blas) 18 19 20(let* ((one 1.0) (zero 0.0)) 21 (declare (type (double-float 1.0 1.0) one) 22 (type (double-float 0.0 0.0) zero) 23 (ignorable one zero)) 24 (defun dgbmv (trans m n kl ku alpha a lda x incx beta y incy) 25 (declare (type (array double-float (*)) y x a) 26 (type (double-float) beta alpha) 27 (type (f2cl-lib:integer4) incy incx lda ku kl n m) 28 (type (simple-string *) trans)) 29 (f2cl-lib:with-multi-array-data 30 ((trans character trans-%data% trans-%offset%) 31 (a double-float a-%data% a-%offset%) 32 (x double-float x-%data% x-%offset%) 33 (y double-float y-%data% y-%offset%)) 34 (prog ((i 0) (info 0) (ix 0) (iy 0) (j 0) (jx 0) (jy 0) (k 0) (kup1 0) 35 (kx 0) (ky 0) (lenx 0) (leny 0) (temp 0.0)) 36 (declare (type (f2cl-lib:integer4) i info ix iy j jx jy k kup1 kx ky 37 lenx leny) 38 (type (double-float) temp)) 39 (setf info 0) 40 (cond 41 ((and (not (lsame trans "N")) 42 (not (lsame trans "T")) 43 (not (lsame trans "C"))) 44 (setf info 1)) 45 ((< m 0) 46 (setf info 2)) 47 ((< n 0) 48 (setf info 3)) 49 ((< kl 0) 50 (setf info 4)) 51 ((< ku 0) 52 (setf info 5)) 53 ((< lda (f2cl-lib:int-add kl ku 1)) 54 (setf info 8)) 55 ((= incx 0) 56 (setf info 10)) 57 ((= incy 0) 58 (setf info 13))) 59 (cond 60 ((/= info 0) 61 (xerbla "DGBMV " info) 62 (go end_label))) 63 (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) 64 (go end_label)) 65 (cond 66 ((lsame trans "N") 67 (setf lenx n) 68 (setf leny m)) 69 (t 70 (setf lenx m) 71 (setf leny n))) 72 (cond 73 ((> incx 0) 74 (setf kx 1)) 75 (t 76 (setf kx 77 (f2cl-lib:int-sub 1 78 (f2cl-lib:int-mul 79 (f2cl-lib:int-sub lenx 1) 80 incx))))) 81 (cond 82 ((> incy 0) 83 (setf ky 1)) 84 (t 85 (setf ky 86 (f2cl-lib:int-sub 1 87 (f2cl-lib:int-mul 88 (f2cl-lib:int-sub leny 1) 89 incy))))) 90 (cond 91 ((/= beta one) 92 (cond 93 ((= incy 1) 94 (cond 95 ((= beta zero) 96 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 97 ((> i leny) nil) 98 (tagbody 99 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%) 100 zero) 101 label10))) 102 (t 103 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 104 ((> i leny) nil) 105 (tagbody 106 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%) 107 (* beta 108 (f2cl-lib:fref y-%data% 109 (i) 110 ((1 *)) 111 y-%offset%))) 112 label20))))) 113 (t 114 (setf iy ky) 115 (cond 116 ((= beta zero) 117 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 118 ((> i leny) nil) 119 (tagbody 120 (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%) 121 zero) 122 (setf iy (f2cl-lib:int-add iy incy)) 123 label30))) 124 (t 125 (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) 126 ((> i leny) nil) 127 (tagbody 128 (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%) 129 (* beta 130 (f2cl-lib:fref y-%data% 131 (iy) 132 ((1 *)) 133 y-%offset%))) 134 (setf iy (f2cl-lib:int-add iy incy)) 135 label40)))))))) 136 (if (= alpha zero) (go end_label)) 137 (setf kup1 (f2cl-lib:int-add ku 1)) 138 (cond 139 ((lsame trans "N") 140 (setf jx kx) 141 (cond 142 ((= incy 1) 143 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) 144 ((> j n) nil) 145 (tagbody 146 (cond 147 ((/= (f2cl-lib:fref x (jx) ((1 *))) zero) 148 (setf temp 149 (* alpha 150 (f2cl-lib:fref x-%data% 151 (jx) 152 ((1 *)) 153 x-%offset%))) 154 (setf k (f2cl-lib:int-sub kup1 j)) 155 (f2cl-lib:fdo (i 156 (max (the f2cl-lib:integer4 1) 157 (the f2cl-lib:integer4 158 (f2cl-lib:int-add j 159 (f2cl-lib:int-sub 160 ku)))) 161 (f2cl-lib:int-add i 1)) 162 ((> i 163 (min (the f2cl-lib:integer4 m) 164 (the f2cl-lib:integer4 165 (f2cl-lib:int-add j kl)))) 166 nil) 167 (tagbody 168 (setf (f2cl-lib:fref y-%data% (i) ((1 *)) y-%offset%) 169 (+ 170 (f2cl-lib:fref y-%data% 171 (i) 172 ((1 *)) 173 y-%offset%) 174 (* temp 175 (f2cl-lib:fref a-%data% 176 ((f2cl-lib:int-add k i) j) 177 ((1 lda) (1 *)) 178 a-%offset%)))) 179 label50)))) 180 (setf jx (f2cl-lib:int-add jx incx)) 181 label60))) 182 (t 183 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) 184 ((> j n) nil) 185 (tagbody 186 (cond 187 ((/= (f2cl-lib:fref x (jx) ((1 *))) zero) 188 (setf temp 189 (* alpha 190 (f2cl-lib:fref x-%data% 191 (jx) 192 ((1 *)) 193 x-%offset%))) 194 (setf iy ky) 195 (setf k (f2cl-lib:int-sub kup1 j)) 196 (f2cl-lib:fdo (i 197 (max (the f2cl-lib:integer4 1) 198 (the f2cl-lib:integer4 199 (f2cl-lib:int-add j 200 (f2cl-lib:int-sub 201 ku)))) 202 (f2cl-lib:int-add i 1)) 203 ((> i 204 (min (the f2cl-lib:integer4 m) 205 (the f2cl-lib:integer4 206 (f2cl-lib:int-add j kl)))) 207 nil) 208 (tagbody 209 (setf (f2cl-lib:fref y-%data% (iy) ((1 *)) y-%offset%) 210 (+ 211 (f2cl-lib:fref y-%data% 212 (iy) 213 ((1 *)) 214 y-%offset%) 215 (* temp 216 (f2cl-lib:fref a-%data% 217 ((f2cl-lib:int-add k i) j) 218 ((1 lda) (1 *)) 219 a-%offset%)))) 220 (setf iy (f2cl-lib:int-add iy incy)) 221 label70)))) 222 (setf jx (f2cl-lib:int-add jx incx)) 223 (if (> j ku) (setf ky (f2cl-lib:int-add ky incy))) 224 label80))))) 225 (t 226 (setf jy ky) 227 (cond 228 ((= incx 1) 229 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) 230 ((> j n) nil) 231 (tagbody 232 (setf temp zero) 233 (setf k (f2cl-lib:int-sub kup1 j)) 234 (f2cl-lib:fdo (i 235 (max (the f2cl-lib:integer4 1) 236 (the f2cl-lib:integer4 237 (f2cl-lib:int-add j 238 (f2cl-lib:int-sub 239 ku)))) 240 (f2cl-lib:int-add i 1)) 241 ((> i 242 (min (the f2cl-lib:integer4 m) 243 (the f2cl-lib:integer4 244 (f2cl-lib:int-add j kl)))) 245 nil) 246 (tagbody 247 (setf temp 248 (+ temp 249 (* 250 (f2cl-lib:fref a-%data% 251 ((f2cl-lib:int-add k i) j) 252 ((1 lda) (1 *)) 253 a-%offset%) 254 (f2cl-lib:fref x-%data% 255 (i) 256 ((1 *)) 257 x-%offset%)))) 258 label90)) 259 (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%) 260 (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%) 261 (* alpha temp))) 262 (setf jy (f2cl-lib:int-add jy incy)) 263 label100))) 264 (t 265 (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) 266 ((> j n) nil) 267 (tagbody 268 (setf temp zero) 269 (setf ix kx) 270 (setf k (f2cl-lib:int-sub kup1 j)) 271 (f2cl-lib:fdo (i 272 (max (the f2cl-lib:integer4 1) 273 (the f2cl-lib:integer4 274 (f2cl-lib:int-add j 275 (f2cl-lib:int-sub 276 ku)))) 277 (f2cl-lib:int-add i 1)) 278 ((> i 279 (min (the f2cl-lib:integer4 m) 280 (the f2cl-lib:integer4 281 (f2cl-lib:int-add j kl)))) 282 nil) 283 (tagbody 284 (setf temp 285 (+ temp 286 (* 287 (f2cl-lib:fref a-%data% 288 ((f2cl-lib:int-add k i) j) 289 ((1 lda) (1 *)) 290 a-%offset%) 291 (f2cl-lib:fref x-%data% 292 (ix) 293 ((1 *)) 294 x-%offset%)))) 295 (setf ix (f2cl-lib:int-add ix incx)) 296 label110)) 297 (setf (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%) 298 (+ (f2cl-lib:fref y-%data% (jy) ((1 *)) y-%offset%) 299 (* alpha temp))) 300 (setf jy (f2cl-lib:int-add jy incy)) 301 (if (> j ku) (setf kx (f2cl-lib:int-add kx incx))) 302 label120)))))) 303 (go end_label) 304 end_label 305 (return 306 (values nil nil nil nil nil nil nil nil nil nil nil nil nil)))))) 307 308(in-package #-gcl #:cl-user #+gcl "CL-USER") 309#+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) 310(eval-when (:load-toplevel :compile-toplevel :execute) 311 (setf (gethash 'fortran-to-lisp::dgbmv fortran-to-lisp::*f2cl-function-info*) 312 (fortran-to-lisp::make-f2cl-finfo 313 :arg-types '((simple-string) (fortran-to-lisp::integer4) 314 (fortran-to-lisp::integer4) (fortran-to-lisp::integer4) 315 (fortran-to-lisp::integer4) (double-float) 316 (array double-float (*)) (fortran-to-lisp::integer4) 317 (array double-float (*)) (fortran-to-lisp::integer4) 318 (double-float) (array double-float (*)) 319 (fortran-to-lisp::integer4)) 320 :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil 321 nil) 322 :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) 323 324