program delta4
C
C	has four-ply look-ahead with pruning
C
C	12 December 1991 -- deltaj -- autoplay version of delta2
C	                              (computer vs. computer)
C
C	13 December 1991 -- added full look-ahead for lift phase
C
C	15 May 1992 -- deltax : two-player version/move checker
C
C	9 July 1992 -- full version for 0,1,2 human players
C
	integer*4 move(43,5),rotate(25,8),shape(25),brot(25)
	integer*4 first(25),last(25),board(27)
	integer*4 list(200,3),size,gend
	integer*4 bscore,wscore,bwins,wwins,hcolor
	character*50 algeb
	character*6 gamrec(30)
	character*4 shift
	character*2 drop
	character*1 answ
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	data move/9*1,7*2,7*3,6*7,6*8,8*13,
     1     3,4,5,13,19,25,11,16,21,4,5,14,20,12,17,22,1,11,13,18,23,15,
     2     5,17,22,19,25,9,10,6,16,18,23,20,10,1,11,21,23,25,15,5,3,
     3	   2,3,4,7,13,19,6,11,16,3,4,8,14,7,12,17,2,7,8,13,18,9,4,
     4     12,17,13,19,8,9,7,12,13,18,14,9,7,12,17,18,19,14,9,8,
     5     0,2,2,0,7,7,0,6,6,0,3,0,8,0,7,7,0,0,0,8,8,0,0,
     6     0,12,0,13,0,8,0,0,0,13,0,0,0,0,0,0,0,0,0,0,
     7     0,0,3,0,0,13,0,0,11,0,0,0,0,0,0,12,0,0,0,0,13,22*0/
	data rotate/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,
     1     20,21,22,23,24,25,5,4,3,2,1,10,9,8,7,6,15,14,13,12,11,
     2     20,19,18,17,16,25,24,23,22,21,1,6,11,16,21,2,7,12,17,22,
     3     3,8,13,18,23,4,9,14,19,24,5,10,15,20,25,21,16,11,6,1,22,
     4     17,12,7,2,23,18,13,8,3,24,19,14,9,4,25,20,15,10,5,21,22,23,
     5     24,25,16,17,18,19,20,11,12,13,14,15,6,7,8,9,10,1,2,3,4,5,
     6     25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,
     7     4,3,2,1,5,10,15,20,25,4,9,14,19,24,3,8,13,18,23,2,7,12,17,
     8     22,1,6,11,16,21,25,20,15,10,5,24,19,14,9,4,23,18,13,8,3,
     9     22,17,12,7,2,21,16,11,6,1/
	data shape/1,2,3,2,1,2,4,5,4,2,3,5,6,5,3,2,4,5,4,2,1,2,3,2,1/
	data brot/1,1,1,2,2,3,1,1,2,7,3,3,1,7,7,4,4,5,6,8,4,5,5,6,6/
	data first/1,10,17,10,1,10,24,30,24,10,17,30,36,30,17,
     1             10,24,30,24,10,1,10,17,10,1/
	data last/9,16,23,16,9,16,29,35,29,16,23,35,43,35,23,
     1            16,29,35,29,16,9,16,23,16,9/
	data algeb/
     1   'a5a4a3a2a1b5b4b3b2b1c5c4c3c2c1d5d4d3d2d1e5e4e3e2e1'/

  1	continue
	bscore = 0    ! black is color 1 and bin 26
	wscore = 0    ! white is color 2 and bin 27
	bwins  = 0
	wwins  = 0
	type 9005
	accept 9002,nhuman
	if(nhuman.lt.0.or.nhuman.gt.2) then
	  stop
	else if(nhuman.lt.2) then
	  type 9003
	  accept 9002,iseed
	end if
  7	continue
	gend = 0
	jseed = iseed
	hcolor = 1
	movnum = 0
	do io=1,30
	  gamrec(io)='      '
	end do
	do io=1,27
	  board(io)=0
	end do
	if(nhuman.eq.1) then
	  call hdrop(board,algeb,hcolor)
	  if(board(25+hcolor).eq.1.and.board(28-hcolor).eq.0) then
	    call cdrop(board,algeb,3-hcolor)
	    call hshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,hcolor)
	    call cdrop(board,algeb,3-hcolor)
	    if(board(28-hcolor).eq.1) then
	      call cshift(board,algeb,list,size,move,rotate,shape,
     1          brot,first,last,gend,3-hcolor)
	    end if
	  else if(board(26).eq.0) then
	    type *,' O.K.... I''ll play Black and move first '
	    hcolor = 2
	    call cdrop(board,algeb,3-hcolor)
  8	    continue
	    call hdrop(board,algeb,hcolor)
	    if(board(27).eq.0) go to 8
	    call cshift(board,algeb,list,size,move,rotate,shape,
     1        brot,first,last,gend,3-hcolor)
	    call hdrop(board,algeb,hcolor)
	    if(board(27).eq.2) call cshift(board,algeb,list,size,
     1        move,rotate,shape,brot,first,last,gend,3-hcolor)
	  end if
	  do while(gend.eq.0)
	    call hshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,hcolor)
	    if(gend.eq.3) go to 1
	    call score(bscore,bwins,wscore,wwins,board,gend,hcolor)
	    if(gend.gt.0) go to 20
	    call cshift(board,algeb,list,size,move,rotate,shape,
     1        brot,first,last,gend,3-hcolor)
	    if(gend.eq.3) go to 1
	    call score(bscore,bwins,wscore,wwins,board,gend,hcolor)
	    if(gend.gt.0) go to 20
	  end do
	else if(nhuman.eq.0) then
	  call cdrop(board,algeb,1)
	  call cdrop(board,algeb,2)
	  call cshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,1)
	  call cdrop(board,algeb,2)
	  do while(gend.eq.0)
	    call cshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,1)
	    call score(bscore,bwins,wscore,wwins,board,gend,1)
	    if(gend.gt.0) go to 20
	    call cshift(board,algeb,list,size,move,rotate,shape,
     1        brot,first,last,gend,2)
	    call score(bscore,bwins,wscore,wwins,board,gend,1)
	    if(gend.gt.0) go to 20
	  end do
	else if(nhuman.eq.2) then
	  hcolor=1
	  call hdrop(board,algeb,hcolor)
	  if(board(27).gt.0) go to 18
	  call hdrop(board,algeb,3-hcolor)
	  call hshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,hcolor)
	  call hdrop(board,algeb,3-hcolor)
	  if(board(27).eq.1) then
	    call hshift(board,algeb,list,size,move,rotate,shape,
     1        brot,first,last,gend,3-hcolor)
	  end if
  18	  continue
	  do while(gend.eq.0)
	    if(hcolor.eq.2) then
	      hcolor=1
	      go to 19
	    end if
	    call hshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,hcolor)
	    if(gend.eq.3) go to 1
	    call score(bscore,bwins,wscore,wwins,board,gend,hcolor)
	    if(gend.gt.0) go to 20
  19	    continue
	    call hshift(board,algeb,list,size,move,rotate,shape,
     1        brot,first,last,gend,3-hcolor)
	    if(gend.eq.3) go to 1
	    call score(bscore,bwins,wscore,wwins,board,gend,3-hcolor)
	    if(gend.gt.0) go to 20
	  end do
	end if
  20	continue
	type 9004
	accept 9001,answ
	if(answ.eq.'Y'.or.answ.eq.'y') then
	  go to 7
	end if
	go to 1  ! restart
  30 	continue
 9001	format(a)
 9002	format(i12)
 9003	format(' Enter random seed : ',$)
 9004	format(/,' Another game ? ',$)
 9005	format(' How many human players ? ',$)
	end
