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

;;; Usage:
;;; 	<sat1 I f J
;;;
;;; J = (I:f*) = {g \in F : gf^N \in I, for N >> 0}, where
;;; I is a submodule of the free module F (typically I is an ideal).
incr-set prlevel 1
jump END
;;;
;;; Parameters:
;;;  I = matrix representing a submodule of a free module F
;;;  f = 1x1 matrix, an element of the base ring R of I.
;;;
;;; Output values:
;;;  J = matrix with the same number of rows as I.
;;;
;;; This script uses the method of Bayer's thesis:
;;; 	First set up a ring S with one more variable than
;;; the ring over which I, f are defined.  The new
;;; variable comes last, and reverse lex is used,
;;; so that after computing a standard basis, we can 
;;; conveniently "divide by the highest possible power of z."
;;; We apply this division to the module (IS + (f-z)FS).
;;;
;;; The ring R may be a quotient ring.

; last modified 4/25/89 DE,MS
START:
;Check to see whether f has degree 0.  If so, decide whether f=0 and
;act accordingly:
col-deg #2 1 @degf
if @degf>0 continue
compress #2 @f
ncols @f @test
if @test=0 is_zero
;f is a unit so J:= I
copy #1 #3
jump cleanup_scalar

is_zero:
;f = 0 \in I,  so J:= (1)
<ideal #3 1

cleanup_scalar:
kill @degf @f @test
jump END

continue:
; first create the ring S, whose variables correspond to the variables of
; R, the base ring of I and f, with one more variable adjoined, corresponding
; to f.  The new ring has reverse lex order.

setring #1
<copyring x @R    ; needed to avoid conflicts of variable names

; Compute the degree of f.
col-deg #2 1 @degf
row-deg #2 1 @rowdegf
int @degf @degf-@rowdegf

ring @z
    ;
    1
    z
    @degf
    ;
ring-sum @R @z @S
<copyring z @S

; transport I, f to the new ring S.  The following works because the variables
; corresponding to R come first.
ev @S #1 @I
ev @S #2 @f

nvars @S @zloc
poly @fz {@f}-z[@zloc]
tensor @I @fz @I

; compute the saturation
std @I @I
sat @I @Isat z[@zloc]

; map back to the original ring
setring #1
<getvars @oldvars
concat @oldvars #2
ev @oldvars @Isat #3

kill @R @degf @rowdegf @z @S @I @f @zloc @fz @Isat @oldvars
kill @R'zero @z'zero @S'zero 
END:
incr-set prlevel -1

$;;;;;;;;;;;;;;;;;;;;; EXAMPLES ;;;;;;;;;;;;;;;;;
;; The normalization in A3 of the cuspidal cubic in A2
reset
ring r
    ;
    3
    abx
    2 3 1
    ;
poly g a3-b2
qring g s

poly I ax-b
poly f a

<sat1
set prlevel -1
<sat1 I f J
type J
listvars
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
reset
<ring 1 a r
<ideal I a2
<ideal f 1
<sat1 I f K
type K
;a2

<ideal f 0
<sat1 I f K
type K
;1
listvars
