;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     The data in this file contains enhancments.                    ;;;;;
;;;                                                                    ;;;;;
;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
;;;     All rights reserved                                            ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "MAXIMA")
(macsyma-module irinte)
(load-macsyma-macros rzmac)

(DECLARE-TOP (SPECIAL CHECKCOEFSIGNLIST EC-1 R12 1//2 VAR GLOBALCAREFLAG
		  ZEROSIGNTEST PRODUCTCASE $RADEXPAND))

(DEFUN HASVAR (EXP) (NOT (FREEVAR EXP)))

(DEFUN ZERP (A) (EQUAL A 0))

(DEFUN INTEGERPFR (A) (IF (NOT (MAXIMA-INTEGERP A)) (INTEGERP1 A)))

(DEFUN NONZERP (A) (NOT (EQUAL A 0)))

(DEFUN FREEVNZ (A) (AND (FREEVAR A) (NOT (EQUAL A 0))))

(DEFUN INTE (FUNCT X)
       (PROG (CHECKCOEFSIGNLIST GLOBALCAREFLAG $RADEXPAND)
	     (SETQ $RADEXPAND T)
	     (RETURN (INTIR-REF FUNCT X))))

(DEFUN INTIR-REF (FUN X)
       (PROG (A)
	     (COND ((SETQ A (INTIR1 FUN X))(RETURN A)))
	     (COND ((SETQ A (INTIR2 FUN X))(RETURN A)))
	     (RETURN (INTIR3 FUN X))))

(DEFUN INTIR1 (FUN X)
       (PROG (ASSOCLIST E0 R0 E1 E2 R1 R2 D P)
	     (SETQ ASSOCLIST (FACTPOW (SPECREPCHECK FUN) X))
	     (SETQ E1 (CDRAS 'E1 ASSOCLIST) E2 (CDRAS 'E2 ASSOCLIST))
	     (COND ((NULL ASSOCLIST)(RETURN NIL)))
	     (SETQ D (CDRAS 'D ASSOCLIST) P (CDRAS 'P ASSOCLIST)
		   E0 (CDRAS 'E0 ASSOCLIST) R0 (CDRAS 'R0 ASSOCLIST)
		   R1 (CDRAS 'R1 ASSOCLIST) R2 (CDRAS 'R2 ASSOCLIST))
	     (COND ((FLOATP E0)(SETQ E0 (RDIS (RATION1 E0)))))
	     (COND ((FLOATP E1)(SETQ E1 (RDIS (RATION1 E1)))))
	     (COND ((FLOATP E2)(SETQ E2 (RDIS (RATION1 E2)))))
	     (RETURN (INTIR1-REF D P R0 E0 R1 E1 R2 E2 X))))

(DEFUN INTIR2 (FUNCT X)
       (PROG (RES)
	     (COND ((SETQ RES (INTIR FUNCT X))(RETURN RES)))
	     (RETURN (INTIRFACTOROOT FUNCT X))))