C	
	subroutine legal(board,color,list,size,move,rotate,shape,
     1       brot,first,last)
	integer*4 board(27),color,list(200,3),size
	integer*4 move(43,5),rotate(25,8),shape(25),brot(25)
	integer*4 first(25),last(25)
	character*6 gamrec(30)
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	size=0
	do i=1,25
	  if(board(i).eq.color) then
	    do j=first(i),last(i)
 	      do k=2,5
	        if(move(j,k).gt.0) then
	          if(board(rotate(move(j,k),brot(i))).ne.0) go to 10
	        end if
	      end do
	      size=size+1
	      list(size,1)=i
	      list(size,2)=rotate(move(j,2),brot(i))
	      list(size,3)=rotate(move(j,3),brot(i))
  10	      continue
	    end do
	  end if
	end do
	return
	end
c
	subroutine draw(board)
	integer*4 board(27)
	character*3 numb(5)
	character*1 symb(3)
	data symb/'.','O','X'/
	data numb/' 5 ',' 4 ',' 3 ',' 2 ',' 1 '/
	type *,' '
	do io=1,5
	  type *,numb(io),(symb(1+board(io+5*jo)),jo=0,4)
	end do
	type *,'   ABCDE'
	type *,' '
	return
	end
C
	subroutine hdrop(board,algeb,color)
	integer*4 board(27),color
	character*50 algeb
	character*6 gamrec(30)
	character*2 drop
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	if(color.eq.1) then
	  type 9000
	else if(color.eq.2) then
	  type 9002
	end if
	accept 9001,drop
	if(drop(1:1).eq.'*') then
