C	Changed to FLECS 11-Apr-80 M.R.Brown
OpC	Changed to RSX 10-Dec-79 M.R.Brown
C		my comments are Tasteful Dual Case So You Can Distinguish
C
C     BACKGAMMON PLAYING PROGRAM.
C     HUB GOT THIS.
C
C
	INTEGER BOARD(26),ROLL(2),MOVE(2,4),BOARD1(26)
	INTEGER BOARD2(26),SCORE(6),BOARD3(26),TEST(2)
	BYTE IBUF(20)
	REAL A
	T1=SECNDS(0.0)
C	FLECS cannot have an IF expression continue to next line
C	So use two
	IF(T1.GT.46800.0.AND.T1.LT.59400.0)
	WRITE(1,*)
	1'Time wasted playing computer games can never be recovered!'
	FIN
	IF(T1.LT.43200.0.AND.T1.GT.30600.0)
	WRITE(1,*)
	1'Time wasted playing computer games can never be recovered!'
	FIN
C	Now lets spin up the random number generator so we always get
C	a reasonable start.
	I1=T1/2000
	I2=SQRT(T1)/10
	DO(I=1,(I1/10)+10)ID=RAN(I1,I2)
9     CALL INIT(BOARD)
	CALL PRINTB(BOARD)
	WRITE(1,*) 'DO YOU NEED INSTRUCTIONS? '
	READ(1,99)NCHRS,(IBUF(I),I=1,NCHRS)
99	FORMAT(Q,20A1)
	IF(IBUF(1).EQ.'N'.OR.IBUF(1).EQ.'n')GOTO 80
	WRITE(1,*)
     +'     THIS IS THE PLAYING BOARD,  IT  LOOKS  DIFFERENT'
	WRITE(1,*)
     +'FROM  THE NORMAL BOARD BECAUSE YOUR OPPONETS SIDE HAS'
	WRITE(1,*)
     +'BEEN ROTATED AND PLACED TO THE LEFT OF YOUR SIDE.   A'
	WRITE(1,*)
     +'PLUS SIGN REPRESENTS A POINT ON THE BOARD.  THERE ARE'
	WRITE(1,*)
     +'TWO  POINTS  BY  THEMSELVES  ON  THE  LEFT AND RIGHT.'
	WRITE(1,*)
     +'THESE ARE OCCUPIED BY MEN AFTER THEY HAVE  BEEN  HIT.'
	WRITE(1,*)
     +'THE COMPUTER PLAYS RED (SYMBOLIZED AS -R-)  AND MOVES'
	WRITE(1,*)
     +'FROM  RIGHT  TO  LEFT.  THE PLAYER USES THE WHITE MEN'
	WRITE(1,*)
     +'( -W- )  AND MOVES FROM LEFT TO RIGHT.'
	WRITE(1,*)
     +'     THE NUMBERS  BELOW  THE  POINTS  ARE  USED  WHEN'
	WRITE(1,*)
     +'MOVING  YOUR  MEN.  THE POINTS ARE NUMBERED FROM 1 TO'
	WRITE(1,*)
     +'26, YOU MUST  MENTALLY  ADD  THE  TENS  DIGIT,  THERE'
	WRITE(1,*)
     +'WASN T ROOM TO PRINT IT.  MOVE ARE MADE BY SPECIFYING'
	WRITE(1,*)
     +'THE  -FROM-  POINT  AND  THE  ROLL  OF  THE DIE.  THE'
	WRITE(1,*)
     +'NUMBERS ARE SEPARATED BY COMMAS.  TO MAKE THE -LOVERS'
	WRITE(1,*)
     +'LEAP- MOVE ON AN OPENING ROLL OF 6 5, YOU WOULD  TYPE'
	WRITE(1,*)
     +'2,6,8,5.   THE COMPUTER WOULD THEN MAKE THAT MOVE FOR'
	WRITE(1,*)
     +'YOU.'
C***  DETERMINE WHO GOES FIRST
80    CONTINUE
	WRITE(1,*)' '
	CALL GETROL(ROLL,I1,I2)
	WRITE(1,89) ROLL(1)
89    FORMAT(1X, 'I ROLLED A', I2)
	WRITE(1,88) ROLL(2)
88    FORMAT(1X, 'YOU ROLLED A', I2)
	IF(ROLL(1)-ROLL(2)) 81,82,83
