archive/share/lisp/optvar.lisp

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for LMIVAX::MAX$DISK:[SHARE2]OPTVAR.MC;2
   3 ;;; Written on 9/20/1984 05:11:16, from MACSYMA 302
   4 ;;; Translated for LPH
   5
   6 ;;; TRANSL-AUTOLOAD version NIL
   7 ;;; TRANSS version 87 TRANSL version 1157 TRUTIL version 27
   8 ;;; TRANS1 version 108 TRANS2 version 39 TRANS3 version 50
   9 ;;; TRANS4 version 29 TRANS5 version 26 TRANSF version NIL
  10 ;;; TROPER version 15 TRPRED version 6 MTAGS version NIL
  11 ;;; MDEFUN version 58 TRANSQ version 88 FCALL version 40
  12 ;;; ACALL version 70 TRDATA version 68 MCOMPI version 146
  13 ;;; 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 "OPTVAR.MC;2")
  23
  24 ;;; General declarations required for translated MACSYMA code.
  25
  26 (DECLARE
  27   (SPECIAL
  28     $K $DYDT $DD $C $AUX $TIME $GRINDSWITCH $SOLVERADCAN $SINGSOLVE ^W))
  29
  30 (DEFMTRFUN-EXTERNAL ($IC $ANY MDEFINE NIL NIL))
  31
  32 (DECLARE (SPECIAL $AUX))
  33
  34 (DECLARE (SPECIAL $C))
  35
  36 (DECLARE (SPECIAL $DD))
  37
  38 (DECLARE (SPECIAL $DYDT))
  39
  40 (DECLARE (SPECIAL $K))
  41
  42 (DEFMTRFUN-EXTERNAL ($HAM $ANY MDEFINE NIL NIL))
  43
  44 (DEFMTRFUN-EXTERNAL ($EL $ANY MDEFINE NIL NIL))
  45
  46 (DEFMTRFUN-EXTERNAL ($CONVERT $ANY MDEFINE NIL NIL))
  47
  48
  49 (SETQ ^W T)
  50
  51 (SETQ $TIME (SETQ $GRINDSWITCH (SETQ $SOLVERADCAN (SETQ $SINGSOLVE T))))
  52
  53 (MEVAL* '(($ALIAS) $DIFF $DIFF))
  54
  55 (DEFPROP $IC T TRANSLATED)
  56
  57 (ADD2LNC '$IC $PROPS)
  58
  59 (DEFMTRFUN ($IC $ANY MDEFINE NIL NIL) ($SOLN $XA $YA $DYA) NIL
  60            (SIMPLIFY (MFUNCTION-CALL $IC2 $SOLN $XA $YA $DYA)))
  61
  62 (DEFPROP $DV T TRANSLATED)
  63
  64 (ADD2LNC '$DV $PROPS)
  65
  66 (DEFMTRFUN
  67   ($DV $ANY MDEFMACRO NIL NIL) ($A) NIL
  68   (MBUILDQ-SUBST
  69     (LIST (CONS '$A $A)) '(($DEFINE_VARIABLE) $A ((MQUOTE) $A) $ANY)))
  70
  71 (MEVAL* '(($MODEDECLARE) $AUX $ANY))
  72
  73 (MEVAL* '(($DECLARE) $AUX $SPECIAL))
  74
  75 (DEF-MTRVAR $AUX '$AUX)
  76
  77 (MEVAL* '(($MODEDECLARE) $C $ANY))
  78
  79 (MEVAL* '(($DECLARE) $C $SPECIAL))
  80
  81 (DEF-MTRVAR $C '$C)
  82
  83 (MEVAL* '(($MODEDECLARE) $DD $ANY))
  84
  85 (MEVAL* '(($DECLARE) $DD $SPECIAL))
  86
  87 (DEF-MTRVAR $DD '$DD)
  88
  89 (MEVAL* '(($MODEDECLARE) $DYDT $ANY))
  90
  91 (MEVAL* '(($DECLARE) $DYDT $SPECIAL))
  92
  93 (DEF-MTRVAR $DYDT '$DYDT)
  94
  95 (MEVAL* '(($MODEDECLARE) $K $ANY))
  96
  97 (MEVAL* '(($DECLARE) $K $SPECIAL))
  98
  99 (DEF-MTRVAR $K '$K)
 100
 101 (DEFPROP $HAM T TRANSLATED)
 102
 103 (ADD2LNC '$HAM $PROPS)
 104
 105 (DEFMTRFUN
 106  ($HAM $ANY MDEFINE NIL NIL) ($ODES) NIL
 107  ((LAMBDA ($T $NSV $STATEVARS $AUXVARS $ANSW $ELIST $AUXDE)
 108     NIL
 109     (COND ((NOT (MFUNCTION-CALL $LISTP $ODES))
 110              (SETQ $ODES (LIST '(MLIST) $ODES))))
 111     (SETQ $T (SIMPLIFY (MFUNCTION-CALL $PART $ODES 1 1 2)))
 112     (SETQ $NSV (MFUNCTION-CALL $LENGTH $ODES))
 113     (SETQ $STATEVARS (SETQ $AUXVARS (SETQ $ELIST '((MLIST)))))
 114     (DO (($I 1 (+ 1 $I))) ((IS-BOOLE-CHECK (MGRP $I $NSV)) '$DONE)
 115       (SETQ
 116         $STATEVARS
 117         (SIMPLIFY (MFUNCTION-CALL
 118                     $ENDCONS (SIMPLIFY (MFUNCTION-CALL $PART $ODES $I 1 1))
 119                     $STATEVARS)))
 120       (SETQ
 121         $AUXVARS
 122         (SIMPLIFY
 123           (MFUNCTION-CALL
 124             $ENDCONS (MARRAYREF (TRD-MSYMEVAL $AUX '$AUX) $I) $AUXVARS))))
 125     (SETQ
 126       $ANSW
 127       (LIST '(MLIST)
 128             (DOSUM
 129               (FUNGEN&ENV-FOR-MEVALSUMARG
 130                 ($ODES) ($I)
 131                 (MUL* (SIMPLIFY (MFUNCTION-CALL $RHS (MARRAYREF $ODES $I)))
 132                       (MARRAYREF (TRD-MSYMEVAL $AUX '$AUX) $I))
 133                 ((MTIMES) (($RHS) (($ODES ARRAY) $I)) (($AUX ARRAY) $I)))
 134               '$I 1 $NSV T)))
 135     (DO (($I 1 (+ 1 $I))) ((IS-BOOLE-CHECK (MGRP $I $NSV)) '$DONE)
 136       (SETQ
 137         $AUXDE
 138         (SIMPLIFY
 139           (LIST
 140             '(MEQUAL)
 141             (SIMPLIFY (LIST '(%DERIVATIVE)
 142                             (MARRAYREF (TRD-MSYMEVAL $AUX '$AUX) $I) $T))
 143             (*MMINUS
 144               (SIMPLIFY (MFUNCTION-CALL $DIFF (MARRAYREF $ANSW 1)
 145                                         (MARRAYREF $STATEVARS $I)))))))
 146       (SETQ $ANSW (SIMPLIFY (MFUNCTION-CALL $ENDCONS $AUXDE $ANSW)))
 147       (COND
 148         ((LIKE (SIMPLIFY (MFUNCTION-CALL $RHS $AUXDE)) 0)
 149            (SETQ
 150              $ANSW
 151              (SIMPLIFY
 152                (MFUNCTION-CALL
 153                  $ENDCONS
 154                  (SIMPLIFY
 155                    (LIST '(MEQUAL) (MARRAYREF (TRD-MSYMEVAL $AUX '$AUX) $I)
 156                          (MARRAYREF (TRD-MSYMEVAL $C '$C) $I)))
 157                  $ANSW))))))
 158     (DO (($ITEM) (MDO (CDR $ANSW) (CDR MDO))) ((NULL MDO) '$DONE)
 159       (SETQ $ITEM (CAR MDO))
 160       (SETQ
 161         $ELIST
 162         (SIMPLIFY (MFUNCTION-CALL
 163                     $ENDCONS
 164                     (SIMPLIFY ($FIRST (SIMPLIFY (MFUNCALL '$LDISP $ITEM))))
 165                     $ELIST))))
 166     $ELIST)
 167   '$T '$NSV '$STATEVARS '$AUXVARS '$ANSW '$ELIST '$AUXDE))
 168
 169 (DEFPROP $EL T TRANSLATED)
 170
 171 (ADD2LNC '$EL $PROPS)
 172
 173 (DEFMTRFUN
 174  ($EL $ANY MDEFINE NIL NIL) ($F $YLIST $TLIST) NIL
 175  ((LAMBDA ($LY $LT $FSUB $ENERGYCON $FY $ANSW $ELIST)
 176    NIL
 177    (COND ((NOT (MFUNCTION-CALL $LISTP $TLIST))
 178             (SETQ $TLIST (LIST '(MLIST) $TLIST))))
 179    (COND ((NOT (MFUNCTION-CALL $LISTP $YLIST))
 180             (SETQ $YLIST (LIST '(MLIST) $YLIST))))
 181    (SETQ $LY (MFUNCTION-CALL $LENGTH $YLIST))
 182    (SETQ $LT (MFUNCTION-CALL $LENGTH $TLIST))
 183    (SETQ $FSUB $F)
 184    (SETQ $ENERGYCON (LIKE $LT 1))
 185    (DO (($I 1 (+ 1 $I))) ((IS-BOOLE-CHECK (MGRP $I $LY)) '$DONE)
 186      (DO (($J 1 (+ 1 $J))) ((IS-BOOLE-CHECK (MGRP $J $LT)) '$DONE)
 187        (MARRAYSET
 188          (SIMPLIFY
 189            (MFUNCTION-CALL $DERIVDEGREE $FSUB (MARRAYREF $YLIST $I)
 190                            (MARRAYREF $TLIST $J)))
 191          (TRD-MSYMEVAL $DD '$DD) $I $J)
 192        (COND ((IS-BOOLE-CHECK
 193                 (MGRP (MARRAYREF (TRD-MSYMEVAL $DD '$DD) $I $J) 1))
 194                 (SETQ $ENERGYCON NIL)))
 195        (DO (($KK 1 (+ 1 $KK)))
 196            ((IS-BOOLE-CHECK
 197               (MGRP $KK (MARRAYREF (TRD-MSYMEVAL $DD '$DD) $I $J)))
 198               '$DONE)
 199          (SETQ
 200            $FSUB
 201            (SIMPLIFY
 202              (MFUNCTION-CALL
 203                $SUBSTITUTE
 204                (SIMPLIFY
 205                  (LIST '(MEQUAL)
 206                        (SIMPLIFY (LIST '(%DERIVATIVE) (MARRAYREF $YLIST $I)
 207                                        (MARRAYREF $TLIST $J) $KK))
 208                        (MARRAYREF (TRD-MSYMEVAL $DYDT '$DYDT) $I $J $KK)))
 209                $FSUB))))))
 210    (COND ((NOT (MFUNCTION-CALL $FREEOF (MARRAYREF $TLIST 1) $FSUB))
 211             (SETQ $ENERGYCON NIL)))
 212    (SETQ $ANSW (COND ((IS-BOOLE-CHECK $ENERGYCON) (LIST '(MLIST) $FSUB))
 213                      (T '((MLIST)))))
 214    (DO (($I 1 (+ 1 $I))) ((IS-BOOLE-CHECK (MGRP $I $LY)) '$DONE)
 215      (SETQ
 216        $FY (SIMPLIFY (MFUNCTION-CALL $DIFF $FSUB (MARRAYREF $YLIST $I))))
 217      (SETQ
 218        $ANSW
 219        (SIMPLIFY
 220          (MFUNCTION-CALL
 221            $ENDCONS
 222            (SIMPLIFY
 223              (LIST
 224                '(MEQUAL)
 225                (DOSUM
 226                  (FUNGEN&ENV-FOR-MEVALSUMARG
 227                    ($I) ($J)
 228                    (DOSUM
 229                      (FUNGEN&ENV-FOR-MEVALSUMARG
 230                        ($FSUB $J $I $TLIST) ($KK)
 231                        (MUL*
 232                          (POWER -1 (ADD* $KK -1))
 233                          (SIMPLIFY
 234                            (LIST '(%DERIVATIVE)
 235                                  (SIMPLIFY
 236                                    (MFUNCTION-CALL
 237                                      $DIFF $FSUB
 238                                      (MARRAYREF (TRD-MSYMEVAL $DYDT '$DYDT)
 239                                                 $I $J $KK)))
 240                                  (MARRAYREF $TLIST $J) $KK)))
 241                        ((MTIMES)
 242                         ((MEXPT) ((MMINUS) 1) ((MPLUS) $KK ((MMINUS) 1)))
 243                         ((%DERIVATIVE)
 244                          (($DIFF) $FSUB (($DYDT ARRAY) $I $J $KK))
 245                          (($TLIST ARRAY) $J) $KK)))
 246                      '$KK 1 (MARRAYREF (TRD-MSYMEVAL $DD '$DD) $I $J) T)
 247                    (($SUM)
 248                     ((MTIMES)
 249                      ((MEXPT) ((MMINUS) 1) ((MPLUS) $KK ((MMINUS) 1)))
 250                      ((%DERIVATIVE)
 251                       (($DIFF) $FSUB (($DYDT ARRAY) $I $J $KK))
 252                       (($TLIST ARRAY) $J) $KK))
 253                     $KK 1 (($DD ARRAY) $I $J)))
 254                  '$J 1 $LT T)
 255                $FY))
 256            $ANSW)))
 257      (COND
 258        ((IS-BOOLE-CHECK $ENERGYCON)
 259           (MARRAYSET
 260             (ADD*
 261               (MARRAYREF $ANSW 1)
 262               (*MMINUS
 263                 (MUL* (SIMPLIFY
 264                         (MFUNCTION-CALL
 265                           $DIFF $FSUB
 266                           (MARRAYREF (TRD-MSYMEVAL $DYDT '$DYDT) $I 1 1)))
 267                       (SIMPLIFY (LIST '(%DERIVATIVE) (MARRAYREF $YLIST $I)
 268                                       (MARRAYREF $TLIST 1))))))
 269             $ANSW 1)))
 270      (COND
 271        ((AND (LIKE $FY 0) (LIKE $LT 1)
 272              (LIKE (MARRAYREF (TRD-MSYMEVAL $DD '$DD) $I 1) 1))
 273           (SETQ
 274             $ANSW
 275             (SIMPLIFY
 276               (MFUNCTION-CALL
 277                 $ENDCONS
 278                 (SIMPLIFY
 279                   (LIST
 280                     '(MEQUAL)
 281                     (SIMPLIFY
 282                       (MFUNCTION-CALL
 283                         $DIFF $FSUB
 284                         (MARRAYREF (TRD-MSYMEVAL $DYDT '$DYDT) $I 1 1)))
 285                     (MARRAYREF (TRD-MSYMEVAL $K '$K) $I)))
 286                 $ANSW))))))
 287    (COND
 288      ((IS-BOOLE-CHECK $ENERGYCON)
 289         (MARRAYSET (SIMPLIFY (LIST '(MEQUAL) (MARRAYREF $ANSW 1)
 290                                    (MARRAYREF (TRD-MSYMEVAL $K '$K) 0)))
 291                    $ANSW 1)))
 292    (DO (($I 1 (+ 1 $I))) ((IS-BOOLE-CHECK (MGRP $I $LY)) '$DONE)
 293      (DO (($J 1 (+ 1 $J))) ((IS-BOOLE-CHECK (MGRP $J $LT)) '$DONE)
 294        (DO (($KK 1 (+ 1 $KK)))
 295            ((IS-BOOLE-CHECK
 296               (MGRP $KK (MARRAYREF (TRD-MSYMEVAL $DD '$DD) $I $J)))
 297               '$DONE)
 298          (SETQ
 299            $ANSW
 300            (SIMPLIFY
 301              (MFUNCTION-CALL
 302                $SUBSTITUTE
 303                (SIMPLIFY
 304                  (LIST '(MEQUAL)
 305                        (MARRAYREF (TRD-MSYMEVAL $DYDT '$DYDT) $I $J $KK)
 306                        (SIMPLIFY (LIST '(%DERIVATIVE) (MARRAYREF $YLIST $I)
 307                                        (MARRAYREF $TLIST $J) $KK))))
 308                $ANSW))))))
 309    (SETQ $ELIST '((MLIST)))
 310    (DO (($EQN) (MDO (CDR $ANSW) (CDR MDO))) ((NULL MDO) '$DONE)
 311      (SETQ $EQN (CAR MDO))
 312      (SETQ
 313        $ELIST
 314        (SIMPLIFY (MFUNCTION-CALL
 315                    $ENDCONS
 316                    (SIMPLIFY ($FIRST (SIMPLIFY (MFUNCALL '$LDISP $EQN))))
 317                    $ELIST))))
 318    $ELIST)
 319   '$LY '$LT '$FSUB '$ENERGYCON '$FY '$ANSW '$ELIST))
 320
 321 (DEFPROP $CONVERT T TRANSLATED)
 322
 323 (ADD2LNC '$CONVERT $PROPS)
 324
 325 (DEFMTRFUN
 326   ($CONVERT $ANY MDEFINE NIL NIL) ($ODES $YLIST $T) NIL
 327   ((LAMBDA ($ANSW)
 328      NIL
 329      (PROG ()
 330           (COND ((NOT (MFUNCTION-CALL $LISTP $YLIST))
 331                    (SETQ $YLIST (LIST '(MLIST) $YLIST))))
 332           (SETQ $ANSW (SIMPLIFY (MFUNCALL '$EV $ODES '$EVAL)))
 333           (DO (($YY) (MDO (CDR $YLIST) (CDR MDO))) ((NULL MDO) '$DONE)
 334             (SETQ $YY (CAR MDO))
 335             (SETQ
 336               $ANSW
 337               (SIMPLIFY
 338                 (MFUNCTION-CALL
 339                   $SUBSTITUTE
 340                   (SIMPLIFY
 341                     (LIST
 342                       '(MEQUAL) $YY
 343                       (SIMPLIFY
 344                         (MFUNCTION-CALL $FUNMAKE $YY (LIST '(MLIST) $T)))))
 345                   $ANSW))))
 346           (RETURN $ANSW)))
 347    '$ANSW))
 348
 349 (SETQ ^W NIL)
 350
 351 (compile-forms-to-compile-queue)
 352