C	  restore saved game
	  open(unit=94,form='formatted',file=for094,status='old')
	  read(94,9010) (board(io),io=1,27)
	  read(94,9011) color,movnum,iseed
	  do io=1,movnum
	    read(94,9012) gamrec(io)
	  end do
	  close(94)
	  call draw(board)
	  return
	end if
	mwhite=(index(algeb,drop)+1)/2
	if(mwhite.ge.1.and.mwhite.le.25) then
	  if(board(mwhite).eq.0) then
	    board(mwhite)=color
	    board(25+color)=board(25+color)+1
	    call draw(board)
	    movnum=movnum+1
	    gamrec(movnum)(3:4)=drop
	    return
	  end if
	end if
	return
 9000	format(' Enter Black drop : ',$)
 9001	format(a)
 9002	format(' Enter White drop : ',$)
 9010	format(27i2)
 9011	format(3i15)
 9012	format(' ',a)
	end
c
	subroutine cdrop(board,algeb,color)
	integer*4 board(27),iconv(40),color
	character*50 algeb
	character*6 gamrec(30)
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	data iconv/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
     1    21,22,23,24,25,5*13,8,12,14,18,3,11,23,1,25,10/
  3	continue
	half=ran(iseed)
	if(board(26).eq.1.and.half.lt.0.5.and.board(13).eq.0) then
	  mblack=13
	else
	  mblack=iconv(1+int(40*ran(iseed)))
	end if
	if(board(mblack).gt.0) go to 3
	if(nhuman.eq.1) then
	  type *,' I drop at ',algeb(mblack+mblack-1:mblack+mblack)
	else if(color.eq.1) then
	  type *,' Black drops at ',algeb(mblack+mblack-1:mblack+mblack)
	else if(color.eq.2) then
	  type *,' White drops at ',algeb(mblack+mblack-1:mblack+mblack)
	end if
	board(mblack)=color
	board(25+color)=board(25+color)+1
	call draw(board)
	movnum=movnum+1
	gamrec(movnum)(3:4)=algeb(mblack+mblack-1:mblack+mblack)
	return
	end
c
	subroutine hshift(board,algeb,list,size,move,rotate,shape,brot,
     1        first,last,gend,color)
	integer*4 board(27),list(200,3),size
	integer*4 move(43,5),rotate(25,8),shape(25),brot(25)
	integer*4 first(25),last(25),gend,color
	character*50 algeb
	character*6 gamrec(30)
	character*6 shift9
	character*4 shift
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	call legal(board,color,list,size,move,rotate,shape,
     1             brot,first,last)
	if(size.eq.0) then
	  if(nhuman.eq.1) then
	    type *,' You cannot move '
	  else if(color.eq.1) then
	    type *,' Black cannot move '
	  else if(color.eq.2) then
	    type *,' White cannot move '
	  end if
	  gend = 3 - color
	  return
	end if
  4	continue
	if(board(25+color).eq.9) then
  5	  continue
	  if(color.eq.1) then
	    type 9006,size
	  else if(color.eq.2) then
	    type 9008,size
	  end if
	  accept 9001,shift9
	  if(shift9(1:1).eq.shift9(2:2)) then