C***  PLAYER GOES FIRST
81    CONTINUE
	WRITE(1,*)'YOU GO FIRST'
	CALL PRINTB(BOARD)
	GO TO 55
C***  ROLL AGAIN, DOUBLES
82    CONTINUE
	WRITE(1,*)'DOUBLES, ROLL AGAIN.'
	GO TO 80
C***  COMPUTER GOES FIRST
83    CONTINUE
	WRITE(1,*)'I GO FIRST'
	GO TO 4
1     CALL GETROL(ROLL,I1,I2)
C***  SWITCHES, I - SWAP ROLLS, J - NOT 2 MOVES, K - DOUBLE ROLL
4     ISW=0
	JSW=0
	KSW=0
	ISCORE=1000
	WRITE(1,2) ROLL
2     FORMAT(1X, 'I ROLL',2I2,'.')
C***  INITIALIZE BASED ON ROLL
3     CONTINUE
	MOVE(1,1)=0
	MOVE(2,1)=-ROLL(1)
	MOVE(1,2)=0
	MOVE(2,2)=-ROLL(2)
10    CONTINUE
	CALL MAKNXT(BOARD,BOARD1,MOVE(1,1))
	IF(MOVE(1,1).EQ.-1) GO TO 100
20    CONTINUE
	CALL MAKNXT(BOARD1,BOARD2,MOVE(1,2))
	IF(MOVE(1,2).EQ.-1) GO TO 30
	CALL EVAL(BOARD2,SCORE)
	JSW=1
	IF(SCORE(6).GT.ISCORE) GO TO 20
	ISCORE=SCORE(6)
	DO(I=1,26)BOARD3(I)=BOARD2(I)
	GO TO 20
C***  SET POINT FOR SECOND ROLL TO BEGINNING
30    CONTINUE
	MOVE(1,2)=0
	GO TO 10
C***  END OF FINDING MOVES
50    CONTINUE
	IF(JSW.NE.0) GO TO 52
C***  CHECK IF THERE IS AT LEAST ONE THING TO DO.
	ISCORE=1000
	DO 70 J=2,26
	MOVE(1,1)=J
	MOVE(1,2)=J
	I=1
	IF(MOVCHK(BOARD,MOVE(1,I)).NE.0) GO TO 71
	I=2
	IF(MOVCHK(BOARD,MOVE(1,I)).EQ.0) GO TO 70
C***  MAKE THE FIRST ROLL
71    CONTINUE
	JSW=1
	CALL MAKMOV(BOARD,BOARD2,MOVE(1,I))
	CALL EVAL(BOARD2,SCORE)
	IF(SCORE(6).GT.ISCORE) GO TO 70
	ISCORE=SCORE(6)
	DO(I=1,26)BOARD3(I)=BOARD2(I)
70    CONTINUE
	IF(JSW.NE.0) GO TO 52
	WRITE(1,*)'I CANNOT MOVE'
	GO TO 53
C***  IF DOUBLES, DO MOVE TWICE
52    CONTINUE
	DO(I=1,26)BOARD(I)=BOARD3(I)
	IF(KSW.NE.0) GO TO 56
	KSW=1
	IF(ROLL(1).NE.ROLL(2)) GO TO 56
	JSW=0
	GO TO 3
56    CONTINUE
C***  INITIALIZE KSW FOR PLAYER
	KSW=0
	CALL PRINTB(BOARD)
	CALL EVAL(BOARD,SCORE)
	IF(SCORE(2).EQ.0) GO TO 54
	GO TO 53
C***  END OF GAME, COMPUTER WON
54    WRITE(1,*)'I WIN, THANKS FOR THE GAME'
	CALL EXIT
	GO TO 9
C***  GET THE PLAYERS MOVE
53    CONTINUE
	CALL GETROL(ROLL,I1,I2)
55    CONTINUE
	CALL INPMOV(BOARD,ROLL)
	CALL PRINTB(BOARD)
	CALL EVAL(BOARD,SCORE)
	IF(SCORE(1).EQ.0) GO TO 65
	GO TO 1
C***  PLAYER WON
65    WRITE(1,*)'YOU WIN, THANKS'
	CALL EXIT
	GO TO 9
C***  SWAP THE ROLLS
100   CONTINUE
	IF(ISW.EQ.1) GO TO 50
	MOVE(1,1)=0
	MOVE(2,1)=-ROLL(2)
	MOVE(1,2)=0
	MOVE(2,2)=-ROLL(1)
	ISW=1
	GO TO 10
	END
      INTEGER FUNCTION MOVCHK(BOARD,MOVE)
