archive/share/lisp/dblint.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE1]DBLINT.MC;2
   3 ;;; Written on 9/09/1984 16:32:33, from MACSYMA 302
   4 ;;; Translated for LPH
   5
   6 ;;; TRANSL-AUTOLOAD version NIL
   7 ;;; DCL version NIL TRANSS version 87 TRANSL version 1157
   8 ;;; TRUTIL version 27 TRANS1 version 108 TRANS2 version 39
   9 ;;; TRANS3 version 50 TRANS4 version 29 TRANS5 version 26
  10 ;;; TRANSF version NIL TROPER version 15 TRPRED version 6
  11 ;;; MTAGS version NIL MDEFUN version 58 TRANSQ version 88
  12 ;;; FCALL version 40 ACALL version 70 TRDATA version 68
  13 ;;; MCOMPI version 146 TRMODE version 73 TRHOOK version NIL
  14 (eval-when (compile eval)
  15       (setq *infile-name-key*
  16                   (namestring (truename '#.standard-input))))
  17
  18 (eval-when (compile)
  19    (setq $tr_semicompile 'NIL)
  20    (setq forms-to-compile-queue ()))
  21
  22 (comment "MAX$DISK:[SHARE1]DBLINT.MC;2")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE (FIXNUM $DBLINT_Y $DBLINT_X) (SPECIAL $DBLINT_X $DBLINT_Y))
  27
  28 (DECLARE (SPECIAL $DBLINT_Y))
  29
  30 (DECLARE (SPECIAL $DBLINT_X))
  31
  32 (DEFMTRFUN-EXTERNAL ($DBLINT $ANY MDEFINE NIL NIL))
  33
  34
  35 (MEVAL* '(($MODEDECLARE) $DBLINT_Y $FIXNUM))
  36
  37 (MEVAL* '(($DECLARE) $DBLINT_Y $SPECIAL))
  38
  39 (DEFPROP $DBLINT_Y ASSIGN-MODE-CHECK ASSIGN)
  40
  41 (DEF-MTRVAR $DBLINT_Y 10)
  42
  43 (MEVAL* '(($MODEDECLARE) $DBLINT_X $FIXNUM))
  44
  45 (MEVAL* '(($DECLARE) $DBLINT_X $SPECIAL))
  46
  47 (DEFPROP $DBLINT_X ASSIGN-MODE-CHECK ASSIGN)
  48
  49 (DEF-MTRVAR $DBLINT_X 10)
  50
  51 (DEFPROP $DBLINT T TRANSLATED)
  52
  53 (ADD2LNC '$DBLINT $PROPS)
  54
  55 (DEFMTRFUN
  56   ($DBLINT $ANY MDEFINE NIL NIL) ($F $C $D $A $B) (DECLARE (FLONUM $B $A))
  57   (PROGN
  58     NIL
  59     ((LAMBDA ($M2 $N2 $H $J1 $J2 $J3 $X $DOX $COX $HX $K1 $K2 $K3 $Y $Z $L)
  60        (DECLARE
  61          (FLONUM
  62            $L $Z $Y $K3 $K2 $K1 $HX $COX $DOX $X $J3 $J2 $J1 $H $N2 $M2))
  63        (PROG ()
  64             (SETQ $N2 (|//$| 0.5d+0 (FLOAT (TRD-MSYMEVAL $DBLINT_X 0))))
  65             (SETQ $M2 (|//$| 0.5d+0 (FLOAT (TRD-MSYMEVAL $DBLINT_Y 0))))
  66             (SETQ $H (*$ (+$ $B (-$ $A)) $N2))
  67             (SETQ $J1 0.0D+0)
  68             (SETQ $J2 0.0D+0)
  69             (SETQ $J3 0.0D+0)
  70             (DO (($I 0 (+ 1 $I)))
  71                 ((> $I (* 2 (TRD-MSYMEVAL $DBLINT_X 0))) '$DONE)
  72               NIL
  73               (SETQ $X (+$ $A (*$ (FLOAT $I) $H)))
  74               (SETQ $DOX (MFUNCALL $D $X))
  75               (SETQ $COX (MFUNCALL $C $X))
  76               (SETQ $HX (*$ (+$ $DOX (-$ $COX)) $M2))
  77               (SETQ $K1 (+$ (MFUNCALL $F $X $COX) (MFUNCALL $F $X $DOX)))
  78               (SETQ $K2 0.0D+0)
  79               (SETQ $K3 0.0D+0)
  80               (DO (($J 1 (+ 1 $J)))
  81                   ((> $J (+ (* 2 (TRD-MSYMEVAL $DBLINT_Y 0)) -1)) '$DONE)
  82                 NIL
  83                 (SETQ $Y (+$ $COX (*$ (FLOAT $J) $HX)))
  84                 (SETQ $Z (MFUNCALL $F $X $Y))
  85                 (COND ((MFUNCTION-CALL $EVENP $J) (SETQ $K2 (+$ $K2 $Z)))
  86                       (T (SETQ $K3 (+$ $K3 $Z)))))
  87               (SETQ
  88                 $L (|//$| (*$ (+$ $K1 (*$ 2.0d+0 $K2) (*$ 4.0d+0 $K3)) $HX)
  89                           3.0d+0))
  90               (COND ((OR (= $I 0) (= $I (* 2 (TRD-MSYMEVAL $DBLINT_X 0))))
  91                        (SETQ $J1 (+$ $J1 $L)))
  92                     ((MFUNCTION-CALL $EVENP $I) (SETQ $J2 (+$ $J2 $L)))
  93                     (T (SETQ $J3 (+$ $J3 $L)))))
  94             (RETURN
  95               (|//$|
  96                 (*$ (+$ $J1 (*$ 2.0d+0 $J2) (*$ 4.0d+0 $J3)) $H) 3.0d+0))))
  97      0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0
  98      0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0 0.0D+0)))
  99
 100 (compile-forms-to-compile-queue)
 101