;;; -*- Mode: Lisp; Package: Macsyma -*-
;;; Translated code for LMIVAX::MAX$DISK:[SHARE2]DIFFER.MC;12
;;; Written on 9/24/1984 04:17:06, from MACSYMA 302
;;; Translated for LPH

;;; TRANSL-AUTOLOAD version NIL
;;; TRANSS version 87 TRANSL version 1157 TRUTIL version 27
;;; TRANS1 version 108 TRANS2 version 39 TRANS3 version 50
;;; TRANS4 version 29 TRANS5 version 26 TRANSF version NIL
;;; TROPER version 15 TRPRED version 6 MTAGS version NIL
;;; MDEFUN version 58 TRANSQ version 88 FCALL version 40
;;; ACALL version 70 TRDATA version 68 MCOMPI version 146
;;; TRMODE version 73 TRHOOK version NIL
(eval-when (compile eval)
      (setq *infile-name-key*
	          (namestring (truename '#.standard-input))))

(eval-when (compile)
   (setq $tr_semicompile 'NIL)
   (setq forms-to-compile-queue ()))

(comment "MAX$DISK:[SHARE2]DIFFER.MC;12")

;;; General declarations required for translated MACSYMA code.

(DECLARE (SPECIAL %U $LISTARITH $SIMPSUM ^W $PROGRAMMODE $LOADPRINT
		  $ARRAY $U $INDEX $DIFFERVERBOSE $NORMALIZE))

(DECLARE (SPECIAL $NORMALIZE))

(DECLARE (SPECIAL $DIFFERVERBOSE))

(DECLARE (SPECIAL $INDEX))

(DECLARE (SPECIAL $U))

(DECLARE (SPECIAL $ARRAY))

(DEFMTRFUN-EXTERNAL ($MAGNITUDE $ANY MDEFINE NIL NIL))

(DEFMTRFUN-EXTERNAL ($EIGENVALUES $ANY MDEFINE NIL NIL))

(DEFMTRFUN-EXTERNAL ($EIGENVECTOR $ANY MDEFINE NIL NIL))

(DEFMTRFUN-EXTERNAL ($STANDARDIZE $ANY MDEFINE NIL NIL))

(DEFMTRFUN-EXTERNAL ($FIRST_ORDER_DIFFERENCE $ANY MDEFINE NIL NIL))

(DEFMTRFUN-EXTERNAL ($SECOND_ORDER_DIFFERENCE $ANY MDEFINE NIL NIL))

(DEF-MTRVAR %U '%U 1)

(DEFMTRFUN-EXTERNAL ($SYSTEM $ANY MDEFINE NIL NIL))

(DEFMTRFUN-EXTERNAL ($DIFFERENCE $ANY MDEFINE NIL NIL))


(MEVAL* '(($MODEDECLARE) $NORMALIZE $BOOLEAN))

(MEVAL* '(($DECLARE) $NORMALIZE $SPECIAL))

(DEFPROP $NORMALIZE ASSIGN-MODE-CHECK ASSIGN)

(DEF-MTRVAR $NORMALIZE NIL)

(MEVAL* '(($MODEDECLARE) $DIFFERVERBOSE $BOOLEAN))

(MEVAL* '(($DECLARE) $DIFFERVERBOSE $SPECIAL))

(DEFPROP $DIFFERVERBOSE ASSIGN-MODE-CHECK ASSIGN)

(DEF-MTRVAR $DIFFERVERBOSE NIL)

(MEVAL* '(($MODEDECLARE) $INDEX $ANY))

(MEVAL* '(($DECLARE) $INDEX $SPECIAL))

(DEF-MTRVAR $INDEX '$INDEX)

(MEVAL* '(($MODEDECLARE) $U $ANY))

(MEVAL* '(($DECLARE) $U $SPECIAL))

(DEF-MTRVAR $U '$U)

(MEVAL* '(($MODEDECLARE) $ARRAY $ANY))

(MEVAL* '(($DECLARE) $ARRAY $SPECIAL))

(DEF-MTRVAR $ARRAY '$ARRAY)

(DEFPROP $MAGNITUDE T TRANSLATED)

(ADD2LNC '$MAGNITUDE $PROPS)

(DEFMTRFUN
 ($MAGNITUDE $ANY MDEFINE NIL NIL) ($VECTOR) NIL
 ((LAMBDA ($SCALARMATRIX)
    NIL
    (PROG ()
	 (COND
	   ((OR (MFUNCTION-CALL $LISTP $VECTOR)
		(= (MFUNCTION-CALL $LENGTH $VECTOR) 1))
	      (RETURN
		(SIMPLIFY
		  (LIST
		    '(%SQRT)
		    (NCMUL2
		      $VECTOR
		      (SIMPLIFY (MFUNCTION-CALL $TRANSPOSE $VECTOR))))))))
	 (COND
	   ((= (MFUNCTION-CALL
		 $LENGTH (SIMPLIFY (MFUNCTION-CALL $TRANSPOSE $VECTOR)))
	       1)
	      (RETURN
		(SIMPLIFY
		  (LIST
		    '(%SQRT)
		    (NCMUL2 (SIMPLIFY (MFUNCTION-CALL $TRANSPOSE $VECTOR))
			    $VECTOR))))))
	 (SIMPLIFY
	   (MFUNCTION-CALL $PRINT '|&magnitude:  not a vector --| $VECTOR))
	 (RETURN NIL)))
  T))

(DEFPROP $EIGENVALUES T TRANSLATED)

(ADD2LNC '$EIGENVALUES $PROPS)

(DEFMTRFUN
 ($EIGENVALUES $ANY MDEFINE NIL NIL) ($MX) NIL
 ((LAMBDA ($LOADPRINT $PROGRAMMODE $CHARPOLY LAMBDA $RESULT)
    NIL
    (PROG ()
	 (COND
	   ((NOT (= (MFUNCTION-CALL $LENGTH $MX)
		    (MFUNCTION-CALL
		      $LENGTH (SIMPLIFY (MFUNCTION-CALL $TRANSPOSE $MX)))))
	      (SIMPLIFY
		(MFUNCTION-CALL
		  $PRINT '|&eigenvalues:  not a square matrix --| $MX))
	      (RETURN NIL)))
	 (SETQ $CHARPOLY (SIMPLIFY (MFUNCALL '$CHARPOLY $MX LAMBDA)))
	 (SETQ $RESULT (SIMPLIFY (MFUNCTION-CALL $SOLVE $CHARPOLY LAMBDA)))
	 (RETURN
	   (DO ((SUM0002 (CDR $RESULT) (CDR SUM0002)) (SUM0001 NIL) ($X))
	       ((NULL SUM0002) (CONS '(MLIST) (NREVERSE SUM0001)))
	     (SETQ $X (CAR SUM0002)
		   SUM0001
		   (CONS (SIMPLIFY (MFUNCTION-CALL $RHS $X)) SUM0001))))))
  NIL T '$CHARPOLY 'LAMBDA '$RESULT))

(DEFPROP $EIGENVECTOR T TRANSLATED)

(ADD2LNC '$EIGENVECTOR $PROPS)

(DEFMTRFUN
 ($EIGENVECTOR $ANY MDEFINE NIL NIL) ($MX $EIGENVALUE) NIL
 ((LAMBDA
     ($LOADPRINT $PROGRAMMODE ^W $DEGREE $XLIST $XVECTOR $EQNLIST $RESULT)
    NIL
    (PROG ()
	(SETQ $DEGREE (MFUNCTION-CALL $LENGTH $MX))
	(COND
	  ((NOT
	     (LIKE $DEGREE
		   (MFUNCTION-CALL
		     $LENGTH (SIMPLIFY (MFUNCTION-CALL $TRANSPOSE $MX)))))
	     (SIMPLIFY
	       (MFUNCTION-CALL
		 $PRINT '|&eigenvector:  not a square matrix --| $MX))
	     (RETURN NIL)))
	(SETQ
	  $XLIST
	  ((LAMBDA (|000003| NN0004)
	     (COND
	       ((NOT (< NN0004 |000003|))
		  (DO (($I |000003| (1+ $I))
		       (SUM0005
			 NIL
			 (CONS (SIMPLIFY (MFUNCTION-CALL $CONCAT '$X $I))
			       SUM0005)))
		      ((> $I NN0004) (CONS '(MLIST) (NREVERSE SUM0005)))
		    (DECLARE (FIXNUM $I))))
	       (T (INTERVAL-ERROR '$MAKELIST |000003| NN0004))))
	   1 $DEGREE))
	(SETQ
	  $XVECTOR
	  (SIMPLIFY (MFUNCTION-CALL
		      $TRANSPOSE (SIMPLIFY (LIST '($MATRIX) $XLIST)))))
	(SETQ
	  $MX
	  (ADD*
	    (NCMUL2 $MX $XVECTOR) (*MMINUS (MUL* $EIGENVALUE $XVECTOR))))
	(SETQ
	  $EQNLIST
	  ((LAMBDA (|000006| NN0007)
	     (COND
	       ((NOT (< NN0007 |000006|))
		  (DO
		    (($I |000006| (1+ $I))
		     (SUM0008
		       NIL
		       (CONS
			 (SIMPLIFY (LIST '(MEQUAL) (MARRAYREF $MX $I 1) 0))
			 SUM0008)))
		    ((> $I NN0007) (CONS '(MLIST) (NREVERSE SUM0008)))
		    (DECLARE (FIXNUM $I))))
	       (T (INTERVAL-ERROR '$MAKELIST |000006| NN0007))))
	   1 $DEGREE))
	(COND
	  ((MFUNCTION-CALL
	     $MEMBER (SIMPLIFY (LIST '(MEQUAL) 0 0)) $EQNLIST)
	     (SETQ $EQNLIST
		   (SIMPLIFY
		     (MFUNCTION-CALL
		       $DELETE (SIMPLIFY (LIST '(MEQUAL) 0 0)) $EQNLIST))))
	  (T (SETQ $EQNLIST (SIMPLIFY (MFUNCTION-CALL $REST $EQNLIST)))))
	(SETQ
	  $RESULT
	  (SIMPLIFY
	    ($FIRST
	      (SIMPLIFY
		(MFUNCTION-CALL
		  $SOLVE
		  (SIMPLIFY
		    (MFUNCTION-CALL
		      $CONS (SIMPLIFY (LIST '(MEQUAL) '$X1 1)) $EQNLIST))
		  $XLIST)))))
	(SETQ
	  $RESULT
	  (DO ((SUM0010 (CDR $RESULT) (CDR SUM0010)) (SUM0009 NIL) ($X))
	      ((NULL SUM0010) (CONS '(MLIST) (NREVERSE SUM0009)))
	    (SETQ $X (CAR SUM0010)
		  SUM0009
		  (CONS (SIMPLIFY (MFUNCTION-CALL $PART $X 2)) SUM0009))))
	(RETURN
	  (COND
	    ((LIKE (TRD-MSYMEVAL $NORMALIZE NIL) T)
	       (DIV
		 $RESULT (SIMPLIFY (MFUNCTION-CALL $MAGNITUDE $RESULT))))
	    (T $RESULT)))))
  NIL T T '$DEGREE '$XLIST '$XVECTOR '$EQNLIST '$RESULT))

(DEFPROP $STANDARDIZE T TRANSLATED)

(ADD2LNC '$STANDARDIZE $PROPS)

(DEFMTRFUN
 ($STANDARDIZE $ANY MDEFINE NIL NIL) ($EQN $VAR) NIL
 ((LAMBDA ($X $Y)
    NIL
    (SETQ
      $X (MARRAYREF 'MQAPPLY (SIMPLIFY (MFUNCTION-CALL $PART $VAR 0))
		    (ADD* (SIMPLIFY (MFUNCTION-CALL $PART $VAR 1)) 1)))
    (SETQ $Y (SIMPLIFY (MFUNCTION-CALL $SOLVE $EQN $X)))
    (COND
      ((LIKE $Y '((MLIST)))
	 (SIMPLIFY
	   (MFUNCTION-CALL $PRINT '|&difference:  no| $X '|&term --| $EQN))
	 ((LAMBDA (X)
	    (COND ((NULL MCATCH)
		     (DISPLA X) (*MERROR '|THROW not within CATCH|)))
	    (*THROW 'MCATCH X))
	  '$MISSING_TERM)))
    (COND ((LIKE $Y '$ALL) $EQN) (T (SIMPLIFY ($FIRST $Y)))))
  '$X '$Y))

(DEFPROP $FIRST_ORDER_DIFFERENCE T TRANSLATED)

(ADD2LNC '$FIRST_ORDER_DIFFERENCE $PROPS)

(DEFMTRFUN
  ($FIRST_ORDER_DIFFERENCE $ANY MDEFINE NIL NIL) ($EQN $VAR) NIL
  ((LAMBDA ($A $B $SIMPSUM)
     NIL
     (SETQ
       $A (SIMPLIFY (MFUNCTION-CALL
		      $COEFF (SIMPLIFY (MFUNCTION-CALL $RHS $EQN)) $VAR)))
     (SETQ
       $B
       (ADD*
	 (SIMPLIFY (MFUNCTION-CALL $RHS $EQN)) (*MMINUS (MUL* $A $VAR))))
     (SIMPLIFY
       (LIST
	 '(MEQUAL) $VAR
	 (ADD*
	   (MUL* (POWER $A (TRD-MSYMEVAL $INDEX '$INDEX))
		 (MARRAYREF (TRD-MSYMEVAL $ARRAY '$ARRAY) 0))
	   (MUL*
	     $B
	     (DOSUM (FUNGEN&ENV-FOR-MEVALSUMARG
		      ($A) ($K) (POWER $A $K) ((MEXPT) $A $K))
		    '$K 0 (ADD* (TRD-MSYMEVAL $INDEX '$INDEX) -1) T))))))
   '$A '$B T))

(DEFPROP $SECOND_ORDER_DIFFERENCE T TRANSLATED)

(ADD2LNC '$SECOND_ORDER_DIFFERENCE $PROPS)

(DEFMTRFUN
 ($SECOND_ORDER_DIFFERENCE $ANY MDEFINE NIL NIL) ($EQN $VAR) NIL
 ((LAMBDA ()
    NIL
    (SIMPLIFY
      (MFUNCTION-CALL
	$PART
	(SIMPLIFY
	  (MFUNCTION-CALL
	    $SYSTEM
	    (LIST
	      '(MLIST) $EQN
	      (SIMPLIFY
		(LIST '(MEQUAL)
		      (MARRAYREF (TRD-MSYMEVAL $ARRAY '$ARRAY)
				 (ADD* (TRD-MSYMEVAL $INDEX '$INDEX) 1))
		      (MARRAYREF (TRD-MSYMEVAL $ARRAY '$ARRAY)
				 (ADD* (TRD-MSYMEVAL $INDEX '$INDEX) 1)))))
	    (LIST '(MLIST)
		  (MARRAYREF (TRD-MSYMEVAL $ARRAY '$ARRAY)
			     (ADD* (TRD-MSYMEVAL $INDEX '$INDEX) 1))
		  $VAR)))
	2 1)))))

(DEFPROP $SYSTEM T TRANSLATED)

(ADD2LNC '$SYSTEM $PROPS)

(DEFMTRFUN
 ($SYSTEM $ANY MDEFINE NIL NIL) ($EQNLIST $VARLIST) NIL
 ((LAMBDA ($LISTARITH $NORMALIZE $A $U $LAMBDAS $S $SINVERSE $D)
   NIL
   (ASSIGN-MODE-CHECK '$NORMALIZE $NORMALIZE)
   (SETQ
     $EQNLIST
     (SIMPLIFY
       (MAP1
	 (GETOPR
	   (M-TLAMBDA
	     ($X $Y) NIL
	     (SIMPLIFY
	       (MFUNCTION-CALL
		 $RHS (SIMPLIFY (MFUNCTION-CALL $STANDARDIZE $X $Y))))))
	 $EQNLIST $VARLIST)))
   (SETQ
     $A
     (DO ((SUM0013 (CDR $EQNLIST) (CDR SUM0013)) (SUM0012 NIL) ($EQN))
	 ((NULL SUM0013) (CONS '(MLIST) (NREVERSE SUM0012)))
       (SETQ
	 $EQN (CAR SUM0013)
	 SUM0012
	 (CONS
	   (DO ((SUM0015 (CDR $VARLIST) (CDR SUM0015))
		(SUM0014 NIL) ($VAR))
	       ((NULL SUM0015) (CONS '(MLIST) (NREVERSE SUM0014)))
	     (SETQ
	       $VAR (CAR SUM0015)
	       SUM0014
	       (CONS
		 (SIMPLIFY (MFUNCTION-CALL $COEFF $EQN $VAR)) SUM0014)))
	   SUM0012))))
   (SETQ $A (SIMPLIFY (MAPPLY-TR '$MATRIX $A)))
   (MARRAYSET
    (SIMPLIFY
      (MFUNCTION-CALL
	$TRANSPOSE
	(DO ((SUM0017 (CDR $VARLIST) (CDR SUM0017)) (SUM0016 NIL) ($VAR))
	    ((NULL SUM0017) (CONS '(MLIST) (NREVERSE SUM0016)))
	  (SETQ
	    $VAR (CAR SUM0017)
	    SUM0016
	    (CONS
	      (SIMPLIFY
		(MFUNCALL
		  '$EV $VAR
		  (SIMPLIFY
		    (MFUNCTION-CALL
		      $SOLVE
		      (SIMPLIFY (LIST '(MEQUAL)
				      (TRD-MSYMEVAL $INDEX '$INDEX) 0))))))
	      SUM0016)))))
    (TRD-MSYMEVAL $U '$U) 0)
   (MARRAYSET (SIMPLIFY (MFUNCTION-CALL $TRANSPOSE $VARLIST))
	      (TRD-MSYMEVAL $U '$U) (TRD-MSYMEVAL $INDEX '$INDEX))
   (COND
     ((LIKE (TRD-MSYMEVAL $DIFFERVERBOSE NIL) T)
	(SIMPLIFY
	  (MFUNCALL
	    '$LDISPLAY
	    (MARRAYREF (TRD-MSYMEVAL %U '%U) (TRD-MSYMEVAL $INDEX '$INDEX))
	    (MARRAYREF (TRD-MSYMEVAL %U '%U) 0) '$A))
	(SIMPLIFY
	  (MFUNCALL
	    '$LDISP
	    (SIMPLIFY
	      (LIST '(MEQUAL)
		    (MARRAYREF (TRD-MSYMEVAL %U '%U)
			       (ADD* (TRD-MSYMEVAL $INDEX '$INDEX) 1))
		    (MUL* '$A (MARRAYREF (TRD-MSYMEVAL %U '%U)
					 (TRD-MSYMEVAL $INDEX '$INDEX)))))
	    (SIMPLIFY
	      (LIST
		'(MEQUAL)
		(MARRAYREF
		  (TRD-MSYMEVAL %U '%U) (TRD-MSYMEVAL $INDEX '$INDEX))
		'((MNCTIMES) $S ((MNCTIMES) ((MEXPT) LAMBDA $N)
				 ((MNCTIMES) ((MNCEXPT) $S ((MMINUS) 1))
				  (($U ARRAY) 0))))))))))
   (SETQ $LAMBDAS (SIMPLIFY (MFUNCTION-CALL $EIGENVALUES $A)))
   (SETQ
     $S
     (DO ((SUM0019 (CDR $LAMBDAS) (CDR SUM0019)) (SUM0018 NIL) (LAMBDA))
	 ((NULL SUM0019) (CONS '(MLIST) (NREVERSE SUM0018)))
       (SETQ
	 LAMBDA (CAR SUM0019)
	 SUM0018
	 (CONS
	   (SIMPLIFY (MFUNCTION-CALL $EIGENVECTOR $A LAMBDA)) SUM0018))))
   (SETQ
     $S
     (SIMPLIFY
       (MFUNCTION-CALL $TRANSPOSE (SIMPLIFY (MAPPLY-TR '$MATRIX $S)))))
   (SETQ $SINVERSE (NCPOWER $S -1))
   (SETQ
     $D
     (MUL* $LAMBDAS
	   (SIMPLIFY
	     (MFUNCTION-CALL $IDENT (MFUNCTION-CALL $LENGTH $LAMBDAS)))))
   (MARRAYSET
     (NCMUL2
       $S
       (NCMUL2 (POWER $D (TRD-MSYMEVAL $INDEX '$INDEX))
	       (NCMUL2 $SINVERSE (MARRAYREF (TRD-MSYMEVAL $U '$U) 0))))
     (TRD-MSYMEVAL $U '$U) (TRD-MSYMEVAL $INDEX '$INDEX))
   (SIMPLIFY
     (MFUNCTION-CALL
       $TRANSPOSE
       (SIMPLIFY
	 (MAP1
	   (GETOPR '&=) $VARLIST
	   (SIMPLIFY
	     (MFUNCTION-CALL
	       $PART
	       (SIMPLIFY
		 (MFUNCTION-CALL
		   $TRANSPOSE (MARRAYREF (TRD-MSYMEVAL $U '$U)
					 (TRD-MSYMEVAL $INDEX '$INDEX))))
	       1)))))))
  T NIL '$A '$U '$LAMBDAS '$S '$SINVERSE '$D))

(DEFPROP $DIFFERENCE T TRANSLATED)

(ADD2LNC '$DIFFERENCE $PROPS)

(DEFMTRFUN
 ($DIFFERENCE $ANY MDEFINE NIL NIL) ($EQN $VAR) NIL
 ((LAMBDA ($LOADPRINT $PROGRAMMODE $ARRAY $INDEX $HIGHERORDER)
    NIL
    (PROG ()
       (COND
	 ((MFUNCTION-CALL $LISTP $EQN)
	    (SETQ
	      $ARRAY
	      (DO ((SUM0021 (CDR $VAR) (CDR SUM0021)) (SUM0020 NIL) ($X))
		  ((NULL SUM0021) (CONS '(MLIST) (NREVERSE SUM0020)))
		(SETQ
		  $X (CAR SUM0021)
		  SUM0020
		  (CONS (SIMPLIFY (MFUNCTION-CALL $PART $X 0)) SUM0020))))
	    (SETQ $INDEX
		  (SIMPLIFY
		    (MFUNCTION-CALL $PART (SIMPLIFY ($FIRST $VAR)) 1)))
	    (RETURN (SIMPLIFY (MFUNCTION-CALL $SYSTEM $EQN $VAR)))))
       (SETQ $ARRAY (SIMPLIFY (MFUNCTION-CALL $PART $VAR 0)))
       (SETQ $INDEX (SIMPLIFY (MFUNCTION-CALL $PART $VAR 1)))
       (SETQ
	 $HIGHERORDER
	 ((LAMBDA (|000022| NN0023)
	    (COND
	      ((NOT (< NN0023 |000022|))
		 (DO
		   (($N |000022| (1+ $N))
		    (SUM0024
		      NIL
		      (CONS
			(MARRAYREF (TRD-MSYMEVAL $ARRAY '$ARRAY)
				   (ADD* (TRD-MSYMEVAL $INDEX '$INDEX) $N))
			SUM0024)))
		   ((> $N NN0023) (CONS '(MLIST) (NREVERSE SUM0024)))
		   (DECLARE (FIXNUM $N))))
	      (T (INTERVAL-ERROR '$MAKELIST |000022| NN0023))))
	  2 5))
       (SETQ
	 $EQN
	 ((LAMBDA ()
	    ((LAMBDA (MCATCH)
	       (PROG2
		 NIL
		 (*CATCH
		   'MCATCH
		   (PROGN
		     (SIMPLIFY (MFUNCTION-CALL $STANDARDIZE $EQN $VAR))))
		 (ERRLFUN1 MCATCH)))
	     (CONS BINDLIST LOCLIST)))))
       (COND ((LIKE $EQN '$MISSING_TERM) (RETURN '$DONE)))
       (RETURN
	 (COND
	   ((NOT
	      (MFUNCTION-CALL
		$MEMBER 'NIL
		(SIMPLIFY
		  (MAP1 (GETOPR
			  (M-TLAMBDA&ENV (($X) ($EQN)) NIL
					 (MFUNCTION-CALL $FREEOF $X $EQN)))
			$HIGHERORDER))))
	      (SIMPLIFY
		(MFUNCTION-CALL $FIRST_ORDER_DIFFERENCE $EQN $VAR)))
	   (T (SIMPLIFY
		(MFUNCTION-CALL $SECOND_ORDER_DIFFERENCE $EQN $VAR)))))))
  NIL T '$ARRAY '$INDEX '$HIGHERORDER))

(compile-forms-to-compile-queue)