share/colnew/lisp/lsyslv.lisp

   1 ;;; Compiled by f2cl version:
   2 ;;; ("f2cl1.l,v 1.221 2010/05/26 19:25:52 rtoy Exp $"
   3 ;;;  "f2cl2.l,v 1.37 2008/02/22 22:19:33 rtoy Exp $"
   4 ;;;  "f2cl3.l,v 1.6 2008/02/22 22:19:33 rtoy Exp $"
   5 ;;;  "f2cl4.l,v 1.7 2008/02/22 22:19:34 rtoy Exp $"
   6 ;;;  "f2cl5.l,v 1.204 2010/02/23 05:21:30 rtoy Exp $"
   7 ;;;  "f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $"
   8 ;;;  "macros.l,v 1.114 2010/05/17 01:42:14 rtoy Exp $")
   9
  10 ;;; Using Lisp CMU Common Lisp CVS Head 2010-05-25 18:21:07 (20A 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 :colnew)
  18
  19
  20 (defun lsyslv
  21        (msing xi xiold z dmz delz deldmz g w v rhs dmzo integs ipvtg ipvtw
  22         rnorm mode fsub dfsub gsub dgsub guess)
  23   (declare (type double-float rnorm)
  24            (type (array f2cl-lib:integer4 (*)) ipvtw ipvtg)
  25            (type (array f2cl-lib:integer4 (*)) integs)
  26            (type (array double-float (*)) dmzo rhs v w g deldmz delz dmz z
  27                                           xiold xi)
  28            (type (f2cl-lib:integer4) mode msing))
  29   (let ((colloc-rho
  30          (make-array 7
  31                      :element-type 'double-float
  32                      :displaced-to (colloc-part-0 *colloc-common-block*)
  33                      :displaced-index-offset 0))
  34         (colloc-coef
  35          (make-array 49
  36                      :element-type 'double-float
  37                      :displaced-to (colloc-part-0 *colloc-common-block*)
  38                      :displaced-index-offset 7))
  39         (colord-m
  40          (make-array 20
  41                      :element-type 'f2cl-lib:integer4
  42                      :displaced-to (colord-part-0 *colord-common-block*)
  43                      :displaced-index-offset 5))
  44         (colsid-zeta
  45          (make-array 40
  46                      :element-type 'double-float
  47                      :displaced-to (colsid-part-0 *colsid-common-block*)
  48                      :displaced-index-offset 0))
  49         (colbas-acol
  50          (make-array 196
  51                      :element-type 'double-float
  52                      :displaced-to (colbas-part-0 *colbas-common-block*)
  53                      :displaced-index-offset 28)))
  54     (symbol-macrolet ((precis (aref (colout-part-0 *colout-common-block*) 0))
  55                       (rho colloc-rho)
  56                       (coef colloc-coef)
  57                       (k (aref (colord-part-0 *colord-common-block*) 0))
  58                       (ncomp (aref (colord-part-0 *colord-common-block*) 1))
  59                       (mstar (aref (colord-part-0 *colord-common-block*) 2))
  60                       (kd (aref (colord-part-0 *colord-common-block*) 3))
  61                       (mmax (aref (colord-part-0 *colord-common-block*) 4))
  62                       (m colord-m)
  63                       (zeta colsid-zeta)
  64                       (aright (aref (colsid-part-0 *colsid-common-block*) 41))
  65                       (izeta (aref (colsid-part-1 *colsid-common-block*) 0))
  66                       (izsave (aref (colsid-part-1 *colsid-common-block*) 1))
  67                       (n (aref (colapr-part-0 *colapr-common-block*) 0))
  68                       (nold (aref (colapr-part-0 *colapr-common-block*) 1))
  69                       (nz (aref (colapr-part-0 *colapr-common-block*) 3))
  70                       (ndmz (aref (colapr-part-0 *colapr-common-block*) 4))
  71                       (iguess (aref (colnln-part-0 *colnln-common-block*) 4))
  72                       (acol colbas-acol))
  73       (f2cl-lib:with-multi-array-data
  74           ((xi double-float xi-%data% xi-%offset%)
  75            (xiold double-float xiold-%data% xiold-%offset%)
  76            (z double-float z-%data% z-%offset%)
  77            (dmz double-float dmz-%data% dmz-%offset%)
  78            (delz double-float delz-%data% delz-%offset%)
  79            (deldmz double-float deldmz-%data% deldmz-%offset%)
  80            (g double-float g-%data% g-%offset%)
  81            (w double-float w-%data% w-%offset%)
  82            (v double-float v-%data% v-%offset%)
  83            (rhs double-float rhs-%data% rhs-%offset%)
  84            (dmzo double-float dmzo-%data% dmzo-%offset%)
  85            (integs f2cl-lib:integer4 integs-%data% integs-%offset%)
  86            (ipvtg f2cl-lib:integer4 ipvtg-%data% ipvtg-%offset%)
  87            (ipvtw f2cl-lib:integer4 ipvtw-%data% ipvtw-%offset%))
  88         (prog ((izet 0) (iz 0) (value 0.0) (jj 0) (xcol 0.0) (hrho 0.0) (j 0)
  89                (gval 0.0) (h 0.0) (xii 0.0) (l 0) (lw 0) (nrow 0) (ncol 0)
  90                (iold 0) (lside 0) (iv 0) (iw 0) (ig 0) (irhs 0) (idmzo 0)
  91                (idmz 0) (i 0) (m1 0)
  92                (dummy (make-array 1 :element-type 'double-float))
  93                (at (make-array 28 :element-type 'double-float))
  94                (df (make-array 800 :element-type 'double-float))
  95                (dmval (make-array 20 :element-type 'double-float))
  96                (dgz (make-array 40 :element-type 'double-float))
  97                (f (make-array 40 :element-type 'double-float))
  98                (zval (make-array 40 :element-type 'double-float)))
  99           (declare (type (array double-float (40)) zval f dgz)
 100                    (type (array double-float (20)) dmval)
 101                    (type (array double-float (800)) df)
 102                    (type (array double-float (28)) at)
 103                    (type (array double-float (1)) dummy)
 104                    (type double-float xii h gval hrho xcol value)
 105                    (type (f2cl-lib:integer4) m1 i idmz idmzo irhs ig iw iv
 106                                              lside iold ncol nrow lw l j jj iz
 107                                              izet))
 108           (setf m1 (f2cl-lib:int-add mode 1))
 109           (f2cl-lib:computed-goto (label10 label30 label30 label30 label310)
 110                                   m1)
 111          label10
 112           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 113                         ((> i mstar) nil)
 114             (tagbody label20 (setf (f2cl-lib:fref zval (i) ((1 40))) 0.0)))
 115          label30
 116           (setf idmz 1)
 117           (setf idmzo 1)
 118           (setf irhs 1)
 119           (setf ig 1)
 120           (setf iw 1)
 121           (setf iv 1)
 122           (setf izeta 1)
 123           (setf lside 0)
 124           (setf iold 1)
 125           (setf ncol (f2cl-lib:int-mul 2 mstar))
 126           (setf rnorm 0.0)
 127           (if (> mode 1) (go label80))
 128           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 129                         ((> i n) nil)
 130             (tagbody
 131               (setf (f2cl-lib:fref integs-%data%
 132                                    (2 i)
 133                                    ((1 3) (1 1))
 134                                    integs-%offset%)
 135                       ncol)
 136               (if (< i n) (go label40))
 137               (setf (f2cl-lib:fref integs-%data%
 138                                    (3 n)
 139                                    ((1 3) (1 1))
 140                                    integs-%offset%)
 141                       ncol)
 142               (setf lside mstar)
 143               (go label60)
 144              label40
 145               (setf (f2cl-lib:fref integs-%data%
 146                                    (3 i)
 147                                    ((1 3) (1 1))
 148                                    integs-%offset%)
 149                       mstar)
 150              label50
 151               (if (= lside mstar) (go label60))
 152               (if
 153                (>= (f2cl-lib:fref zeta ((f2cl-lib:int-add lside 1)) ((1 40)))
 154                    (+ (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)
 155                       precis))
 156                (go label60))
 157               (setf lside (f2cl-lib:int-add lside 1))
 158               (go label50)
 159              label60
 160               (setf nrow (f2cl-lib:int-add mstar lside))
 161              label70
 162               (setf (f2cl-lib:fref integs-%data%
 163                                    (1 i)
 164                                    ((1 3) (1 1))
 165                                    integs-%offset%)
 166                       nrow)))
 167          label80
 168           (if (= mode 2) (go label90))
 169           (setf lw (f2cl-lib:int-mul kd kd n))
 170           (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
 171                         ((> l lw) nil)
 172             (tagbody
 173              label84
 174               (setf (f2cl-lib:fref w-%data% (l) ((1 1)) w-%offset%) 0.0)))
 175          label90
 176           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 177                         ((> i n) nil)
 178             (tagbody
 179               (setf xii (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%))
 180               (setf h
 181                       (-
 182                        (f2cl-lib:fref xi-%data%
 183                                       ((f2cl-lib:int-add i 1))
 184                                       ((1 1))
 185                                       xi-%offset%)
 186                        (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)))
 187               (setf nrow
 188                       (f2cl-lib:fref integs-%data%
 189                                      (1 i)
 190                                      ((1 3) (1 1))
 191                                      integs-%offset%))
 192              label100
 193               (if (> izeta mstar) (go label140))
 194               (if (> (f2cl-lib:fref zeta (izeta) ((1 40))) (+ xii precis))
 195                   (go label140))
 196               (if (= mode 0) (go label110))
 197               (if (/= iguess 1) (go label102))
 198               (multiple-value-bind (var-0 var-1 var-2)
 199                   (funcall guess xii zval dmval)
 200                 (declare (ignore var-1 var-2))
 201                 (when var-0
 202                   (setf xii var-0)))
 203               (go label110)
 204              label102
 205               (if (/= mode 1) (go label106))
 206               (multiple-value-bind
 207                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 208                      var-9 var-10 var-11 var-12 var-13 var-14 var-15 var-16)
 209                   (approx iold xii zval at coef xiold nold z dmz k ncomp mmax m
 210                    mstar 2 dummy 0)
 211                 (declare (ignore var-2 var-3 var-4 var-5 var-6 var-7 var-8
 212                                  var-9 var-10 var-11 var-12 var-13 var-14
 213                                  var-15 var-16))
 214                 (setf iold var-0)
 215                 (setf xii var-1))
 216               (go label110)
 217              label106
 218               (multiple-value-bind
 219                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 220                      var-9 var-10 var-11 var-12 var-13 var-14 var-15 var-16)
 221                   (approx i xii zval at dummy xi n z dmz k ncomp mmax m mstar 1
 222                    dummy 0)
 223                 (declare (ignore var-2 var-3 var-4 var-5 var-6 var-7 var-8
 224                                  var-9 var-10 var-11 var-12 var-13 var-14
 225                                  var-15 var-16))
 226                 (setf i var-0)
 227                 (setf xii var-1))
 228              label108
 229               (if (= mode 3) (go label120))
 230              label110
 231               (multiple-value-bind (var-0 var-1 var-2)
 232                   (funcall gsub izeta zval gval)
 233                 (declare (ignore var-1))
 234                 (when var-0
 235                   (setf izeta var-0))
 236                 (when var-2
 237                   (setf gval var-2)))
 238               (setf (f2cl-lib:fref rhs-%data%
 239                                    ((f2cl-lib:int-add ndmz izeta))
 240                                    ((1 1))
 241                                    rhs-%offset%)
 242                       (- gval))
 243               (setf rnorm (+ rnorm (expt gval 2)))
 244               (if (= mode 2) (go label130))
 245              label120
 246               (gderiv (f2cl-lib:array-slice g double-float (ig) ((1 1))) nrow
 247                izeta zval dgz 1 dgsub)
 248              label130
 249               (setf izeta (f2cl-lib:int-add izeta 1))
 250               (go label100)
 251              label140
 252               (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1))
 253                             ((> j k) nil)
 254                 (tagbody
 255                   (setf hrho (* h (f2cl-lib:fref rho (j) ((1 7)))))
 256                   (setf xcol (+ xii hrho))
 257                   (if (= mode 0) (go label200))
 258                   (if (/= iguess 1) (go label160))
 259                   (multiple-value-bind (var-0 var-1 var-2)
 260                       (funcall guess
 261                                xcol
 262                                zval
 263                                (f2cl-lib:array-slice dmzo
 264                                                      double-float
 265                                                      (irhs)
 266                                                      ((1 1))))
 267                     (declare (ignore var-1 var-2))
 268                     (when var-0
 269                       (setf xcol var-0)))
 270                   (go label170)
 271                  label160
 272                   (if (/= mode 1) (go label190))
 273                   (multiple-value-bind
 274                         (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 275                          var-9 var-10 var-11 var-12 var-13 var-14 var-15
 276                          var-16)
 277                       (approx iold xcol zval at coef xiold nold z dmz k ncomp
 278                        mmax m mstar 2
 279                        (f2cl-lib:array-slice dmzo double-float (irhs) ((1 1)))
 280                        1)
 281                     (declare (ignore var-2 var-3 var-4 var-5 var-6 var-7 var-8
 282                                      var-9 var-10 var-11 var-12 var-13 var-14
 283                                      var-15 var-16))
 284                     (setf iold var-0)
 285                     (setf xcol var-1))
 286                  label170
 287                   (multiple-value-bind (var-0 var-1 var-2)
 288                       (funcall fsub xcol zval f)
 289                     (declare (ignore var-1 var-2))
 290                     (when var-0
 291                       (setf xcol var-0)))
 292                   (f2cl-lib:fdo (jj 1 (f2cl-lib:int-add jj 1))
 293                                 ((> jj ncomp) nil)
 294                     (tagbody
 295                       (setf value
 296                               (-
 297                                (f2cl-lib:fref dmzo-%data%
 298                                               (irhs)
 299                                               ((1 1))
 300                                               dmzo-%offset%)
 301                                (f2cl-lib:fref f (jj) ((1 40)))))
 302                       (setf (f2cl-lib:fref rhs-%data%
 303                                            (irhs)
 304                                            ((1 1))
 305                                            rhs-%offset%)
 306                               (- value))
 307                       (setf rnorm (+ rnorm (expt value 2)))
 308                       (setf irhs (f2cl-lib:int-add irhs 1))
 309                      label180))
 310                   (go label210)
 311                  label190
 312                   (multiple-value-bind
 313                         (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 314                          var-9 var-10 var-11 var-12 var-13 var-14 var-15
 315                          var-16)
 316                       (approx i xcol zval
 317                        (f2cl-lib:array-slice acol
 318                                              double-float
 319                                              (1 j)
 320                                              ((1 28) (1 7)))
 321                        coef xi n z dmz k ncomp mmax m mstar 4 dummy 0)
 322                     (declare (ignore var-2 var-3 var-4 var-5 var-6 var-7 var-8
 323                                      var-9 var-10 var-11 var-12 var-13 var-14
 324                                      var-15 var-16))
 325                     (setf i var-0)
 326                     (setf xcol var-1))
 327                   (if (= mode 3) (go label210))
 328                   (multiple-value-bind (var-0 var-1 var-2)
 329                       (funcall fsub xcol zval f)
 330                     (declare (ignore var-1 var-2))
 331                     (when var-0
 332                       (setf xcol var-0)))
 333                   (f2cl-lib:fdo (jj 1 (f2cl-lib:int-add jj 1))
 334                                 ((> jj ncomp) nil)
 335                     (tagbody
 336                       (setf value
 337                               (-
 338                                (f2cl-lib:fref dmz-%data%
 339                                               (irhs)
 340                                               ((1 1))
 341                                               dmz-%offset%)
 342                                (f2cl-lib:fref f (jj) ((1 40)))))
 343                       (setf (f2cl-lib:fref rhs-%data%
 344                                            (irhs)
 345                                            ((1 1))
 346                                            rhs-%offset%)
 347                               (- value))
 348                       (setf rnorm (+ rnorm (expt value 2)))
 349                       (setf irhs (f2cl-lib:int-add irhs 1))
 350                      label195))
 351                   (go label220)
 352                  label200
 353                   (multiple-value-bind (var-0 var-1 var-2)
 354                       (funcall fsub
 355                                xcol
 356                                zval
 357                                (f2cl-lib:array-slice rhs
 358                                                      double-float
 359                                                      (irhs)
 360                                                      ((1 1))))
 361                     (declare (ignore var-1 var-2))
 362                     (when var-0
 363                       (setf xcol var-0)))
 364                   (setf irhs (f2cl-lib:int-add irhs ncomp))
 365                  label210
 366                   (multiple-value-bind
 367                         (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 368                          var-9 var-10 var-11 var-12 var-13)
 369                       (vwblok xcol hrho j
 370                        (f2cl-lib:array-slice w double-float (iw) ((1 1)))
 371                        (f2cl-lib:array-slice v double-float (iv) ((1 1)))
 372                        (f2cl-lib:array-slice ipvtw
 373                                              f2cl-lib:integer4
 374                                              (idmz)
 375                                              ((1 1)))
 376                        kd zval df
 377                        (f2cl-lib:array-slice acol
 378                                              double-float
 379                                              (1 j)
 380                                              ((1 28) (1 7)))
 381                        (f2cl-lib:array-slice dmzo double-float (idmzo) ((1 1)))
 382                        ncomp dfsub msing)
 383                     (declare (ignore var-1 var-2 var-3 var-4 var-5 var-6 var-7
 384                                      var-8 var-9 var-10 var-11 var-12))
 385                     (setf xcol var-0)
 386                     (setf msing var-13))
 387                   (if (/= msing 0) (go end_label))
 388                  label220))
 389               (if (/= mode 2)
 390                   (gblock h (f2cl-lib:array-slice g double-float (ig) ((1 1)))
 391                    nrow izeta
 392                    (f2cl-lib:array-slice w double-float (iw) ((1 1)))
 393                    (f2cl-lib:array-slice v double-float (iv) ((1 1))) kd dummy
 394                    (f2cl-lib:array-slice deldmz double-float (idmz) ((1 1)))
 395                    (f2cl-lib:array-slice ipvtw
 396                                          f2cl-lib:integer4
 397                                          (idmz)
 398                                          ((1 1)))
 399                    1))
 400               (if (< i n) (go label280))
 401               (setf izsave izeta)
 402              label240
 403               (if (> izeta mstar) (go label290))
 404               (if (= mode 0) (go label250))
 405               (if (/= iguess 1) (go label245))
 406               (multiple-value-bind (var-0 var-1 var-2)
 407                   (funcall guess aright zval dmval)
 408                 (declare (ignore var-1 var-2))
 409                 (when var-0
 410                   (setf aright var-0)))
 411               (go label250)
 412              label245
 413               (if (/= mode 1) (go label246))
 414               (multiple-value-bind
 415                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 416                      var-9 var-10 var-11 var-12 var-13 var-14 var-15 var-16)
 417                   (approx (f2cl-lib:int-add nold 1) aright zval at coef xiold
 418                    nold z dmz k ncomp mmax m mstar 1 dummy 0)
 419                 (declare (ignore var-0 var-2 var-3 var-4 var-5 var-6 var-7
 420                                  var-8 var-9 var-10 var-11 var-12 var-13 var-14
 421                                  var-15 var-16))
 422                 (setf aright var-1))
 423               (go label250)
 424              label246
 425               (multiple-value-bind
 426                     (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7 var-8
 427                      var-9 var-10 var-11 var-12 var-13 var-14 var-15 var-16)
 428                   (approx (f2cl-lib:int-add n 1) aright zval at coef xi n z dmz
 429                    k ncomp mmax m mstar 1 dummy 0)
 430                 (declare (ignore var-0 var-2 var-3 var-4 var-5 var-6 var-7
 431                                  var-8 var-9 var-10 var-11 var-12 var-13 var-14
 432                                  var-15 var-16))
 433                 (setf aright var-1))
 434              label248
 435               (if (= mode 3) (go label260))
 436              label250
 437               (multiple-value-bind (var-0 var-1 var-2)
 438                   (funcall gsub izeta zval gval)
 439                 (declare (ignore var-1))
 440                 (when var-0
 441                   (setf izeta var-0))
 442                 (when var-2
 443                   (setf gval var-2)))
 444               (setf (f2cl-lib:fref rhs-%data%
 445                                    ((f2cl-lib:int-add ndmz izeta))
 446                                    ((1 1))
 447                                    rhs-%offset%)
 448                       (- gval))
 449               (setf rnorm (+ rnorm (expt gval 2)))
 450               (if (= mode 2) (go label270))
 451              label260
 452               (gderiv (f2cl-lib:array-slice g double-float (ig) ((1 1))) nrow
 453                (f2cl-lib:int-add izeta mstar) zval dgz 2 dgsub)
 454              label270
 455               (setf izeta (f2cl-lib:int-add izeta 1))
 456               (go label240)
 457              label280
 458               (setf ig (f2cl-lib:int-add ig (f2cl-lib:int-mul nrow ncol)))
 459               (setf iv (f2cl-lib:int-add iv (f2cl-lib:int-mul kd mstar)))
 460               (setf iw (f2cl-lib:int-add iw (f2cl-lib:int-mul kd kd)))
 461               (setf idmz (f2cl-lib:int-add idmz kd))
 462               (if (= mode 1) (setf idmzo (f2cl-lib:int-add idmzo kd)))
 463              label290))
 464           (if (or (= mode 0) (= mode 3)) (go label300))
 465           (setf rnorm
 466                   (f2cl-lib:dsqrt
 467                    (/ rnorm (f2cl-lib:dfloat (f2cl-lib:int-add nz ndmz)))))
 468           (if (/= mode 2) (go label300))
 469           (go end_label)
 470          label300
 471           (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5)
 472               (fcblok g integs n ipvtg df msing)
 473             (declare (ignore var-0 var-1 var-2 var-3 var-4))
 474             (setf msing var-5))
 475           (setf msing (f2cl-lib:int-sub msing))
 476           (if (/= msing 0) (go end_label))
 477          label310
 478           (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
 479                         ((> l ndmz) nil)
 480             (tagbody
 481               (setf (f2cl-lib:fref deldmz-%data% (l) ((1 1)) deldmz-%offset%)
 482                       (f2cl-lib:fref rhs-%data% (l) ((1 1)) rhs-%offset%))
 483              label311))
 484           (setf iz 1)
 485           (setf idmz 1)
 486           (setf iw 1)
 487           (setf izet 1)
 488           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 489                         ((> i n) nil)
 490             (tagbody
 491               (setf nrow
 492                       (f2cl-lib:fref integs-%data%
 493                                      (1 i)
 494                                      ((1 3) (1 1))
 495                                      integs-%offset%))
 496               (setf izeta (f2cl-lib:int-sub (f2cl-lib:int-add nrow 1) mstar))
 497               (if (= i n) (setf izeta izsave))
 498              label322
 499               (if (= izet izeta) (go label324))
 500               (setf (f2cl-lib:fref delz-%data%
 501                                    ((f2cl-lib:int-add (f2cl-lib:int-sub iz 1)
 502                                                       izet))
 503                                    ((1 1))
 504                                    delz-%offset%)
 505                       (f2cl-lib:fref rhs-%data%
 506                                      ((f2cl-lib:int-add ndmz izet))
 507                                      ((1 1))
 508                                      rhs-%offset%))
 509               (setf izet (f2cl-lib:int-add izet 1))
 510               (go label322)
 511              label324
 512               (setf h
 513                       (-
 514                        (f2cl-lib:fref xi-%data%
 515                                       ((f2cl-lib:int-add i 1))
 516                                       ((1 1))
 517                                       xi-%offset%)
 518                        (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)))
 519               (gblock h (f2cl-lib:array-slice g double-float (1) ((1 1))) nrow
 520                izeta (f2cl-lib:array-slice w double-float (iw) ((1 1)))
 521                (f2cl-lib:array-slice v double-float (1) ((1 1))) kd
 522                (f2cl-lib:array-slice delz double-float (iz) ((1 1)))
 523                (f2cl-lib:array-slice deldmz double-float (idmz) ((1 1)))
 524                (f2cl-lib:array-slice ipvtw f2cl-lib:integer4 (idmz) ((1 1))) 2)
 525               (setf iz (f2cl-lib:int-add iz mstar))
 526               (setf idmz (f2cl-lib:int-add idmz kd))
 527               (setf iw (f2cl-lib:int-add iw (f2cl-lib:int-mul kd kd)))
 528               (if (< i n) (go label320))
 529              label326
 530               (if (> izet mstar) (go label320))
 531               (setf (f2cl-lib:fref delz-%data%
 532                                    ((f2cl-lib:int-add (f2cl-lib:int-sub iz 1)
 533                                                       izet))
 534                                    ((1 1))
 535                                    delz-%offset%)
 536                       (f2cl-lib:fref rhs-%data%
 537                                      ((f2cl-lib:int-add ndmz izet))
 538                                      ((1 1))
 539                                      rhs-%offset%))
 540               (setf izet (f2cl-lib:int-add izet 1))
 541               (go label326)
 542              label320))
 543           (sbblok g integs n ipvtg delz)
 544           (dmzsol kd mstar n v delz deldmz)
 545           (if (/= mode 1) (go end_label))
 546           (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1))
 547                         ((> l ndmz) nil)
 548             (tagbody
 549               (setf (f2cl-lib:fref dmz-%data% (l) ((1 1)) dmz-%offset%)
 550                       (f2cl-lib:fref dmzo-%data% (l) ((1 1)) dmzo-%offset%))
 551              label321))
 552           (setf iz 1)
 553           (setf idmz 1)
 554           (setf iw 1)
 555           (setf izet 1)
 556           (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 557                         ((> i n) nil)
 558             (tagbody
 559               (setf nrow
 560                       (f2cl-lib:fref integs-%data%
 561                                      (1 i)
 562                                      ((1 3) (1 1))
 563                                      integs-%offset%))
 564               (setf izeta (f2cl-lib:int-sub (f2cl-lib:int-add nrow 1) mstar))
 565               (if (= i n) (setf izeta izsave))
 566              label330
 567               (if (= izet izeta) (go label340))
 568               (setf (f2cl-lib:fref z-%data%
 569                                    ((f2cl-lib:int-add (f2cl-lib:int-sub iz 1)
 570                                                       izet))
 571                                    ((1 1))
 572                                    z-%offset%)
 573                       (f2cl-lib:fref dgz (izet) ((1 40))))
 574               (setf izet (f2cl-lib:int-add izet 1))
 575               (go label330)
 576              label340
 577               (setf h
 578                       (-
 579                        (f2cl-lib:fref xi-%data%
 580                                       ((f2cl-lib:int-add i 1))
 581                                       ((1 1))
 582                                       xi-%offset%)
 583                        (f2cl-lib:fref xi-%data% (i) ((1 1)) xi-%offset%)))
 584               (gblock h (f2cl-lib:array-slice g double-float (1) ((1 1))) nrow
 585                izeta (f2cl-lib:array-slice w double-float (iw) ((1 1))) df kd
 586                (f2cl-lib:array-slice z double-float (iz) ((1 1)))
 587                (f2cl-lib:array-slice dmz double-float (idmz) ((1 1)))
 588                (f2cl-lib:array-slice ipvtw f2cl-lib:integer4 (idmz) ((1 1))) 2)
 589               (setf iz (f2cl-lib:int-add iz mstar))
 590               (setf idmz (f2cl-lib:int-add idmz kd))
 591               (setf iw (f2cl-lib:int-add iw (f2cl-lib:int-mul kd kd)))
 592               (if (< i n) (go label350))
 593              label342
 594               (if (> izet mstar) (go label350))
 595               (setf (f2cl-lib:fref z-%data%
 596                                    ((f2cl-lib:int-add (f2cl-lib:int-sub iz 1)
 597                                                       izet))
 598                                    ((1 1))
 599                                    z-%offset%)
 600                       (f2cl-lib:fref dgz (izet) ((1 40))))
 601               (setf izet (f2cl-lib:int-add izet 1))
 602               (go label342)
 603              label350))
 604           (sbblok g integs n ipvtg z)
 605           (dmzsol kd mstar n v z dmz)
 606           (go end_label)
 607          end_label
 608           (return
 609            (values msing
 610                    nil
 611                    nil
 612                    nil
 613                    nil
 614                    nil
 615                    nil
 616                    nil
 617                    nil
 618                    nil
 619                    nil
 620                    nil
 621                    nil
 622                    nil
 623                    nil
 624                    rnorm
 625                    nil
 626                    nil
 627                    nil
 628                    nil
 629                    nil
 630                    nil)))))))
 631
 632 (in-package #:cl-user)
 633 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 634 (eval-when (:load-toplevel :compile-toplevel :execute)
 635   (setf (gethash 'fortran-to-lisp::lsyslv
 636                  fortran-to-lisp::*f2cl-function-info*)
 637           (fortran-to-lisp::make-f2cl-finfo
 638            :arg-types '((fortran-to-lisp::integer4) (array double-float (1))
 639                         (array double-float (1)) (array double-float (1))
 640                         (array double-float (1)) (array double-float (1))
 641                         (array double-float (1)) (array double-float (1))
 642                         (array double-float (1)) (array double-float (1))
 643                         (array double-float (1)) (array double-float (1))
 644                         (array fortran-to-lisp::integer4 (3))
 645                         (array fortran-to-lisp::integer4 (1))
 646                         (array fortran-to-lisp::integer4 (1)) double-float
 647                         (fortran-to-lisp::integer4) t t t t t)
 648            :return-values '(fortran-to-lisp::msing nil nil nil nil nil nil nil
 649                             nil nil nil nil nil nil nil fortran-to-lisp::rnorm
 650                             nil nil nil nil nil nil)
 651            :calls '(fortran-to-lisp::dmzsol fortran-to-lisp::sbblok
 652                     fortran-to-lisp::fcblok fortran-to-lisp::gblock
 653                     fortran-to-lisp::vwblok fortran-to-lisp::gderiv
 654                     fortran-to-lisp::approx))))
 655