Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0092/wgmm10.for
There are no other files named wgmm10.for in the archive.
00100 C THIS PROGRAM MUST BE COMPILED WITH VERSION 27A FORTRAN IV !!!
00200 C ONLY - HOUSTON P. LOWRY PITZER COLLEGE CLAREMONT CALIFORNIA
00300 INTEGER HPLA,HLPB
00400 INTEGER OPT,DSR,ASK
00500 LOGICAL EXSW,DONSW(2),GRPATT(2),NEGSW,QSW,TSW
00600 DIMENSION NP(2),ATTWRD(3),TLKWRD(3)
00700 DIMENSION PPAY(4),NSTRT(4),NTSTRT(2),NTKACC(2)
00800 DIMENSION NSUB(2),INDTOT(4,9,2),INDATT(9,2),INDTLK(9,2)
00900 DIMENSION INDPRB(9,2),IGRTOT(4,2),IGRPRB(2)
01000 DIMENSION IGRATT(2), IDATA(50), DATA(10)
01100 DIMENSION DSR(5/7)
01200 DIMENSION IQTOT(4,2), IQATT(2),QPOT(2)
01300 DIMENSION TXTEAM(2),REPLY(3)
01400 DIMENSION TERM(4,3),NORD(4,2),POT(2),PPOT(2),CHAN1(2),
01500 1 CHAN2(2)
01600 COMMON /C1/ TERM
01700 COMMON /C2/ NORD
01800 COMMON /C3/ REPLY
01900 COMMON /C4/ POTIN,POT,PPOT
02000 COMMON /C5/ QST
02100 COMMON /C6/ CHAN1,CHAN2
02200 COMMON /TSR/ DSR
02300 COMMON /HPL1/ HPLA,DEVICE
02400 DATA TXNONE/5HNONE /
02500 DATA TXTEAM(1),TXTEAM(2)/5HYOUR ,5HOTHER/
02600 DATA QST/1H?/
02700 DATA DSR/5,6,7/
02800 493 CONTINUE
02900 494 CONTINUE
03000 495 CONTINUE
03100 WRITE (5,9100)
03200 9100 FORMAT ('1WGMM11 5/8/76',/,' TEAM 2 TTY (TTYNN FORM ): ',$ )
03300 9101 FORMAT(A5)
03400 9102 READ(5,9101,END=555)DEVICE
03500 OPEN (UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
03600 OPEN (UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
03700 9104 WRITE (5,9105)
03800 9105 FORMAT(' HELP? ',$ )
03900 9106 READ(5,9107,END=555)ASK
04000 9107 FORMAT(A3)
04100 IF (ASK .EQ. 'NO' .OR. ASK .EQ. 'N') GOTO 92
04200 9108 WRITE (5,9109)
04300 9109 FORMAT ('0SET 3 = 20 MILITARY AND 0 ECONOMIC ',/,
04400 1' SET 4 = 10 MILITARY AND 10 ECONOMIC ',/,
04500 2' SET 5 = 0 MILITARY AND 20 ECONOMIC ',/,
04600 3' PHAMTOM EXPERIMENTER ON LPT, ^ Z WILL END RUN SAVING FILES',/,
04700 4' ALL ASSIGNMENTS ARE NOW COMPLETELY INTERNAL',/,
04800 5' HOUSTON P. LOWRY PITZER COLLEGE 5/8/76')
04900 92 WRITE (5,499)
05000 499 FORMAT (' DATA FILENAME (5 CHARS. MAX.) ? ',$ )
05100 READ (5,498,END=555) FILEN
05200 OPEN(UNIT=7,DEVICE='LPT',ACCESS='SEQOUT',FILE='EXPR')
05300 OPEN(UNIT=4,DEVICE='DSK',ACCESS='SEQOUT',FILE=FILEN)
05400 OPEN(UNIT=8,DEVICE='LPT',ACCESS='SEQOUT',FILE='PRNTR')
05500 498 FORMAT (A5)
05600 WRITE (5,504)
05700 504 FORMAT(' 3 DIGIT SESSION CODE: ',$)
05800 READ (5,5111,END=555) ICODE
05900 5111 FORMAT (I)
06000 WRITE (5,9114)
06100 9114 FORMAT (' HOW MANY EXCHANGES ARE PERMITTED DURING TALKS ?',$)
06200 READ (5,9115,END=555) HPLA
06300 9115 FORMAT (F2.0)
06400 WRITE (5,9116)
06500 9116 FORMAT (' HOW MANY SETS ARE TO BE PERMITTED ?',$)
06600 READ (5,9115,END=555) HPLB
06700 WRITE (5,6001)
06800 6001 FORMAT(' FAST INIT? ',$)
06900 READ (5,51,END=555) (REPLY(I),I=1,3)
07000 CALL CODE (3,I)
07100 IF (I .NE. 2) GO TO 102
07200 6013 WRITE (5,6002)
07300 6002 FORMAT(' WHICH SET? ',$)
07400 READ (5,5111,END=555) J
07500 IF (J .EQ. 0) J = 1
07600 IF (J .LE. 10) GO TO 6012
07700 6004 WRITE (5,6003)
07800 6003 FORMAT(' TRY AGAIN')
07900 GO TO 6013
08000 6012 GO TO (61,62,63,64,65,70,70,70,70,70),J
08100 70 WRITE (5,6020)
08200 6020 FORMAT(' NONEXISTENT')
08300 GO TO 6004
08400 62 TSW = .TRUE.
08500 GO TO 72
08600 61 TSW = .FALSE.
08700 72 NP(1) = 1
08800 NP(2) = 1
08900 MAXT = 1
09000 NEGSW = .TRUE.
09100 QSW = .TRUE.
09200 MAXMOV = 5
09300 MAXCH = 4
09400 OPT = 2
09500 EXSW = .TRUE.
09600 NSTRT(1) = 20
09700 NSTRT(2) = 0
09800 MATTOT = 20
09900 NGAME = 2
10000 PPAY(1) = -.02
10100 PPAY(2) = 0.02
10200 APAY1 = .06
10300 POTIN = 2.5
10400 WB = 5.
10500 GO TO 71
10600 63 NSTRT(1) =20
10700 NSTRT(2) =0
10800 GO TO 73
10900 64 NSTRT(1) =10
11000 NSTRT(2) =10
11100 GO TO 73
11200 65 NSTRT(1) =0
11300 NSTRT(2) =20
11400 GO TO 73
11500 73 TSW=.TRUE.
11600 NP(1)=1
11700 NP(2)=1
11800 MAXT=1
11900 NEGSW=.TRUE.
12000 QSW=.TRUE.
12100 MAXMOV=5
12200 MAXCH=4
12300 OPT=2
12400 EXSW=.TRUE.
12500 TERM(1,1)='MILIT'
12600 TERM(1,2)='ARY U'
12700 TERM(1,3)='NITS '
12800 TERM(2,1)='ECONO'
12900 TERM(2,2)='MIC U'
13000 TERM(2,3)='NITS '
13100 TERM(3,1)='NONE '
13200 TERM(3,2)=' '
13300 TERM(4,1)='NONE '
13400 TERM(4,2)=' '
13500 MATTOT=20
13600 NGAME=2
13700 ATTWRD(1)='ATTAC'
13800 ATTWRD(2)='K '
13900 ATTWRD(3)=' '
14000 TLKWRD(1)='TALKS'
14100 TLKWRD(2)=' '
14200 TLKWRD(3)=' '
14300 PPAY(1)=-.20
14400 PPAY(2)=.20
14500 APAY1=.50
14600 POTIN=7.50
14700 WB=30.00
14800 GO TO 71
14900 71 DO 43 I=1,2
15000 POT(I) = POTIN
15100 43 PPOT(I) = POTIN
15200 GOTO 101
15300 102 WRITE (5,10) QST
15400 10 FORMAT(' # PLAYERS',A1)
15500 DO 1 N=1,2
15600 WRITE (5,11) N
15700 11 FORMAT(' TEAM ',I1,': ',$)
15800 1 READ (5,5111,END=555) NP(N)
15900 MAXT=1
16000 IF (NP(1).LT.NP(2)) MAXT=2
16100 WRITE (5,1000) QST
16200 1000 FORMAT(' NEGOTIATIONS',A1,1X,$)
16300 NEGSW=.FALSE.
16400 READ (5,51,END=555) (REPLY(I),I=1,3)
16500 CALL CODE (3,JNEG)
16600 IF (JNEG.EQ.2) NEGSW=.TRUE.
16700 WRITE (5,1010) QST
16800 1010 FORMAT(' NEGOTIATIONS BY TTY',A1,1X,$)
16900 TSW = .FALSE.
17000 READ (5,51,END=555) (REPLY(I),I=1,3)
17100 CALL CODE (3,JTY)
17200 IF (JTY .EQ. 2) TSW = .TRUE.
17300 1002 WRITE (5,2000) QST
17400 2000 FORMAT(' QUESTIONS',A1,1X,$)
17500 QSW=.FALSE.
17600 READ (5,51,END=555) (REPLY(I),I=1,3)
17700 CALL CODE (3,JQS)
17800 IF (JQS.EQ.2) QSW=.TRUE.
17900 WRITE (5,13) QST
18000 13 FORMAT(' MOVES/SET',A1,1X,$)
18100 READ (5,51,END=555) REPLY
18200 CALL CODE (3,MAXMOV)
18300 WRITE (5,1313) QST
18400 1313 FORMAT(' MAX. CHANGES/MOVE',A1,1X,$)
18500 READ (5,51,END=555) (REPLY(I),I=1,3)
18600 CALL CODE (3,MAXCH)
18700 C
18800 WRITE (5,190) QST
18900 190 FORMAT(' DISPLAY RESULTS',A1,1X,$)
19000 READ (5,51,END=555) (REPLY(I),I=1,3)
19100 CALL CODE (3,OPT)
19200 WRITE (5,14)
19300 14 FORMAT(' NAME MATERIALS: '/
19400 1 ' TYPE NONE WHERE APPROPRIATE'/' ')
19500 EXSW=.FALSE.
19600 DO 2 N=1,4
19700 READ (5,16,END=555) (TERM(N,I),I=1,3)
19800 16 FORMAT (3A5)
19900 2 IF (TERM(N,1).EQ.TXNONE) EXSW=.TRUE.
20000 NGAME=4
20100 IF (EXSW) NGAME=2
20200 C THAT MEANS WE ARE PLAYIMG THE SIMPLE GAME
20300 C SPECIFY THE WORD FOR "ATTACK"
20400 WRITE (5,17)
20500 17 FORMAT(' ATTACK WORD: ',$)
20600 READ (5,16,END=555) (ATTWRD(I),I=1,3)
20700 IF (.NOT. NEGSW) GO TO 19
20800 WRITE (5,18)
20900 18 FORMAT(' NEGOTIATIONS WORD: ',$)
21000 READ (5,16,END=555) (TLKWRD(I),I=1,3)
21100 19 WRITE (5,20) QST
21200 20 FORMAT(' NONCOMPETETIVE PAYOFFS',A1)
21300 WRITE (5,21)
21400 21 FORMAT(' NEG. NUMBERS = COSTS: ',/' ')
21500 DO 3 N=1,4
21600 IF (TERM(N,1) .EQ.TXNONE) GO TO 3
21700 WRITE (5,22) (TERM(N,I),I=1,3),QST
21800 22 FORMAT (' FOR ',3A5,A1,1X,$)
21900 READ (5,23,END=555) PPAY(N)
22000 23 FORMAT (F)
22100 3 CONTINUE
22200 WRITE (5,24) QST
22300 24 FORMAT(' COMPETITIVE PAYOFFS',A1/' ')
22400 IF (EXSW) GO TO 40
22500 WRITE (5,25) (TERM(1,I),I=1,3),(TERM(2,J),J=1,3) ,QST
22600 25 FORMAT (' FOR' ,3A5,' OVER' ,3A5,A1/' ')
22700 READ (5,23,END=555) APAY1
22800 WRITE (5,25) (TERM(2,I),I=1,3),(TERM(3,J),J=1,3) ,QST
22900 READ (5,23,END=555) APAY2
23000 GO TO 4
23100 40 WRITE (5,22) (TERM(1,I),I=1,3),QST
23200 READ (5,23,END=555) APAY1
23300 4 WRITE (5,30) QST
23400 30 FORMAT(' PLAYER FUNDS',A1,1X,$)
23500 READ (5,23,END=555) POTIN
23600 WRITE (5,31) QST
23700 31 FORMAT(' WORLD BANK FUNDS',A1,1X,$)
23800 READ (5,23,END=555) WB
23900 DO 42 I=1,2
24000 POT(I)=POTIN
24100 42 PPOT(I)=POTIN
24200 MATTOT = 0
24300 WRITE (5,32) QST
24400 32 FORMAT(' # MATERIALS',A1/' ')
24500 DO 5 N=1,4
24600 IF (TERM(N,1) .EQ. TXNONE) GO TO 5
24700 WRITE (5,33) (TERM(N,I),I=1,3),QST
24800 33 FORMAT(' HOW MANY ',3A5,A1,1X,$)
24900 READ (5,34,END=555) NSTRT(N)
25000 34 FORMAT (I)
25100 MATTOT = MATTOT + NSTRT(N)
25200 5 CONTINUE
25300 101 IDATA(1) = ICODE
25400 IDATA(2) = NP(1)
25500 IDATA(3) = NP(2)
25600 IDATA(4) = MAXMOV
25700 IDATA(5) = MAXCH
25800 IDATA(6) = NGAME
25900 IDATA(7) = OPT
26000 IDATA(8) = JNEG
26100 IDATA(9) = JQS
26200 WRITE (4,105) (IDATA(K),K=1,9),(PPAY(J),J=1,4),APAY1,
26300 1 APAY2,POTIN,WB,(NSTRT(L),L=1,4)
26400 WRITE (8,106) (IDATA(K),K=1,9),(PPAY(J),J=1,4),APAY1,
26500 1 APAY2,POTIN,WB,(NSTRT(L),L=1,4)
26600 105 FORMAT(I4,1H1,1X,2I1,1X,6I2,1X,8F6.2,1X,4I2)
26700 106 FORMAT(' ',I3,3H 1 ,2I2,4I3,2I2,8F8.2,4I3)
26800 WRITE (5,501)
26900 501 FORMAT('1')
27000 IF (NSET .LT. HPLB) GOTO 59
27100 555 WRITE (5,556)
27200 WRITE (6,556)
27300 556 FORMAT(21H THE GAME IS FINISHED/22H THANK YOU FOR PLAYING/' ')
27400 WRITE (7,556)
27500 OPEN(UNIT=20,DEVICE='DSK',ACCESS='SEQOUT',FILE='TALK.DAT')
27600 CLOSE(UNIT=20,DISPOSE='DELETE')
27700 CALL EXIT
27800 GO TO 92
27900 59 NMOVE = 1
28000 NSET = NSET + 1
28100 DO 55 I=1,2
28200 DO 54 J=1,4
28300 NORD(J,I) = NSTRT(J)
28400 54 CONTINUE
28500 55 CONTINUE
28600 60 WRITE (5,666) NMOVE
28700 WRITE (6,666) NMOVE
28800 WRITE (7,666) NMOVE
28900 666 FORMAT('0MOVE ',I3)
29000 WRITE (6,1208)
29100 IF (.NOT. QSW) GO TO 667
29200 DO 799 NT=1,2
29300 NDEV = NT + 4
29400 701 WRITE (7,7000) NT,QST
29500 7000 FORMAT(' QST. SIDE ',I1,A1)
29600 WRITE (NDEV,7001) QST
29700 7001 FORMAT(' DO YOU HAVE A QUESTION',A1,1X,$)
29800 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
29900 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
30000 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
30100 CALL CODE (NT,JQUEST)
30200 IF (JQUEST .EQ. 2) GO TO 702
30300 WRITE (NDEV,1208)
30400 GO TO 799
30500 702 WRITE (NDEV,7002)
30600 7002 FORMAT(28H TYPE IN THE DESIRED NUMBERS)
30700 DO 760 KCT=1,2
30800 WRITE (7,7003) TXTEAM(KCT)
30900 WRITE (NDEV,7003) TXTEAM(KCT)
31000 7003 FORMAT(5H FOR ,A5,5H SIDE)
31100 IQSUM = 0
31200 DO 750 N=1,4
31300 IF (TERM(N,1) .EQ. TXNONE) GO TO 750
31400 WRITE (NDEV,1209) (TERM(N,I),I=1,3),QST
31500 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
31600 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
31700 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
31800 CALL CODE (NT,IQTOT(N,KCT))
31900 IQSUM = IQSUM + IQTOT(N,KCT)
32000 750 CONTINUE
32100 IF (IQSUM .EQ. MATTOT) GO TO 761
32200 WRITE (NDEV,7005)
32300 7005 FORMAT(24H WRONG TOTAL - TRY AGAIN )
32400 GO TO 702
32500 761 WRITE (7,7004) TXTEAM(KCT),(ATTWRD(I),I=1,3),QST
32600 WRITE (NDEV,7004) TXTEAM(KCT),(ATTWRD(I),I=1,3),QST
32700 7004 FORMAT(6H DOES ,A5,6H SIDE ,3A5,A1,1X,$)
32800 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
32900 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
33000 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
33100 CALL CODE (NT,IQATT(KCT))
33200 760 CONTINUE
33300 QPOT(1) = 0.0
33400 QPOT(2) = 0.
33500 IF ((IQATT(1) .NE. 2) .AND. (IQATT(2) .NE. 2)) GO TO 780
33600 DO 775 KCT=1,2
33700 IF (IQATT(KCT) .NE. 2) GO TO 775
33800 LCT = 3 - KCT
33900 IF (EXSW) GO TO 774
34000 QADIFF = FLOAT(IQTOT(1,KCT) - IQTOT(2,LCT))*APAY1
34100 QPOT(KCT) = QPOT(KCT) + QADIFF
34200 QPOT(LCT) = QPOT(LCT) - QADIFF
34300 QADIFF = FLOAT(IQTOT(2,KCT) - IQTOT(3,LCT))*APAY2
34400 QPOT(KCT) = QPOT(KCT) + QADIFF
34500 QPOT(LCT) = QPOT(LCT) - QADIFF
34600 GO TO 775
34700 774 QADIFF = FLOAT(IQTOT(1,KCT) - IQTOT(1,LCT))*APAY1
34800 IF ((IQATT(1) .EQ. 2) .AND. (IQATT(2) .EQ. 2))
34900 1 QADIFF = QADIFF/2.0
35000 QPOT(KCT) = QPOT(KCT) + QADIFF
35100 QPOT(LCT) = QPOT(LCT) - QADIFF
35200 775 CONTINUE
35300 IF (QPOT(1) .LT. 0.0) GO TO 776
35400 WRITE (NDEV,7750) QPOT(1)
35500 7750 FORMAT(16H YOU WOULD WIN $,F5.2,20H FROM THE OTHER SIDE/' ')
35600 GO TO 780
35700 776 WRITE (NDEV,7760) QPOT(2)
35800 7760 FORMAT(16H YOU WOULD PAY $,F5.2,18H TO THE OTHER SIDE/' ')
35900 780 DO 785 KCT = 1,2
36000 QPDIFF = 0.0
36100 DO 784 N=1,4
36200 IF (TERM(N,1) .EQ. TXNONE) GO TO 784
36300 QPDIFF = QPDIFF + FLOAT(IQTOT(N,KCT))*PPAY(N)
36400 784 CONTINUE
36500 7841 FORMAT(' ',A5,17H SIDE WOULD PAY $,F5.2,14H TO WORLD BANK/' ')
36600 7840 FORMAT(1X,A5,21H SIDE WOULD RECEIVE $,F5.2,
36700 1 16H FROM WORLD BANK/' ')
36800 QPOT(KCT) = QPOT(KCT) + QPDIFF
36900 IF (QPDIFF .LT. 0.0) GO TO 788
37000 WRITE (NDEV,7840) TXTEAM(KCT),QPDIFF
37100 GO TO 785
37200 788 QPDIFF = - QPDIFF
37300 WRITE (NDEV,7841) TXTEAM(KCT),QPDIFF
37400 785 CONTINUE
37500 IF ((IQATT(1) .NE. 2) .AND. (IQATT(2) .NE. 2)) GO TO 798
37600 DO 795 KCT=1,2
37700 IF (QPOT(KCT) .LT. 0.0) GO TO 794
37800 WRITE (NDEV,7930) TXTEAM(KCT),QPOT(KCT)
37900 7930 FORMAT(15H TOTAL GAIN TO ,A5,10H SIDE OF $,F5.2)
38000 GO TO 795
38100 794 QPOT(KCT) = -QPOT(KCT)
38200 WRITE (NDEV,7940) TXTEAM(KCT),QPOT(KCT)
38300 7940 FORMAT(15H TOTAL LOSS TO ,A5,10H SIDE OF $,F5.2)
38400 795 CONTINUE
38500 798 GO TO 701
38600 799 CONTINUE
38700 667 IF (.NOT. NEGSW) GO TO 1222
38800 WRITE (7,503) (TLKWRD(I),I=1,3),QST
38900 503 FORMAT('0INITIATE ',3A5,A1)
39000 DO 100 N=1,2
39100 NDEV = N + 4
39200 WRITE (7,502) N
39300 502 FORMAT (6H TEAM ,I1)
39400 WRITE (NDEV,500) (TLKWRD(I),I=1,3),QST
39500 500 FORMAT('0DO YOU WISH TO INITIATE ',3A5,A1,1X,$)
39600 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
39700 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
39800 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
39900 51 FORMAT(3A1)
40000 CALL CODE(N,NTSTRT(N))
40100 WRITE (NDEV,52) (TLKWRD(I),I=1,3),QST
40200 52 FORMAT (' WILL YOU ACCEPT IF OTHER SIDE INITIATES ',
40300 1 3A5,A1,1X,$)
40400 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
40500 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
40600 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
40700 CALL CODE (N,NTKACC(N))
40800 WRITE (NDEV,1208)
40900 100 CONTINUE
41000 IF ((NTSTRT(1) .EQ. 2) .AND. (NTKACC(2) .EQ. 2)) GO TO 110
41100 IF ((NTSTRT(2) .EQ. 2) .AND. (NTKACC(1) .EQ. 2)) GO TO 110
41200 GO TO 120
41300 110 WRITE (5,1100) (TLKWRD(I),I=1,3)
41400 1100 FORMAT(' ',3A5,17H WILL TAKE PLACE. )
41500 WRITE (6,1100) (TLKWRD(I),I=1,3)
41600 WRITE (7,1100) (TLKWRD(I),I=1,3)
41700 IF (TSW) CALL TALKS(NTSTRT,NTKACC,ICODE,NSET,NMOVE)
41800 IF (TSW) GO TO 1222
41900 GO TO 1222
42000 120 WRITE (5,12220) (TLKWRD(I),I=1,3)
42100 WRITE (6,12220) (TLKWRD(I),I=1,3)
42200 12220 FORMAT(4H NO ,3A5)
42300 1222 DO 121 N=1,2
42400 DONSW(N) = .FALSE.
42500 IF (NP(N) .EQ. 1) DONSW(N) = .TRUE.
42600 121 NSUB(N) = 1
42700 NT = MAXT
42800 122 IF (DONSW(1) .AND. DONSW(2)) GO TO 200
42900 IF (DONSW(NT)) GO TO 130
43000 NDEV = NT + 4
43100 WRITE (7,1200) NT,NSUB(NT)
43200 WRITE (NDEV,1200) NT,NSUB(NT)
43300 1200 FORMAT('0TEAM',I1,3X,8HSUBJECT ,I1)
43400 MSUB = NSUB(NT)
43500 WRITE (NDEV,12001)
43600 12001 FORMAT(16H YOUR ASSETS ARE )
43700 CALL TPCASH (NDEV,NT)
43800 MT = 3 - NT
43900 WRITE (NDEV,12002)
44000 12002 FORMAT(17H THEIR ASSETS ARE )
44100 CALL TPCASH (NDEV,MT)
44200 WRITE (NDEV,1201)
44300 1201 FORMAT(12H YOU HAVE : )
44400 123 CALL TPMAT (NT,NDEV)
44500 WRITE (NDEV,1203) QST
44600 1203 FORMAT(' WHAT DO YOU WANT AS YOUR NEW ALLOCATION',A1)
44700 WRITE (NDEV,12003) MATTOT
44800 12003 FORMAT(15H TOTAL MUST BE ,I2)
44900 WRITE (NDEV,12004) MAXCH
45000 12004 FORMAT(31H YOU CANNOT EXCHANGE MORE THAN ,I2,6H ITEMS)
45100 DO 124 N=1,4
45200 IF (TERM(N,1) .EQ. TXNONE) GO TO 124
45300 WRITE (NDEV,1209) (TERM(N,I),I=1,3),QST
45400 1209 FORMAT(' HOW MANY ',3A5,
45500 1 ' DO YOU WANT TO HAVE AT END OF THIS MOVE',A1,1X,$)
45600 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
45700 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
45800 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
45900 CALL CODE (NT,INDTOT(N,MSUB,NT))
46000 124 CONTINUE
46100 NDIFF = 0
46200 NSM = 0
46300 DO 125 N=1,4
46400 IF (TERM(N,1) .EQ. TXNONE) GO TO 125
46500 NDIFF = NDIFF + MAX0(INDTOT(N,MSUB,NT),NORD(N,NT))
46600 NDIFF = NDIFF - MIN0(INDTOT(N,MSUB,NT),NORD(N,NT))
46700 NSM = NSM + INDTOT(N,MSUB,NT)
46800 125 CONTINUE
46900 IF (NDIFF .GT. MAXCH*2) GO TO 126
47000 IF (NSM .NE. MATTOT) GO TO 126
47100 GO TO 127
47200 126 WRITE (7,1202)
47300 WRITE (NDEV,1202)
47400 1202 FORMAT (24H ILLEGAL MOVE, TRY AGAIN )
47500 GO TO 123
47600 127 WRITE (7,1204) (ATTWRD(I),I=1,3),QST
47700 WRITE (NDEV,1204) (ATTWRD(I),I=1,3),QST
47800 1204 FORMAT(' DO YOU WISH TO ',3A5,A1,1X,$)
47900 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
48000 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
48100 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
48200 CALL CODE (NT,INDATT(MSUB,NT))
48300 IF (.NOT. NEGSW) GO TO 12051
48400 WRITE (7,1205) (TLKWRD(I),I=1,3),QST
48500 WRITE (NDEV,1205) (TLKWRD(I),I=1,3),QST
48600 1205 FORMAT (' DO YOU WISH TO ENTER ',3A5,A1,1X,$)
48700 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
48800 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
48900 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
49000 CALL CODE (NT,INDTLK(MSUB,NT))
49100 12051 WRITE (7,1206) (ATTWRD(I),I=1,3)
49200 WRITE (NDEV,1206) (ATTWRD(I),I=1,3)
49300 1206 FORMAT(' ESTIMATE PROBABILITY THAT OTHER SIDE WILL ',3A5)
49400 WRITE (NDEV,1207)
49500 1207 FORMAT(' TYPE NUMBER BETWEEN 0 AND 100: ',$)
49600 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
49700 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
49800 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
49900 CALL CODE (NT,INDPRB(MSUB,NT))
50000 WRITE (NDEV,1208)
50100 1208 FORMAT('1 PLEASE WAIT' /'1')
50200 NSUB(NT) = NSUB(NT) + 1
50300 IF (NSUB(NT) .GT. NP(NT)) DONSW(NT) = .TRUE.
50400 130 NT = 3 - NT
50500 GO TO 122
50600 200 IF (NP(1) .NE. 1) WRITE (5,2500)
50700 2500 FORMAT(21H PAUSE FOR DISCUSSION )
50800 IF (NP(2) .NE. 1) WRITE (6,2500)
50900 IF ((NP(1) + NP(2)) .LE. 2) GO TO 25000
51000 WRITE (7,2500)
51100 25000 WRITE (7,2502)
51200 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
51300 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
51400 2502 FORMAT('0READY FOR GROUP DECISIONS' )
51500 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
51600 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
51700 2501 FORMAT(' READY FOR DECISION FROM TEAM ',I1)
51800 WRITE (7,1210)
51900 1210 FORMAT(' NEW ALLOCATION?')
52000 DO 252 NT=1,2
52100 WRITE (7,502) NT
52200 NDEV = NT + 4
52300 WRITE (NDEV,2501) NT
52400 NVED = MOD(NT,2) + 5
52500 WRITE (NVED,2503)
52600 2503 FORMAT(' PLEASE WAIT')
52700 WRITE (NDEV,12005) QST
52800 12005 FORMAT (' DISPLAY ASSETS?',A1,1X,$)
52900 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
53000 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
53100 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
53200 CALL CODE (3,III)
53300 IF (III.NE. 2) GO TO 251
53400 WRITE (NDEV,12001)
53500 CALL TPCASH (NDEV,NT)
53600 MT = 3-NT
53700 WRITE (NDEV,12002)
53800 CALL TPCASH (NDEV,MT)
53900 251 WRITE (NDEV,1201)
54000 CALL TPMAT (NT,NDEV)
54100 WRITE (NDEV,1203) QST
54200 WRITE (NDEV,12003) MATTOT
54300 WRITE (NDEV,12004) MAXCH
54400 DO 254 N=1,4
54500 IF (TERM(N,1) .EQ. TXNONE) GO TO 254
54600 WRITE (NDEV,1209) (TERM(N,I),I=1,3),QST
54700 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
54800 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
54900 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
55000 CALL CODE (NT,IGRTOT(N,NT))
55100 254 CONTINUE
55200 NDIFF = 0
55300 NSM = 0
55400 DO 255 N=1,4
55500 IF (TERM(N,1) .EQ. TXNONE) GO TO 255
55600 NDIFF = NDIFF + MAX0(IGRTOT(N,NT),NORD(N,NT))
55700 NDIFF = NDIFF - MIN0(IGRTOT(N,NT),NORD(N,NT))
55800 NSM = NSM + IGRTOT(N,NT)
55900 255 CONTINUE
56000 IF (NDIFF .GT. (MAXCH*2)) GO TO 256
56100 IF (NSM .NE. MATTOT) GO TO 256
56200 GO TO 257
56300 256 WRITE (7,1202)
56400 WRITE (NDEV,1202)
56500 GO TO 251
56600 257 DO 2570 N=1,4
56700 IF (TERM(N,1) .EQ. TXNONE) GO TO 2570
56800 NORD(N,NT) = IGRTOT(N,NT)
56900 2570 CONTINUE
57000 WRITE (7,1204) (ATTWRD(I),I=1,3),QST
57100 WRITE (NDEV,1204) (ATTWRD(I),I=1,3),QST
57200 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
57300 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
57400 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
57500 CALL CODE (NT,IGRATT(NT))
57600 GRPATT(NT) = .FALSE.
57700 IF (IGRATT(NT) .EQ. 2) GRPATT(NT) = .TRUE.
57800 WRITE (7,1206) (ATTWRD(I),I=1,3)
57900 WRITE (NDEV,1206) (ATTWRD(I),I=1,3)
58000 WRITE (NDEV,1207)
58100 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
58200 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
58300 READ (NDEV,51,END=555) (REPLY(I),I=1,3)
58400 CALL CODE (NT,IGRPRB(NT))
58500 252 CONTINUE
58600 WRITE (5,2555) NMOVE
58700 WRITE (6,2555) NMOVE
58800 WRITE (7,2555) NMOVE
58900 2555 FORMAT(' END OF MOVE ',I3)
59000 NMOVE = NMOVE + 1
59100 IDATA(2) = NSET
59200 IDATA(3) = NMOVE
59300 DO 3100 NT = 1,2
59400 IDATA(4) = NT
59500 DO 3000 J=5,36
59600 3000 IDATA(J) = 0
59700 MAX = NP(NT)
59800 IF (MAX .EQ. 1) GO TO 3050
59900 DO 3010 NSB=1,MAX
60000 K=8*(NSB-1)
60100 IDATA(K+5)=NSB
60200 DO 3020 L=1,4
60300 KL=K+L+5
60400 3020 IDATA(KL)=INDTOT(L,NSB,NT)
60500 IDATA(K+10)= INDATT(NSB,NT)
60600 IDATA(K+11)=INDTLK(NSB,NT)
60700 IDATA(K+12)=INDPRB(NSB,NT)
60800 3010 CONTINUE
60900 3050 DO 3030 K=1,4
61000 3030 IDATA(K+36)= NORD(K,NT)
61100 IDATA(41)= IGRATT(NT)
61200 IDATA(42)= NTSTRT(NT)
61300 IDATA(43)= NTKACC(NT)
61400 IDATA(44)= IGRPRB(NT)
61500 WRITE (8,3202) (IDATA(K),K=1,44)
61600 WRITE (4,3201) (IDATA(K),K=1,44)
61700 3100 CONTINUE
61800 3201 FORMAT (I3,1H2,2I2,I1,1X,4(I1,4I2,2I1,I3),4I2,3I1,I3)
61900 3202 FORMAT (' ',I3,3H 2 ,2I2,1X,I1,1X,4(7I2,I4),2X,4I3,3I2,I4)
62000 IF (GRPATT(1).OR.GRPATT(2)) GO TO 300
62100 IF (NMOVE.GT.MAXMOV) GO TO 400
62200 GO TO 60
62300 300 DO 301 NT=1,2
62400 301 PPOT(NT)=POT(NT)
62500 DO 302 NT=1,2
62600 IF (.NOT.GRPATT(NT)) GO TO 302
62700 NDEV=7-NT
62800 WRITE (NDEV,3001) (ATTWRD(I),I=1,3)
62900 3001 FORMAT (' THE OTHER SIDE DECIDED TO ',3A5/
63000 1 18H THIS SET IS OVER.)
63100 MT=3-NT
63200 4100 FORMAT (28H THIS SET HAS ENDED WITHOUT ,
63300 1 3A5,6H AFTER,I2,7H MOVES.)
63400 IF (EXSW) GO TO 303
63500 DIFF=FLOAT(NORD(1,NT)-NORD(2,MT))*APAY1
63600 POT(NT)=POT(NT)+DIFF
63700 POT(MT)=POT(MT)-DIFF
63800 DIFF=FLOAT(NORD(2,NT)-NORD(3,MT))*APAY2
63900 POT(NT)=POT(NT)+DIFF
64000 POT(MT)=POT(MT)-DIFF
64100 GO TO 302
64200 303 DIFF=FLOAT(NORD(1,NT)-NORD(1,MT))*APAY1
64300 IF (GRPATT(1).AND.GRPATT(2)) DIFF=DIFF/2
64400 POT(NT)=POT(NT)+DIFF
64500 POT(MT)=POT(MT)-DIFF
64600 302 CONTINUE
64700 GO TO 401
64800 400 PPOT(1)=POT(1)
64900 WRITE (5,4100) (ATTWRD(I),I=1,3),MAXMOV
65000 WRITE (6,4100) (ATTWRD(I),I=1,3),MAXMOV
65100 WRITE (7,4100) (ATTWRD(I),I=1,3),MAXMOV
65200 PPOT(2)=POT(2)
65300 401 DO 410 N=1,4
65400 IF (TERM(N,1).EQ.TXNONE) GO TO 410
65500 DO 409 NT=1,2
65600 DIFF=FLOAT(NORD(N,NT))*PPAY(N)
65700 POT(NT)=POT(NT)+DIFF
65800 WB=WB-DIFF
65900 409 CONTINUE
66000 410 CONTINUE
66100 DO 420 NT=1,2
66200 NDEV=NT+4
66300 MT=3-NT
66400 WRITE (NDEV,1201)
66500 WRITE (7,502) NT
66600 CALL TPMAT (NT,7)
66700 CALL TPMAT (NT,NDEV)
66800 IF (OPT .EQ. 1) GO TO 420
66900 WRITE (NDEV,4101)
67000 4101 FORMAT (12H THEY HAD : )
67100 CALL TPMAT (MT,NDEV)
67200 IF (NMOVE .EQ. 1 .OR. NMOVE .EQ. MAXMOV
67300 1 .OR. GRPATT(1) .OR. GRPATT(2)) GO TO 421
67400 421 WRITE (NDEV,12001)
67500 CALL TPCASH (NDEV,NT)
67600 WRITE (NDEV,12002)
67700 CALL TPCASH (NDEV,MT)
67800 420 CONTINUE
67900 LAUGH=1
68000 WRITE(7,502)LAUGH
68100 CALL TPCASH (7,1)
68200 LAUGH=2
68300 WRITE(7,502)LAUGH
68400 CALL TPCASH (7,2)
68500 IDATA(4)=IGRATT(1)
68600 IDATA(5)=IGRATT(2)
68700 DO 3310 L=1,4
68800 IDATA(L+5)= NORD(L,1)
68900 IDATA(L+9)=NORD(L,2)
69000 3310 CONTINUE
69100 DATA(1)=POT(1)
69200 DATA(2)=CHAN1(1)
69300 DATA(3)=CHAN2(1)
69400 DATA(4)=POT(2)
69500 DATA(5)=CHAN1(2)
69600 DATA(6)=CHAN2(2)
69700 WRITE (4,3301) (IDATA(K),K=1,13),(DATA(K),K=1,6)
69800 WRITE (8,3302) (IDATA(K),K=1,13),(DATA(K),K=1,6)
69900 3302 FORMAT('0',I3,' 3 ',2I3,2I2,2(4I2,1X),2(1X,3F7.2))
70000 3301 FORMAT(I3,' 3 ',2I3,2I2,2(4I2,1X),2(1X,3F7.2))
70100 IF (NSET .GE. HPLB) GOTO 555
70200 IF (WB.GT.0) GO TO 59
70300 WRITE (7,9000)
70400 9000 FORMAT (31H WORLD BANK HAS RUN OUT OF CASH)
70500 GO TO 59
70600 CALL EXIT
70700 END
70800 SUBROUTINE CODE (NT,NANS)
70900 COMMON /TSR/ DSR
71000 C
71100 C
71200 C AND CODES APPROPRIATE INPUT AS AN INTEGER VARIABLE
71300 C AFTER CORRECTING FOR THE POSITION OF BLANKS.
71400 C
71500 C CODES:
71600 C Y=YES=2
71700 C N=NO=1
71800 C %=BLANK
71900 C ANY OTHER NON-INTEGER INPUT IS REJECTED AND THE
72000 C SUBJECT IS ASKED TORESPOND AGAIN.
72100 C
72200 C NT-TEAM NUMBER
72300 C NANS-CODED ANSWER
72400 C
72500 DIMENSION DIG(10),ANS(3)
72600 DIMENSION JANS(3)
72700 COMMON /C3/ ANS
72800 COMMON /C5/ QST
72900 DATA BY,BN,BB,BP/1HY,1HN,1H ,1H%/
73000 DATA DIG/'1 ','2 ','3 ','4 ','5 ',
73100 1 '6 ','7 ','8 ','9 ','0 '/
73200 C
73300 C IB - STORES LOCATION OF BLANKS
73400 C
73500 NDEV=NT+4
73600 1 IB=1
73700 C
73800 C COMPARE ANSWERS TO LIST OF ACCEPTABLE CHARACTERS
73900 C
74000 IF (NT.NE.3) WRITE (7,203) (ANS(K),K=1,3)
74100 DO 50 K=1,3
74200 IF (ANS(K).EQ.BP) ANS(K)=BB
74300 IF (ANS(K).EQ.BB) GO TO 45
74400 C
74500 C IS THIS CHARACTER AN INTEGER?
74600 C
74700 DO 25 J=1,10
74800 IF (ANS(K) .EQ. DIG(J)) GO TO 40
74900 25 CONTINUE
75000 C
75100 C IS THIS CHARACTER Y OR N?
75200 C
75300 IF (ANS(K).NE.BY) GO TO 30
75400 NANS=2
75500 555 RETURN
75600 C
75700 C PUT APPROPRIATE DIGIT IN JANS
75800 C
75900 30 IF (ANS(K).NE.BN) GO TO 150
76000 NANS=1
76100 RETURN
76200 40 JANS(K)=J
76300 IF (JANS(K).EQ.10) JANS(K)=0
76400 GO TO 50
76500 C
76600 C KEEP TRACK OF BLANKS
76700 C
76800 45 IB= IB+K
76900 50 CONTINUE
77000 C
77100 C CONVERT TO AN INTEGER VARIABLE IGNORING BLANKS
77200 C
77300 GO TO (60,150,150,70,150,80,90),IB
77400 C
77500 C NO BLANKS
77600 C
77700 60 NANS=JANS(1)*100+JANS(2)*10+JANS(3)
77800 IF (NANS.GT.100)GO TO 150
77900 RETURN
78000 C
78100 C THIRD COLUMN BLANK
78200 C
78300 70 NANS=JANS(1)*10+JANS(2)
78400 RETURN
78500 C
78600 C SECOND AND THIRD COLUMN BLANK
78700 C
78800 80 NANS=JANS(1)
78900 RETURN
79000 C
79100 C EVERYTHING BLANK
79200 C
79300 90 NANS=0
79400 RETURN
79500 C
79600 C ERROR ON INPUT
79700 C
79800 150 WRITE (NDEV,201) QST
79900 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
80000 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
80100 READ (NDEV,202,END=555) ANS
80200 GO TO 1
80300 201 FORMAT(' WHAT',A1,1X,$)
80400 202 FORMAT (3A1)
80500 203 FORMAT (1X,3A1)
80600 STOP
80700 END
80800 SUBROUTINE TPMAT (NT,NDEV)
80900 COMMON /TSR/ DSR
81000 C THIS SUBROUTINE TYPES OUT THE ARMAMENTS OF TEAM NT ON DEVICE NDEV
81100 DIMENSION TERM(4,3),NMAT(4,2)
81200 COMMON/C1/ TERM
81300 COMMON/C2/ NMAT
81400 DATA TXNONE/5HNONE /
81500 DO 10 N=1,4
81600 IF (TERM(N,1).EQ.TXNONE) GO TO 10
81700 WRITE (NDEV,100) NMAT(N,NT), (TERM(N,I),I=1,3)
81800 100 FORMAT (5X,I2,1X,3A5)
81900 10 CONTINUE
82000 555 RETURN
82100 END
82200 SUBROUTINE TPCASH (NDEV,NT)
82300 COMMON /TSR/ DSR
82400 C THIS SUBROUTINE WRITE OUT ON DEVICE NDEV THE RESULTS FOR TEAM NT
82500 DIMENSION POT(2),PPOT(2),CHAN1(2),CHAN2(2)
82600 COMMON /C4/ POTIN,POT,PPOT
82700 COMMON /C6/ CHAN1, CHAN2
82800 WRITE (NDEV,101) POT(NT)
82900 101 FORMAT (7H $,F5.2,25H PRESENT PLAYING CAPITAL )
83000 DF=POT(NT)-PPOT(NT)
83100 CHAN1(NT)=DF
83200 IF (DF) 10,11,11
83300 10 DF=-DF
83400 WRITE (NDEV,102) DF
83500 102 FORMAT (7H $,F5.2,21H LOST IN THE LAST SET )
83600 GO TO 12
83700 11 WRITE (NDEV,103) DF
83800 103 FORMAT (7H $,F5.2,23H GAINED IN THE LAST SET )
83900 12 DF=POT(NT)-POTIN
84000 CHAN2(NT)= DF
84100 IF (DF) 13,14,14
84200 13 DF=-DF
84300 WRITE (NDEV,104) DF
84400 104 FORMAT (7H $,F5.2,13H LOST OVERALL )
84500 GO TO 15
84600 14 WRITE (NDEV,105) DF
84700 105 FORMAT (7H $,F5.2,15H GAINED OVERALL )
84800 15 RETURN
84900 END
85000 SUBROUTINE TALKS (INIT,IACC,NCODE,NSET,NMOVE)
85100 DIMENSION INIT(2),IACC(2),LINE(15)
85200 COMMON /TSR/ DSR
85300 COMMON /HPL1/ HPLA,DEVICE
85400 LOGICAL SW,SW1
85500 DATA KBLNK/' '/
85600 DATA SW1/.FALSE./
85700 IF (SW1) GO TO 11
85800 SW1=.TRUE.
85900 IF(NMOVE.EQ.1) SW=.FALSE.
86000 CALL OFILE(21,'NEGOT')
86100 WRITE (7,908) NCODE
86200 WRITE (21,908) NCODE
86300 908 FORMAT('0***** NEGOTIATION TEXT *****'/
86400 1 '0SESSION CODE: ',I3)
86500 C SET LOGICAL UNIT NUMBERS FOR INITIATING AND ACCEPTING TEAMS
86600 C
86700 11 DO 1 I=1,2
86800 K1 = I
86900 K2 = MOD(I,2) + 1
87000 IF (.NOT.(INIT(K1) .EQ. 2 .AND. IACC(K2) .EQ. 2)) GO TO 1
87100 NINIT = K1 + 4
87200 NACC = K2 + 4
87300 1 CONTINUE
87400 NM = 0
87500 3 WRITE (NACC,900)
87600 900 FORMAT('0PLEASE WAIT')
87700 WRITE (7,909)NSET,NMOVE,K1,K2
87800 WRITE (21,909)NSET,NMOVE,K1,K2
87900 909 FORMAT('0SET #',I5/' MOVE #',I5/' INITIATING TEAM #',I5/
88000 1 ' ACCEPTING TEAM #',I5/'0')
88100 IF (SW) GOTO 4
88200 WRITE (NINIT,901)
88300 901 FORMAT('1TO SEND A MESSAGE TO THE OTHER TEAM:'/
88400 X' PUSH THE KEY LABELED (RETURN) AT THE END OF EACH LINE.'/
88500 1 ' AFTER THE FINAL LINE OF THE MESSAGE HAS BEEN TYPED,'/
88600 2' AND THE (RETURN) KEY HAS BEEN TYPED, HOLD DOWN THE KEY'/
88700 3' LABELED (CONTROL). WHILE HOLDING IT DOWN, TYPE THE LETTER (Z).'/
88800 4'-ENTER MESSAGE NOW.'/'0')
88900 GO TO 6
89000 4 WRITE (NINIT,902)
89100 902 FORMAT('1MESSAGE:'/' ')
89200 6 CALL OFILE(20,'TALK')
89300 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
89400 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
89500 5 READ (NINIT,903,END=21) LINE
89600 903 FORMAT(15A5)
89700 WRITE (20,904) LINE
89800 904 FORMAT(' ',15A5)
89900 GO TO 5
90000 21 CALL IFILE(20,'TALK')
90100 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
90200 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
90300 24 READ (20,903,END=25) LINE
90400 WRITE (7,903) LINE
90500 GO TO 24
90600 25 CALL IFILE(20,'TALK')
90700 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
90800 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
90900 23 READ (20,903,END=22) LINE
91000 WRITE (21,904) LINE
91100 DO 7 K=15,1,-1
91200 IF (LINE(K) .NE. KBLNK) GO TO 8
91300 7 CONTINUE
91400 8 WRITE (NACC,903) (LINE(I),I=1,K)
91500 GO TO 23
91600 22 WRITE (NACC,905)
91700 905 FORMAT('0DO YOU WISH TO MAKE A REPLY (YES OR NO)?',$)
91800 OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT')
91900 OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT')
92000 READ (NACC,906,END=555) QUES
92100 906 FORMAT(A3)
92200 IF (QUES .EQ. 'YES') GO TO 30
92300 IF (QUES .NE. 'NO') GO TO 22
92400 WRITE (NACC,910)
92500 910 FORMAT('1THE OTHER TEAM HAS BEEN NOTIFIED THAT YOU DO NOT'
92600 2/' WISH TO REPLY.')
92700 WRITE (NINIT,911)
92800 911 FORMAT('1THE OTHER TEAM HAS RECEIVED YOUR MESSAGE AND DOES NOT'/
92900 2' WISH TO REPLY.')
93000 WRITE (7,912) K2
93100 912 FORMAT('1TEAM',I2,' HAS DECIDED NOT TO REPLY.')
93200 RETURN
93300 30 K3 = NINIT
93400 NINIT = NACC
93500 NACC = K3
93600 K1 = NINIT - 4
93700 K2 = NACC - 4
93800 NM = NM + 1
93900 IF (NM .EQ. 2) SW = .TRUE.
94000 IF (MOD(NM,2) .NE. 0) GO TO 3
94100 K3 = NM/2
94200 WRITE (7,907) K3
94300 907 FORMAT(' ',I2,' EXCHGS. ',/)
94400 IF (K3 .LT. HPLA) GOTO 3
94500 WRITE (5,554)
94600 WRITE (6,554)
94700 WRITE (7,554)
94800 554 FORMAT (' FURTHER EXCHANGES ARE NOT PERMITTED AT PRESENT.')
94900 555 RETURN
95000 END