C
C      A ROUTINE TO CHECK A BACKGAMMON MOVE.
C
C
C      BOARD - A 26 INTEGER ARRAY REPRESENTING THE THE STATE
C                  OF THE PLAYING BOARD.
C      MOVE  - A 2 INTEGER ARRAY REPRESENTING THE MOVE TO BE CHECKED.
C
C
C          MOVCHK - 0 IF NOT LEGAL, 1 IF LEGAL
C
C      CHECK FOR A PIECE ON THE FROM POINT, CHECK IF MEN MUST ENTER,
C          CHECK IF MOVE BEARS OFF MEN AND IF THAT IS LEGAL, CHECK FOR
C          THE NORMAL MOVES.  UP TO FOUR MOVES MAY BE TESTED.
C          THE PLAYER'S MOVES ARE IN THE POSITIVE DIRECTION, THE
C          COMPUTER'S ARE IN THE NEGATIVE.
C
C*
	INTEGER IOURS,OFFBRD
C     INTEGER MOVCHK,BOARD(26),MOVE(2),IBRDF,IBRDT
	INTEGER BOARD(26),MOVE(2),IBRDF,IBRDT
C***  INITIALIZE USEFUL PARAMETERS.
	MOVCHK=0
	MOVEP=MOVE(1)
	MOVER=MOVE(2)
	MOVET=MOVEP+MOVER
	IBRDF=BOARD(MOVEP)
	IBRDT=BOARD(MOVET)
C***  IF IOURS=1 - COMPUTERS MEN  IOURS=0 - PLAYERS MEN
	IOURS=0
	IF(MOVE(2).LT.0) IOURS=1
C
C***  BRANCH TO TEST CASES BASED ON MOVE POINT SPECIFIED.
C***  IF THE MOVE IS TO OFF THE BOARD, A VACANT SQUARE MIGHT BE LEGAL.
C***  IN OTHER CASES, A VACANT SQUARE IS ILLEGAL.
C***  IF THE MOVE TO POINT IS OCCUPIED BY OPPOSING MEN, MORE THAN
C***  ONE MAN MAKES AN ILLEGAL MOVE.
C
	OFFBRD=26
	IF(IOURS.EQ.0) OFFBRD=1
	IF(BOARD(OFFBRD).NE.0.AND.MOVEP.NE.OFFBRD) RETURN
C***  BRANCH IF BEARING OFF SPECIFIED.
	IF(IBRDF.EQ.0) RETURN
	IF(ISHFT(IBRDF,-4).NE.IOURS) RETURN
	IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100
	IF(IBRDT.EQ.0) GO TO 10
	IF(ISHFT(IBRDT,-4).EQ.IOURS) GOTO 10
	IF(IAND(IBRDT,15).LT.2) GOTO 10
	RETURN
10    CONTINUE
	MOVCHK=1
	RETURN
C***  CHECK BEARING OFF TYPE MOVES
100   CONTINUE
C***  CHECK IF ALL THE MEN ARE IN
	DO 105 I=1,19
	I1=I
	IF(IOURS.NE.0) I1=27-I
	IF(BOARD(I1).EQ.0) GOTO 105
	IF(ISHFT(BOARD(I1),-4).EQ.IOURS) RETURN
105   CONTINUE
C***  IF BEARING OFF EXACTLY, BRANCH TO LEGAL MOVE RETURN.
	IF(MOVET.EQ.26.OR.MOVET.EQ.1) GO TO 110
C***  MAKE SURE NO MEN ON HIGHER POINTS
	GO TO (120,130),IOURS+1
	WRITE(1,*)'IOURS - ILLEGAL VALUE'
	RETURN
120   CONTINUE
	MOVEP1=MOVEP-1
	IF(MOVEP1.LE.20) GO TO 126
	DO 125 I=20,MOVEP1
	IF(BOARD(I).EQ.0) GO TO 125
	IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN
125   CONTINUE
126   MOVCHK=1
	RETURN
130   CONTINUE
	MOVEP1=MOVEP+1
	IF(MOVEP1.GE.7) GO TO 136
	DO(I=MOVEP1,7)
	IF(ISHFT(BOARD(I),-4).EQ.IOURS) RETURN
	FIN
136   MOVCHK=1
	RETURN
