share/lbfgs/lb1.lisp

   1 ;;; Compiled by f2cl version:
   2 ;;; ("f2cl1.l,v 1.215 2009/04/07 22:05:21 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.200 2009/01/19 02:38:17 rtoy Exp $"
   7 ;;;  "f2cl6.l,v 1.48 2008/08/24 00:56:27 rtoy Exp $"
   8 ;;;  "macros.l,v 1.112 2009/01/08 12:57:19 rtoy Exp $")
   9
  10 ;;; Using Lisp CMU Common Lisp 19f (19F)
  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 :common-lisp-user)
  18
  19
  20 (defun lb1 (iprint iter nfun gnorm n m x f g stp finish)
  21   (declare (type f2cl-lib:logical finish)
  22            (type (array double-float (*)) g x)
  23            (type (double-float) stp f gnorm)
  24            (type (f2cl-lib:integer4) m n nfun iter)
  25            (type (array f2cl-lib:integer4 (*)) iprint))
  26   (let ()
  27     (symbol-macrolet ((mp (lb3-mp *lb3-common-block*)))
  28       (f2cl-lib:with-multi-array-data
  29           ((iprint f2cl-lib:integer4 iprint-%data% iprint-%offset%)
  30            (x double-float x-%data% x-%offset%)
  31            (g double-float g-%data% g-%offset%))
  32         (prog nil
  33           (cond
  34             ((= iter 0)
  35              (f2cl-lib:fformat mp
  36                                ("*************************************************"
  37                                 "~%"))
  38              (f2cl-lib:fformat mp
  39                                ("  N=" 1 (("~5D")) "   NUMBER OF CORRECTIONS="
  40                                 1 (("~2D")) "~%" "       INITIAL VALUES" "~%")
  41                                n
  42                                m)
  43              (f2cl-lib:fformat mp
  44                                (" F= " 1 (("~22,15,2,1,'*,,'DE")) "   GNORM= "
  45                                 1 (("~22,15,2,1,'*,,'DE")) "~%")
  46                                f
  47                                gnorm)
  48              (cond
  49                ((>= (f2cl-lib:fref iprint (2) ((1 2))) 1)
  50                 (f2cl-lib:fformat mp (" VECTOR X= " "~%"))
  51                 (f2cl-lib:fformat mp
  52                                   (4 ("~2@T" 1 (("~22,15,2,1,'*,,'DE"))) "~%")
  53                                   (do ((i 1 (f2cl-lib:int-add i 1))
  54                                        (%ret nil))
  55                                       ((> i n) (nreverse %ret))
  56                                     (declare (type f2cl-lib:integer4 i))
  57                                     (push
  58                                      (f2cl-lib:fref x-%data%
  59                                                     (i)
  60                                                     ((1 n))
  61                                                     x-%offset%)
  62                                      %ret)))
  63                 (f2cl-lib:fformat mp (" GRADIENT VECTOR G= " "~%"))
  64                 (f2cl-lib:fformat mp
  65                                   (4 ("~2@T" 1 (("~22,15,2,1,'*,,'DE"))) "~%")
  66                                   (do ((i 1 (f2cl-lib:int-add i 1))
  67                                        (%ret nil))
  68                                       ((> i n) (nreverse %ret))
  69                                     (declare (type f2cl-lib:integer4 i))
  70                                     (push
  71                                      (f2cl-lib:fref g-%data%
  72                                                     (i)
  73                                                     ((1 n))
  74                                                     g-%offset%)
  75                                      %ret)))))
  76              (f2cl-lib:fformat mp
  77                                ("*************************************************"
  78                                 "~%"))
  79              (f2cl-lib:fformat mp
  80                                ("~%" "   I  NFN" "~5@T" "FUNC" "~20@T" "GNORM"
  81                                 "~19@T" "STEPLENGTH" "~%" "~%")))
  82             (t
  83              (if
  84               (and
  85                (= (f2cl-lib:fref iprint-%data% (1) ((1 2)) iprint-%offset%) 0)
  86                (and (/= iter 1) (not finish)))
  87               (go end_label))
  88              (cond
  89                ((/= (f2cl-lib:fref iprint (1) ((1 2))) 0)
  90                 (cond
  91                   ((or
  92                     (=
  93                      (mod (f2cl-lib:int-add iter (f2cl-lib:int-sub 1))
  94                           (f2cl-lib:fref iprint (1) ((1 2))))
  95                      0)
  96                     finish)
  97                    (if
  98                     (and
  99                      (>
 100                       (f2cl-lib:fref iprint-%data% (2) ((1 2)) iprint-%offset%)
 101                       1)
 102                      (> iter 1))
 103                     (f2cl-lib:fformat mp
 104                                       ("~%" "   I  NFN" "~5@T" "FUNC" "~20@T"
 105                                        "GNORM" "~19@T" "STEPLENGTH" "~%" "~%")))
 106                    (f2cl-lib:fformat mp
 107                                      (2 (1 (("~4D")) "~1@T") "~3@T" 3
 108                                       (1 (("~22,15,2,1,'*,,'DE")) "~2@T") "~%")
 109                                      iter
 110                                      nfun
 111                                      f
 112                                      gnorm
 113                                      stp))
 114                   (t
 115                    (go end_label))))
 116                (t
 117                 (if
 118                  (and
 119                   (> (f2cl-lib:fref iprint-%data% (2) ((1 2)) iprint-%offset%)
 120                      1)
 121                   finish)
 122                  (f2cl-lib:fformat mp
 123                                    ("~%" "   I  NFN" "~5@T" "FUNC" "~20@T"
 124                                     "GNORM" "~19@T" "STEPLENGTH" "~%" "~%")))
 125                 (f2cl-lib:fformat mp
 126                                   (2 (1 (("~4D")) "~1@T") "~3@T" 3
 127                                    (1 (("~22,15,2,1,'*,,'DE")) "~2@T") "~%")
 128                                   iter
 129                                   nfun
 130                                   f
 131                                   gnorm
 132                                   stp)))
 133              (cond
 134                ((or (= (f2cl-lib:fref iprint (2) ((1 2))) 2)
 135                     (= (f2cl-lib:fref iprint (2) ((1 2))) 3))
 136                 (cond
 137                   (finish
 138                    (f2cl-lib:fformat mp (" FINAL POINT X= " "~%")))
 139                   (t
 140                    (f2cl-lib:fformat mp (" VECTOR X= " "~%"))))
 141                 (f2cl-lib:fformat mp
 142                                   (4 ("~2@T" 1 (("~22,15,2,1,'*,,'DE"))) "~%")
 143                                   (do ((i 1 (f2cl-lib:int-add i 1))
 144                                        (%ret nil))
 145                                       ((> i n) (nreverse %ret))
 146                                     (declare (type f2cl-lib:integer4 i))
 147                                     (push
 148                                      (f2cl-lib:fref x-%data%
 149                                                     (i)
 150                                                     ((1 n))
 151                                                     x-%offset%)
 152                                      %ret)))
 153                 (cond
 154                   ((= (f2cl-lib:fref iprint (2) ((1 2))) 3)
 155                    (f2cl-lib:fformat mp (" GRADIENT VECTOR G= " "~%"))
 156                    (f2cl-lib:fformat mp
 157                                      (4 ("~2@T" 1 (("~22,15,2,1,'*,,'DE")))
 158                                       "~%")
 159                                      (do ((i 1 (f2cl-lib:int-add i 1))
 160                                           (%ret nil))
 161                                          ((> i n) (nreverse %ret))
 162                                        (declare (type f2cl-lib:integer4 i))
 163                                        (push
 164                                         (f2cl-lib:fref g-%data%
 165                                                        (i)
 166                                                        ((1 n))
 167                                                        g-%offset%)
 168                                         %ret)))))))
 169              (if finish
 170                  (f2cl-lib:fformat mp
 171                                    ("~%"
 172                                     " THE MINIMIZATION TERMINATED WITHOUT DETECTING ERRORS."
 173                                     "~%" " IFLAG = 0" "~%")))))
 174           (go end_label)
 175          end_label
 176           (return (values nil nil nil nil nil nil nil nil nil nil nil)))))))
 177
 178 (in-package #:cl-user)
 179 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 180 (eval-when (:load-toplevel :compile-toplevel :execute)
 181   (setf (gethash 'fortran-to-lisp::lb1 fortran-to-lisp::*f2cl-function-info*)
 182           (fortran-to-lisp::make-f2cl-finfo
 183            :arg-types '((array fortran-to-lisp::integer4 (2))
 184                         (fortran-to-lisp::integer4) (fortran-to-lisp::integer4)
 185                         (double-float) (fortran-to-lisp::integer4)
 186                         (fortran-to-lisp::integer4) (array double-float (*))
 187                         (double-float) (array double-float (*)) (double-float)
 188                         fortran-to-lisp::logical)
 189            :return-values '(nil nil nil nil nil nil nil nil nil nil nil)
 190            :calls 'nil)))
 191