C	    save game record
	    open(unit=94,form='formatted',file=for094,status='new')
	    write(94,9010) (board(io),io=1,27)
	    write(94,9011) color,movnum,iseed
	    do io=1,movnum
	      write(94,9012) gamrec(io)
	    end do
	    close(94)
	    gend=3
	    return
	  end if
	  mwhite=(index(algeb,shift9(1:2))+1)/2
	  mmove=(index(algeb,shift9(3:4))+1)/2
	  mlift=(index(algeb,shift9(5:6))+1)/2
	  if(mlift.lt.1.or.mlift.gt.25) go to 5
	else
	  if(color.eq.1) then
	    type 9005,size
	  else if(color.eq.2) then
	    type 9007,size
	  end if
	  accept 9001,shift
	  if(shift(1:1).eq.shift(2:2)) then
C	    save game record
	    open(unit=94,form='formatted',file=for094,status='new')
	    write(94,9010) (board(io),io=1,27)
	    write(94,9011) color,movnum,iseed
	    do io=1,movnum
	      write(94,9012) gamrec(io)
	    end do
	    close(94)
	    gend=3
	    return
	  end if
	  mwhite=(index(algeb,shift(1:2))+1)/2
	  mmove=(index(algeb,shift(3:4))+1)/2
	end if
	do io=1,size
	  if(list(io,1).eq.mwhite.and.list(io,2).eq.mmove) then
	    if(board(25+color).lt.9) then
	      board(mwhite)=0
	      board(mmove)=color
	      board(list(io,3))=color
	      board(25+color)=board(25+color)+1
	      call draw(board)
	      movnum=movnum+1
	      gamrec(movnum)(1:4)=shift
	      call test(board,gend)
	      return
	    else if(board(mlift).eq.color.and.mlift.ne.mwhite) then
	      board(mwhite)=0
	      board(mlift)=0
	      board(mmove)=color
	      board(list(io,3))=color
	      call draw(board)
	      movnum=movnum+1
	      gamrec(movnum)=shift9
	      call test(board,gend)
	      return
	    end if
	  end if
	end do
	type *,' illegal move... '
	go to 4
 9001	format(a)
 9005	format(' (',i2,') Enter Black move : ',$)
 9006	format(' (',i2,') Enter Black move and lift : ',$)
 9007	format(' (',i2,') Enter White move : ',$)
 9008	format(' (',i2,') Enter White move and lift : ',$)
 9010	format(27i2)
 9011	format(3i15)
 9012	format(' ',a)
	end
C
	subroutine cshift(board,algeb,list,size,move,rotate,
     1        shape,brot,first,last,gend,color)
	integer*4 board(27),list(200,3),size,testbd(27),color
	integer*4 move(43,5),rotate(25,8),shape(25),brot(25)
	integer*4 first(25),last(25),gend,full(10),value,bvalue,best(2)
	character*50 algeb
	character*6 gamrec(30)
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	call legal(board,color,list,size,move,rotate,shape,brot,
     1             first,last)
	if(size.eq.0) then
	  gend = 3-color
	  if(nhuman.eq.1) then
	    type *,' I cannot move '
	  else if(color.eq.1) then
	    type *,' Black cannot move '
	  else if(color.eq.2) then
	    type *,' White cannot move '
	  end if
	  return
	end if
