C C C ******************************************************* C * * C * SUBROUTINE TO CHECK POWER, TIME AND OTHER THINGS * C * * C ******************************************************* C SUBROUTINE CHKPAT(TINTCP,FUNMES) 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/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 INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,CMD INTEGER D9,E9,S9,B9,R9 REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TDAMC, &TLOOS,TBALEN,TALSD,TBOSS,TINTRD,TINTCP,TMOVE LOGICAL*1 SHIP BYTE FUNMES(25) C TDAMC=.FALSE. TINTCP=.FALSE. IF(CMD.NE.8)GOTO 2 GOTO(2,23,2,2,23,23,23,23,23,2),ITASK 2 R3=0.1+RAN(II,JJ)/5. IF(COND.NE.DCKD)POW=POW-INT(R3*10.)-SHLD(5)/1000 IF(POW.LT.0)POW=0 IF(POW.GT.0 .AND. STATUS(12).LE.-8.0)STATUS(12)=0.0 IF(POW.GT.0 .AND. GASP.NE.0.)GASP=0. IF(STATUS(12).GE.0. .OR. POW.GT.0)GOTO 3 GASP=GASP+R3 IF(GASP.LE.0.5)GOTO 3 CALL DAMCON(13,11,TDAMC) IF(TDISAB)GOTO 1 3 DATE=DATE+R3 IF(DATE.LE.FLOAT(IDLN))GOTO 4 TTMOUT=.TRUE. GOTO 1 C DAMAGE CONTROL SECTION 4 CONFAC=1. IF(COND.EQ.GRN)CONFAC=2.0 IF(COND.EQ.DCKD)CONFAC=3.0 IF(TINTRD .AND. ITR(4).EQ.1)CONFAC=0.5 CRWFAC=1.-FLOAT(NCAS(1))/430. REPFAC=(0.1+RAN(II,JJ)/5.)*CONFAC*CRWFAC DO 5 I=1,12 IF(STATUS(I).GE.0. .OR. I.EQ.12 .AND. POW.EQ.0)GOTO 5 STATUS(I)=STATUS(I)+REPFAC IF(STATUS(I).LE.0.)GOTO 5 20 TYPE 21 21 FORMAT(/1X,'** REPORT FROM DAMAGE CONTROL:') 2000 WRITE(3,21) CALL DAMCON(I,99,TDAMC) STATUS(I)=0. 5 CONTINUE 1 IF(NCAS(1)+NCAS(2).LT.500)GOTO 6 10 TYPE 11 11 FORMAT(//1X,10(1H*),' ENTIRE SHIP''S CREW HAS BEEN KILLED ',10(1H* &)/) 1000 WRITE(3,11) TDISAB=.TRUE. RETURN 6 IF(COND.EQ.GRN .OR. DATE-DTLSTH.LT.1.)GOTO 8 IF(RAN(II,JJ).GT.0.5)GOTO 8 CALL HITS IF(TDEST .OR. TDISAB)RETURN DO 7 I=1,7 CALL ALMOVE(TMOVE,.FALSE.,I) 7 CONTINUE 8 IF(TALSD)CALL ASELFD IF(TINTRD)CALL INTRUD(TINTCP) CALL HUMOUR(II,JJ,IBELL,FUNMES) 23 RETURN END C C C ********************************************************* C * * C * SUBROUTINE TO CHECK CONDITIONS AND GIVE WARNINGS * C * * C ********************************************************* C SUBROUTINE CHECKS 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,DLN,BEARNG,NCAS(2),CMD,IG2,NPRIS, &IBELL COMMON/MISC2/NPROB,L5,L8,GASP,ITASK,SDATE,AFILE(4),CFILE(4),DTLSTH COMMON/SYMBL/DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR(10,10) 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 INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,DLN,CMD INTEGER D9,E9,S9,B9,R9 REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TNEW,TTMOUT,TOVER,TSHLD,TBASLO,TSLFDS,TWARN,THELLO,TLOOS, &TBALEN,TALSD,TEST,TBOSS,TINTRD LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP C IF(POW.GT.0 .OR. CMD.EQ.2 .OR. CMD.EQ.3)GOTO 16 IF(CMD.EQ.8)GOTO(90,90,16,90,90,16,16,16,16,16),ITASK+1 90 TYPE 91,IBELL,0.5-GASP 91 FORMAT(/1X,'*** WARNING - POWER RESERVES EXHAUSTED ***':,A1//1X'Po &wer is required to maintain Life Support System.'/1X,'Backup Life &Support System can be maintained on batteries'/1X,'for 0.5 stardat &es. TIME LEFT IS',F5.2,' STARDATES.'/) WRITE(3,91)"0,0.5-GASP STATUS(12)=-9. IF(STATUS(6).GE.0. .AND. (RANK.LE.2. .OR. CMD.NE.4))TYPE 31 31 FORMAT(1X,'I suggest that you reduce shield strength'/1X,'in order & to regain power reserves.') IF(STATUS(6).LT.0.)TYPE 41 41 FORMAT(1X,'I suggest you regain power by using tractor beams or' &/1X,'transporters to bypass the damaged shield control circuits.') 16 IF(.NOT.TSHLD)GOTO 17 TSHLD=.FALSE. GOTO 18 17 GOTO(19,22,22,22,19,19,22,2,19,19,19,22,22,22,22),CMD 2 GOTO(19,19,22,19,19,22,22,19,22,22,19),ITASK+1 19 IF(COND.EQ.GRN)GOTO 18 IF(SHLD(5).LT.H1 .AND. COND.EQ.RED)GOTO 4 IF(COND.EQ.DCKD)GOTO 3 IF(H1.EQ.0 .AND. K(7,1).NE.0 .AND. SHLD(5).LT.INT(575.*FLOAT(K(7,3 &))/600.))GOTO 4 GOTO 18 3 IF(.NOT.TROM1 .AND. N3.LE.0)GOTO 18 IF(CMD.NE.1 .AND. CMD.NE.9)GOTO 18 IF(SHLD(5).GT.0)GOTO 18 4 IF(SHLD(5).GT.0)GOTO 110 10 TYPE 11,IBELL 11 FORMAT(/1X,A1,'*** WARNING - SHIELDS DOWN ***'/) 1000 WRITE(3,11)"0 GOTO 5 110 TYPE 111,IBELL 111 FORMAT(/1X,A1,'*** WARNING - SHIELDS DANGEROUSLY LOW ***'/) 11000 WRITE(3,111)"0 5 TSHLD=.TRUE. IF(CMD.EQ.8)CMD=0 ITASK=0 GOTO 6 18 IF(TROM1)GOTO 44 IF(RAN(II,JJ).LE.FLOAT(M2/20) .OR. CMD.EQ.13)GOTO 6 IF(K(7,1).NE.0)GOTO 6 IF(TALTOW .AND. ICAPV(4).EQ.1 .AND. ICAPV(5).EQ.0)GOTO 6 IF(RAN(II,JJ).GT.RANK/20.-.05)GOTO 6 TROM1=.TRUE. TROM2=.FALSE. N2=N2+1 CALL PLACE(K(7,1),K(7,2)) SECT(K(7,1),K(7,2))=R9 120 TYPE 121 121 FORMAT(/1X,'*** WARNING - ROMULAN DETECTED ***'/) 12000 WRITE(3,121) IF(COND.EQ.DCKD)GOTO 1 CALL BALERT COND=RED 1 K(7,3)=600 44 IF(TROM2)GOTO 6 IF(K(7,3).GT.100)GOTO 38 SECTOR(K(7,1),K(7,2))=ROM TROM2=.TRUE. IF(STATUS(4).LT.0.)GOTO 6 20 TYPE 21,K(7,1),K(7,2) 21 FORMAT(/1X,'** ROMULAN WARSHIP HAS TURNED OFF ITS CLOAKING DEVICE &- SECTOR',I3,',',I3/) 2000 WRITE(3,21)K(7,1),K(7,2) GOTO 6 38 K(7,3)=K(7,3)-50 6 IF(RANK.LE.2.)RETURN IF(.NOT.TALSD)CALL CHKASD IF(.NOT.TINTRD)CALL CHKINT 22 RETURN END