(DEFUN INTIR3 (EXP X)
       (PROG (ASSOCLIST E F G R0)
	     (COND ((SETQ ASSOCLIST (ELLIPTQUAD EXP X))
		    (SETQ E (CDRAS 'E ASSOCLIST) F (CDRAS 'F ASSOCLIST)
			  G (CDRAS 'G ASSOCLIST) R0 (CDRAS 'R0 ASSOCLIST))
		    (ASSUME `(($NOTEQUAL) ,E 0))
		    (RETURN (INTIR3-R0TEST ASSOCLIST X E F G R0))))
	     (RETURN NIL)))

(DEFUN INTIR3-R0TEST (ASSOCLIST X E F G R0)
       (COND ((ROOT+ANYTHING R0 X) NIL)
	     (T (INTIR3-REF ASSOCLIST X E F G R0))))

(DEFUN INTIR1-REF (D P R0 E0 R1 E1 R2 E2 X)
       ((LAMBDA (NUME1 NUME2)
		(COND ((AND (PLUSP NUME1)(PLUSP NUME2))
		       (PP-INTIR1 D P R0 E0 R1 E1 R2 E2 X))
		      ((AND (MINUSP NUME1)(MINUSP NUME2))
		       (MM-INTIR1 D P R0 E0 R1 E1 R2 E2 X))
		      ((PLUSP NUME1)(PM-INTIR1 D P R0 E0 R1 E1 R2 E2 X))
		      (T (PM-INTIR1 D P R0 E0 R2 E2 R1 E1 X))))
	(CADR E1) (CADR E2)))

(DEFUN PP-INTIR1 (D P R0 E0 R1 E1 R2 E2 X)
       ((LAMBDA (NUME1 NUME2)
		(COND ((GREATERP NUME1 NUME2)(PP-INTIR1-EXEC D P R0 E0 R1 E1 R2 E2 X))
		      (T (PP-INTIR1-EXEC D P R0 E0 R2 E2 R1 E1 X))))
	(CADR E1) (CADR E2)))

(DEFUN MM-INTIR1 (D P R0 E0 R1 E1 R2 E2 X)
       ((LAMBDA (NUME1 NUME2)
		(COND ((GREATERP NUME1 NUME2)(MM-INTIR1-EXEC D P R0 E0 R1 E1 R2 E2 X))
		      (T (MM-INTIR1-EXEC D P R0 E0 R2 E2 R1 E1 X))))
	(CADR E1) (CADR E2)))

(DEFUN PM-INTIR1 (D P R0 E0 ROFPOS EPOS ROFNEG ENEG X)
       ((LAMBDA (NUMEPOS NUMUL-1ENEG)
		(COND ((GREATERP NUMEPOS NUMUL-1ENEG)
		       (MM-INTIR1 D (MUL P (POWER ROFPOS (SUB EPOS ENEG)))
				  R0 E0 ROFPOS ENEG ROFNEG ENEG X))
		      ((OR (EQUAL E0 0) (PLUSP E0))
		       (PP-INTIR1 D (MUL P (POWER ROFNEG (SUB ENEG EPOS)))
				  R0 E0 ROFPOS EPOS ROFNEG EPOS X))
		      (T (MM-INTIR1 D (MUL P (POWER ROFPOS (SUB EPOS ENEG)))
				    R0 E0 ROFPOS ENEG ROFNEG ENEG X))))
	(CADR EPOS)
	(MUL -1 (CADR ENEG))))

(DEFUN PP-INTIR1-EXEC (D P R0 E0 ROFMAX EMAX ROFMIN EMIN X)
       (INTIR (MUL D P (COND ((EQUAL E0 0) 1) (T (POWER R0 E0)))
		   (POWER ROFMAX (ADD EMAX (MUL -1 EMIN)))
		   (POWER ($EXPAND (MUL ROFMAX ROFMIN)) EMIN)) X))

(DEFUN MM-INTIR1-EXEC (D P R0 E0 ROFMIN EMIN ROFMAX EMAX X)
       (INTIR (MUL D P (COND ((EQUAL E0 0) 1) (T (POWER R0 E0)))
		   (POWER ROFMAX (ADD EMAX (MUL -1 EMIN)))
		   (POWER ($EXPAND (MUL ROFMAX ROFMIN)) EMIN)) X))

(DEFUN INTIR3-REF (ASSOCLIST X E F G R0)
       ((LAMBDA (SIGNDISC D P E0)
		(COND ((OR (EQ SIGNDISC '$POSITIVE)(EQ SIGNDISC '$NEGATIVE))
		       (PNS-INTIR3 X E F G D P R0 E0))
		      (T (ZS-INTIR3 X E F D P R0 E0))))
	(SIGNDISCR E F G)
	(CDRAS 'D ASSOCLIST)
	(CDRAS 'P ASSOCLIST)
	(CDRAS 'E0 ASSOCLIST)))

(DEFUN ROOT+ANYTHING (EXP VAR)
       (M2 EXP '((MPLUS) ((COEFFPT) (C NONZERP) ((MEXPT) (U HASVAR) (V INTEGERPFR)))
			 ((COEFFPP)(C TRUE))) NIL))
 
(DEFUN PNS-INTIR3 (X E F G D P R0 E0)
       ((LAMBDA (DISCR)
		((LAMBDA (P*R0^E0 2*E*X+F 2*E*D*INVDISC)
			 (MUL (SUB (INTIR2 (MUL 2*E*D*INVDISC
						(INV (SUB 2*E*X+F DISCR))
						P*R0^E0)
					   X)
				   (INTIR2 (MUL 2*E*D*INVDISC
						(INV (ADD 2*E*X+F DISCR))
						P*R0^E0)
					   X))))
		 (MUL P (POWER R0 E0))
		 (ADD (MUL 2 E X) F)
		 (MUL 2 E D (INV DISCR))))
	(POWER (SUB (MUL F F)(MUL 4 E G)) (INV 2))))

(DEFUN ZS-INTIR3 (X E F D P R0 E0)
       (INTIR2 (MUL D P E
		    (POWER (ADD X (DIV F (ADD E E))) -2) (POWER R0 E0))
	       X))

(DEFUN CDRAS (A B)
       (CDR (zl-ASSOC A B)))

(DEFUN INTIR (FUNCT X)
       (PROG (ASSOCLIST)
	     (SETQ ASSOCLIST (JMAUG (SPECREPCHECK FUNCT) X))
	     (RETURN (INTI FUNCT X ASSOCLIST))))

(DEFUN INTI (FUNCT X ASSOCLIST)
       (PROG (MET N EXPR F E DENOM)
	     (SETQ N (CDRAS 'N ASSOCLIST))
	     (COND ((OR (NULL ASSOCLIST) (MAXIMA-INTEGERP N))
		    (RETURN NIL)))
	     (SETQ F (CDRAS 'F ASSOCLIST) E (CDRAS 'E ASSOCLIST))
	     (COND ((OR (EQUAL E 0) (NULL E))
		    (RETURN (INTIRA FUNCT X))))
	     (COND ((NOT (NUMBERP F)) (GO JUMP)))
	     (COND ((PLUSP F)(GO JUMP)))
	     (SETQ DENOM (ADD (MUL F X) E) F (MUL -1 F) E (MUL -1 E)
		   FUNCT (MUL -1 (DIV (MEVAL (MUL DENOM FUNCT))(ADD (MUL F X) E))))
	JUMP (SETQ EXPR
		   (MUL (POWER F -1)
			(INTIRA (DISTREXPANDROOT
				 (CDR ($SUBSTITUTE
					(MUL (POWER F -1)
					     (ADD (SETQ MET
							(MAKE-SYMBOL
							  "YANNIS")
							)
							     (MUL -1 E)))
						   X FUNCT)))
				MET)))
	(RETURN ($EXPAND ($SUBSTITUTE (ADD (MUL F X) E) MET EXPR)))))

(DEFUN DISTREXPANDROOT (EXPR)
       (COND ((NULL EXPR) 1)
	     (T (MUL (EXPANDROOT (CAR EXPR))
		     (DISTREXPANDROOT (CDR EXPR))))))

(DEFUN EXPANDROOT (EXPR)
       (COND ((ATOM EXPR) EXPR)
	     (T (COND ((AND (EQ (CAAR EXPR) 'MEXPT)
			    (INTEGERPFR (CADDR EXPR)))
		       ($EXPAND EXPR))
		      (T EXPR)))))

(DEFUN INTIRFACTOROOT (EXPR X)
       (PROG (ASSOCLIST EXP)
	     (SETQ EXP EXPR)
	     (COND ((SETQ ASSOCLIST (JMAUG (SETQ EXPR (DISTRFACTOR (TIMESTEST EXPR) X)) X))
		    (RETURN (INTI EXPR X ASSOCLIST))))
	     (SETQ GLOBALCAREFLAG 'T)
	     (COND ((SETQ ASSOCLIST (JMAUG (SETQ EXP (DISTRFACTOR (TIMESTEST EXP) X)) X))
		    (SETQ GLOBALCAREFLAG NIL)
		    (RETURN (INTI EXP X ASSOCLIST))))
	     (SETQ GLOBALCAREFLAG NIL)
	     (RETURN NIL)))

(DEFUN DISTRFACTOR (EXPR X)
       (COND ((NULL EXPR) 1)
	     (T (MUL (FACTOROOT (CAR EXPR) X)
		     (DISTRFACTOR (CDR EXPR) X)))))

(DEFUN FACTOROOT (EXPR VAR)
       (COND ((ATOM EXPR) EXPR)
	     (T (COND ((AND (EQ (CAAR EXPR) 'MEXPT)
			    (HASVAR EXPR)
			    (INTEGERPFR (CADDR EXPR)))
		       (CAREFULFACTOR EXPR VAR))
		      (T EXPR)))))

(DEFUN CAREFULFACTOR (EXPR X)
       (COND ((NULL GLOBALCAREFLAG)($FACTOR EXPR))
	     (T (RESTOREX ($FACTOR (POWER (DIV (CADR EXPR) X) (CADDR EXPR))) X))))

(DEFUN RESTOREX (EXPR VAR)
       (COND ((ATOM EXPR) EXPR)
	     (T (COND ((EQ (CAAR EXPR) 'MTIMES)
		       (DISTRESTOREX (CDR EXPR) VAR))
		      (T EXPR)))))

(DEFUN DISTRESTOREX (EXPR VAR)
       (COND ((NULL EXPR) 1)
	     (T (MUL (RESTOROOT (CAR EXPR) VAR)
		     (DISTRESTOREX (CDR EXPR) VAR)))))

(DEFUN RESTOROOT (EXPR VAR)
       (COND ((ATOM EXPR) EXPR)
	     (T (COND ((AND (EQ (CAAR EXPR) 'MEXPT)
			    (INTEGERPFR (CADDR EXPR))
			    (MPLUSP (CADR EXPR)))
		       (POWER ($EXPAND (MUL VAR (CADR EXPR))) (CADDR EXPR)))
		      (T EXPR)))))

(DEFUN TIMESTEST (EXPR)
       (COND ((ATOM EXPR)(LIST EXPR))
	     (T (COND ((EQ (CAAR EXPR) 'MTIMES)(CDR EXPR))
		      (T (LIST EXPR))))))

(DEFUN INTIRA (FUNCT X)
       (PROG (A B C EC-1 D M N ASSOCLIST PLUSPOWFO1 PLUSPOWFO2 MINUSPOWFO
		POLFACT SIGNN POSZPOWLIST NEGPOWLIST R12)
	     (SETQ ASSOCLIST (JMAUG (SPECREPCHECK FUNCT) X))
	     (SETQ N (CDRAS 'N ASSOCLIST) R12 1//2)
	     (COND ((OR (NULL ASSOCLIST) (MAXIMA-INTEGERP N))(RETURN NIL)))
	     (COND ((FLOATP N)(SETQ N (RDIS (RATION1 N)))))
	     (SETQ D (CDRAS 'D ASSOCLIST))
	     (COND ((EQUAL D 0) (RETURN 0)))
	     (SETQ C (CDRAS 'A ASSOCLIST))
	     (IF (EQUAL C 0) (RETURN NIL))
	     (SETQ M (CDRAS 'M ASSOCLIST) POLFACT (CDRAS 'P ASSOCLIST) N (CADR N)
		   SIGNN (CHECKSIGNTM N) EC-1 (POWER C -1)
		   B (CDRAS 'B ASSOCLIST) A (CDRAS 'C ASSOCLIST)
		   PLUSPOWFO1 (MUL R12 (PLUS N -1))
		   MINUSPOWFO (MUL R12 (PLUS N 1))
		   PLUSPOWFO2 (TIMES -1 MINUSPOWFO)
		   POSZPOWLIST (CAR (POWERCOEFLIST POLFACT M X))
		   NEGPOWLIST (CADR (POWERCOEFLIST POLFACT M X)))
	     (COND ((AND (NULL NEGPOWLIST)(NOT (NULL POSZPOWLIST)))
		    (COND ((EQ SIGNN '$POSITIVE)
			   (RETURN (AUGMULT (MUL D
						 (NUMMNUMN POSZPOWLIST
							   PLUSPOWFO1
							   MINUSPOWFO C B A X))))))
		    (RETURN (AUGMULT (MUL D
					  (NUMMDENN POSZPOWLIST
						    PLUSPOWFO2 C B A X))))))
	     (COND ((AND (NULL POSZPOWLIST)(NOT (NULL NEGPOWLIST)))
		    (COND ((EQ SIGNN '$POSITIVE)
			   (RETURN (AUGMULT (MUL D
						 (DENMNUMN NEGPOWLIST
							   MINUSPOWFO C B A X))))))
		    (RETURN (AUGMULT (MUL D
					  (DENMDENN NEGPOWLIST
						    PLUSPOWFO2 C B A X))))))
	     (COND ((AND (NOT (NULL NEGPOWLIST)) (NOT (NULL POSZPOWLIST)))
		    (COND ((EQ SIGNN '$POSITIVE)
			   (RETURN (ADD (AUGMULT (MUL D
						      (NUMMNUMN POSZPOWLIST
								PLUSPOWFO1
								MINUSPOWFO C B A X)))
					(AUGMULT (MUL D
						      (DENMNUMN NEGPOWLIST
								MINUSPOWFO C B A X)))))))
		    (RETURN (ADD (AUGMULT (MUL D
					       (NUMMDENN POSZPOWLIST
							 PLUSPOWFO2 C B A X)))
				 (AUGMULT (MUL D
					       (DENMDENN NEGPOWLIST
							 PLUSPOWFO2 C B A X)))))))))

(DEFUN JMAUG (EXP VAR)
       (M2 EXP '((MTIMES) ((COEFFTT) (D FREEVAR))
			  ((COEFFTT)(P POLYP))
			  ((MEXPT) ((MPLUS) ((COEFFPT)(F FREEVAR)(X VARP))
					    ((COEFFPP)(E FREEVAR)))
				   (M MAXIMA-INTEGERP))
			  ((MEXPT) ((MPLUS) ((COEFFPT) (A FREEVAR) ((MEXPT) (X VARP) 2))
					    ((COEFFPT) (B FREEVAR)(X VARP))
					    ((COEFFPP) (C FREEVAR)))
				   (N INTEGERP1)))
	   NIL))

(DEFUN FACTPOW (EXP VAR)
       (M2 EXP '((MTIMES) ((COEFFTT) (D FREEVAR))
			  ((COEFFTT) (P POLYP))
			  ((MEXPT) (R1 HASVAR)
				   (E1 INTEGERPFR))
			  ((MEXPT) (R2 HASVAR)
				   (E2 INTEGERPFR))
			  ((MEXPT) (R0 HASVAR)
				   (E0 MAXIMA-INTEGERP)))
	   NIL))

(DEFUN ELLIPTQUAD (EXP VAR)
       (M2 EXP '((MTIMES) ((COEFFTT) (D FREEVAR))
			  ((COEFFTT) (P POLYP))
			  ((MEXPT) ((MPLUS) ((COEFFPT) (E FREEVNZ) ((MEXPT) (X VARP) 2))
					    ((COEFFPT) (F FREEVAR) (X VARP))
					    ((COEFFPP) (G FREEVAR)))
				   -1)
			  ((MEXPT) (R0 HASVAR)
				   (E0 INTEGERPFR)))
	   NIL))

(DEFUN POLFOO (C B A X)
       (ADD (MUL C X X)
	    (MUL B X)
	    A))

(DEFUN POWERCOEFLIST (FUN M VAR) 
       (PROG (EXPANFUN MAXPOWFUN POWFUN COEF POSZPOWLIST NEGPOWLIST) 
	     (SETQ EXPANFUN (UNQUOTE ($EXPAND (MUL (PREVCONSTEXPAN FUN VAR)
						   (POWER VAR M)))))
	     (COND ((AND (EQUAL FUN 1) (GREATERP M 0))
		    (RETURN (CONS NIL (LIST (LIST (CONS M (LIST 1))))))))
	     (COND ((AND (EQUAL FUN 1)(LESSP M 0))
		    (RETURN (CONS NIL (LIST (LIST (CONS (TIMES -1 M ) (LIST 1))))))))
	     (COND ((EQUAL EXPANFUN 1)
		    (RETURN (CONS (LIST (CONS 0 (LIST 1)))
				  (LIST NIL)))))
	     (SETQ MAXPOWFUN ($HIPOW EXPANFUN VAR)
		   POWFUN ($LOPOW EXPANFUN VAR))
	LOOP (SETQ COEF ($COEFF EXPANFUN (POWER VAR POWFUN)))
	     (COND ((NUMBERP COEF) (GO TESTJUMP)))
	     (GO NOJUMP)
    TESTJUMP (COND ((AND (NOT (ZEROP POWFUN)) (ZEROP COEF))
		    (GO JUMP)))
    NOJUMP   (COND ((GREATERP POWFUN 0)
		    (SETQ POSZPOWLIST (APPEND POSZPOWLIST
					      (LIST (CONS POWFUN (LIST COEF)))))))
             (COND ((ZEROP POWFUN)
		    (SETQ POSZPOWLIST
			  (APPEND POSZPOWLIST
				  (LIST (CONS 0 (LIST (CONSTERM (CDR EXPANFUN) VAR))))))))
	     (COND ((LESSP POWFUN 0)
		    (SETQ NEGPOWLIST (APPEND NEGPOWLIST
					     (LIST (CONS (TIMES  -1 POWFUN)(LIST COEF)))))))
	     (COND ((EQUAL POWFUN MAXPOWFUN)
		    (RETURN (LIST POSZPOWLIST (REVERSE NEGPOWLIST)))))
	JUMP (SETQ POWFUN (ADD1 POWFUN)) (GO LOOP)))

(DEFUN CONSTERM (FUN VAR) 
       (COND ((NULL FUN) 0)
	     ((FREEOF VAR (CAR FUN))
	      (ADD (CAR FUN) (CONSTERM (CDR FUN) VAR)))
	     (T (CONSTERM (CDR FUN) VAR))))

(DEFUN PREVCONSTEXPAN (FUN VAR) 
       (COND ((ATOM FUN) FUN)
	     ((EQ (CAAR FUN) 'MPLUS)
	      (COND ((AND (FREEOF VAR FUN)
			  (NOT (INSIDE FUN 'MEXPT)))
		     (LIST '(MQUOTE) FUN))
		    ((AND (FREEOF VAR FUN) (INSIDE FUN 'MEXPT))
		     (LIST '(MQUOTE)
			   (DISTRINPLUSPREV (CDR FUN) VAR)))
		    ((INSIDE FUN 'MEXPT)
		     (DISTRINPLUSPREV (CDR FUN) VAR))
		    (T FUN)))
	     ((EQ (CAAR FUN) 'MTIMES)
	      (DISTRINTIMESPREV (CDR FUN) VAR))
	     ((AND (NOT (INSIDE (CDR FUN) VAR))
		   (EQ (CAAR FUN) 'MEXPT))
	      (POWER (PREVCONSTEXPAN (CADR FUN) VAR) (CADDR FUN)))
	     (T FUN)))

(DEFUN DISTRINPLUSPREV (FUN VAR) 
       (COND ((NULL FUN) 0)
	     (T (ADD (PREVCONSTEXPAN (CAR FUN) VAR)
		     (DISTRINPLUSPREV (CDR FUN) VAR))))) 

(DEFUN DISTRINTIMESPREV (FUN VAR) 
       (COND ((NULL FUN) 1)
	     (T (MUL (PREVCONSTEXPAN (CAR FUN) VAR)
		     (DISTRINTIMESPREV (CDR FUN) VAR))))) 

(DEFUN INSIDE (FUN ARG)
       (COND ((ATOM FUN)(EQUAL FUN ARG)) 
	     ((INSIDE (CAR FUN) ARG) T)
	     (T (INSIDE (CDR FUN) ARG))))

(DEFUN UNQUOTE (FUN) 
       (COND ((NOT (INSIDE FUN 'MQUOTE)) FUN)
	     (T (UNQUOTE (MEVAL FUN)))))

(DEFUN CHECKSIGNTM (EXPR)
       (PROG (ASLIST QUEST ZEROSIGNTEST PRODUCTCASE)
	     (SETQ ASLIST CHECKCOEFSIGNLIST)
	     (COND ((ATOM EXPR) (GO LOOP)))
	     (COND ((EQ (CAAR EXPR) 'MTIMES)(SETQ PRODUCTCASE T)))
	LOOP (COND ((NULL ASLIST)
		    (SETQ CHECKCOEFSIGNLIST
			  (APPEND CHECKCOEFSIGNLIST
				  (LIST (CONS EXPR
					      (LIST
					       (SETQ QUEST (CHECKFLAGANDACT EXPR)))))))
		    (RETURN QUEST)))
	     (COND ((EQUAL (CAAR ASLIST) EXPR) (RETURN (CADAR ASLIST))))
	     (SETQ ASLIST (CDR ASLIST))
	     (GO LOOP)))

(DEFUN CHECKFLAGANDACT (EXPR)
       (COND (PRODUCTCASE
	      (SETQ PRODUCTCASE NIL)
	      (FINDSIGNOFTHEIRPRODUCT (FINDSIGNOFACTORS (CDR EXPR))))
	     (T (ASKSIGN ($REALPART EXPR)))))

(DEFUN FINDSIGNOFACTORS (LISTOFACTORS)
       (COND ((NULL LISTOFACTORS) NIL)
	     ((EQ ZEROSIGNTEST '$ZERO) '$ZERO)
	     (T (APPEND (LIST (SETQ ZEROSIGNTEST (CHECKSIGNTM (CAR LISTOFACTORS))))
			(FINDSIGNOFACTORS (CDR LISTOFACTORS))))))

(DEFUN FINDSIGNOFTHEIRPRODUCT (LLIST)
       (PROG (SIGN)
	     (COND ((EQ LLIST '$ZERO) (RETURN '$ZERO)))
	     (SETQ SIGN '$POSITIVE)
	LOOP (COND ((NULL LLIST) (RETURN SIGN)))
	     (COND ((EQ (CAR LLIST) '$POSITIVE)
		    (SETQ LLIST (CDR LLIST))
		    (GO LOOP)))
	     (COND ((EQ (CAR LLIST) '$NEGATIVE)
		    (SETQ SIGN (CHANGESIGN SIGN) LLIST (CDR LLIST))
		    (GO LOOP)))
	     (RETURN '$ZERO)))

(DEFUN CHANGESIGN (SIGN)
       (COND ((EQ SIGN '$POSITIVE) '$NEGATIVE)
	     (T '$POSITIVE)))

(DEFUN DEN1 (C B A X)
       ((LAMBDA (EXPO EXPR)
		(PROG (SIGNDISCRIM SIGNC SIGNB)
		      (SETQ SIGNC (CHECKSIGNTM (POWER C -1)))
		      (SETQ SIGNB (CHECKSIGNTM (POWER B 2)))
		      (SETQ SIGNDISCRIM (SIGNDIS2 C B A SIGNC SIGNB))
		      (COND ((AND (EQ SIGNC '$POSITIVE)
				  (EQ SIGNDISCRIM '$NEGATIVE))
			     (RETURN (AUGMULT (MUL* (POWER  C EXPO)
						    (LIST '(%ASINH)
							  (MUL EXPR
							       (POWER (ADD (MUL 4 C A)
									   (MUL -1 B B))
							    EXPO))))))))
		      (COND ((AND (EQ SIGNC '$POSITIVE)
				  (EQ SIGNDISCRIM '$ZERO))
			    (RETURN (AUGMULT (MUL* (POWER -1 EXPR)
						   (POWER C EXPO)
						   (LIST '(%LOG) EXPR))))))
		     (COND ((EQ SIGNC '$POSITIVE)
			    (RETURN (AUGMULT (MUL* (POWER C EXPO)
						   (LIST '(%LOG)
							 (ADD (MUL 2
								   (POWER C R12)
								   (POWER
								    (POLFOO C B
									   A X)
								    R12))
							      EXPR)))))))
		     (COND ((AND (EQ SIGNC '$NEGATIVE)
				 (EQ SIGNDISCRIM '$POSITIVE))
			    (RETURN (AUGMULT (MUL* -1
						   (POWER (MUL -1 C) EXPO)
						   (LIST '(%ASIN)
							 (MUL EXPR
							      (POWER (ADD (MUL B B)
									  (MUL -4 C A))
								     EXPO))))))))
		     (COND ((EQ SIGNC '$NEGATIVE)
			    (RETURN (AUGMULT (MUL (POWER -1 EXPO)
						  (DEN1 (MUL -1 C)
							(MUL -1 B)
							(MUL -1 A)
							X))))))))
	(LIST '(RAT) -1 2) (ADD (MUL 2 C X) B))) 

(DEFUN SIGNDISCR (C B A) 
       (CHECKSIGNTM (SIMPLIFYA (ADD (POWER B 2)
				    (MUL -4 C A))
			       NIL)))

(DEFUN ASKINVER (A)
       (CHECKSIGNTM (POWER A -1)))

(DEFUN SIGNDIS1 (C B A)
       (COND ((EQUAL (MUL B A) 0)
	      (COND ((AND (EQUAL B 0)(EQUAL A 0)) '$ZERO)
		    (T '$NONZERO)))
	     (T (CHECKSIGNTM (POWER (ADD (MUL B B) (MUL -4 C A)) 2)))))

(DEFUN SIGNDIS2 (C B A SIGNC SIGNB)
       (COND ((EQUAL SIGNB '$ZERO)
	      (COND ((EQUAL A 0) '$ZERO)
		    (T ((LAMBDA (ASKINV)
				(COND ((OR (AND (EQ SIGNC '$POSITIVE)
						(EQ ASKINV '$NEGATIVE))
					   (AND (EQ SIGNC '$NEGATIVE)
						(EQ ASKINV '$POSITIVE)))
				       '$POSITIVE)
				      (T '$NEGATIVE)))
			(ASKINVER A)))))
	     (T (COND ((EQUAL A 0) '$POSITIVE)
		      (T (SIGNDISCR C B A))))))

(DEFUN SIGNDIS3 (C B A SIGNA)
       (COND ((EQUAL B 0)
	      (COND ((EQUAL (CHECKSIGNTM EC-1) SIGNA) '$NEGATIVE)
		    (T '$POSITIVE)))
	     (T (SIGNDISCR C B A))))

(DEFUN NUMMNUMN (POSZPOWLIST PLUSPOWFO1 P C B A X) 
       ((LAMBDA (EXPR EXPO EX)
		(PROG (RESULT CONTROLPOW COEF COUNT RES1 RES2 M PARTRES)
		      (SETQ RESULT 0 CONTROLPOW (CAAR POSZPOWLIST)
			    COEF (CADAR POSZPOWLIST))
		      (COND ((ZEROP CONTROLPOW)
			     (SETQ RESULT (AUGMULT (MUL COEF (NUMN PLUSPOWFO1 C B A X)))
				   COUNT 1)
			     (GO LOOP)))
		JUMP1 (SETQ RES1 (ADD (AUGMULT (MUL EXPR EXPO
						    (POWER (PLUS P P 1) -1)))
				      (AUGMULT (MUL -1 B R12 EXPO
					       (NUMN PLUSPOWFO1 C B A X)))))
		      (COND ((EQUAL CONTROLPOW 1)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES1)))
				   COUNT 2)
			     (GO LOOP)))
		JUMP2 (SETQ RES2 (ADD (AUGMULT (MUL* X EXPR EXPO
						     (INV (PLUS P P 2))))
				      (AUGMULT (MUL* B (PLUS P P 3)
						     (LIST '(RAT) -1 4)
						     EX
						     (INV (PLUS P P P 1
								(TIMES P P)
								(TIMES P P)))
						     EXPR))
				      (AUGMULT (MUL (INV (PLUS P 1))
						    EX
						    (LIST '(RAT) 1 8.)
						    (ADD (MUL (POWER B 2)
							      (PLUS P P 3))
							 (MUL -4 A C))
						    (NUMN PLUSPOWFO1 C B A X)))))
		      (COND ((EQUAL CONTROLPOW 2)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES2)))
				   COUNT 3)
			     (GO LOOP)))
		JUMP3 (SETQ COUNT 4 M 3)
		JUMP  (SETQ PARTRES
			    ((LAMBDA (PRO)
				     (ADD (AUGMULT (MUL (POWER X (PLUS M -1))
							EXPR EXPO PRO))
					  (AUGMULT (MUL -1 B (PLUS P P M M -1)
							R12 EXPO PRO RES2))
					  (AUGMULT (MUL -1 A (PLUS M -1)
							EXPO PRO RES1))))
			     (POWER (PLUS M P P) -1)))
		      (SETQ M (PLUS  M 1))
		      (COND ((GREATERP M CONTROLPOW)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF PARTRES))))
			     (GO LOOP)))
		JUMP4 (SETQ RES1 RES2 RES2 PARTRES)
		      (GO JUMP)
		LOOP  (SETQ POSZPOWLIST (CDR POSZPOWLIST))
		      (COND ((NULL POSZPOWLIST) (RETURN RESULT)))
		      (SETQ COEF (CADAR POSZPOWLIST))
		      (SETQ CONTROLPOW (CAAR POSZPOWLIST))
		      (COND ((EQUAL COUNT 4) (GO JUMP4)))
		      (COND ((EQUAL COUNT 1) (GO JUMP1)))
		      (COND ((EQUAL COUNT 2) (GO JUMP2)))
		      (GO JUMP3)))
	(POWER (POLFOO C B A X) (ADD P R12)) EC-1 (POWER C -2)))

(DEFUN NUMN (P C B A X)
       ((LAMBDA (EXP1 EXP2 EXP3 EXP4 EXP5) 
		(COND ((ZEROP P) (ADD (AUGMULT (MUL (LIST '(RAT) 1 4) EXP1
						    EXP2 (POWER (POLFOO C B A X) EXP3)))
				      (AUGMULT (MUL (LIST '(RAT) 1 8) EXP1 EXP4 
						    (DEN1 C B A X)))))
		      (T (ADD (AUGMULT (MUL (LIST '(RAT) 1 4) EXP1 EXP5 EXP2
					    (POWER (POLFOO C B A X) (ADD P EXP3))))
			      (AUGMULT (MUL (LIST '(RAT) 1 8) EXP1 EXP5 (PLUS P P 1)
					    EXP4 (NUMN (PLUS P -1) C B A X)))))))
	EC-1 (ADD B (MUL 2 C X)) R12
	(ADD (MUL 4 A C) (MUL -1 B B)) (LIST '(RAT) 1 (PLUS P 1))))

(DEFUN AUGMULT (X)
       ($MULTTHRU (SIMPLIFYA X NIL))) 
 
(DEFUN DENMDENN (NEGPOWLIST P C B A X)
       ((LAMBDA (EXP1)
		(PROG (RESULT CONTROLPOW COEF COUNT RES1 RES2 M PARTRES SIGNA EA-1)
		      (SETQ SIGNA (CHECKSIGNTM (SIMPLIFYA A NIL)))
		      (COND ((EQ SIGNA '$ZERO)
			     (RETURN (NOCONSTQUAD NEGPOWLIST P C B X))))
		      (SETQ RESULT 0 CONTROLPOW (CAAR NEGPOWLIST) EA-1 (POWER A -1))
		      (SETQ COEF (CADAR NEGPOWLIST))
		      (COND ((ZEROP CONTROLPOW)
			     (SETQ RESULT (AUGMULT  (MUL COEF (DENN P C B A X)))
				   COUNT 1)
			     (GO LOOP)))
		JUMP1 (SETQ RES1 (DEN1DENN P C B A X))
		      (COND ((EQUAL CONTROLPOW 1)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES1)))
				   COUNT 2)
			     (GO LOOP)))
		JUMP2 (SETQ RES2 (ADD (AUGMULT (MUL -1 EA-1 (POWER X -1) EXP1))
				      (AUGMULT (MUL -1 B (PLUS 1 P P) R12
						    EA-1 (DEN1DENN P C B A X)))
				      (AUGMULT (MUL -2 P C EA-1 (DENN P C B A X)))))
		      (COND ((EQUAL CONTROLPOW 2)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES2)))
				   COUNT 3)
			     (GO LOOP)))
		JUMP3 (SETQ COUNT 4 M 3)
		JUMP  (SETQ PARTRES
			    ((LAMBDA (EXP2)
				     (ADD (AUGMULT (MUL EXP2 EA-1
							(POWER X (PLUS 1 (TIMES -1 M)))
							EXP1))
					  (AUGMULT (MUL B (PLUS P P M M -3) R12
							EA-1 EXP2 RES2))
					  (AUGMULT (MUL C EA-1 EXP2
							(PLUS P P M -2) RES1))))
			     (SIMPLIFYA (LIST '(RAT) -1 (PLUS M -1)) NIL)))
		      (SETQ M (PLUS M 1))
		      (COND ((GREATERP M CONTROLPOW)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF PARTRES))))
			     (GO LOOP)))
		JUMP4 (SETQ RES1 RES2 RES2 PARTRES)
		      (GO JUMP)
		LOOP  (SETQ NEGPOWLIST (CDR NEGPOWLIST))
		      (COND ((NULL NEGPOWLIST) (RETURN RESULT)))
		      (SETQ COEF (CADAR NEGPOWLIST)
			    CONTROLPOW (CAAR NEGPOWLIST))
		      (COND ((EQUAL COUNT 4) (GO JUMP4)))
		      (COND ((EQUAL COUNT 1) (GO JUMP1)))
		      (COND ((EQUAL COUNT 2) (GO JUMP2)))
		      (GO JUMP3)))
	(POWER (POLFOO C B A X) (ADD R12 (TIMES -1 P)))))

(DEFUN DENN (P C B A X)
       ((LAMBDA (SIGNDISC EXP1 EXP2 EXP3)
		(COND ((AND (EQ SIGNDISC '$ZERO)(ZEROP P))
		       (AUGMULT (MUL* EC-1
				      (LIST '(%LOG) (ADD X (MUL B R12  EC-1 ))))))
		      ((AND (EQ SIGNDISC '$ZERO)(GREATERP P 0))
		       (AUGMULT (MUL* (LIST '(RAT) -1 (PLUS P P))
				      (POWER C (MUL (LIST '(RAT) -1 2)
						    (PLUS P P 1)))
				      (POWER (ADD X (MUL B R12  EC-1 ))
					     (TIMES -2 P)))))
		      ((ZEROP P) (DEN1 C B A X))
		      ((EQUAL P 1)
		       (AUGMULT (MUL 2 EXP1 EXP2 (POWER (POLFOO C B A X)
							(LIST '(RAT) -1 2)))))
		      (T (ADD (AUGMULT (MUL 2 EXP1 EXP3 EXP2
					    (POWER (POLFOO C B A X)
						   (ADD R12 (TIMES -1 P)))))
			      (AUGMULT (MUL 8 C (PLUS P -1) EXP3 EXP2
					    (DENN (PLUS P -1) C B A X)))))))
	(SIGNDIS1 C B A) (ADD B (MUL 2 C X))
	(POWER (ADD (MUL 4 A C)(MUL B B -1)) -1) (INV (PLUS P P -1))))

(DEFUN DEN1DENN (P C B A X)
       ((LAMBDA (SIGNA EA-1)
		(COND ((EQ SIGNA '$ZERO)(NOCONSTQUAD 1 P C B X))
		      ((ZEROP P) (DEN1DEN1 C B A X))
		      (T (ADD (AUGMULT (MUL (INV (PLUS P P -1)) EA-1
					    (POWER (POLFOO C B A X)
						   (ADD R12 (TIMES -1 P)))))
			      (AUGMULT (MUL EA-1 (DEN1DENN (PLUS P -1) C B A X)))
			      (AUGMULT (MUL -1 R12 EA-1 B (DENN P C B A X)))))))
	(CHECKSIGNTM (POWER A 2))
	(POWER A -1)))

(DEFUN DEN1DEN1 (C B A X)
       ((LAMBDA (EXP2 EXP3 EXP4)
		(PROG (SIGNDISCRIM CONDITION SIGNA EXP1)
		      (SETQ SIGNA (CHECKSIGNTM (SIMPLIFYA A NIL)))
		      (SETQ CONDITION  (ADD (MUL B X) A A))
		      (COND ((EQ SIGNA '$ZERO)
			     (RETURN (NOCONSTQUAD '((1 1)) 0 C B X))))
		      (SETQ SIGNDISCRIM (SIGNDIS3 C B A SIGNA)
			    EXP1 (POWER A (INV -2)))
		      (COND ((AND (EQ SIGNA '$POSITIVE)
				  (EQ SIGNDISCRIM '$NEGATIVE))
			     (RETURN (MUL* -1 EXP1
					   (LIST '(%ASINH)
						 (AUGMULT (MUL EXP2 EXP3
							       (POWER (ADD (MUL 4 A C)
									   (MUL -1 B B))
								      EXP4))))))))
		      (COND ((AND (EQ SIGNDISCRIM '$ZERO)
				  (EQ SIGNA '$POSITIVE))
			     (RETURN (MUL* (POWER -1 CONDITION) -1 EXP1
					   (LIST '(%LOG)
						 (AUGMULT (MUL EXP3 EXP2)))))))
		      (COND ((EQ SIGNA '$POSITIVE)
			     (RETURN (MUL* -1 EXP1
					   (LIST '(%LOG)
						 (ADD B (MUL 2 A EXP3)
						      (MUL 2 EXP3
							   (POWER A R12)
							   (POWER (POLFOO C B A X)
								  R12))))))))
		      (COND ((AND (EQ SIGNA '$NEGATIVE)
				  (EQ SIGNDISCRIM '$POSITIVE))
			     (RETURN (MUL* (POWER (MUL -1 A) EXP4)
					   (LIST '(%ASIN)
						 (AUGMULT (MUL EXP2 EXP3
							       (POWER (ADD (MUL B B)
									   (MUL -4 A C))
								      EXP4))))))))
		      (RETURN (MUL -1 (POWER -1 R12)
				   (DEN1DEN1 (MUL -1 C) (MUL -1 B) (MUL -1 A) X)))))
	(ADD (MUL B X) A A) (POWER (LIST '(MABS) X) -1) (LIST '(RAT) -1 2)))
 
(DEFUN NOCONSTQUAD (NEGPOWLIST P C B X)
       ((LAMBDA (EXP1 EXP2 EXP3)
		(PROG (RESULT CONTROLPOW COEF COUNT RES1 SIGNB M PARTRES EB-1)
		      (SETQ SIGNB (CHECKSIGNTM (POWER B 2)))
		      (COND ((EQ SIGNB '$ZERO)
			     (RETURN (TRIVIAL1 NEGPOWLIST P C X))))
		      (SETQ RESULT 0 CONTROLPOW (CAAR NEGPOWLIST)
			    COEF (CADAR NEGPOWLIST) EB-1 (INV B))
		      (COND ((ZEROP CONTROLPOW)
			     (SETQ RESULT (AUGMULT (MUL COEF (DENN P C B 0 X)))
				   COUNT 1)
			     (GO LOOP)))
		JUMP1 (SETQ RES1 (ADD (AUGMULT (MUL -2 EXP1 EB-1 EXP2
						    (POWER (POLFOO C B 0 X)
							   (ADD R12 EXP3))))
				 (AUGMULT (MUL -4 P C EXP1 EB-1 (DENN P C B 0 X)))))
		      (COND ((EQUAL CONTROLPOW 1)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES1)))
				   COUNT 2)
			     (GO LOOP)))
		JUMP2 (SETQ COUNT 3 M 2)
		JUMP  (SETQ PARTRES (ADD (AUGMULT (MUL -2 (INV (PLUS P P M M -1))
						       EB-1
						       (POWER X	(MUL -1 M))
						       (POWER (POLFOO C B 0 X)
							      (ADD R12 EXP3))))
					 (AUGMULT (MUL -2 C (PLUS P P M -1)
					       EB-1 (INV (PLUS P P M M -1)) RES1))))
		      (SETQ M (PLUS M 1))
		      (COND ((GREATERP M CONTROLPOW)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF PARTRES))))
			     (GO LOOP)))
		JUMP3 (SETQ RES1 PARTRES)
		      (GO JUMP)
		LOOP  (SETQ NEGPOWLIST (CDR NEGPOWLIST))
		      (COND ((NULL NEGPOWLIST) (RETURN RESULT)))
		      (SETQ COEF (CADAR NEGPOWLIST)
			    CONTROLPOW (CAAR NEGPOWLIST))
		      (COND ((EQUAL COUNT 3) (GO JUMP3)))
		      (COND ((EQUAL COUNT 1) (GO JUMP1)))
		      (GO JUMP2)))
	(INV (PLUS P P 1)) (POWER X -1) (TIMES -1 P)))

(DEFUN TRIVIAL1 (NEGPOWLIST P C X)
       (COND ((NULL NEGPOWLIST) 0)
	     (T (ADD (AUGMULT (MUL (POWER X
					  (ADD (TIMES -2 P)
					       (MUL -1
						    (CAAR NEGPOWLIST))))
				   (CADAR NEGPOWLIST)
				   (POWER C
					  (ADD (TIMES -1 P)
					       (LIST '(RAT) -1 2)))
				   (INV (ADD (TIMES -2 P)
					     (MUL -1 (CAAR NEGPOWLIST))))))
		     (TRIVIAL1 (CDR NEGPOWLIST) P C X)))))

(DEFUN NUMMDENN (POSZPOWLIST P C B A X)
       ((LAMBDA (EXP1 EXP2 EXP3 EXP4 EXP5 EXP6 EXP7)
		(PROG (RESULT CONTROLPOW COEF COUNT RES1 RES2 M PARTRES SIGNDISCRIM)
		      (SETQ RESULT 0 CONTROLPOW (CAAR POSZPOWLIST))
		      (SETQ COEF (CADAR POSZPOWLIST) SIGNDISCRIM (SIGNDIS1 C B A))
		      (COND ((ZEROP CONTROLPOW)
			     (SETQ RESULT (AUGMULT (MUL COEF  (DENN P C B A X)))
				   COUNT 1)
			     (GO LOOP)))
		JUMP1 (SETQ RES1
			    (ADD (AUGMULT (MUL -1  EC-1 EXP1 EXP2))
				 (AUGMULT (MUL B (LIST '(RAT) -1 2)
					       EC-1 (DENN P C B A X)))))
		      (COND ((EQUAL CONTROLPOW 1)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES1)))
				   COUNT 2)
			     (GO LOOP)))
		JUMP2 (COND ((AND (GREATERP P 0)
				  (NOT (EQ SIGNDISCRIM '$ZERO)))
			     (SETQ RES2
				   (ADD (AUGMULT (MUL EC-1 EXP1 EXP3 EXP2
						      (ADD (MUL 2 A B)
							   (MUL 2 B B X)
							   (MUL -4 A C X))))
					(AUGMULT (MUL EC-1 EXP3 EXP1
						      (ADD (MUL 4 A C)
							   (MUL 2 B B P)
							   (MUL -3 B B))
						      (DENN (PLUS P -1)
							    C B A X)))))))
		      (COND ((AND (EQUAL P 0)
				  (NOT (EQ SIGNDISCRIM '$ZERO)))
			     (SETQ RES2
				   (ADD (AUGMULT (MUL (LIST '(RAT) 1 4)
						      EXP5
						      (ADD (MUL 2 C X)
							   (MUL -3 B))
						      (POWER (POLFOO C B A X)
							     R12)))
					(AUGMULT (MUL (LIST '(RAT) 1 8)
						      EXP5
						      (ADD (MUL 3 B B)
							   (MUL -4 A C))
						      (DEN1 C B A X)))))))
		      (COND ((AND (EQUAL P 0)(EQ SIGNDISCRIM '$ZERO))
			     (SETQ RES2
				   (ADD (AUGMULT (MUL* B B (LIST '(RAT) 1 4)
						       (POWER C -3)
						       (LIST '(%LOG) EXP4)))
					(AUGMULT (MUL EC-1 R12 (POWER EXP4 2)))
					(AUGMULT (MUL -1 B X EXP5))))))
		      (COND ((AND (EQUAL P 1) (EQ SIGNDISCRIM '$ZERO))
			     (SETQ RES2
				   (ADD (AUGMULT (MUL* EC-1 (LIST '(%LOG) EXP4)))
					(AUGMULT (MUL B EXP5 (POWER EXP4 -1)))
					(AUGMULT (MUL (LIST '(RAT) -1 8)
						      (POWER C -3)
						      B B (POWER EXP4 -2)))))))
		      (COND ((AND (EQ SIGNDISCRIM '$ZERO)(GREATERP P 1))
			     (SETQ RES2
				   (ADD (AUGMULT (MUL EC-1 (POWER EXP4 EXP6)
						      (INV EXP6)))
					(AUGMULT (MUL -1 B EXP5 (INV EXP7)
						      (POWER EXP4 EXP7)))
					(AUGMULT (MUL B B (LIST '(RAT) -1 8)
						      (POWER C -3)
						      (INV P)
						      (POWER EXP4
							     (TIMES -2 P))))))))
		      (COND ((EQUAL CONTROLPOW 2)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES2)))
				   COUNT 3)
			     (GO LOOP)))
		JUMP3 (SETQ COUNT 4 M 3)
		JUMP  (SETQ PARTRES
			    ((LAMBDA (DENOM PM-1)
				     (ADD (AUGMULT (MUL* (POWER X PM-1)
							 EC-1 (LIST '(RAT) -1 DENOM)
							 (POWER (POLFOO C B A X)
								(ADD R12
								     (TIMES -1 P)))))
					  (AUGMULT (MUL B (PLUS P P 1 (TIMES -2 M))
							(LIST '(RAT) -1 2)
							EC-1 (INV DENOM) RES2))
					  (AUGMULT (MUL A PM-1 EC-1 (INV DENOM) RES1))))
			     (PLUS P P (TIMES -1 M))
			     (PLUS M -1)))
		ON    (SETQ M (PLUS M 1))
		      (COND ((GREATERP M CONTROLPOW)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF PARTRES))))
			     (GO LOOP)))
		JUMP4 (SETQ RES1 RES2 RES2 PARTRES)
		      (COND ((EQUAL M (PLUS  P P))
			     (SETQ PARTRES
				   ((LAMBDA (EXPR)
					    (ADD (MUL X EXPR)
						 (MUL -1 (DISTRINT (CDR ($EXPAND EXPR))
								   X))))
				    (NUMMDENN (LIST (LIST (PLUS M -1) 1))
					      P C B A X)))
			     (GO ON)))
		      (GO JUMP)
		LOOP  (SETQ POSZPOWLIST (CDR POSZPOWLIST))
		      (COND ((NULL POSZPOWLIST) (RETURN RESULT)))
		      (SETQ COEF (CADAR POSZPOWLIST) CONTROLPOW (CAAR POSZPOWLIST))
		      (COND ((EQUAL COUNT 4) (GO JUMP4)))
		      (COND ((EQUAL COUNT 1) (GO JUMP1)))
		      (COND ((EQUAL COUNT 2) (GO JUMP2)))
		      (GO JUMP3)))
	(INV (PLUS P P -1)) (POWER (POLFOO C B A X) (ADD R12 (TIMES -1 P)))
	(POWER (ADD (MUL 4 A C)(MUL -1 B B)) -1) (ADD X (MUL B R12 EC-1))
	(POWER C -2) (PLUS 2 (TIMES -2 P)) (PLUS 1 (TIMES -2 P))))

(DEFUN DENMNUMN (NEGPOWLIST POW C B A X)
       ((LAMBDA (EXP1 EXP2)
		(PROG (RESULT CONTROLPOW P COEF COUNT RES1 RES2 M
			      PARTRES SIGNA EA-1)
		      (SETQ P (PLUS POW POW -1))
		      (COND ((EQ (CAR NEGPOWLIST) 'T)
			     (SETQ NEGPOWLIST (CDR NEGPOWLIST))
			     (GO THERE)))
		      (SETQ SIGNA (CHECKSIGNTM (POWER A 2)))
		      (COND ((EQ SIGNA '$ZERO)
			     (RETURN (NONCONSTQUADENUM NEGPOWLIST P C B X))))
		      (SETQ EA-1 (INV A))
		THERE (SETQ RESULT 0 CONTROLPOW (CAAR NEGPOWLIST)
			    COEF (CADAR NEGPOWLIST))
		      (COND ((ZEROP CONTROLPOW)
			     (SETQ RESULT (AUGMULT (MUL COEF
							(NUMN (ADD (MUL P R12) R12)
							      C B A X)))
				   COUNT 1)
			     (GO LOOP)))
		JUMP1 (SETQ RES1 (DEN1NUMN POW C B A X))
		      (COND ((EQUAL CONTROLPOW 1)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES1)))
				   COUNT 2)
			     (GO LOOP)))
		JUMP2 (COND ((NOT (EQUAL P 1))
			     (SETQ RES2 (ADD (AUGMULT (MUL -1 EXP1
							   (POWER (POLFOO C B A X)
								  (ADD POW
								       (LIST '(RAT) -1 2)))))
					     (AUGMULT (MUL B (LIST '(RAT) EXP2 2)
							   (DEN1NUMN (PLUS POW -1)
								     C B A X)))
					     (AUGMULT (MUL C EXP2 (NUMN (PLUS POW -2)
									C B A X)))))))
		      (COND ((EQUAL P 1)
			     (SETQ RES2 (ADD (AUGMULT (MUL -1 (POWER (POLFOO C B A X)
								     R12)
							   EXP1))
					     (AUGMULT (MUL B R12 (DEN1DEN1 C B A X)))
					     (AUGMULT (MUL C (DEN1 C B A X)))))))
		      (COND ((EQUAL CONTROLPOW 2)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF RES2)))
				   COUNT 3)
			     (GO LOOP)))
		JUMP3 (SETQ COUNT 4 M 3)
		JUMP  (SETQ PARTRES
			    ((LAMBDA (EXP3 EXP4)
				     (ADD (AUGMULT (MUL* (LIST '(RAT) -1 EXP3)
							 EA-1 (POWER X (PLUS 1 EXP4))
							 (POWER (POLFOO C B A X)
								(ADD (LIST '(RAT) P 2)
								     1))))
					  (AUGMULT (MUL (INV (PLUS M M -2))
							EA-1 B (PLUS P 4 (TIMES -2 M))
							RES2))
					  (AUGMULT (MUL C EA-1 (PLUS P 3 EXP4)
							(INV EXP3) RES1))))
			     (PLUS M -1) (TIMES -1 M))
			    M (PLUS M 1))
		      (COND ((GREATERP M CONTROLPOW)
			     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF PARTRES))))
			     (GO LOOP)))
		JUMP4 (SETQ RES1 RES2 RES2 PARTRES)
		      (GO JUMP)
		LOOP  (SETQ NEGPOWLIST (CDR NEGPOWLIST))
		      (COND ((NULL NEGPOWLIST) (RETURN RESULT)))
		      (SETQ COEF (CADAR NEGPOWLIST) CONTROLPOW (CAAR NEGPOWLIST))
		      (COND ((EQUAL COUNT 4) (GO JUMP4)))
		      (COND ((EQUAL COUNT 1) (GO JUMP1)))
		      (COND ((EQUAL COUNT 2) (GO JUMP2)))
		      (GO JUMP3)))
	(POWER X -1) (PLUS POW POW -1)))

(DEFUN NONCONSTQUADENUM (NEGPOWLIST P C B X)
       (PROG (RESULT COEF M)
	     (COND ((EQUAL P 1)(RETURN (CASE1 NEGPOWLIST C B X))))
	     (SETQ RESULT 0)
        LOOP (SETQ M (CAAR NEGPOWLIST) COEF (CADAR NEGPOWLIST))
	     (SETQ RESULT (ADD RESULT (AUGMULT (MUL COEF (CASEGEN M P C B X))))
		   NEGPOWLIST (CDR NEGPOWLIST))
	     (COND ((NULL NEGPOWLIST) (RETURN RESULT)))
	     (GO LOOP)))

(DEFUN CASEGEN (M P C B X)
       ((LAMBDA (EXP1 EXP2 EXP3 EXP4 EXP5)
		(COND ((EQUAL P 1) (CASE1 (LIST (LIST M 1)) C B X))
		      ((ZEROP M) (CASE0 P C B X))
		      ((EQUAL M (PLUS P 1))
		       (ADD (AUGMULT (MUL -1 EXP1 (INV EXP2) EXP3))
			    (AUGMULT (MUL B R12 (CASEGEN EXP2 EXP4 C B X)))
			    (AUGMULT (MUL C (CASEGEN (PLUS M -2) EXP4 C B X)))))
		      ((EQUAL M 1) (ADD (AUGMULT (MUL (INV P) EXP1))
					(AUGMULT (MUL B R12 (CASE0 EXP4 C B X)))))
		      (T (ADD (AUGMULT (MUL -1 EXP1 (INV EXP5) EXP3))
			      (AUGMULT (MUL -1 P B R12 (INV EXP5)
					    (CASEGEN EXP2 EXP4 C B X)))))))
	(POWER (POLFOO C B 0 X)(LIST '(RAT) P 2))
	(PLUS M -1)
	(POWER X (PLUS 1 (TIMES -1 M)))
	(PLUS P -2)
	(PLUS M -1 (TIMES -1 P))))

(DEFUN CASE1 (NEGPOWLIST C B X)
       ((LAMBDA (EXP1 EB-1)
		(PROG (RESULT CONTROLPOW M1 COEF COUNT RES1 RES2 M SIGNC
			      SIGNB PARTRES RES)
		      (SETQ RESULT 0 CONTROLPOW (CAAR NEGPOWLIST)
			    COEF (CADAR NEGPOWLIST) M1 (PLUS CONTROLPOW -2))
		      (COND ((ZEROP CONTROLPOW)
			     (SETQ RESULT (AUGMULT (MUL COEF (CASE0 1 C B X)))
				   COUNT 1)
			     (GO LOOP)))
		JUMP1 (COND ((EQUAL CONTROLPOW 1)
			     (SETQ RESULT
				   (ADD RESULT
					(AUGMULT (MUL COEF (DEN1NUMN 1 C B 0 X))))
				   COUNT 2)
			     (GO LOOP)))
		JUMP2 (COND ((EQUAL CONTROLPOW 2)
			     (SETQ RESULT
				   (ADD RESULT
					(AUGMULT (MUL COEF
						      (DENMNUMN '(T (2 1))
								1 C B 0 X))))
				   COUNT 3)
			     (GO LOOP)))
		JUMP3 (SETQ SIGNB (CHECKSIGNTM (POWER B 2)))
		      (COND ((EQ SIGNB '$ZERO)(SETQ COUNT 5)(GO JUMP5)))
		      (SETQ COUNT 4 M 0 SIGNC (CHECKSIGNTM EC-1))
		      (COND ((EQ SIGNC '$POSITIVE)
			     (SETQ RES
				   (AUGMULT (MUL* 2 EXP1
						  (LIST '(%LOG)
							(ADD (POWER (MUL C X)
								    R12)
							     (POWER (ADD B
									 (MUL C X))
								    R12))))))
			     (GO JUMP4)))
		      (SETQ RES
			    (AUGMULT (MUL* 2 EXP1
					   (LIST '(%ATAN)
						 (POWER (MUL C X
							     (POWER (ADD B
									 (MUL -1 C X))
								    -1))
							R12)))))
		JUMP4 (SETQ M (PLUS M 1)
			    RES (ADD (AUGMULT (MUL -2 (POWER (POLFOO C B 0 X) R12)
						   EB-1 (INV (PMM-1 M))
						   (EXT-1M X M)))
				     (AUGMULT (MUL* (LIST '(RAT) -2 (PMM-1 M))
						    C (SUB1 M)
						    EB-1 RES))))
		      (COND ((EQUAL M M1) (SETQ RES2 RES) (GO JUMP4)))
		      (COND ((EQUAL (SUB1 M) M1)
			     (IF (NULL RES2) (RETURN NIL))
			     (SETQ RES1 RES
				   PARTRES (ADD (AUGMULT (MUL -1
							      (POWER (POLFOO C B 0 X)
								     R12)
							      (R1M M)
							      (EXT-1M X M)))
						(AUGMULT (MUL B R12 (R1M M) RES1))
						(AUGMULT (MUL C (R1M M) RES2))))
			     (GO ON)))
		      (GO JUMP4)
		JUMP5 (SETQ M CONTROLPOW)
		      (COND ((ZEROP M)
			     (SETQ PARTRES (MUL* EXP1 (LIST '(%LOG) X)))
			     (GO ON)))
		      (SETQ PARTRES (MUL -1 EXP1 (EXT-1M X M) (R1M M)))
		ON    (SETQ RESULT (ADD RESULT  (AUGMULT (MUL COEF PARTRES))))
		LOOP  (SETQ NEGPOWLIST (CDR NEGPOWLIST))
		      (COND ((NULL NEGPOWLIST) (RETURN RESULT)))
		      (SETQ COEF (CADAR NEGPOWLIST) CONTROLPOW (CAAR NEGPOWLIST))
		      (COND ((EQUAL COUNT 5) (GO JUMP5)))
		      (COND ((EQUAL COUNT 1) (GO JUMP1)))
		      (COND ((EQUAL COUNT 2) (GO JUMP2)))
		      (COND ((EQUAL COUNT 3) (GO JUMP3)))
		      (SETQ M1 (PLUS CONTROLPOW -2))
		      (COND ((EQUAL M1 M) (SETQ RES2 RES1)))
		      (GO JUMP4)))
	(POWER C (LIST '(RAT) -1 2)) (POWER B -1)))

(DEFUN PMM-1 (M) (PLUS M M -1))

(DEFUN R1M (M) (LIST '(RAT) 1 M))

(DEFUN EXT-1M (X M) (POWER X (TIMES -1 M))) 

(DEFUN CASE0 (POWER C B X)
       ((LAMBDA (EXP1 EXP2 EXP3 EXP4 EB-1)
		(PROG (SIGNC P RESULT)
		      (SETQ SIGNC (CHECKSIGNTM EC-1) P 1)
		      (COND ((EQ SIGNC '$POSITIVE)
			     (SETQ RESULT
				   (ADD (AUGMULT (MUL EXP1 EC-1 EXP2
						      (POWER (POLFOO C B 0 X)
							     R12)))
					(AUGMULT (MUL* B B (LIST '(RAT) -1 8)
						       EXP3
						       (LIST '(%LOG)
							     (ADD EXP2
								  (MUL 2
								       (POWER C R12)
								       (POWER
									(POLFOO C B 0 X)
									R12))))))))))
		      (COND ((EQ SIGNC '$NEGATIVE)
			     (SETQ RESULT
				   (ADD (AUGMULT (MUL EXP1 EC-1 EXP4
						      (POWER (POLFOO (MUL -1 C)
								     B 0 X)
							     R12)))
					(AUGMULT (MUL* B B (LIST '(RAT) 1 8)
						       EXP3
						       (LIST '(%ASIN)
							     (MUL EB-1 EXP4))))))))
		LOOP  (COND ((EQUAL POWER P) (RETURN RESULT)))
		      (SETQ P (PLUS P 2)
			    RESULT ((LAMBDA (EXP5)
					    (ADD (AUGMULT (MUL R12 EC-1 EXP5 EXP2
							       (POWER (POLFOO C B 0 X)
								      (LIST '(RAT) P 2))))
						 (AUGMULT (MUL P B B (LIST '(RAT) -1 4)
							       EC-1 EXP5 RESULT))))
				    (INV (PLUS P 1))))
		      (GO LOOP)))
	(LIST '(RAT) 1 4) (ADD B (MUL 2 C X)) (POWER C (LIST '(RAT) -3 2))
	(ADD (MUL 2 C X)(MUL -1 B)) (POWER B -1)))

(DEFUN DEN1NUMN (P C B A X)
       (COND ((EQUAL P 1)
	      (ADD (POWER (POLFOO C B A X) R12 )
		   (AUGMULT (MUL A (DEN1DEN1 C B A X)))
		   (AUGMULT (MUL B R12 (DEN1 C B A X)))))
	     (T (ADD (AUGMULT (MUL (POWER (POLFOO C B A X)
					  (ADD P (LIST '(RAT) -1 2)))
				   (INV (PLUS P P -1))))
		     (AUGMULT (MUL A (DEN1NUMN (PLUS P -1) C B A X)))
		     (AUGMULT (MUL B R12 (NUMN (PLUS P -2) C B A X)))))))

(DEFUN DISTRINT (EXPR X)
       (COND ((NULL EXPR) 0)
	     (T (ADD (INTIRA (CAR EXPR) X)
		     (DISTRINT (CDR EXPR) X)))))