src/numerical/slatec/dbesj.lisp

   1 ;;; Compiled by f2cl version:
   2 ;;; ("f2cl1.l,v 46c1f6a93b0d 2012/05/03 04:40:28 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 46c1f6a93b0d 2012/05/03 04:40:28 toy $"
   7 ;;;  "f2cl6.l,v 1d5cbacbb977 2008/08/24 00:56:27 rtoy $"
   8 ;;;  "macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $")
   9
  10 ;;; Using Lisp CMU Common Lisp snapshot-2012-04 (20C Unicode)
  11 ;;;
  12 ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
  13 ;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
  14 ;;;           (:array-slicing t) (:declare-common nil)
  15 ;;;           (:float-format double-float))
  16
  17 (in-package :slatec)
  18
  19
  20 (let ((rtwo 1.34839972492648)
  21       (pdf 0.785398163397448)
  22       (rttp 0.797884560802865)
  23       (pidt 1.5707963267949)
  24       (pp
  25        (make-array 4
  26                    :element-type 'double-float
  27                    :initial-contents '(8.72909153935547 0.26569393226503
  28                                        0.124578576865586 7.70133747430388e-4)))
  29       (inlim 150)
  30       (fnulim
  31        (make-array 2
  32                    :element-type 'double-float
  33                    :initial-contents '(100.0 60.0))))
  34   (declare (type (double-float) rtwo pdf rttp pidt)
  35            (type (simple-array double-float (4)) pp)
  36            (type (f2cl-lib:integer4) inlim)
  37            (type (simple-array double-float (2)) fnulim))
  38   (defun dbesj (x alpha n y nz)
  39     (declare (type (array double-float (*)) y)
  40              (type (f2cl-lib:integer4) nz n)
  41              (type (double-float) alpha x))
  42     (prog ((temp (make-array 3 :element-type 'double-float))
  43            (wk (make-array 7 :element-type 'double-float)) (ak 0.0) (akm 0.0)
  44            (ans 0.0) (ap 0.0) (arg 0.0) (coef 0.0) (dalpha 0.0) (dfn 0.0)
  45            (dtm 0.0) (earg 0.0) (elim1 0.0) (etx 0.0) (fidal 0.0) (flgjy 0.0)
  46            (fn 0.0) (fnf 0.0) (fni 0.0) (fnp1 0.0) (fnu 0.0) (gln 0.0)
  47            (rden 0.0) (relb 0.0) (rtx 0.0) (rzden 0.0) (s 0.0) (sa 0.0)
  48            (sb 0.0) (sxo2 0.0) (s1 0.0) (s2 0.0) (t$ 0.0) (ta 0.0) (tau 0.0)
  49            (tb 0.0) (tfn 0.0) (tm 0.0) (tol 0.0) (tolln 0.0) (trx 0.0) (tx 0.0)
  50            (t1 0.0) (t2 0.0) (xo2 0.0) (xo2l 0.0) (slim 0.0) (rtol 0.0) (i 0)
  51            (ialp 0) (idalp 0) (iflw 0) (in 0) (is 0) (i1 0) (i2 0) (k 0) (kk 0)
  52            (km 0) (kt 0) (nn 0) (ns 0))
  53       (declare (type (f2cl-lib:integer4) ns nn kt km kk k i2 i1 is in iflw
  54                                          idalp ialp i)
  55                (type (simple-array double-float (7)) wk)
  56                (type (simple-array double-float (3)) temp)
  57                (type (double-float) rtol slim xo2l xo2 t2 t1 tx trx tolln tol
  58                                     tm tfn tb tau ta t$ s2 s1 sxo2 sb sa s
  59                                     rzden rtx relb rden gln fnu fnp1 fni fnf fn
  60                                     flgjy fidal etx elim1 earg dtm dfn dalpha
  61                                     coef arg ap ans akm ak))
  62       (setf nz 0)
  63       (setf kt 1)
  64       (setf ns 0)
  65       (setf ta (f2cl-lib:d1mach 3))
  66       (setf tol (max ta 1.0e-15))
  67       (setf i1 (f2cl-lib:int-add (f2cl-lib:i1mach 14) 1))
  68       (setf i2 (f2cl-lib:i1mach 15))
  69       (setf tb (f2cl-lib:d1mach 5))
  70       (setf elim1 (* -2.303 (+ (* i2 tb) 3.0)))
  71       (setf rtol (/ 1.0 tol))
  72       (setf slim (* (f2cl-lib:d1mach 1) rtol 1000.0))
  73       (setf tolln (* 2.303 tb i1))
  74       (setf tolln (min tolln 34.5388))
  75       (f2cl-lib:arithmetic-if (f2cl-lib:int-sub n 1)
  76                               (go label720)
  77                               (go label10)
  78                               (go label20))
  79      label10
  80       (setf kt 2)
  81      label20
  82       (setf nn n)
  83       (f2cl-lib:arithmetic-if x (go label730) (go label30) (go label80))
  84      label30
  85       (f2cl-lib:arithmetic-if alpha (go label710) (go label40) (go label50))
  86      label40
  87       (setf (f2cl-lib:fref y (1) ((1 *))) 1.0)
  88       (if (= n 1) (go end_label))
  89       (setf i1 2)
  90       (go label60)
  91      label50
  92       (setf i1 1)
  93      label60
  94       (f2cl-lib:fdo (i i1 (f2cl-lib:int-add i 1))
  95                     ((> i n) nil)
  96         (tagbody (setf (f2cl-lib:fref y (i) ((1 *))) 0.0) label70))
  97       (go end_label)
  98      label80
  99       (if (< alpha 0.0) (go label710))
 100       (setf ialp (f2cl-lib:int alpha))
 101       (setf fni
 102               (coerce
 103                (the f2cl-lib:integer4
 104                     (f2cl-lib:int-sub (f2cl-lib:int-add ialp n) 1))
 105                'double-float))
 106       (setf fnf (- alpha ialp))
 107       (setf dfn (+ fni fnf))
 108       (setf fnu dfn)
 109       (setf xo2 (* x 0.5))
 110       (setf sxo2 (* xo2 xo2))
 111       (if (<= sxo2 (+ fnu 1.0)) (go label90))
 112       (setf ta (max 20.0 fnu))
 113       (if (> x ta) (go label120))
 114       (if (> x 12.0) (go label110))
 115       (setf xo2l (f2cl-lib:flog xo2))
 116       (setf ns (f2cl-lib:int-add (f2cl-lib:int (- sxo2 fnu)) 1))
 117       (go label100)
 118      label90
 119       (setf fn fnu)
 120       (setf fnp1 (+ fn 1.0))
 121       (setf xo2l (f2cl-lib:flog xo2))
 122       (setf is kt)
 123       (if (<= x 0.5) (go label330))
 124       (setf ns 0)
 125      label100
 126       (setf fni (+ fni ns))
 127       (setf dfn (+ fni fnf))
 128       (setf fn dfn)
 129       (setf fnp1 (+ fn 1.0))
 130       (setf is kt)
 131       (if (> (f2cl-lib:int-add (f2cl-lib:int-sub n 1) ns) 0) (setf is 3))
 132       (go label330)
 133      label110
 134       (setf ans (max (- 36.0 fnu) 0.0))
 135       (setf ns (f2cl-lib:int ans))
 136       (setf fni (+ fni ns))
 137       (setf dfn (+ fni fnf))
 138       (setf fn dfn)
 139       (setf is kt)
 140       (if (> (f2cl-lib:int-add (f2cl-lib:int-sub n 1) ns) 0) (setf is 3))
 141       (go label130)
 142      label120
 143       (setf rtx (f2cl-lib:fsqrt x))
 144       (setf tau (* rtwo rtx))
 145       (setf ta (+ tau (f2cl-lib:fref fnulim (kt) ((1 2)))))
 146       (if (<= fnu ta) (go label480))
 147       (setf fn fnu)
 148       (setf is kt)
 149      label130
 150       (setf i1 (abs (f2cl-lib:int-sub 3 is)))
 151       (setf i1 (max (the f2cl-lib:integer4 i1) (the f2cl-lib:integer4 1)))
 152       (setf flgjy 1.0)
 153       (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5 var-6 var-7)
 154           (dasyjy #'djairy x fn flgjy i1
 155            (f2cl-lib:array-slice temp double-float (is) ((1 3))) wk iflw)
 156         (declare (ignore var-0 var-1 var-2 var-3 var-4 var-5 var-6))
 157         (setf iflw var-7))
 158       (if (/= iflw 0) (go label380))
 159       (f2cl-lib:computed-goto (label320 label450 label620) is)
 160      label310
 161       (setf (f2cl-lib:fref temp (1) ((1 3))) (f2cl-lib:fref temp (3) ((1 3))))
 162       (setf kt 1)
 163      label320
 164       (setf is 2)
 165       (setf fni (- fni 1.0))
 166       (setf dfn (+ fni fnf))
 167       (setf fn dfn)
 168       (if (= i1 2) (go label450))
 169       (go label130)
 170      label330
 171       (setf gln (dlngam fnp1))
 172       (setf arg (- (* fn xo2l) gln))
 173       (if (< arg (- elim1)) (go label400))
 174       (setf earg (exp arg))
 175      label340
 176       (setf s 1.0)
 177       (if (< x tol) (go label360))
 178       (setf ak 3.0)
 179       (setf t2 1.0)
 180       (setf t$ 1.0)
 181       (setf s1 fn)
 182       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 183                     ((> k 17) nil)
 184         (tagbody
 185           (setf s2 (+ t2 s1))
 186           (setf t$ (/ (* (- t$) sxo2) s2))
 187           (setf s (+ s t$))
 188           (if (< (abs t$) tol) (go label360))
 189           (setf t2 (+ t2 ak))
 190           (setf ak (+ ak 2.0))
 191           (setf s1 (+ s1 fn))
 192          label350))
 193      label360
 194       (setf (f2cl-lib:fref temp (is) ((1 3))) (* s earg))
 195       (f2cl-lib:computed-goto (label370 label450 label610) is)
 196      label370
 197       (setf earg (/ (* earg fn) xo2))
 198       (setf fni (- fni 1.0))
 199       (setf dfn (+ fni fnf))
 200       (setf fn dfn)
 201       (setf is 2)
 202       (go label340)
 203      label380
 204       (setf (f2cl-lib:fref y (nn) ((1 *))) 0.0)
 205       (setf nn (f2cl-lib:int-sub nn 1))
 206       (setf fni (- fni 1.0))
 207       (setf dfn (+ fni fnf))
 208       (setf fn dfn)
 209       (f2cl-lib:arithmetic-if (f2cl-lib:int-sub nn 1)
 210                               (go label440)
 211                               (go label390)
 212                               (go label130))
 213      label390
 214       (setf kt 2)
 215       (setf is 2)
 216       (go label130)
 217      label400
 218       (setf (f2cl-lib:fref y (nn) ((1 *))) 0.0)
 219       (setf nn (f2cl-lib:int-sub nn 1))
 220       (setf fnp1 fn)
 221       (setf fni (- fni 1.0))
 222       (setf dfn (+ fni fnf))
 223       (setf fn dfn)
 224       (f2cl-lib:arithmetic-if (f2cl-lib:int-sub nn 1)
 225                               (go label440)
 226                               (go label410)
 227                               (go label420))
 228      label410
 229       (setf kt 2)
 230       (setf is 2)
 231      label420
 232       (if (<= sxo2 fnp1) (go label430))
 233       (go label130)
 234      label430
 235       (setf arg (+ (- arg xo2l) (f2cl-lib:flog fnp1)))
 236       (if (< arg (- elim1)) (go label400))
 237       (go label330)
 238      label440
 239       (setf nz (f2cl-lib:int-sub n nn))
 240       (go end_label)
 241      label450
 242       (if (/= ns 0) (go label451))
 243       (setf nz (f2cl-lib:int-sub n nn))
 244       (if (= kt 2) (go label470))
 245       (setf (f2cl-lib:fref y (nn) ((1 *))) (f2cl-lib:fref temp (1) ((1 3))))
 246       (setf (f2cl-lib:fref y ((f2cl-lib:int-sub nn 1)) ((1 *)))
 247               (f2cl-lib:fref temp (2) ((1 3))))
 248       (if (= nn 2) (go end_label))
 249      label451
 250       (setf trx (/ 2.0 x))
 251       (setf dtm fni)
 252       (setf tm (* (+ dtm fnf) trx))
 253       (setf ak 1.0)
 254       (setf ta (f2cl-lib:fref temp (1) ((1 3))))
 255       (setf tb (f2cl-lib:fref temp (2) ((1 3))))
 256       (if (> (abs ta) slim) (go label455))
 257       (setf ta (* ta rtol))
 258       (setf tb (* tb rtol))
 259       (setf ak tol)
 260      label455
 261       (setf kk 2)
 262       (setf in (f2cl-lib:int-sub ns 1))
 263       (if (= in 0) (go label690))
 264       (if (/= ns 0) (go label670))
 265       (setf k (f2cl-lib:int-sub nn 2))
 266       (f2cl-lib:fdo (i 3 (f2cl-lib:int-add i 1))
 267                     ((> i nn) nil)
 268         (tagbody
 269           (setf s tb)
 270           (setf tb (- (* tm tb) ta))
 271           (setf ta s)
 272           (setf (f2cl-lib:fref y (k) ((1 *))) (* tb ak))
 273           (setf dtm (- dtm 1.0))
 274           (setf tm (* (+ dtm fnf) trx))
 275           (setf k (f2cl-lib:int-sub k 1))
 276          label460))
 277       (go end_label)
 278      label470
 279       (setf (f2cl-lib:fref y (1) ((1 *))) (f2cl-lib:fref temp (2) ((1 3))))
 280       (go end_label)
 281      label480
 282       (setf in (f2cl-lib:int (+ (- alpha tau) 2.0)))
 283       (if (<= in 0) (go label490))
 284       (setf idalp (f2cl-lib:int-sub ialp in 1))
 285       (setf kt 1)
 286       (go label500)
 287      label490
 288       (setf idalp ialp)
 289       (setf in 0)
 290      label500
 291       (setf is kt)
 292       (setf fidal (coerce (the f2cl-lib:integer4 idalp) 'double-float))
 293       (setf dalpha (+ fidal fnf))
 294       (setf arg (- x (* pidt dalpha) pdf))
 295       (setf sa (sin arg))
 296       (setf sb (cos arg))
 297       (setf coef (/ rttp rtx))
 298       (setf etx (* 8.0 x))
 299      label510
 300       (setf dtm (+ fidal fidal))
 301       (setf dtm (* dtm dtm))
 302       (setf tm 0.0)
 303       (if (and (= fidal 0.0) (< (abs fnf) tol)) (go label520))
 304       (setf tm (* 4.0 fnf (+ fidal fidal fnf)))
 305      label520
 306       (setf trx (- dtm 1.0))
 307       (setf t2 (/ (+ trx tm) etx))
 308       (setf s2 t2)
 309       (setf relb (* tol (abs t2)))
 310       (setf t1 etx)
 311       (setf s1 1.0)
 312       (setf fn 1.0)
 313       (setf ak 8.0)
 314       (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1))
 315                     ((> k 13) nil)
 316         (tagbody
 317           (setf t1 (+ t1 etx))
 318           (setf fn (+ fn ak))
 319           (setf trx (- dtm fn))
 320           (setf ap (+ trx tm))
 321           (setf t2 (/ (* (- t2) ap) t1))
 322           (setf s1 (+ s1 t2))
 323           (setf t1 (+ t1 etx))
 324           (setf ak (+ ak 8.0))
 325           (setf fn (+ fn ak))
 326           (setf trx (- dtm fn))
 327           (setf ap (+ trx tm))
 328           (setf t2 (/ (* t2 ap) t1))
 329           (setf s2 (+ s2 t2))
 330           (if (<= (abs t2) relb) (go label540))
 331           (setf ak (+ ak 8.0))
 332          label530))
 333      label540
 334       (setf (f2cl-lib:fref temp (is) ((1 3))) (* coef (- (* s1 sb) (* s2 sa))))
 335       (if (= is 2) (go label560))
 336       (setf fidal (+ fidal 1.0))
 337       (setf dalpha (+ fidal fnf))
 338       (setf is 2)
 339       (setf tb sa)
 340       (setf sa (- sb))
 341       (setf sb tb)
 342       (go label510)
 343      label560
 344       (if (= kt 2) (go label470))
 345       (setf s1 (f2cl-lib:fref temp (1) ((1 3))))
 346       (setf s2 (f2cl-lib:fref temp (2) ((1 3))))
 347       (setf tx (/ 2.0 x))
 348       (setf tm (* dalpha tx))
 349       (if (= in 0) (go label580))
 350       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 351                     ((> i in) nil)
 352         (tagbody
 353           (setf s s2)
 354           (setf s2 (- (* tm s2) s1))
 355           (setf tm (+ tm tx))
 356           (setf s1 s)
 357          label570))
 358       (if (= nn 1) (go label600))
 359       (setf s s2)
 360       (setf s2 (- (* tm s2) s1))
 361       (setf tm (+ tm tx))
 362       (setf s1 s)
 363      label580
 364       (setf (f2cl-lib:fref y (1) ((1 *))) s1)
 365       (setf (f2cl-lib:fref y (2) ((1 *))) s2)
 366       (if (= nn 2) (go end_label))
 367       (f2cl-lib:fdo (i 3 (f2cl-lib:int-add i 1))
 368                     ((> i nn) nil)
 369         (tagbody
 370           (setf (f2cl-lib:fref y (i) ((1 *)))
 371                   (- (* tm (f2cl-lib:fref y ((f2cl-lib:int-sub i 1)) ((1 *))))
 372                      (f2cl-lib:fref y ((f2cl-lib:int-sub i 2)) ((1 *)))))
 373           (setf tm (+ tm tx))
 374          label590))
 375       (go end_label)
 376      label600
 377       (setf (f2cl-lib:fref y (1) ((1 *))) s2)
 378       (go end_label)
 379      label610
 380       (setf akm (max (- 3.0 fn) 0.0))
 381       (setf km (f2cl-lib:int akm))
 382       (setf tfn (+ fn km))
 383       (setf ta
 384               (/ (+ (- (+ gln tfn) 0.9189385332) (/ -0.0833333333 tfn))
 385                  (+ tfn 0.5)))
 386       (setf ta (- xo2l ta))
 387       (setf tb (/ (- (+ 1.0 (/ (* -1 1.5) tfn))) tfn))
 388       (setf akm
 389               (+ (/ tolln (- (f2cl-lib:fsqrt (- (* ta ta) (* tolln tb))) ta))
 390                  1.5))
 391       (setf in (f2cl-lib:int-add km (f2cl-lib:int akm)))
 392       (go label660)
 393      label620
 394       (setf gln
 395               (+ (f2cl-lib:fref wk (3) ((1 7)))
 396                  (f2cl-lib:fref wk (2) ((1 7)))))
 397       (if (> (f2cl-lib:fref wk (6) ((1 7))) 30.0) (go label640))
 398       (setf rden
 399               (+
 400                (*
 401                 (+
 402                  (* (f2cl-lib:fref pp (4) ((1 4)))
 403                     (f2cl-lib:fref wk (6) ((1 7))))
 404                  (f2cl-lib:fref pp (3) ((1 4))))
 405                 (f2cl-lib:fref wk (6) ((1 7))))
 406                1.0))
 407       (setf rzden
 408               (+ (f2cl-lib:fref pp (1) ((1 4)))
 409                  (* (f2cl-lib:fref pp (2) ((1 4)))
 410                     (f2cl-lib:fref wk (6) ((1 7))))))
 411       (setf ta (/ rzden rden))
 412       (if (< (f2cl-lib:fref wk (1) ((1 7))) 0.1) (go label630))
 413       (setf tb (/ gln (f2cl-lib:fref wk (5) ((1 7)))))
 414       (go label650)
 415      label630
 416       (setf tb
 417               (/
 418                (+ 1.259921049
 419                   (*
 420                    (+ 0.167989473
 421                       (* 0.0887944358 (f2cl-lib:fref wk (1) ((1 7)))))
 422                    (f2cl-lib:fref wk (1) ((1 7)))))
 423                (f2cl-lib:fref wk (7) ((1 7)))))
 424       (go label650)
 425      label640
 426       (setf ta (/ (* 0.5 tolln) (f2cl-lib:fref wk (4) ((1 7)))))
 427       (setf ta
 428               (* (+ (* (- (* 0.049382716 ta) 0.1111111111) ta) 0.6666666667)
 429                  ta
 430                  (f2cl-lib:fref wk (6) ((1 7)))))
 431       (if (< (f2cl-lib:fref wk (1) ((1 7))) 0.1) (go label630))
 432       (setf tb (/ gln (f2cl-lib:fref wk (5) ((1 7)))))
 433      label650
 434       (setf in (f2cl-lib:int (+ (/ ta tb) 1.5)))
 435       (if (> in inlim) (go label310))
 436      label660
 437       (setf dtm (+ fni in))
 438       (setf trx (/ 2.0 x))
 439       (setf tm (* (+ dtm fnf) trx))
 440       (setf ta 0.0)
 441       (setf tb tol)
 442       (setf kk 1)
 443       (setf ak 1.0)
 444      label670
 445       (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1))
 446                     ((> i in) nil)
 447         (tagbody
 448           (setf s tb)
 449           (setf tb (- (* tm tb) ta))
 450           (setf ta s)
 451           (setf dtm (- dtm 1.0))
 452           (setf tm (* (+ dtm fnf) trx))
 453          label680))
 454       (if (/= kk 1) (go label690))
 455       (setf s (f2cl-lib:fref temp (3) ((1 3))))
 456       (setf sa (/ ta tb))
 457       (setf ta s)
 458       (setf tb s)
 459       (if (> (abs s) slim) (go label685))
 460       (setf ta (* ta rtol))
 461       (setf tb (* tb rtol))
 462       (setf ak tol)
 463      label685
 464       (setf ta (* ta sa))
 465       (setf kk 2)
 466       (setf in ns)
 467       (if (/= ns 0) (go label670))
 468      label690
 469       (setf (f2cl-lib:fref y (nn) ((1 *))) (* tb ak))
 470       (setf nz (f2cl-lib:int-sub n nn))
 471       (if (= nn 1) (go end_label))
 472       (setf k (f2cl-lib:int-sub nn 1))
 473       (setf s tb)
 474       (setf tb (- (* tm tb) ta))
 475       (setf ta s)
 476       (setf (f2cl-lib:fref y (k) ((1 *))) (* tb ak))
 477       (if (= nn 2) (go end_label))
 478       (setf dtm (- dtm 1.0))
 479       (setf tm (* (+ dtm fnf) trx))
 480       (setf k (f2cl-lib:int-sub nn 2))
 481       (f2cl-lib:fdo (i 3 (f2cl-lib:int-add i 1))
 482                     ((> i nn) nil)
 483         (tagbody
 484           (setf s tb)
 485           (setf tb (- (* tm tb) ta))
 486           (setf ta s)
 487           (setf (f2cl-lib:fref y (k) ((1 *))) (* tb ak))
 488           (setf dtm (- dtm 1.0))
 489           (setf tm (* (+ dtm fnf) trx))
 490           (setf k (f2cl-lib:int-sub k 1))
 491          label700))
 492       (go end_label)
 493      label710
 494       (xermsg "SLATEC" "DBESJ" "ORDER, ALPHA, LESS THAN ZERO." 2 1)
 495       (go end_label)
 496      label720
 497       (xermsg "SLATEC" "DBESJ" "N LESS THAN ONE." 2 1)
 498       (go end_label)
 499      label730
 500       (xermsg "SLATEC" "DBESJ" "X LESS THAN ZERO." 2 1)
 501       (go end_label)
 502      end_label
 503       (return (values nil nil nil nil nz)))))
 504
 505 (in-package #:cl-user)
 506 #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or))
 507 (eval-when (:load-toplevel :compile-toplevel :execute)
 508   (setf (gethash 'fortran-to-lisp::dbesj fortran-to-lisp::*f2cl-function-info*)
 509           (fortran-to-lisp::make-f2cl-finfo
 510            :arg-types '((double-float) (double-float)
 511                         (fortran-to-lisp::integer4) (array double-float (*))
 512                         (fortran-to-lisp::integer4))
 513            :return-values '(nil nil nil nil fortran-to-lisp::nz)
 514            :calls '(fortran-to-lisp::xermsg fortran-to-lisp::dlngam
 515                     fortran-to-lisp::dasyjy fortran-to-lisp::i1mach
 516                     fortran-to-lisp::d1mach))))
 517