110   CONTINUE
	MOVCHK=1
	RETURN
	END
      SUBROUTINE NXTMOV(BOARD,MOVE)
C
C      GIVEN A ROLL OF DICE AND THE LAST POINT, GENERATE THE
C         NEXT POSSIBLE POINT IN A KNOWN SEQUENCE.
C
C
C      MOVE - CONTAINS POINT AND ROLL
C          BOARD - THE PLAYING BOARD IN USE
C
C      ROLL - N/C
C          POINT - THE NEXT POINT IN SEQUENCE
C          BOARD - N/C
C
C      IF THE POINT IS ALL ZERO, GENERATE THE INITIAL POINT FROM THE
C          ROLL OF THE DIE.  OTHERWISE INCREMENT THE POINT.
C          WHEN THE POINT REACHES THE END OF THE BOARD, RETURN -1
C          AS THE VALUE OF THE POINT.
C
C*
	INTEGER ROLL,POINT,BOARD(26),MOVE(2)
C***  TEST FOR INITIALIZATION REQUIREMENT.
	POINT=MOVE(1)
	ROLL=MOVE(2)
	IF(POINT.EQ.0) GO TO 100
C***  FIND THE NEXT POINT
	IOURS=0
	IF(ROLL.LT.0) IOURS=1
	POINT=POINT+1
	DO 10 I=POINT,26
	IF(BOARD(I).EQ.0) GO TO 10
	IF(ISHFT(BOARD(I),-4).NE.IOURS) GO TO 10
	POINT=I
	GO TO 200
10    CONTINUE
	POINT=-1
	GO TO 200
C***  INITIALIZE THE POINT
100   CONTINUE
	IOURS=0
	IF(ROLL.LT.0) IOURS=1
	DO 110 I=1,26
	IF(BOARD(I).EQ.0) GO TO 110
	IF(ISHFT(BOARD(I),-4).NE.IOURS) GOTO 110
	POINT=I
	GO TO 200
110   CONTINUE
	POINT=-1
C***  RESTORE THE MOVE VECTOR
200   CONTINUE
	MOVE(1)=POINT
	MOVE(2)=ROLL
	RETURN
	END
      SUBROUTINE GETROL(ROLL,I1,I2)
C
C      ROUTINE TO RETURN A RANDOM ROLL OF THE DICE.
C
C
C
C      ROLL(2) - THE TWO DICE VALUES.
C
C      GET THE RANDOM VALUE AND CONVERT TO AND INTEGER IN
C          THE RANGE 1-6.
C
C*
	INTEGER ROLL(2)
	ROLL(1)=INT(6.0*RAN(I1,I2))+1
	ROLL(2)=INT(6.0*RAN(I1,I2))+1
	RETURN
	END
      SUBROUTINE MAKMOV(OLDBRD,NEWBRD,MOVE)
C
C	 MAKE THE MOVE ON OLD BOARD AND GENERATE NEW BOARD.
C
C     	 BGAMON
C
C     	 OLDBRD - THE BOARD ON WHICH TO MAKE THE MOVE
C          NEWBRD - A POINTER TO THE NEW BOARD
C          MOVE - THE MOVE TO MAKE
C
C     	 OLDBRD - N/C
C          NEWBRD - THE BOARD WITH THE MOVE MADE
C          MOVE - N/C
C
C     	 THE MOVE IS ASSUMED TO BE CORRECT.  ROLLS IN THE POSITIVE
C          DIRECTION A PLAYER MOVES.  IN THE NEGATIVE, COMPUTER.
C
C*
	INTEGER OLDBRD(26),NEWBRD(26),MOVE(2)
	DO 10 I=1,26
10    NEWBRD(I)=OLDBRD(I)
C***  INITIALIZE USEFUL CONSTANTS
	MOVEP=MOVE(1)
	MOVER=MOVE(2)
	MOVET=MOVEP+MOVER
	IBRDF=OLDBRD(MOVEP)
	IBRDT=OLDBRD(MOVET)
	IOURS=ISHFT(IBRDF,-4)
C***  MAKE THE MOVE
C
	IF(MOVET.GT.25.OR.MOVET.LT.2) GO TO 100
	IF(ISHFT(IBRDF,-4).EQ.IOURS) GO TO 20
	WRITE(1,*)'ERROR, MOVING OPPS MAN'
	RETURN
