share/minpack/lisp/dpmpar.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 nil)
  13 ;;;           (:coerce-assigns :as-needed) (:array-type ':array)
  14 ;;;           (:array-slicing t) (:declare-common nil)
  15 ;;;           (:float-format double-float))
  16
  17 (in-package :minpack)
  18
  19
  20 (let ((dmach
  21        (make-array 3
  22                    :element-type 'double-float
  23                    :initial-contents '(2.22044604926e-16 2.22507385852e-308
  24                                        1.79769313485e308))))
  25   (declare (type (array double-float (3)) dmach))
  26   (defun dpmpar (i)
  27     (declare (type (f2cl-lib:integer4) i))
  28     (prog ((maxmag (make-array 4 :element-type 'f2cl-lib:integer4))
  29            (minmag (make-array 4 :element-type 'f2cl-lib:integer4))
  30            (mcheps (make-array 4 :element-type 'f2cl-lib:integer4))
  31            (dpmpar 0.0))
  32       (declare (type (double-float) dpmpar)
  33                (type (array f2cl-lib:integer4 (4)) mcheps minmag maxmag))
  34       '"     **********"
  35       '""
  36       '"     function dpmpar"
  37       '""
  38       '"     this function provides double precision machine parameters"
  39       '"     when the appropriate set of data statements is activated (by"
  40       '"     removing the c from column 1) and all other data statements are"
  41       '"     rendered inactive. most of the parameter values were obtained"
  42       '"     from the corresponding bell laboratories port library function."
  43       '""
  44       '"     the function statement is"
  45       '""
  46       '"       double precision function dpmpar(i)"
  47       '""
  48       '"     where"
  49       '""
  50       '"       i is an integer input variable set to 1, 2, or 3 which"
  51       '"         selects the desired machine parameter. if the machine has"
  52       '"         t base b digits and its smallest and largest exponents are"
  53       '"         emin and emax, respectively, then these parameters are"
  54       '""
  55       '"         dpmpar(1) = b**(1 - t), the machine precision,"
  56       '""
  57       '"         dpmpar(2) = b**(emin - 1), the smallest magnitude,"
  58       '""
  59       '"         dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude."
  60       '""
  61       '"     argonne national laboratory. minpack project. november 1996."
  62       '"     burton s. garbow, kenneth e. hillstrom, jorge j. more'"
  63       '""
  64       '"     **********"
  65       '"     equivalence (dmach(1),mcheps(1))"
  66       '"     equivalence (dmach(2),minmag(1))"
  67       '"     equivalence (dmach(3),maxmag(1))"
  68       '""
  69       '"     machine constants for the ibm 360/370 series,"
  70       '"     the amdahl 470/v6, the icl 2900, the itel as/6,"
  71       '"     the xerox sigma 5/7/9 and the sel systems 85/86."
  72       '""
  73       '"     data mcheps(1),mcheps(2) / z34100000, z00000000 /"
  74       '"     data minmag(1),minmag(2) / z00100000, z00000000 /"
  75       '"     data maxmag(1),maxmag(2) / z7fffffff, zffffffff /"
  76       '""
  77       '"     machine constants for the honeywell 600/6000 series."
  78       '""
  79       '"     data mcheps(1),mcheps(2) / o606400000000, o000000000000 /"
  80       '"     data minmag(1),minmag(2) / o402400000000, o000000000000 /"
  81       '"     data maxmag(1),maxmag(2) / o376777777777, o777777777777 /"
  82       '""
  83       '"     machine constants for the cdc 6000/7000 series."
  84       '""
  85       '"     data mcheps(1) / 15614000000000000000b /"
  86       '"     data mcheps(2) / 15010000000000000000b /"
  87       '""
  88       '"     data minmag(1) / 00604000000000000000b /"
  89       '"     data minmag(2) / 00000000000000000000b /"
  90       '""
  91       '"     data maxmag(1) / 37767777777777777777b /"
  92       '"     data maxmag(2) / 37167777777777777777b /"
  93       '""
  94       '"     machine constants for the pdp-10 (ka processor)."
  95       '""
  96       '"     data mcheps(1),mcheps(2) / \"114400000000, \"000000000000 /"
  97       '"     data minmag(1),minmag(2) / \"033400000000, \"000000000000 /"
  98       '"     data maxmag(1),maxmag(2) / \"377777777777, \"344777777777 /"
  99       '""
 100       '"     machine constants for the pdp-10 (ki processor)."
 101       '""
 102       '"     data mcheps(1),mcheps(2) / \"104400000000, \"000000000000 /"
 103       '"     data minmag(1),minmag(2) / \"000400000000, \"000000000000 /"
 104       '"     data maxmag(1),maxmag(2) / \"377777777777, \"377777777777 /"
 105       '""
 106       '"     machine constants for the pdp-11."
 107       '""
 108       '"     data mcheps(1),mcheps(2) /   9472,      0 /"
 109       '"     data mcheps(3),mcheps(4) /      0,      0 /"
 110       '""
 111       '"     data minmag(1),minmag(2) /    128,      0 /"
 112       '"     data minmag(3),minmag(4) /      0,      0 /"
 113       '""
 114       '"     data maxmag(1),maxmag(2) /  32767,     -1 /"
 115       '"     data maxmag(3),maxmag(4) /     -1,     -1 /"
 116       '""
 117       '"     machine constants for the burroughs 6700/7700 systems."
 118       '""
 119       '"     data mcheps(1) / o1451000000000000 /"
 120       '"     data mcheps(2) / o0000000000000000 /"
 121       '""
 122       '"     data minmag(1) / o1771000000000000 /"
 123       '"     data minmag(2) / o7770000000000000 /"
 124       '""
 125       '"     data maxmag(1) / o0777777777777777 /"
 126       '"     data maxmag(2) / o7777777777777777 /"
 127       '""
 128       '"     machine constants for the burroughs 5700 system."
 129       '""
 130       '"     data mcheps(1) / o1451000000000000 /"
 131       '"     data mcheps(2) / o0000000000000000 /"
 132       '""
 133       '"     data minmag(1) / o1771000000000000 /"
 134       '"     data minmag(2) / o0000000000000000 /"
 135       '""
 136       '"     data maxmag(1) / o0777777777777777 /"
 137       '"     data maxmag(2) / o0007777777777777 /"
 138       '""
 139       '"     machine constants for the burroughs 1700 system."
 140       '""
 141       '"     data mcheps(1) / zcc6800000 /"
 142       '"     data mcheps(2) / z000000000 /"
 143       '""
 144       '"     data minmag(1) / zc00800000 /"
 145       '"     data minmag(2) / z000000000 /"
 146       '""
 147       '"     data maxmag(1) / zdffffffff /"
 148       '"     data maxmag(2) / zfffffffff /"
 149       '""
 150       '"     machine constants for the univac 1100 series."
 151       '""
 152       '"     data mcheps(1),mcheps(2) / o170640000000, o000000000000 /"
 153       '"     data minmag(1),minmag(2) / o000040000000, o000000000000 /"
 154       '"     data maxmag(1),maxmag(2) / o377777777777, o777777777777 /"
 155       '""
 156       '"     machine constants for the data general eclipse s/200."
 157       '""
 158       '"     note - it may be appropriate to include the following card -"
 159       '"     static dmach(3)"
 160       '""
 161       '"     data minmag/20k,3*0/,maxmag/77777k,3*177777k/"
 162       '"     data mcheps/32020k,3*0/"
 163       '""
 164       '"     machine constants for the harris 220."
 165       '""
 166       '"     data mcheps(1),mcheps(2) / '20000000, '00000334 /"
 167       '"     data minmag(1),minmag(2) / '20000000, '00000201 /"
 168       '"     data maxmag(1),maxmag(2) / '37777777, '37777577 /"
 169       '""
 170       '"     machine constants for the cray-1."
 171       '""
 172       '"     data mcheps(1) / 0376424000000000000000b /"
 173       '"     data mcheps(2) / 0000000000000000000000b /"
 174       '""
 175       '"     data minmag(1) / 0200034000000000000000b /"
 176       '"     data minmag(2) / 0000000000000000000000b /"
 177       '""
 178       '"     data maxmag(1) / 0577777777777777777777b /"
 179       '"     data maxmag(2) / 0000007777777777777776b /"
 180       '""
 181       '"     machine constants for the prime 400."
 182       '""
 183       '"     data mcheps(1),mcheps(2) / :10000000000, :00000000123 /"
 184       '"     data minmag(1),minmag(2) / :10000000000, :00000100000 /"
 185       '"     data maxmag(1),maxmag(2) / :17777777777, :37777677776 /"
 186       '""
 187       '"     machine constants for the vax-11."
 188       '""
 189       '"     data mcheps(1),mcheps(2) /   9472,  0 /"
 190       '"     data minmag(1),minmag(2) /    128,  0 /"
 191       '"     data maxmag(1),maxmag(2) / -32769, -1 /"
 192       '""
 193       '"     machine constants for ieee machines."
 194       '""
 195       '""
 196       (setf dpmpar (f2cl-lib:fref dmach (i) ((1 3))))
 197       (go end_label)
 198       '""
 199       '"     last card of function dpmpar."
 200       '""
 201      end_label
 202       (return (values dpmpar nil)))))
 203
 204 (in-package #:cl-user)
 205 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 206 (eval-when (:load-toplevel :compile-toplevel :execute)
 207   (setf (gethash 'fortran-to-lisp::dpmpar
 208                  fortran-to-lisp::*f2cl-function-info*)
 209           (fortran-to-lisp::make-f2cl-finfo
 210            :arg-types '((fortran-to-lisp::integer4))
 211            :return-values '(nil)
 212            :calls 'nil)))
 213