
incr-set prlevel 1
if #0=4 START
incr-set prlevel -1
;;; Usage:
;;; 	<adjunction1 i s j e
;;;
;;;	i ideal of a smooth surface in P4,
;;;	s coordinate ring of Pr=P(H^0(H+K)),
;;;     j ideal of the adjoint surface
;;;	e ideal of the exceptional divisor, more precisely of the
;;;	  corresponding points in V(j)
;;;     
;;;
incr-set prlevel 1
jump END
;;; Parameters:
;;;
;;; Output values:
;;;
;;; (discussion) 
;;;              
;;;
;;; Caveats: It assumes the surface to be regular (q=0) and
;;;          the adjunction morphism birational. Moreover,
;;;          the image of the adjunction morphism is assumed to be
;;;          cut out by quadrics (which usualy happens for deg >>0).
;;;	     To achieve more generality, remove the "set autodegree 2"'s
;;;          at the prize of a non negligible lost of speed...   
;;;       
; created 92, SP.(general version of the adjunction script)
START:
<getvars @var
copy #1 @i
<nres @i @fi 3
transpose @fi.3 @m
<res @m @fm 3
transpose @fi.2 @ti
lift-std @fm.2 @lfm
lift @lfm @ti @lti
transpose @lti @lti
res @lti @flti 2
transpose @flti.2 @w
mult @w @fm.3 @w
std @w @sw
min @sw @twt
max @sw @twtm
if @twt-@twtm=0 PG0
k-basis @sw @tmp !
@twt
@twt
ncols @tmp @pg
nrows @w @no
submat @w @ww
1..@no-@pg
;
submat @w @ww1
@no-@pg+1..@no
;
lift-std @var @var
lift @var @ww1 @ww1
koszul @var 2 @tmp2
concat @ww1 @tmp2
<stack @w @ww1 @ww
kill @tmp @tmp2 @pg @ww @ww1
PG0:
kill @sw 
setdegs @w
;
;
nrows @w @r
char @var @char
ring @rs
@char
5+@r
x[0]-x[4]#2[0]-#2[@r-1]
;
;
submat @rs @map
1
1..5
ev @map @w @w
submat @rs @y
1
6..5+@r
mult @y @w @yw
poly @x x[0]
poly @xx x[1]
set autodegree 2
set autocalc 1
quot @yw @x @j
quot @yw @xx @jj
copy @rs @map1
edit @map1
ce 1 2 0
ev @map1 @yw @yw1
ce 1 2 x[1]
ce 1 3 0
ev @map1 @yw @yw2
ce 1 3 x[2]
ce 1 4 0
ev @map1 @yw @yw3
ce 1 4 x[3]
ce 1 5 0
ev @map1 @yw @yw4
ce 1 5 x[4]
ce 1 1 0
ev @map1 @yw @yw5
quotient @yw1 @x @j1
quotient @yw2 @x @j2
quotient @yw3 @x @j3
quotient @yw4 @x @j4
quotient @yw5 @xx @j0
ring #2
@char
@r
#2[0]-#2[@r-1]
;
;
fetch @jj @jj
fetch @j #3 
concat #3 @jj
fetch @j1 @j1
fetch @j2 @j2
fetch @j3 @j3
fetch @j4 @j4
fetch @j0 @j0
set autocalc -1
std #3 #3
shout echo Invariants of the adjoint surface:
shout hilb #3
concat @j1 @j2 @j3 @j4 @j0
std @j1 @j1
deg @j1 @cod @no
if @r>@cod OUT
int @no 0
OUT:
shout echo
shout echo Number of (-1) lines: 
shout type @no
copy @j1 #4
kill @jj @j0 @j1 @j2 @j3 @j4 @j @yw @yw1 @yw2 @yw3 @yw4 @map1 @var
kill  @i @fi @w @r @x @char @y @rs @rs'zero @m @fm @xx @yw5 @twt @twtm 
kill  @cod @ti @lfm @lti @flti  @map @no
END:
incr-set prlevel -1

$;;;;;;;; EXAMPLE SECTION ;;;;;;;;;;;;;;;;;;;;;;;;;