20    CONTINUE
C***  BRANCH IF HITTING
	IF(ISHFT(IBRDT,-4).NE.IOURS.AND.IBRDT.NE.0) GO TO 200
	NEWBRD(MOVEP)=NEWBRD(MOVEP)-1
	IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0
C	CHECK THE NEXT AREA FOR CORRECT OPERATION
	ITEMP=ISHFT(IOURS,4)
	NEWBRD(MOVET)=(ITEMP.OR.NEWBRD(MOVET)+1)
	RETURN
C***  PERFORM THE HIT TYPE MOVE
200   CONTINUE
	NEWBRD(MOVEP)=NEWBRD(MOVEP)-1
	IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0
	NEWBRD(MOVET)=ISHFT(IOURS,4)+1
	OFFBRD=26-IOURS*25
	NEWBRD(OFFBRD)=(ISHFT(1-IOURS,4).OR.NEWBRD(OFFBRD)+1)
	RETURN
100   CONTINUE
C***  BEARING OFF TYPE MOVE
	NEWBRD(MOVEP)=NEWBRD(MOVEP)-1
	IF(IAND(NEWBRD(MOVEP),15).EQ.0) NEWBRD(MOVEP)=0
	RETURN
	END
	SUBROUTINE PRINTB(BOARD)
C
C      PRINT THE BACKGAMMON BOARD
C
C
C     	 BOARD - THE BOARD TO PRINT
C
C
C     	 PRINT THE BOARD IN A CONVIENT FORMAT
C
C*
	INTEGER BOARD(26),PRNTBF(26)
	INTEGER ABLANK, AR, AW
	DATA ABLANK/' '/, AR/'R'/, AW/'W'/
	DO 10 I=1,15
	COUNT=16-I
	PFLAG=0
	DO 20 J=1,26
	PRNTBF(J)=ABLANK
	IF(IAND(BOARD(J),15).LT.COUNT) GO TO 20
	PRNTBF(J)=AR
	IF(ISHFT(BOARD(J),-4).EQ.0) PRNTBF(J)=AW
	PFLAG=1
20    CONTINUE
C***  PRINT THE BUFFER IF PFLAG=1
	IF(PFLAG.EQ.0) GO TO 10
	WRITE(1,30) PRNTBF
30    FORMAT(2X,A1,2X,6A2,1X,6A2,2X,6A2,1X,6A2,1X,A1)
10    CONTINUE
	WRITE(1,*)
     $'^  + + + + + +  + + + + + +   + + + + + +  + + + + + +  ^'
	WRITE(1,*)
     $'1  2 3 4 5 6 7  8 9 | 11| 13  | 15| 17| 19 | 21| 23| 25 |'
	WRITE(1,*)
     $'                    10  12    14  16  18   20  22  24   26'
	RETURN
	END
      SUBROUTINE INIT(BOARD)
C
C      INITIALIZE THE PLAYING BOARD.
C
C
C	 BOARD - A BOARD TO INITIALIZE
C
C
C	 GENERATE THE INITIAL PLAYING FORMAT
C
C*
	INTEGER BOARD(26)
	RED=16
	WHITE=0
	DO 10 I=1,26
10    BOARD(I)=0
C***  PUT THE MEN ON THE BOARD
	BOARD(2)=WHITE+2
	BOARD(7)=RED+5
	BOARD(9)= RED+3
	BOARD(13)=WHITE+5
	BOARD(14)=RED+5
	BOARD(18)=WHITE+3
	BOARD(20)=WHITE+5
	BOARD(25)=RED+2
	RETURN
	END
      SUBROUTINE INPMOV(BOARD,ROLL)
C
C     	 INPUT A MOVE FROM THE PLAYER.
C
C     	 BGAMON
C
C     	 BOARD - THE STATE OF THE BOARD BEFORE MOVING
C
C     	 BOARD - THE STATE OF THE BOARD AFTER MOVING
C
C     	 GET THE NEXT ROLL FOR THE PLAYER.
C          INPUT THE MOVE.  CHECK FOR LEGALITY AGAINST BOARD.
C          UPON RETURN THE NEW BOARD IS IN 'BOARD' AND IT WAS A
C          LEGAL MOVE.  THE ROUTINE WILL GIVE ERROR MESSAGES.
C
C     	 1.0
C*
	INTEGER ROLL(2),MOVE(2,4),BOARD(26),BOARD1(26),BOARD2(26)
	INTEGER TEST(2)
	MOVSW=0
	WRITE(1,3) ROLL