C	Find the best move
	bvalue=-99999
	best(1)=0
	best(2)=0
	do io=1,size
	  do jo=1,27
	    testbd(jo)=board(jo)
	  end do
	  testbd(list(io,1))=0
	  testbd(list(io,2))=color
	  testbd(list(io,3))=color
	  if(testbd(25+color).lt.9) then
	    testbd(25+color)=board(25+color)+1
	    call evalu(testbd,move,rotate,shape,
     1          brot,first,last,value,bvalue,color,3-color)
	    ind1=2*list(io,1)-1
	    ind2=2*list(io,2)-1
	    type 9010,algeb(ind1:ind1+1),algeb(ind2:ind2+1),value
	    pick=ran(iseed)
	    if(value.gt.bvalue.or.
     1        (value.eq.bvalue.and.pick.lt.0.5)) then
	      bvalue=value
	      best(1)=io
	    end if
	    if(value.gt.1980) go to 5  ! found winning move in 1
	  else
	    ijk=0
	    do ko=1,25
	      if(testbd(ko).eq.color.and.ko.ne.list(io,2).and.
     1           ko.ne.list(io,3)) then
	        ijk=ijk+1
	        full(ijk)=ko
	      end if
	    end do
	    if(ijk.ne.8) type *,' @#%$ ',(full(mo),mo=1,ijk)
	    do lo=1,ijk
	      testbd(full(lo))=0
	      call evalu(testbd,move,rotate,shape,
     1          brot,first,last,value,bvalue,color,3-color)
	      ind1=2*list(io,1)-1
	      ind2=2*list(io,2)-1
	      ind3=2*full(lo)-1
	      type 9011,algeb(ind1:ind1+1),algeb(ind2:ind2+1),
     1                  algeb(ind3:ind3+1),value
	      pick=ran(iseed)
	      if(value.gt.bvalue.or.
     1          (value.eq.bvalue.and.pick.lt.0.5)) then
	        bvalue=value
	        best(1)=io
	        best(2)=full(lo)
	      end if
	      testbd(full(lo))=color
	      if(value.gt.1980) go to 5  ! found winning move in 1
	    end do
	  end if
	end do
  5	continue
	board(list(best(1),1))=0
	board(list(best(1),2))=color
	board(list(best(1),3))=color
	ial1 = (2*list(best(1),1))-1
	ial2 = (2*list(best(1),2))-1
	if(board(25+color).lt.9) then
	  board(25+color)=board(25+color)+1
	  if(nhuman.eq.1) then
	    type *,' My move is ',algeb(ial1:ial1+1),algeb(ial2:ial2+1)
	  else if(color.eq.1) then
	    type *,' Black''s move is ',
     1             algeb(ial1:ial1+1),algeb(ial2:ial2+1)
	  else if(color.eq.2) then
	    type *,' White''s move is ',
     1             algeb(ial1:ial1+1),algeb(ial2:ial2+1)
	  end if
	  movnum=movnum+1
	  gamrec(movnum)(1:2)=algeb(ial1:ial1+1)
	  gamrec(movnum)(3:4)=algeb(ial2:ial2+1)
	else
	  ial3=best(2)
	  board(ial3)=0
	  ial3 = (2*ial3)-1
	  if(nhuman.eq.1) then
	    type *,' My move is ',
     1       algeb(ial1:ial1+1),algeb(ial2:ial2+1),algeb(ial3:ial3+1)
	  else if(color.eq.1) then
	    type *,' Black''s move is ',
     1       algeb(ial1:ial1+1),algeb(ial2:ial2+1),algeb(ial3:ial3+1)
	  else if(color.eq.2) then
	    type *,' White''s move is ',
     1       algeb(ial1:ial1+1),algeb(ial2:ial2+1),algeb(ial3:ial3+1)
	  end if
	  movnum=movnum+1
	  gamrec(movnum)(1:2)=algeb(ial1:ial1+1)
	  gamrec(movnum)(3:4)=algeb(ial2:ial2+1)
	  gamrec(movnum)(5:6)=algeb(ial3:ial3+1)
	end if
	call draw(board)
	call test(board,gend)
 9010	format(' Move ',a,a,' has a value of ',i5)
 9011	format(' Move ',a,a,a,' has a value of ',i5)
	return
	end
