C C C ************************************** C * * C * SUBROUTINE TO SET UP NEW GAME * C * * C ************************************** C SUBROUTINE NEWGAM(TDAMC,TRESUM,TLOG,SDLN,NS,NGAM,TAMES,TEXAM) COMMON QUAD(8,8),SECT(10,10),NGAL(8,8),K(7,5),STATUS(13),R1,C1,R,C &,H1,POW,SHLD(5),NTORP,A,B,H(7),N1,N2,N3,N4,N5,N6,II,JJ,RANK,ITR(4) COMMON/MISC1/ICAPV(5),M1,M2,DATE,IDLN,BEARNG,NCAS(2),CMD,IG2,NPRIS &,IBELL COMMON/MISC2/NPROB,L5,L8,GASP,ITASK,SDATE,AFILE(4),CFILE(4),DTLSTH COMMON/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) COMMON/RATNG/NBASD,NRESC,NFRES,NROMD,NCAPAL,NPRTKN COMMON/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/OBJCTS/D9,S9,E9,K9,B9,R9,M9 COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD COMMON/TESTS2/TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO, &TBOSS COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN COMMON/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) COMMON/NEWDAT/REGION,RONUM INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,RBAS,CBAS,STBS,CMD INTEGER D9,E9,S9,B9,R9 REAL*8 COND,KL,RM,GRN,RED,DCKD,DEST,DISAB,REGION,PSWRD LOGICAL*1 SHIP,NAME1 LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TDAMC, &TEST,TRESUM,TLOOS,TBALEN,TALSD,TLOG,TBOSS,TINTRD LOGICAL TRENEG,TSLAP,TSHOOT,TBAN,TAMES,TEXAM C IF(TNEW)CALL CLOSE(3) IF(TNEW)GOTO 35 IF(L5.EQ.1)GOTO 40 TBOSS=.FALSE. 35 TROM1=.FALSE. TROM2=.FALSE. TWON=.FALSE. TLOST=.FALSE. TDISAB=.FALSE. TDAMC=.FALSE. TNEW=.FALSE. TTMOUT=.FALSE. TOVER=.FALSE. TBASLO=.FALSE. TRESC=.FALSE. TWARN=.FALSE. THELLO=.FALSE. TDEST=.FALSE. TSLFDS=.FALSE. TALTOW=.FALSE. TBOFF=.FALSE. TALERT=.TRUE. TRESUM=.FALSE. TLOOS=.FALSE. TBALEN=.FALSE. TALSD=.FALSE. TLOG=.FALSE. TINTRD=.FALSE. TRENEG=.FALSE. TSLAP=.FALSE. TSHOOT=.FALSE. TBAN=.FALSE. TEXAM=.FALSE. II=0 JJ=0 N4=0 NN=0 L5=0 L8=0 IBELL="007 NPROB=0 NPRIS=0 GASP=0. RANK=0. NKDESB=0 NBASD=0 NROMD=0 NCAPAL=0 NPRTKN=0 NRESC=0 NFRES=0 BEARNG=0. DO 15 I=1,5 ICAPV(I)=0 IF(I.LE.4)ITR(I)=0 IF(I.LE.2)NCAS(I)=0 15 CONTINUE DO 13 I=1,5 DO 13 J=1,4 STBS(I,J)=0 13 CONTINUE C IF(NGAM.NE.0)GOTO 48 CALL HEADER DO 52 I=1,INT(SECNDS(0.)/100.) RX=RAN(II,JJ) 52 CONTINUE 48 CALL SRVRCD(TEXAM,II,JJ,NGAM) IF(TEXAM)RETURN CALL SETUP(TRESUM,TLOG,NS,NGAM,TAMES) IF(TRESUM)RETURN NGAM=NGAM+1 DO 14 I=1,INT(SECNDS(0.)/10.) RX=RAN(II,JJ) 14 CONTINUE DO 1 I=1,8 DO 1 J=1,8 NGAL(I,J)=-1 N2=0 IF(RAN(II,JJ).GT.0.5)GOTO 2 3 N2=INT(RAN(II,JJ)*10.) IF(N2.GT.5)GOTO 3 2 N4=N4+N2 QUAD(I,J)=N2*100+INT(RAN(II,JJ)*6.) 1 CONTINUE NBAS=6.-AINT(RANK)/2. NBASRM=NBAS DO 7 ID=1,NBAS 8 I=INT(RAN(II,JJ)*10.)+1 J=INT(RAN(II,JJ)*10.)+1 IF(I.GT.8.OR.J.GT.8)GOTO 8 IF(NN.EQ.1)GOTO 9 IF(QUAD(I,J).GE.100)GOTO 8 NKL=(RANK-1.)/2. QUAD(I,J)=QUAD(I,J)+NKL*100 N4=N4+NKL R1=I C1=J NN=1 GOTO 8 9 IF(QUAD(I,J)/10-(QUAD(I,J)/100)*10.NE.0)GOTO 8 IF(IABS(R1-I).LE.1 .AND. IABS(C1-J).LE.1)GOTO 8 IF(ID.EQ.1)GOTO 17 DO 16 I1=1,ID-1 IF(IABS(STBS(I1,1)-I).LE.1 .AND. IABS(STBS(I1,2)-J).LE.1)GOTO 8 16 CONTINUE 17 QUAD(I,J)=QUAD(I,J)+10 STBS(ID,1)=I STBS(ID,2)=J STBS(ID,3)=10000 STBS(ID,5)=500 7 CONTINUE 4 N5=INT(RAN(II,JJ)*100.)+1 NALW=8+INT(RANK)*2 IF(RANK.GE.6. .AND. NG.LE.12)NALW=NALW*(1+MOD(NG,2)) IF(N5.GT.N4 .OR. N5.LE.NALW)GOTO 4 TEST=.FALSE. 39 CALL ORDERS(TEST,SDLN,TLOG) GOTO 47 10 TYPE 11,NALW 11 FORMAT(1X,'THE MINIMUM NUMBER OF VESSELS ALLOWED IS',I4) 40 TYPE 41 41 FORMAT(/1X,'NUMBER OF ALIEN VESSELS TO BE DESTROYED? ',$) 50 READ(5,51,ERR=40)N5 51 FORMAT(I3) NALW=8+INT(RANK)*2 IF(RANK.GE.6. .AND. NG.LE.12)NALW=NALW*(1+MOD(NG,2)) IF(NPL.GT.2 .AND. N5.LT.NALW)GOTO 10 IF(N5.GT.N4)GOTO 60 TEST=.TRUE. GOTO 39 60 TYPE 61,N4 61 FORMAT(1X,'TOO MANY - THE MAXIMUM NUMBER POSSIBLE IS',I4) GOTO 40 47 POW=5000 NTORP=20 DO 12 I=1,13 IF(I.LE.5)SHLD(I)=0 STATUS(I)=0. 12 CONTINUE DTLSTH=DATE IG2=0 R=0 C=0 CALL QADSET IG2=1 IF(TLOG)CALL LOG(NS) RETURN END