3     FORMAT(1X, 'YOU ROLL',2I2,'.')
	WRITE(1,300)
300	FORMAT(' Your move?>',$)
	GO TO 4
61    WRITE(1,1)
1     FORMAT(1X, 'Try again>'$)
4     READ(1,2,END=99,ERR=61) MOVE
2     FORMAT(8I6)
C***  GET THE PLAYERS MOVE
C***  CHECK IF PLAYER MUST ENTER
	IF(BOARD(1).EQ.0) GO TO 67
	TEST(1)=1
	TEST(2)=ROLL(1)
	IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67
	TEST(2)=ROLL(2)
	IF(MOVCHK(BOARD,TEST).NE.0) GO TO 67
	WRITE(1,*)'YOU HAVE NO MOVE'
	RETURN
C***  IF NO SECOND ROLL SPECIFIED, ACCEPT IT
C     IF NO FIRST ROLL, ACCEPT IT
67    CONTINUE
	IF(MOVE(1,1).EQ.0) RETURN
	IF(MOVE(1,2).NE.0) GO TO 64
	IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61
	CALL MAKMOV(BOARD,BOARD,MOVE(1,1))
	GOTO 68
64    IF(MOVE(2,1).EQ.ROLL(1).AND.MOVE(2,2).EQ.ROLL(2)) GO TO 62
	IF(MOVE(2,1).EQ.ROLL(2).AND.MOVE(2,2).EQ.ROLL(1)) GO TO 62
	GO TO 61
62    IF(MOVCHK(BOARD,MOVE(1,1)).EQ.0) GO TO 61
	CALL MAKMOV(BOARD,BOARD1,MOVE(1,1))
	IF(MOVCHK(BOARD1,MOVE(1,2)).EQ.0) GO TO 61
	CALL MAKMOV(BOARD1,BOARD,MOVE(1,2))
68    IF(ROLL(1).EQ.ROLL(2).AND.MOVSW.EQ.0) GO TO 80
	RETURN
C***  DOUBLES, GET SECOND MOVE
80    CONTINUE
	WRITE(1,*)'INPUT NEXT MOVE'
	MOVSW=1
	GO TO 4
99	WRITE(1,*)'Nice Playing With You.'
	STOP
	END
      SUBROUTINE MAKNXT(BOARD,NEWBRD,MOVE)
C
C     	 MAKE THE NEXT MOVE IN SEQUENCE
C
C     	 BGAMON
C
C     	
C
C     	
C
C     	 IF THE MOVE(1) RETURNED IS -1, NO MORE MOVES
C
C     	 1.0
C*
	INTEGER BOARD(26),NEWBRD(26),MOVE(2)
10    CALL NXTMOV(BOARD,MOVE)
	IF(MOVE(1).EQ.-1) RETURN
	IF(MOVCHK(BOARD,MOVE).EQ.0) GO TO 10
	CALL MAKMOV(BOARD,NEWBRD,MOVE)
	RETURN
	END
      SUBROUTINE EVAL(BOARD,STATUS)
C
C     	 EVALUATE THE BOARD POSITION
C
C     	 BGAMON
C
C     	 BOARD - THE PLAYING BOARD TO BE EVALUATED
C          STATUS - N/A
C
C     	 BOARD - N/C
C          STATUS - ARRAY CONTAINING THE SCORE
C
C     	
C
C     	 1.0
C*
	INTEGER BOARD(26),STATUS(6)
	DATA LUTR /6/
C***  CALCULATE THE SCORE
	DO 5 I=1,6
5     STATUS(I)=0
C***  GENERATE THE PLAYERS COUNT
	DO 10 I=1,25
	IF(BOARD(I).EQ.0) GO TO 10
	IF(ISHFT(BOARD(I),-4).NE.0) GO TO 10
	STATUS(1)=STATUS(1)+IAND(BOARD(I),15)*(26-I)
10    CONTINUE
C***  GENERATE COMPUTERS SCORE
	DO 20 I=2,26
	IF(BOARD(I).EQ.0) GO TO 20
	IF(ISHFT(BOARD(I),-4).EQ.0) GO TO 20
	STATUS(2)=STATUS(2)+IAND(BOARD(I),15)*(I-1)
20    CONTINUE
C***  GENERATE THE VUNERABILITY INDEX OF THE PLAYER
	DO 30 I=2,25
	IBRDP=BOARD(I)
	IF(IBRDP.EQ.0) GOTO 30
	IF(ISHFT(IBRDP,-4).NE.0) GO TO 30
	IF(IAND(IBRDP,15).NE.1) GO TO 30
