incr-set prlevel 1
if #0=3 START 
incr-set prlevel -1

;;; Usage:
;;;     <nzd x m mbar
;;;
;;; Test to see whether the linear form 
;;; in the 1x1 matrix x is a nonzerodivisor
;;; on m and set mbar = m/xm OVER THE CURRENT RING 
;;; ( if the base ring of m has n variables, the first
;;; n-1 variables of the current ring are used )
incr-set prlevel 1
jump END
;;;
;;; Parameters:
;;;		x = 1x1 matrix containing a linear form
;;;		m = module
;;; Output values:
;;;		mbar = m/xm as a module over the current ring 
;;; 	The program also prints a message telling whether
;;;		x is a nonzerodivisor on m.
;;;
;;; The program uses the saturation method for finding whether 
;;; x is a nonzerodivisor -- generally cheapest, as it involves only
;;; one standard basis computation, and that in reverse lex order.
;;; The ideal that is printed is actually (0:x*)_m, the set of all
;;; elements of m which are killed by a power of x.

;Last modified 5/7/89 DE 5/14/89 DE
START:

;Get a handle to the current ring:
<getvars rbar@

;Begin by making a change of variables so that x becomes
;the last variable over a new ring s@ whose order is
;reverse lex:

setring #1
<getvars vars@
ncols vars@ number@
ring-from-cols vars@ s@
y[1]-y[number@]

<x_to_last #1 f@ dummy@  ;We don't need the second output of x_to_last here.
ev f@ #2 M1@

;First test to see whether x is a nonzerodivisor on M
;by testing whether sat picks up anything:
std M1@ M1@
sat M1@ N1@ y[number@]
reduce M1@ N1@ zero@

;Report:

;decide whether zero@ is zero:
compress zero@ zero@
ncols zero@ zero@
if zero@ isnt_nzd ;branch if zero@ is nonzero
shout echo #1 is a nonzerodivisor
jump endreport

isnt_nzd:
shout echo #1 is a zerodivisor

endreport:

;Now we want to reduce M mod x.
;To do this, we simply reduce M1@ modulo y[number@]:
submat rbar@ rbar@
	1
	1..(number@-1)
<ideal zero@ 0
concat rbar@ zero@

ev rbar@ M1@ #3

kill vars@ number@ s@ s@'zero f@ M1@ N1@ dummy@
kill zero@ rbar@
END:
incr-set prlevel -1
$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
reset
<ring 4 a-z s
<ring 3 a-z sbar

setring s
;The putative nonzerodivisor:
poly X a+2b+c+d

;An ideal n1 mod which it is a nonzerodivisor:
<ideal n1 ab ac ad bc bd cd

;An ideal n2 mod which it is not a nonzerodivisor:
transpose s s'
mult s' n1 n2
flatten n2 n2

setring sbar    ;TARGET RING MUST BE CURRENT RING
<nzd
<nzd X n1 n1_
type n1_
;nonzerodivisor

<nzd X n2 n2_
type n2_
;zerodivisor

<nzd X s s_
type s_

listvars
