C THIS PROGRAM MUST BE COMPILED WITH VERSION 27A FORTRAN IV !!! C ONLY - HOUSTON P. LOWRY PITZER COLLEGE CLAREMONT CALIFORNIA INTEGER HPLA,HLPB  INTEGER OPT,DSR,ASK  LOGICAL EXSW,DONSW(2),GRPATT(2),NEGSW,QSW,TSW  DIMENSION NP(2),ATTWRD(3),TLKWRD(3)  DIMENSION PPAY(4),NSTRT(4),NTSTRT(2),NTKACC(2) DIMENSION NSUB(2),INDTOT(4,9,2),INDATT(9,2),INDTLK(9,2)  DIMENSION INDPRB(9,2),IGRTOT(4,2),IGRPRB(2)  DIMENSION IGRATT(2), IDATA(50), DATA(10) DIMENSION DSR(5/7)  DIMENSION IQTOT(4,2), IQATT(2),QPOT(2)  DIMENSION TXTEAM(2),REPLY(3) DIMENSION TERM(4,3),NORD(4,2),POT(2),PPOT(2),CHAN1(2), 1 CHAN2(2)  COMMON /C1/ TERM  COMMON /C2/ NORD  COMMON /C3/ REPLY  COMMON /C4/ POTIN,POT,PPOT  COMMON /C5/ QST  COMMON /C6/ CHAN1,CHAN2 COMMON /TSR/ DSR COMMON /HPL1/ HPLA,DEVICE  DATA TXNONE/5HNONE /  DATA TXTEAM(1),TXTEAM(2)/5HYOUR ,5HOTHER/ DATA QST/1H?/ DATA DSR/5,6,7/ 493 CONTINUE 494 CONTINUE 495 CONTINUE WRITE (5,9100) 9100 FORMAT ('1WGMM11 5/8/76',/,' TEAM 2 TTY (TTYNN FORM ): ',$ ) 9101 FORMAT(A5) 9102 READ(5,9101,END=555)DEVICE OPEN (UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') OPEN (UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') 9104 WRITE (5,9105) 9105 FORMAT(' HELP? ',$ ) 9106 READ(5,9107,END=555)ASK 9107 FORMAT(A3) IF (ASK .EQ. 'NO' .OR. ASK .EQ. 'N') GOTO 92 9108 WRITE (5,9109) 9109 FORMAT ('0SET 3 = 20 MILITARY AND 0 ECONOMIC ',/, 1' SET 4 = 10 MILITARY AND 10 ECONOMIC ',/, 2' SET 5 = 0 MILITARY AND 20 ECONOMIC ',/, 3' PHAMTOM EXPERIMENTER ON LPT, ^ Z WILL END RUN SAVING FILES',/, 4' ALL ASSIGNMENTS ARE NOW COMPLETELY INTERNAL',/, 5' HOUSTON P. LOWRY PITZER COLLEGE 5/8/76') 92 WRITE (5,499) 499  FORMAT (' DATA FILENAME (5 CHARS. MAX.) ? ',$ )  READ (5,498,END=555) FILEN OPEN(UNIT=7,DEVICE='LPT',ACCESS='SEQOUT',FILE='EXPR') OPEN(UNIT=4,DEVICE='DSK',ACCESS='SEQOUT',FILE=FILEN) OPEN(UNIT=8,DEVICE='LPT',ACCESS='SEQOUT',FILE='PRNTR') 498  FORMAT (A5)  WRITE (5,504) 504  FORMAT(' 3 DIGIT SESSION CODE: ',$)  READ (5,5111,END=555) ICODE 5111  FORMAT (I) WRITE (5,9114) 9114 FORMAT (' HOW MANY EXCHANGES ARE PERMITTED DURING TALKS ?',$) READ (5,9115,END=555) HPLA 9115 FORMAT (F2.0) WRITE (5,9116) 9116 FORMAT (' HOW MANY SETS ARE TO BE PERMITTED ?',$) READ (5,9115,END=555) HPLB WRITE (5,6001) 6001 FORMAT(' FAST INIT? ',$) READ (5,51,END=555) (REPLY(I),I=1,3) CALL CODE (3,I) IF (I .NE. 2) GO TO 102 6013 WRITE (5,6002) 6002 FORMAT(' WHICH SET? ',$) READ (5,5111,END=555) J IF (J .EQ. 0) J = 1 IF (J .LE. 10) GO TO 6012 6004 WRITE (5,6003) 6003 FORMAT(' TRY AGAIN') GO TO 6013 6012 GO TO (61,62,63,64,65,70,70,70,70,70),J 70 WRITE (5,6020) 6020 FORMAT(' NONEXISTENT') GO TO 6004 62 TSW = .TRUE. GO TO 72 61 TSW = .FALSE. 72 NP(1) = 1 NP(2) = 1 MAXT = 1 NEGSW = .TRUE. QSW = .TRUE. MAXMOV = 5 MAXCH = 4 OPT = 2 EXSW = .TRUE. NSTRT(1) = 20 NSTRT(2) = 0 MATTOT = 20 NGAME = 2 PPAY(1) = -.02 PPAY(2) = 0.02 APAY1 = .06 POTIN = 2.5 WB = 5. GO TO 71 63 NSTRT(1) =20 NSTRT(2) =0 GO TO 73 64 NSTRT(1) =10 NSTRT(2) =10 GO TO 73 65 NSTRT(1) =0 NSTRT(2) =20 GO TO 73 73 TSW=.TRUE. NP(1)=1 NP(2)=1 MAXT=1 NEGSW=.TRUE. QSW=.TRUE. MAXMOV=5 MAXCH=4 OPT=2 EXSW=.TRUE. TERM(1,1)='MILIT' TERM(1,2)='ARY U' TERM(1,3)='NITS ' TERM(2,1)='ECONO' TERM(2,2)='MIC U' TERM(2,3)='NITS ' TERM(3,1)='NONE ' TERM(3,2)=' ' TERM(4,1)='NONE ' TERM(4,2)=' ' MATTOT=20 NGAME=2 ATTWRD(1)='ATTAC' ATTWRD(2)='K ' ATTWRD(3)=' ' TLKWRD(1)='TALKS' TLKWRD(2)=' ' TLKWRD(3)=' ' PPAY(1)=-.20 PPAY(2)=.20 APAY1=.50 POTIN=7.50 WB=30.00 GO TO 71 71 DO 43 I=1,2 POT(I) = POTIN 43 PPOT(I) = POTIN GOTO 101 102 WRITE (5,10) QST 10 FORMAT(' # PLAYERS',A1) DO 1 N=1,2 WRITE (5,11) N 11 FORMAT(' TEAM ',I1,': ',$) 1 READ (5,5111,END=555) NP(N)  MAXT=1  IF (NP(1).LT.NP(2)) MAXT=2  WRITE (5,1000) QST 1000  FORMAT(' NEGOTIATIONS',A1,1X,$)  NEGSW=.FALSE.  READ (5,51,END=555) (REPLY(I),I=1,3)  CALL CODE (3,JNEG)  IF (JNEG.EQ.2) NEGSW=.TRUE. WRITE (5,1010) QST 1010 FORMAT(' NEGOTIATIONS BY TTY',A1,1X,$) TSW = .FALSE. READ (5,51,END=555) (REPLY(I),I=1,3) CALL CODE (3,JTY) IF (JTY .EQ. 2) TSW = .TRUE. 1002 WRITE (5,2000) QST 2000  FORMAT(' QUESTIONS',A1,1X,$)  QSW=.FALSE.  READ (5,51,END=555) (REPLY(I),I=1,3)  CALL CODE (3,JQS)  IF (JQS.EQ.2) QSW=.TRUE.  WRITE (5,13) QST 13  FORMAT(' MOVES/SET',A1,1X,$)  READ (5,51,END=555) REPLY  CALL CODE (3,MAXMOV)  WRITE (5,1313) QST 1313  FORMAT(' MAX. CHANGES/MOVE',A1,1X,$)  READ (5,51,END=555) (REPLY(I),I=1,3)  CALL CODE (3,MAXCH) C  WRITE (5,190) QST 190  FORMAT(' DISPLAY RESULTS',A1,1X,$)  READ (5,51,END=555) (REPLY(I),I=1,3) CALL CODE (3,OPT)  WRITE (5,14) 14  FORMAT(' NAME MATERIALS: '/ 1 ' TYPE NONE WHERE APPROPRIATE'/' ')  EXSW=.FALSE.  DO 2 N=1,4  READ (5,16,END=555) (TERM(N,I),I=1,3) 16  FORMAT (3A5) 2  IF (TERM(N,1).EQ.TXNONE) EXSW=.TRUE.  NGAME=4  IF (EXSW) NGAME=2 C THAT MEANS WE ARE PLAYIMG THE SIMPLE GAME C SPECIFY THE WORD FOR "ATTACK"  WRITE (5,17) 17  FORMAT(' ATTACK WORD: ',$)  READ (5,16,END=555) (ATTWRD(I),I=1,3)  IF (.NOT. NEGSW) GO TO 19  WRITE (5,18) 18  FORMAT(' NEGOTIATIONS WORD: ',$)  READ (5,16,END=555) (TLKWRD(I),I=1,3) 19  WRITE (5,20) QST 20  FORMAT(' NONCOMPETETIVE PAYOFFS',A1)  WRITE (5,21) 21  FORMAT(' NEG. NUMBERS = COSTS: ',/' ')  DO 3 N=1,4  IF (TERM(N,1) .EQ.TXNONE) GO TO 3  WRITE (5,22) (TERM(N,I),I=1,3),QST 22  FORMAT (' FOR ',3A5,A1,1X,$)  READ (5,23,END=555) PPAY(N) 23  FORMAT (F) 3  CONTINUE  WRITE (5,24) QST 24  FORMAT(' COMPETITIVE PAYOFFS',A1/' ')  IF (EXSW) GO TO 40  WRITE (5,25) (TERM(1,I),I=1,3),(TERM(2,J),J=1,3) ,QST 25  FORMAT (' FOR' ,3A5,' OVER' ,3A5,A1/' ')  READ (5,23,END=555) APAY1  WRITE (5,25) (TERM(2,I),I=1,3),(TERM(3,J),J=1,3) ,QST  READ (5,23,END=555) APAY2  GO TO 4 40  WRITE (5,22) (TERM(1,I),I=1,3),QST  READ (5,23,END=555) APAY1 4  WRITE (5,30) QST 30  FORMAT(' PLAYER FUNDS',A1,1X,$)  READ (5,23,END=555) POTIN  WRITE (5,31) QST 31  FORMAT(' WORLD BANK FUNDS',A1,1X,$)  READ (5,23,END=555) WB  DO 42 I=1,2  POT(I)=POTIN 42  PPOT(I)=POTIN MATTOT = 0 WRITE (5,32) QST 32 FORMAT(' # MATERIALS',A1/' ') DO 5 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 5 WRITE (5,33) (TERM(N,I),I=1,3),QST 33 FORMAT(' HOW MANY ',3A5,A1,1X,$) READ (5,34,END=555) NSTRT(N) 34 FORMAT (I) MATTOT = MATTOT + NSTRT(N) 5 CONTINUE 101 IDATA(1) = ICODE IDATA(2) = NP(1) IDATA(3) = NP(2) IDATA(4) = MAXMOV IDATA(5) = MAXCH IDATA(6) = NGAME IDATA(7) = OPT IDATA(8) = JNEG IDATA(9) = JQS WRITE (4,105) (IDATA(K),K=1,9),(PPAY(J),J=1,4),APAY1, 1 APAY2,POTIN,WB,(NSTRT(L),L=1,4) WRITE (8,106) (IDATA(K),K=1,9),(PPAY(J),J=1,4),APAY1, 1 APAY2,POTIN,WB,(NSTRT(L),L=1,4) 105 FORMAT(I4,1H1,1X,2I1,1X,6I2,1X,8F6.2,1X,4I2) 106 FORMAT(' ',I3,3H 1 ,2I2,4I3,2I2,8F8.2,4I3) WRITE (5,501) 501 FORMAT('1') IF (NSET .LT. HPLB) GOTO 59 555 WRITE (5,556) WRITE (6,556) 556 FORMAT(21H THE GAME IS FINISHED/22H THANK YOU FOR PLAYING/' ') WRITE (7,556) OPEN(UNIT=20,DEVICE='DSK',ACCESS='SEQOUT',FILE='TALK.DAT') CLOSE(UNIT=20,DISPOSE='DELETE') CALL EXIT GO TO 92 59 NMOVE = 1 NSET = NSET + 1 DO 55 I=1,2 DO 54 J=1,4 NORD(J,I) = NSTRT(J) 54 CONTINUE 55 CONTINUE 60 WRITE (5,666) NMOVE WRITE (6,666) NMOVE WRITE (7,666) NMOVE 666 FORMAT('0MOVE ',I3) WRITE (6,1208) IF (.NOT. QSW) GO TO 667 DO 799 NT=1,2 NDEV = NT + 4 701 WRITE (7,7000) NT,QST 7000 FORMAT(' QST. SIDE ',I1,A1) WRITE (NDEV,7001) QST 7001 FORMAT(' DO YOU HAVE A QUESTION',A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,JQUEST) IF (JQUEST .EQ. 2) GO TO 702 WRITE (NDEV,1208) GO TO 799 702 WRITE (NDEV,7002) 7002 FORMAT(28H TYPE IN THE DESIRED NUMBERS) DO 760 KCT=1,2 WRITE (7,7003) TXTEAM(KCT) WRITE (NDEV,7003) TXTEAM(KCT) 7003 FORMAT(5H FOR ,A5,5H SIDE) IQSUM = 0 DO 750 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 750 WRITE (NDEV,1209) (TERM(N,I),I=1,3),QST OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,IQTOT(N,KCT)) IQSUM = IQSUM + IQTOT(N,KCT) 750 CONTINUE IF (IQSUM .EQ. MATTOT) GO TO 761 WRITE (NDEV,7005) 7005 FORMAT(24H WRONG TOTAL - TRY AGAIN ) GO TO 702 761 WRITE (7,7004) TXTEAM(KCT),(ATTWRD(I),I=1,3),QST WRITE (NDEV,7004) TXTEAM(KCT),(ATTWRD(I),I=1,3),QST 7004 FORMAT(6H DOES ,A5,6H SIDE ,3A5,A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,IQATT(KCT)) 760 CONTINUE QPOT(1) = 0.0 QPOT(2) = 0. IF ((IQATT(1) .NE. 2) .AND. (IQATT(2) .NE. 2)) GO TO 780 DO 775 KCT=1,2 IF (IQATT(KCT) .NE. 2) GO TO 775 LCT = 3 - KCT IF (EXSW) GO TO 774 QADIFF = FLOAT(IQTOT(1,KCT) - IQTOT(2,LCT))*APAY1 QPOT(KCT) = QPOT(KCT) + QADIFF QPOT(LCT) = QPOT(LCT) - QADIFF QADIFF = FLOAT(IQTOT(2,KCT) - IQTOT(3,LCT))*APAY2 QPOT(KCT) = QPOT(KCT) + QADIFF QPOT(LCT) = QPOT(LCT) - QADIFF GO TO 775 774 QADIFF = FLOAT(IQTOT(1,KCT) - IQTOT(1,LCT))*APAY1 IF ((IQATT(1) .EQ. 2) .AND. (IQATT(2) .EQ. 2)) 1 QADIFF = QADIFF/2.0 QPOT(KCT) = QPOT(KCT) + QADIFF QPOT(LCT) = QPOT(LCT) - QADIFF 775 CONTINUE IF (QPOT(1) .LT. 0.0) GO TO 776 WRITE (NDEV,7750) QPOT(1) 7750 FORMAT(16H YOU WOULD WIN $,F5.2,20H FROM THE OTHER SIDE/' ') GO TO 780 776 WRITE (NDEV,7760) QPOT(2) 7760 FORMAT(16H YOU WOULD PAY $,F5.2,18H TO THE OTHER SIDE/' ') 780 DO 785 KCT = 1,2 QPDIFF = 0.0 DO 784 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 784 QPDIFF = QPDIFF + FLOAT(IQTOT(N,KCT))*PPAY(N) 784 CONTINUE 7841 FORMAT(' ',A5,17H SIDE WOULD PAY $,F5.2,14H TO WORLD BANK/' ') 7840 FORMAT(1X,A5,21H SIDE WOULD RECEIVE $,F5.2, 1 16H FROM WORLD BANK/' ') QPOT(KCT) = QPOT(KCT) + QPDIFF IF (QPDIFF .LT. 0.0) GO TO 788 WRITE (NDEV,7840) TXTEAM(KCT),QPDIFF GO TO 785 788 QPDIFF = - QPDIFF WRITE (NDEV,7841) TXTEAM(KCT),QPDIFF 785 CONTINUE IF ((IQATT(1) .NE. 2) .AND. (IQATT(2) .NE. 2)) GO TO 798 DO 795 KCT=1,2 IF (QPOT(KCT) .LT. 0.0) GO TO 794 WRITE (NDEV,7930) TXTEAM(KCT),QPOT(KCT) 7930 FORMAT(15H TOTAL GAIN TO ,A5,10H SIDE OF $,F5.2) GO TO 795 794 QPOT(KCT) = -QPOT(KCT) WRITE (NDEV,7940) TXTEAM(KCT),QPOT(KCT) 7940 FORMAT(15H TOTAL LOSS TO ,A5,10H SIDE OF $,F5.2) 795 CONTINUE 798 GO TO 701 799 CONTINUE 667 IF (.NOT. NEGSW) GO TO 1222 WRITE (7,503) (TLKWRD(I),I=1,3),QST 503 FORMAT('0INITIATE ',3A5,A1) DO 100 N=1,2 NDEV = N + 4 WRITE (7,502) N 502 FORMAT (6H TEAM ,I1) WRITE (NDEV,500) (TLKWRD(I),I=1,3),QST 500 FORMAT('0DO YOU WISH TO INITIATE ',3A5,A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) 51 FORMAT(3A1) CALL CODE(N,NTSTRT(N)) WRITE (NDEV,52) (TLKWRD(I),I=1,3),QST 52 FORMAT (' WILL YOU ACCEPT IF OTHER SIDE INITIATES ', 1 3A5,A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (N,NTKACC(N)) WRITE (NDEV,1208) 100 CONTINUE IF ((NTSTRT(1) .EQ. 2) .AND. (NTKACC(2) .EQ. 2)) GO TO 110 IF ((NTSTRT(2) .EQ. 2) .AND. (NTKACC(1) .EQ. 2)) GO TO 110 GO TO 120 110 WRITE (5,1100) (TLKWRD(I),I=1,3) 1100 FORMAT(' ',3A5,17H WILL TAKE PLACE. ) WRITE (6,1100) (TLKWRD(I),I=1,3) WRITE (7,1100) (TLKWRD(I),I=1,3) IF (TSW) CALL TALKS(NTSTRT,NTKACC,ICODE,NSET,NMOVE) IF (TSW) GO TO 1222 GO TO 1222 120 WRITE (5,12220) (TLKWRD(I),I=1,3) WRITE (6,12220) (TLKWRD(I),I=1,3) 12220 FORMAT(4H NO ,3A5) 1222 DO 121 N=1,2 DONSW(N) = .FALSE. IF (NP(N) .EQ. 1) DONSW(N) = .TRUE. 121 NSUB(N) = 1 NT = MAXT 122 IF (DONSW(1) .AND. DONSW(2)) GO TO 200 IF (DONSW(NT)) GO TO 130 NDEV = NT + 4 WRITE (7,1200) NT,NSUB(NT) WRITE (NDEV,1200) NT,NSUB(NT) 1200 FORMAT('0TEAM',I1,3X,8HSUBJECT ,I1) MSUB = NSUB(NT) WRITE (NDEV,12001) 12001 FORMAT(16H YOUR ASSETS ARE ) CALL TPCASH (NDEV,NT) MT = 3 - NT WRITE (NDEV,12002) 12002 FORMAT(17H THEIR ASSETS ARE ) CALL TPCASH (NDEV,MT) WRITE (NDEV,1201) 1201 FORMAT(12H YOU HAVE : ) 123 CALL TPMAT (NT,NDEV) WRITE (NDEV,1203) QST 1203 FORMAT(' WHAT DO YOU WANT AS YOUR NEW ALLOCATION',A1) WRITE (NDEV,12003) MATTOT 12003 FORMAT(15H TOTAL MUST BE ,I2) WRITE (NDEV,12004) MAXCH 12004 FORMAT(31H YOU CANNOT EXCHANGE MORE THAN ,I2,6H ITEMS) DO 124 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 124 WRITE (NDEV,1209) (TERM(N,I),I=1,3),QST 1209 FORMAT(' HOW MANY ',3A5, 1 ' DO YOU WANT TO HAVE AT END OF THIS MOVE',A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,INDTOT(N,MSUB,NT)) 124 CONTINUE NDIFF = 0 NSM = 0 DO 125 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 125 NDIFF = NDIFF + MAX0(INDTOT(N,MSUB,NT),NORD(N,NT)) NDIFF = NDIFF - MIN0(INDTOT(N,MSUB,NT),NORD(N,NT)) NSM = NSM + INDTOT(N,MSUB,NT) 125 CONTINUE IF (NDIFF .GT. MAXCH*2) GO TO 126 IF (NSM .NE. MATTOT) GO TO 126 GO TO 127 126 WRITE (7,1202) WRITE (NDEV,1202) 1202 FORMAT (24H ILLEGAL MOVE, TRY AGAIN ) GO TO 123 127 WRITE (7,1204) (ATTWRD(I),I=1,3),QST WRITE (NDEV,1204) (ATTWRD(I),I=1,3),QST 1204 FORMAT(' DO YOU WISH TO ',3A5,A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,INDATT(MSUB,NT)) IF (.NOT. NEGSW) GO TO 12051 WRITE (7,1205) (TLKWRD(I),I=1,3),QST WRITE (NDEV,1205) (TLKWRD(I),I=1,3),QST 1205 FORMAT (' DO YOU WISH TO ENTER ',3A5,A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,INDTLK(MSUB,NT)) 12051 WRITE (7,1206) (ATTWRD(I),I=1,3) WRITE (NDEV,1206) (ATTWRD(I),I=1,3) 1206 FORMAT(' ESTIMATE PROBABILITY THAT OTHER SIDE WILL ',3A5) WRITE (NDEV,1207) 1207 FORMAT(' TYPE NUMBER BETWEEN 0 AND 100: ',$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,INDPRB(MSUB,NT)) WRITE (NDEV,1208) 1208 FORMAT('1 PLEASE WAIT' /'1') NSUB(NT) = NSUB(NT) + 1 IF (NSUB(NT) .GT. NP(NT)) DONSW(NT) = .TRUE. 130 NT = 3 - NT GO TO 122 200 IF (NP(1) .NE. 1) WRITE (5,2500) 2500 FORMAT(21H PAUSE FOR DISCUSSION ) IF (NP(2) .NE. 1) WRITE (6,2500) IF ((NP(1) + NP(2)) .LE. 2) GO TO 25000 WRITE (7,2500) 25000 WRITE (7,2502) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') 2502 FORMAT('0READY FOR GROUP DECISIONS' ) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') 2501 FORMAT(' READY FOR DECISION FROM TEAM ',I1) WRITE (7,1210) 1210 FORMAT(' NEW ALLOCATION?') DO 252 NT=1,2 WRITE (7,502) NT NDEV = NT + 4 WRITE (NDEV,2501) NT NVED = MOD(NT,2) + 5 WRITE (NVED,2503) 2503 FORMAT(' PLEASE WAIT') WRITE (NDEV,12005) QST 12005 FORMAT (' DISPLAY ASSETS?',A1,1X,$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (3,III) IF (III.NE. 2) GO TO 251 WRITE (NDEV,12001) CALL TPCASH (NDEV,NT) MT = 3-NT WRITE (NDEV,12002) CALL TPCASH (NDEV,MT) 251 WRITE (NDEV,1201) CALL TPMAT (NT,NDEV) WRITE (NDEV,1203) QST WRITE (NDEV,12003) MATTOT WRITE (NDEV,12004) MAXCH DO 254 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 254 WRITE (NDEV,1209) (TERM(N,I),I=1,3),QST OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,IGRTOT(N,NT)) 254 CONTINUE NDIFF = 0 NSM = 0 DO 255 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 255 NDIFF = NDIFF + MAX0(IGRTOT(N,NT),NORD(N,NT)) NDIFF = NDIFF - MIN0(IGRTOT(N,NT),NORD(N,NT)) NSM = NSM + IGRTOT(N,NT) 255 CONTINUE IF (NDIFF .GT. (MAXCH*2)) GO TO 256 IF (NSM .NE. MATTOT) GO TO 256 GO TO 257 256 WRITE (7,1202) WRITE (NDEV,1202) GO TO 251 257 DO 2570 N=1,4 IF (TERM(N,1) .EQ. TXNONE) GO TO 2570 NORD(N,NT) = IGRTOT(N,NT) 2570 CONTINUE WRITE (7,1204) (ATTWRD(I),I=1,3),QST WRITE (NDEV,1204) (ATTWRD(I),I=1,3),QST OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,IGRATT(NT)) GRPATT(NT) = .FALSE. IF (IGRATT(NT) .EQ. 2) GRPATT(NT) = .TRUE. WRITE (7,1206) (ATTWRD(I),I=1,3) WRITE (NDEV,1206) (ATTWRD(I),I=1,3) WRITE (NDEV,1207) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,51,END=555) (REPLY(I),I=1,3) CALL CODE (NT,IGRPRB(NT)) 252 CONTINUE WRITE (5,2555) NMOVE WRITE (6,2555) NMOVE WRITE (7,2555) NMOVE 2555 FORMAT(' END OF MOVE ',I3) NMOVE = NMOVE + 1 IDATA(2) = NSET IDATA(3) = NMOVE DO 3100 NT = 1,2 IDATA(4) = NT  DO 3000 J=5,36 3000 IDATA(J) = 0 MAX = NP(NT) IF (MAX .EQ. 1) GO TO 3050  DO 3010 NSB=1,MAX  K=8*(NSB-1)  IDATA(K+5)=NSB  DO 3020 L=1,4  KL=K+L+5 3020  IDATA(KL)=INDTOT(L,NSB,NT)  IDATA(K+10)= INDATT(NSB,NT)  IDATA(K+11)=INDTLK(NSB,NT)  IDATA(K+12)=INDPRB(NSB,NT) 3010  CONTINUE 3050  DO 3030 K=1,4 3030  IDATA(K+36)= NORD(K,NT)  IDATA(41)= IGRATT(NT)  IDATA(42)= NTSTRT(NT)  IDATA(43)= NTKACC(NT)  IDATA(44)= IGRPRB(NT)  WRITE (8,3202) (IDATA(K),K=1,44)  WRITE (4,3201) (IDATA(K),K=1,44) 3100  CONTINUE 3201  FORMAT (I3,1H2,2I2,I1,1X,4(I1,4I2,2I1,I3),4I2,3I1,I3) 3202  FORMAT (' ',I3,3H 2 ,2I2,1X,I1,1X,4(7I2,I4),2X,4I3,3I2,I4)  IF (GRPATT(1).OR.GRPATT(2)) GO TO 300  IF (NMOVE.GT.MAXMOV) GO TO 400  GO TO 60 300  DO 301 NT=1,2 301  PPOT(NT)=POT(NT)  DO 302 NT=1,2  IF (.NOT.GRPATT(NT)) GO TO 302  NDEV=7-NT  WRITE (NDEV,3001) (ATTWRD(I),I=1,3) 3001  FORMAT (' THE OTHER SIDE DECIDED TO ',3A5/ 1 18H THIS SET IS OVER.)  MT=3-NT 4100  FORMAT (28H THIS SET HAS ENDED WITHOUT , 1 3A5,6H AFTER,I2,7H MOVES.)  IF (EXSW) GO TO 303  DIFF=FLOAT(NORD(1,NT)-NORD(2,MT))*APAY1  POT(NT)=POT(NT)+DIFF  POT(MT)=POT(MT)-DIFF  DIFF=FLOAT(NORD(2,NT)-NORD(3,MT))*APAY2  POT(NT)=POT(NT)+DIFF  POT(MT)=POT(MT)-DIFF  GO TO 302 303  DIFF=FLOAT(NORD(1,NT)-NORD(1,MT))*APAY1  IF (GRPATT(1).AND.GRPATT(2)) DIFF=DIFF/2  POT(NT)=POT(NT)+DIFF  POT(MT)=POT(MT)-DIFF 302  CONTINUE  GO TO 401 400  PPOT(1)=POT(1)  WRITE (5,4100) (ATTWRD(I),I=1,3),MAXMOV  WRITE (6,4100) (ATTWRD(I),I=1,3),MAXMOV  WRITE (7,4100) (ATTWRD(I),I=1,3),MAXMOV  PPOT(2)=POT(2) 401  DO 410 N=1,4  IF (TERM(N,1).EQ.TXNONE) GO TO 410  DO 409 NT=1,2  DIFF=FLOAT(NORD(N,NT))*PPAY(N)  POT(NT)=POT(NT)+DIFF  WB=WB-DIFF 409 CONTINUE 410  CONTINUE  DO 420 NT=1,2  NDEV=NT+4  MT=3-NT  WRITE (NDEV,1201)  WRITE (7,502) NT  CALL TPMAT (NT,7)  CALL TPMAT (NT,NDEV) IF (OPT .EQ. 1) GO TO 420  WRITE (NDEV,4101) 4101  FORMAT (12H THEY HAD : )  CALL TPMAT (MT,NDEV) IF (NMOVE .EQ. 1 .OR. NMOVE .EQ. MAXMOV 1 .OR. GRPATT(1) .OR. GRPATT(2)) GO TO 421 421 WRITE (NDEV,12001)  CALL TPCASH (NDEV,NT)  WRITE (NDEV,12002)  CALL TPCASH (NDEV,MT) 420  CONTINUE  LAUGH=1  WRITE(7,502)LAUGH  CALL TPCASH (7,1)  LAUGH=2  WRITE(7,502)LAUGH  CALL TPCASH (7,2)  IDATA(4)=IGRATT(1)  IDATA(5)=IGRATT(2)  DO 3310 L=1,4  IDATA(L+5)= NORD(L,1)  IDATA(L+9)=NORD(L,2) 3310 CONTINUE  DATA(1)=POT(1)  DATA(2)=CHAN1(1)  DATA(3)=CHAN2(1)  DATA(4)=POT(2)  DATA(5)=CHAN1(2)  DATA(6)=CHAN2(2)  WRITE (4,3301) (IDATA(K),K=1,13),(DATA(K),K=1,6)  WRITE (8,3302) (IDATA(K),K=1,13),(DATA(K),K=1,6) 3302 FORMAT('0',I3,' 3 ',:I3,2I2,2(4I2,1X),2(1X,3F7.2)) 3301 FORMAT(I3,' 3 ',2I3,2I2,2(4I2,1X),2(1X,3F7.2)) IF (NSET .GE. HPLB) GOTO 555  IF (WB.GT.0) GO TO 59  WRITE (7,9000) 9000  FORMAT (31H WORLD BANK HAS RUN OUT OF CASH)  GO TO 59  CALL EXIT END SUBROUTINE CODE (NT,NANS) COMMON /TSR/ DSR C C C  AND CODES APPROPRIATE INPUT AS AN INTEGER VARIABLE C  AFTER CORRECTING FOR THE POSITION OF BLANKS. C C  CODES: C  Y=YES=2 C  N=NO=1 C  %=BLANK C  ANY OTHER NON-INTEGER INPUT IS REJECTED AND THE C  SUBJECT IS ASKED TORESPOND AGAIN. C C  NT-TEAM NUMBER C  NANS-CODED ANSWER C DIMENSION DIG(10),ANS(3) DIMENSION JANS(3) COMMON /C3/ ANS COMMON /C5/ QST DATA BY,BN,BB,BP/1HY,1HN,1H ,1H%/ DATA DIG/'1 ','2 ','3 ','4 ','5 ', 1 '6 ','7 ','8 ','9 ','0 '/ C C  IB - STORES LOCATION OF BLANKS C NDEV=NT+4 1 IB=1 C C  COMPARE ANSWERS TO LIST OF ACCEPTABLE CHARACTERS C IF (NT.NE.3) WRITE (7,203) (ANS(K),K=1,3) DO 50 K=1,3 IF (ANS(K).EQ.BP) ANS(K)=BB IF (ANS(K).EQ.BB) GO TO 45 C C  IS THIS CHARACTER AN INTEGER? C DO 25 J=1,10 IF (ANS(K) .EQ. DIG(J)) GO TO 40 25 CONTINUE C C  IS THIS CHARACTER Y OR N? C IF (ANS(K).NE.BY) GO TO 30 NANS=2 555 RETURN C C  PUT APPROPRIATE DIGIT IN JANS C 30 IF (ANS(K).NE.BN) GO TO 150 NANS=1 RETURN 40 JANS(K)=J IF (JANS(K).EQ.10) JANS(K)=0 GO TO 50 C C  KEEP TRACK OF BLANKS C 45 IB= IB+K 50 CONTINUE C C  CONVERT TO AN INTEGER VARIABLE IGNORING BLANKS C GO TO (60,150,150,70,150,80,90),IB C C  NO BLANKS C 60 NANS=JANS(1)*100+JANS(2)*10+JANS(3) IF (NANS.GT.100)GO TO 150 RETURN C C  THIRD COLUMN BLANK C 70 NANS=JANS(1)*10+JANS(2) RETURN C C  SECOND AND THIRD COLUMN BLANK C 80 NANS=JANS(1) RETURN C C  EVERYTHING BLANK C 90 NANS=0 RETURN C C  ERROR ON INPUT C 150 WRITE (NDEV,201) QST OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NDEV,202,END=555) ANS GO TO 1 201 FORMAT(' WHAT',A1,1X,$) 202 FORMAT (3A1) 203  FORMAT (1X,3A1) STOP END  SUBROUTINE TPMAT (NT,NDEV) COMMON /TSR/ DSR C THIS SUBROUTINE TYPES OUT THE ARMAMENTS OF TEAM NT ON DEVICE NDEV DIMENSION TERM(4,3),NMAT(4,2)  COMMON/C1/ TERM  COMMON/C2/ NMAT  DATA TXNONE/5HNONE /  DO 10 N=1,4  IF (TERM(N,1).EQ.TXNONE) GO TO 10  WRITE (NDEV,100) NMAT(N,NT), (TERM(N,I),I=1,3) 100  FORMAT (5X,I2,1X,3A5) 10  CONTINUE 555 RETURN  END  SUBROUTINE TPCASH (NDEV,NT) COMMON /TSR/ DSR C THIS SUBROUTINE WRITE OUT ON DEVICE NDEV THE RESULTS FOR TEAM NT DIMENSION POT(2),PPOT(2),CHAN1(2),CHAN2(2)  COMMON /C4/ POTIN,POT,PPOT  COMMON /C6/ CHAN1, CHAN2  WRITE (NDEV,101) POT(NT) 101  FORMAT (7H $,F5.2,25H PRESENT PLAYING CAPITAL )  DF=POT(NT)-PPOT(NT)  CHAN1(NT)=DF  IF (DF) 10,11,11 10  DF=-DF  WRITE (NDEV,102) DF 102  FORMAT (7H $,F5.2,21H LOST IN THE LAST SET )  GO TO 12 11  WRITE (NDEV,103) DF 103  FORMAT (7H $,F5.2,23H GAINED IN THE LAST SET ) 12  DF=POT(NT)-POTIN  CHAN2(NT)= DF  IF (DF) 13,14,14 13  DF=-DF  WRITE (NDEV,104) DF 104  FORMAT (7H $,F5.2,13H LOST OVERALL )  GO TO 15 14  WRITE (NDEV,105) DF 105  FORMAT (7H $,F5.2,15H GAINED OVERALL ) 15  RETURN  END SUBROUTINE TALKS (INIT,IACC,NCODE,NSET,NMOVE) DIMENSION INIT(2),IACC(2),LINE(15) COMMON /TSR/ DSR COMMON /HPL1/ HPLA,DEVICE LOGICAL SW,SW1 DATA KBLNK/' '/ DATA SW1/.FALSE./ IF (SW1) GO TO 11 SW1=.TRUE. IF(NMOVE.EQ.1) SW=.FALSE. CALL OFILE(21,'NEGOT') WRITE (7,908) NCODE WRITE (21,908) NCODE 908 FORMAT('0***** NEGOTIATION TEXT *****'/ 1 '0SESSION CODE: ',I3) C SET LOGICAL UNIT NUMBERS FOR INITIATING AND ACCEPTING TEAMS C 11 DO 1 I=1,2 K1 = I K2 = MOD(I,2) + 1 IF (.NOT.(INIT(K1) .EQ. 2 .AND. IACC(K2) .EQ. 2)) GO TO 1 NINIT = K1 + 4 NACC = K2 + 4 1 CONTINUE NM = 0 3 WRITE (NACC,900) 900 FORMAT('0PLEASE WAIT') WRITE (7,909)NSET,NMOVE,K1,K2 WRITE (21,909)NSET,NMOVE,K1,K2 909 FORMAT('0SET #',I5/' MOVE #',I5/' INITIATING TEAM #',I5/ 1 ' ACCEPTING TEAM #',I5/'0') IF (SW) GOTO 4 WRITE (NINIT,901) 901 FORMAT('1TO SEND A MESSAGE TO THE OTHER TEAM:'/ X' PUSH THE KEY LABELED (RETURN) AT THE END OF EACH LINE.'/ 1 ' AFTER THE FINAL LINE OF THE MESSAGE HAS BEEN TYPED,'/ 2' AND THE (RETURN) KEY HAS BEEN TYPED, HOLD DOWN THE KEY'/ 3' LABELED (CONTROL). WHILE HOLDING IT DOWN, TYPE THE LETTER (Z).'/ 4'-ENTER MESSAGE NOW.'/'0') GO TO 6 4 WRITE (NINIT,902) 902 FORMAT('1MESSAGE:'/' ') 6 CALL OFILE(20,'TALK') OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') 5 READ (NINIT,903,END=21) LINE 903 FORMAT(15A5) WRITE (20,904) LINE 904 FORMAT(' ',15A5) GO TO 5 21 CALL IFILE(20,'TALK') OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') 24 READ (20,903,END=25) LINE WRITE (7,903) LINE GO TO 24 25 CALL IFILE(20,'TALK') OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') 23 READ (20,903,END=22) LINE WRITE (21,904) LINE DO 7 K=15,1,-1 IF (LINE(K) .NE. KBLNK) GO TO 8 7 CONTINUE 8 WRITE (NACC,903) (LINE(I),I=1,K) GO TO 23 22 WRITE (NACC,905) 905 FORMAT('0DO YOU WISH TO MAKE A REPLY (YES OR NO)?',$) OPEN(UNIT=5,DEVICE='TTY',ACCESS='SEQINOUT') OPEN(UNIT=6,DEVICE=DEVICE,ACCESS='SEQINOUT') READ (NACC,906,END=555) QUES 906 FORMAT(A3) IF (QUES .EQ. 'YES') GO TO 30 IF (QUES .NE. 'NO') GO TO 22 WRITE (NACC,910) 910 FORMAT('1THE OTHER TEAM HAS BEEN NOTIFIED THAT YOU DO NOT' 2/' WISH TO REPLY.') WRITE (NINIT,911) 911 FORMAT('1THE OTHER TEAM HAS RECEIVED YOUR MESSAGE AND DOES NOT'/ 2' WISH TO REPLY.') WRITE (7,912) K2 912 FORMAT('1TEAM',I2,' HAS DECIDED NOT TO REPLY.') RETURN 30 K3 = NINIT NINIT = NACC NACC = K3 K1 = NINIT - 4 K2 = NACC - 4 NM = NM + 1 IF (NM .EQ. 2) SW = .TRUE. IF (MOD(NM,2) .NE. 0) GO TO 3 K3 = NM/2 WRITE (7,907) K3 907 FORMAT(' ',I2,' EXCHGS. ',/) IF (K3 .LT. HPLA) GOTO 3 WRITE (5,554) WRITE (6,554) WRITE (7,554) 554 FORMAT (' FURTHER EXCHANGES ARE NOT PERMITTED AT PRESENT.') 555 RETURN END