C***  BLOT FOUND
	K=J+12
	IF(K.GT.25) K=25
	DO 35 J=I,K
	IF(ISHFT(BOARD(J),-4).NE.1) GO TO 35
C***  CALCULATE VUNERAILITY, DIRECT SHOTS=2, COMBINATIONS=1
	STATUS(3)=STATUS(3)+2-(J-I)/6
35    CONTINUE
30    CONTINUE
C***  GENERATE THE VUNERABILITY INDEX OF THE COMPUTER
	VUN=0
	DO 40 I=1,25
	IBRDP=BOARD(I)
	IF(IBRDP.EQ.0) GOTO 40
	IF(ISHFT(IBRDP,-4).NE.1) GO TO 40
	IF(IAND(IBRDP,15).GT.1) GO TO 40
C***  BLOT FOUND
	ISW=0
	IF(I.GE.20) ISW=1
	K=I-12
	IF(K.LT.1) K=1
C***  SCAN FOR PLAYERS MEN WITHIN RANGE
	VUN=0
	DO 45 J=K,I
	IF(BOARD(J).EQ.0) GOTO 45
	IF(ISHFT(BOARD(J),-4).NE.0) GO TO 45
C***  VUNERABILITY CALCULATED, DIRECT SHOTS=2, INDIRECT SHOTS=1
	RANGE=I-J
	VUN=VUN+(2-(RANGE-1)/6)
45    CONTINUE
C***  LIMIT VUNERABILITY BECAUSE PROBABILITY OF HIT NOT LINEAR
	IF(VUN.GT.5) VUN=5
C***  WEIGHT VUNERABILITY BY ADVANCEMENT
	ADV=(31-I)/6
C***  WEIGHT VUNERABILITY BY THE NUMBER OF POINTS OCCUPIED IN
C     OPPONETS HOME COURT
	POCC=0
	DO 49 K=20,25
	IF(BOARD(K).EQ.0) GOTO 49
	IF(ISHFT(BOARD(K),-4).NE.0) GO TO 49
	IF(IAND(BOARD(K),15).LT.2) GO TO 49
	POCC=POCC+1
49    CONTINUE
	POCC=POCC/3+1
C***  IF IN OPPONETS HOME COURT AND NOT TOO MANY POINTS
C     OCCUPIED, WEIGHT VUNERABILITY LESS.
	IF(ADV.EQ.1.AND.POCC.LE.2) VUN=VUN/2
	NETVUN=VUN*ADV*POCC
	STATUS(4)=STATUS(4)+NETVUN
40    CONTINUE
C***  GENERATE THE COMPOSITE SCORE OF THE PLAYER
	STATUS(5)=STATUS(1)-STATUS(2)+STATUS(3)
C***  GENERATE THE COMPOSITE SCORE OF THE COMPUTER
	STATUS(6)=STATUS(2)-STATUS(1)+STATUS(4)
C
C***  MODIFY THE COMPOSITE SCORE FROM POSITIONAL FACTORS
C     INCREASE 1 POINT FOR EACH MAN OVER 4 ON A POINT
C     DECREASE BY THE NUMBER OF MADE POINTS
C     INCREASE THE SCORE FOR EACH MAN LEFT
C
C***  MODIFY COMPUTERS SCORE
	IOURS=1
	PCNT=0
	MCNT=0
	DO 50 I=1,26
C***  SET UP SHORTENED VARIBLES
	IBP=BOARD(I)
	CNT=IAND(IBP,15)
	IF(IBP.EQ.0) GO TO 50
	IF(ISHFT(IBP,-4).NE.IOURS) GOTO 50
	MCNT=MCNT+CNT
C***  DISFAVOR COUNTS GREATER THAN 3
	IF(CNT.GT.3) STATUS(6)=STATUS(6)+CNT-3
C***  PERFORM THE FOLLOWING TESTS IF POINT IS MADE
	IF(CNT.LT.2) GO TO 50
C***  KEEP TRACK OF NUMBER OF POINTS
	PCNT=PCNT+1
50    CONTINUE
C***  FAVOR MORE POINTS, FEWER MEN
C     FEWER MEN IS THE OVERRIDING FACTOR
	STATUS(6)=STATUS(6)-PCNT+MCNT*3
	RETURN
	END