C
	subroutine test(board,gend)
	integer*4 board(27),win(4,28),gend
	data win/1,2,3,4,2,3,4,5,6,7,8,9,7,8,9,10,11,12,13,14,
     1    12,13,14,15,16,17,18,19,17,18,19,20,21,22,23,24,22,23,24,25,
     2    1,6,11,16,6,11,16,21,2,7,12,17,7,12,17,22,3,8,13,18,
     3    8,13,18,23,4,9,14,19,9,14,19,24,5,10,15,20,10,15,20,25,
     4    1,7,13,19,7,13,19,25,5,9,13,17,9,13,17,21,6,12,18,24,
     5    2,8,14,20,4,8,12,16,10,14,18,22/
	gend = 0
	if(board(26).lt.4.and.board(27).lt.4) return
	do io=1,28
	  if(board(win(1,io)).gt.0) then
	    if(board(win(1,io)).eq.board(win(2,io))) then
	      if(board(win(2,io)).eq.board(win(3,io))) then
	        if(board(win(3,io)).eq.board(win(4,io))) then
	          gend=board(win(4,io))
	          return
	        end if
	      end if
	    end if
	  end if
	end do
	return
	end
C
	subroutine evalu(board,move,rotate,shape,
     1       brot,first,last,value,bvalue,me,opp)
	integer*4 board(27),list(200,3),size,iblock(27),kboard(27)
	integer*4 move(43,5),rotate(25,8),shape(25),brot(25)
	integer*4 first(25),last(25),value,klist(200,3)
	integer*4 win(4,28),row,hwin,bvalue,full(10),jfull(10),me,opp
	character*50 algeb
	character*6 gamrec(30)
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	data algeb/
     1   'a5a4a3a2a1b5b4b3b2b1c5c4c3c2c1d5d4d3d2d1e5e4e3e2e1'/
	data win/1,2,3,4,2,3,4,5,6,7,8,9,7,8,9,10,11,12,13,14,
     1    12,13,14,15,16,17,18,19,17,18,19,20,21,22,23,24,22,23,24,25,
     2    1,6,11,16,6,11,16,21,2,7,12,17,7,12,17,22,3,8,13,18,
     3    8,13,18,23,4,9,14,19,9,14,19,24,5,10,15,20,10,15,20,25,
     4    1,7,13,19,7,13,19,25,5,9,13,17,9,13,17,21,6,12,18,24,
     5    2,8,14,20,4,8,12,16,10,14,18,22/
	value=0
	size=0
	if(board(26).ge.4.or.board(27).ge.4) then
	  do io=1,28
	    row=0
	    do ijk=1,4
	      if(board(win(ijk,io)).eq.me)  row=row+1
	      if(board(win(ijk,io)).eq.opp) row=row-10
	    end do
	    if(row.eq.4) then
	      value=2000
	      return
	    end if
	  end do
	end if
