Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50364/wgmm11.f4
Click 43,50364/wgmm11.f4 to
see without markup as text/plain
There are no other files named wgmm11.f4 in the archive.
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