mv lus1log lus1log~
/usr/local/matte/bergman/Newbergman/bergman <<%EOF >lus1log &  
%(SET-HEAP-SIZE 1600000)
(system "echo Running on $HOST")         
(load pbseries hseries)
(OFF RAISE)(OFF USERMODE)(LAPIN "../src/macros.sl")(LAPIN "../src/hmacro.sl")
(SETQ calm '((NIL 2 1 0 0 0) (NIL 0 2 0 1 0) (NIL 0 1 1 0 0) (NIL 0 1 0 0 1)))
%(commHlbSplitCaseSeries1 calm)
(PROG	(mp1 mp2 vd nm ed lm rt1 rt2)
	(SETQ ed (commHlbMonVarNo (commHlbFMon2Mon (CAR calm))))
	(SETQ mp1 calm)

	% First main loop: Find the least positive degree of x;
	% this must be the last non-zero such degree.
  Ml1	(COND ((AND (CDR mp1) (NOT (ZEROP (commHlbFirstInFMon (CADR mp1)))))
	       (SETQ mp1 (CDR mp1))
	       (GO Ml1)))
	(SETQ vd (commHlbFirstInFMon (CAR mp1)))

	% Calculate the series for (calm + x^vd).
	(SETQ nm (LIST (CONS 1 0) (CONS -1 vd)))
	(COND ((NOT (SETQ lm (CDR mp1)))
	       (commHlbNumQuotient1!-t nm)
	       (commHlbLowerVar1InMonId vd calm)
	       (SETQ rt2 (commHlbMonId2HSer1 calm))
	       (commHlbRplacNum rt2 (commHlbNumTimesPower
				       (commHlbNumDenDeg2Num rt2)
				       vd))
	       (RETURN (commHlbAddNumDenDeg2
			  (commHlbNum!&DenDeg2NumDenDeg nm (SUB1 ed))
			  rt2))))
	(SETQ rt1 (commHlbMonId2HSer1 (commHlbPruneVar1Copy lm)))
	(commHlbNumQuotient1!-t (SETQ nm 
				      (commHlbNumTimes2
				         nm
					 (commHlbNumDenDeg2Num rt1))))
	(commHlbRplacNum rt1 nm)

	% Calculate (monid : x^vd), by lowering the x-power of the
	% x-divisible monomials by vd, and by removing the superfluous of
	% the other monomials. 
	(RPLACD mp1 NIL)
	(commHlbLowerVar1InMonId vd (SETQ mp1 calm))
	(SETQ lm (CONS NIL lm))


	% Second main loop: Bypass those new monomials who have
	% positive x-exponents ...
  Ml2	(COND ((NOT (ZEROP (CAR (commHlbFMon2Mon (CAR mp1)))))
	       (SETQ mp1 (CDR mp1))
	       (GO Ml2)))

	% Third main loop: ... and go through the others one by one ...
  Ml3	(SETQ mp2 lm)

	% Subloop: ... eliminating multiples thereof among old monomials.
  Sl	(COND ((commHlbNonMonFactorP (CAR mp1) (CADR mp2))
	       (SETQ mp2 (CDR mp2)))
	      (T
	       (RPLACD mp2 (CDDR mp2))))
	(COND ((CDR mp2)
	       (GO Sl))
	      ((AND (SETQ mp1 (CDR mp1)) (CDR lm))
	       (GO Ml3)))

	% Now ( (input)calm : x^vd) = (modified)calm + Cdr[lm], so
	% we may calculate its Hilbert series (as rt2), multiply it with
	% t^vd, and add it to the other Hilbert series.
	(SETQ rt2 (commHlbMonId2HSer1
		     (COND ((CDR lm) (commHlbMergeMonId2 calm (CDR lm)))
			   (T calm))))			    
	(commHlbRplacNum rt2 (commHlbNumTimesPower (commHlbNumDenDeg2Num rt2)
						   vd))
	(RETURN (commHlbAddNumDenDeg2 rt1 rt2)) )
(INTERPBACKTRACE)
(QUIT)
%EOF