C	check for win by stalemate (opponent's mobility zero)
C	  don't need to check our own mobility -- do it after each
C	  of opponent's moves
	call legal(board,opp,list,nsize,move,rotate,shape,
     1       brot,first,last)
	if(nsize.eq.0) then
	  value=2000
	  return
	end if
C	don't look for another two-move win if we already have one
	if(bvalue.gt.980) return
	value=9999
C	check another ply ahead
	do io=1,nsize
	  ivalue=-999
	  do jo=1,27
	    iblock(jo)=board(jo)
	  end do
	  iblock(list(io,1))=0
	  iblock(list(io,2))=opp
	  iblock(list(io,3))=opp
	  if(iblock(25+opp).lt.9) then
            iblock(25+opp)=iblock(25+opp)+1
	    call test(iblock,hwin)
	    if(hwin.eq.opp) then
	      value=-1000
	      return
	    end if
	    call legal(iblock,me,klist,isize,move,rotate,shape,
     1         brot,first,last)
	    if(isize.eq.0) then
	      value=-1000
	      return
	    end if
	    do ijk=1,isize
	      do ko=1,27
	        kboard(ko)=iblock(ko)
	      end do
	      kboard(klist(ijk,1))=0
	      kboard(klist(ijk,2))=me
	      kboard(klist(ijk,3))=me
	      if(kboard(25+me).lt.9) then
	        kboard(25+me)=kboard(25+me)+1
	        call evalu2(kboard,move,rotate,shape,
     1              brot,first,last,kvalue,me,opp)
	        if(kvalue.gt.value) go to 6   ! alpha-beta pruning
	        if(kvalue.gt.ivalue) ivalue=kvalue
	      else
	        ijm=0
	        do ko=1,25
	          if(kboard(ko).eq.me.and.ko.ne.klist(ijk,2).and.
     1               ko.ne.klist(ijk,3)) then
	            ijm=ijm+1
	            jfull(ijm)=ko
	          end if
	        end do
	        if(ijm.ne.8) type *,' @$#% ',(jfull(mo),mo=1,ijm)
	        do lo=1,ijm
	          kboard(jfull(lo))=0
	          call evalu2(kboard,move,rotate,shape,
     1                brot,first,last,kvalue,me,opp)
	          kboard(jfull(lo))=me
	          if(kvalue.gt.value) go to 6   ! alpha-beta pruning
	          if(kvalue.gt.ivalue) ivalue=kvalue
	        end do
	      end if
	    end do	    
	    if(ivalue.lt.value) value=ivalue
	  else
	    ijk=0
	    do ko=1,25
	      if(iblock(ko).eq.opp.and.ko.ne.list(io,2).and.
     1           ko.ne.list(io,3)) then
	        ijk=ijk+1
	        full(ijk)=ko
	      end if
	    end do
	    if(ijk.ne.8) type *,' #@$% ',(full(mo),mo=1,ijk)
	    do lo=1,ijk
	      iblock(full(lo))=0
	      call test(iblock,hwin)
	      if(hwin.eq.opp) then
	        value=-1000
	        return
	      end if
	      call legal(iblock,me,klist,isize,move,rotate,shape,
     1           brot,first,last)
	      if(isize.eq.0) then
	        value=-1000
	        return
	      end if
	      do ijm=1,isize
	        do ko=1,27
	          kboard(ko)=iblock(ko)
	        end do
	        kboard(klist(ijm,1))=0
	        kboard(klist(ijm,2))=me
	        kboard(klist(ijm,3))=me
	        if(kboard(25+me).lt.9) then
	          kboard(25+me)=kboard(25+me)+1
	          call evalu2(kboard,move,rotate,shape,
     1                brot,first,last,kvalue,me,opp)
	          if(kvalue.gt.value) go to 6   ! alpha-beta pruning
	          if(kvalue.gt.ivalue) ivalue=kvalue
	        else
	          ijp=0
	          do ko=1,25
	            if(kboard(ko).eq.me.and.ko.ne.klist(ijm,2).and.
     1                  ko.ne.klist(ijm,3)) then
	              ijp=ijp+1
	              jfull(ijp)=ko
	            end if
	          end do
	          if(ijp.ne.8) type *,' #$%@ ',(jfull(mo),mo=1,ijk)
	          do mo=1,ijp
	            kboard(jfull(mo))=0
	            call evalu2(kboard,move,rotate,shape,
     1                  brot,first,last,kvalue,me,opp)
	            kboard(jfull(mo))=me
	            if(kvalue.gt.value) go to 6   ! alpha-beta pruning
	            if(kvalue.gt.ivalue) ivalue=kvalue
	          end do
	        end if
	      end do	    
	      if(ivalue.lt.value) value=ivalue
	    end do
	  end if
  6	  continue
	end do
	return
	end
C
	subroutine score(bscore,bwins,wscore,wwins,board,gend,color)
	integer*4 board(27)
	integer*4 bscore,bwins,wscore,wwins,gend,empty,color
	character*6 gamrec(30)
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	if(gend.eq.0) return
	empty = 0
	do io=1,25
	  if(board(io).eq.0) empty=empty+1
	end do
C	generate file containing game score
	write(93,*) '   '
C	show what seed was at game start
	write(93,*) ' random seed = ',jseed
	write(93,*) '   '
	if(nhuman.eq.1) then
	  if(color.eq.1) then
	    write(93,*) '      Human     Computer '
	  else if(color.eq.2) then
	    write(93,*) '     Computer    Human '
	  end if
	  if(color.eq.gend) then
	    bwins = bwins + 1
	    bscore = bscore + empty
	    type *,' You win -- congratulations ! '
	  else
	    wwins = wwins + 1
	    wscore = wscore + empty
	    type *,' I win -- hurrah ! '
	  end if
	  type 9200,bwins,bscore,wwins,wscore
C	  Note: human score is always in bwins/bscore since
C	  colors may change from game to game
	else
	  write(93,*) '      Black      White  '
	  if(gend.eq.1) then
	    bwins = bwins + 1
	    bscore = bscore + empty
	  else if(gend.eq.2) then
	    wwins = wwins + 1
	    wscore = wscore + empty
	  end if
	  if(gend.eq.1) then
	    type *,' Black wins ! '
	  else if(gend.eq.2) then
	    type *,' White wins ! '
	  end if
	  type 9203,bwins,bscore,wwins,wscore
	end if
	do io=1,movnum,2
	  j=(io+1)/2
	  if((io+1).le.movnum) then
	    write(93,9201) j,gamrec(io),gamrec(io+1)
	  else
	    write(93,9202) j,gamrec(io)
	  end if
	end do
	if(nhuman.eq.1) then
	  write(93,*) '   '
	  write(93,9200) bwins,bscore,wwins,wscore
	else
	  write(93,*) '   '
	  write(93,9203) bwins,bscore,wwins,wscore
	end if
 9200	format(/,' You have won ',i3,' games for ',i5,' points. ',/,
     1           '   I have won ',i3,' games for ',i5,' points. ')
 9201	format('  (',i2,') ',a,'     ',a)
 9202	format('  (',i2,') ',a)
 9203	format(/,' Black has won ',i3,' games for ',i5,' points. ',/,
     1           ' White has won ',i3,' games for ',i5,' points. ')
	return
	end
C
	subroutine evalu2(board,move,rotate,shape,
     1       brot,first,last,value,me,opp)
	integer*4 board(27),list(200,3),size,nblock(27)
	integer*4 move(43,5),rotate(25,8),shape(25),brot(25)
	integer*4 first(25),last(25),value,xlist(200,3)
	integer*4 win(4,28),row,hwin,llist(200,3),me,opp
	character*6 gamrec(30)
	common/trans/gamrec,movnum,iseed,jseed,nhuman
	data win/1,2,3,4,2,3,4,5,6,7,8,9,7,8,9,10,11,12,13,14,
     1    12,13,14,15,16,17,18,19,17,18,19,20,21,22,23,24,22,23,24,25,
     2    1,6,11,16,6,11,16,21,2,7,12,17,7,12,17,22,3,8,13,18,
     3    8,13,18,23,4,9,14,19,9,14,19,24,5,10,15,20,10,15,20,25,
     4    1,7,13,19,7,13,19,25,5,9,13,17,9,13,17,21,6,12,18,24,
     5    2,8,14,20,4,8,12,16,10,14,18,22/
	value=0
	size=0
	if(board(26).ge.4.or.board(27).ge.4) then
	  do io=1,28
	    row=0
	    do ijk=1,4
	      if(board(win(ijk,io)).eq.me) row=row+1
	      if(board(win(ijk,io)).eq.opp) row=row-10
	    end do
	    if(row.eq.4) then
	      value=1000
	      return
	    else if(row.eq.3) then
	      value=value+4
	    end if
	  end do
	end if
C	difference in mobility
	call legal(board,me,llist,ijsize,move,rotate,shape,
     1       brot,first,last)
	value=value+ijsize
	if(ijsize.eq.0) value=value-10000
	call legal(board,opp,llist,ijsize,move,rotate,shape,
     1       brot,first,last)
	value=value-ijsize
	if(ijsize.eq.0) value=value+1000
C	block any one-move human win	
	do io=1,ijsize
	  do jo=1,27
	    nblock(jo)=board(jo)
	  end do
	  nblock(llist(io,1))=0
	  nblock(llist(io,2))=opp
	  nblock(llist(io,3))=opp
	  if(nblock(25+opp).lt.9) nblock(25+opp)=nblock(25+opp)+1
	  call test(nblock,hwin)
	  if(hwin.eq.opp) then
	    value=value-100000
	    return
	  end if
	  call legal(nblock,me,xlist,msize,move,rotate,shape,
     1       brot,first,last)
	  if(msize.eq.0) then
	    value=value-1000000
	    return
	  end if
	end do
	return
	end