C C C ******************************* C * * C * DAMAGE REPAIR SUBROUTINE * C * * C ******************************* C SUBROUTINE REPAIR(TABORT) 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/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TLOOS,TBALEN,TALSD,TINTRD,TABORT C IF(.NOT.TINTRD)GOTO 1 IF(ITR(4).NE.1 .AND. ITR(4).NE.2)GOTO 1 CALL DAMCON(81,97,.FALSE.) RETURN 1 CALL DAMCON(0,7,.FALSE.) 10 TYPE 11 11 FORMAT(/1X,'* Computer link to Damage Control complete') WRITE(3,11) 80 TYPE 81 81 FORMAT(1X,'SYSTEM NUMBER? ',$) 20 READ(5,21,ERR=80)ISYS 21 FORMAT(I3) IF(ISYS.LT.1 .OR.ISYS.GT.13)TABORT=.TRUE. IF(TABORT)RETURN IF(STATUS(ISYS).LT.0.) GOTO 40 30 TYPE 31 31 FORMAT(1X,'* System is operational') WRITE(3,31) RETURN 40 TYPE 41,POW 41 FORMAT(1X,'* Power avalable to Damage Control:'I5) WRITE(3,41)POW IF(POW.LE.0)TABORT=.TRUE. IF(TABORT)RETURN 50 TYPE 51 51 FORMAT(1X'POWER ALLOCATED? ',$) 60 READ(5,61,ERR=50)XP 61 FORMAT(F10.0) IP=XP IF(IP.GT.POW) GOTO 40 POW=POW-IABS(IP) STATUS(ISYS)=STATUS(ISYS)+FLOAT(IP)/100. 70 TYPE 71 71 FORMAT(1X'* System Status: ',$) WRITE(3,71) IF(STATUS(ISYS).LT.0.)GOTO 100 TYPE 91 91 FORMAT(1H+,'OPERATIONAL') WRITE(3,91) RETURN 100 TYPE 101,ABS(STATUS(ISYS)) 101 FORMAT(1H+,'*INOPERATIVE -- est. repair time:',F7.3,' stardates') WRITE(3,101)ABS(STATUS(ISYS)) RETURN END C C C ******************************************************* C * * C * SUBROUTINE TO PRINT OUT COMBAT STATUS INFORMATION * C * * C ******************************************************* C SUBROUTINE CMSTAT 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/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) COMMON/RATNG/NBASD,NRESC,NFRES,NROMD,NCAPAL,NPRTKN 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 INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,RBAS,CBAS,STBS,CMD INTEGER D9,S9,E9,B9,R9 REAL*8 KL,RM,GRN,RED,DCKD,COND,ALIEN,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TLOOS,TBALEN,TALSD,TINTRD,TEST LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,EE,ENDS,ENDB,SHIP DATA ALIEN/' '/,ON,OFF/'ON','OFF'/,ENDS,ENDB/1HS,1H / C 10 TYPE 11 11 FORMAT(/1X'** COMBAT STATUS REPORT:'/) WRITE(3,11) IF(STATUS(4).GE.0. .OR. COND.NE.RED)GOTO 20 150 TYPE 151 151 FORMAT(1X,'* NOTE: Data on enemy vessels is lacking due'/9X,'To in &operative Short Range Sensors') WRITE(3,151) 20 TYPE 21,A,B,BEARNG,COND,RANK 21 FORMAT(1X,'* SECTOR: ',I3,',',I3,14X,'BEARING:',F7.1,' DEG.'/1X'* &CONDITION: ',A8,10X,'RANK:',3X,F7.0) WRITE(3,21)A,B,BEARNG,COND,RANK ALIEN=KL ID8=5 DO 2 I=1,7 TEST=.FALSE. IF(K(I,1).EQ.0 .OR. I.EQ.7 .AND. .NOT.TROM2) GOTO 2 IF(SECT(K(I,1),K(I,2)).NE.R9) GOTO 5 ALIEN=RM ID8=6 5 IF(K(I,4).EQ.1)GOTO 6 IF(STATUS(4).LT.0. .AND. (IABS(A-K(I,1)).GT.2 .OR. IABS(B-K(I,2)) &.GT.2))TEST=.TRUE. 30 TYPE 31,ALIEN 31 FORMAT(1X'* ',A8,'IN SECTOR',$) WRITE(3,31)ALIEN IF(TEST)GOTO 140 TYPE 281,K(I,1),K(I,2) 281 FORMAT(1H+,I3,',',I3,$) WRITE(3,281)K(I,1),K(I,2) IF(K(I,4).EQ.2)GOTO 220 IF(STATUS(4).LT.0.)GOTO 300 130 TYPE 131,FLOAT(K(I,3)/ID8) 131 FORMAT(1H+,' AT',F7.2,'% POWER') WRITE(3,131)FLOAT(K(I,3)/ID8) GOTO 2 300 TYPE 301 301 FORMAT(1H+,' AT UNKNOWN STRENGTH') WRITE(3,301) GOTO 2 140 TYPE 141,ANGLE(K(I,1),K(I,2),A,B) 141 FORMAT(1H+,' UNKNOWN -- bearing',F7.1,' deg.') WRITE(3,141)ANGLE(K(I,1),K(I,2),A,B) GOTO 2 220 TYPE 221 221 FORMAT(1H+,' HAS INITIATED SELF-DESTRUCT SEQUENCE') WRITE(3,221) GOTO 2 6 IF(SECT(K(I,1),K(I,2)).EQ.R9)ALIEN=RM 100 TYPE 101,ALIEN,K(I,1),K(I,2) 101 FORMAT(1X'* ',A8,'IN SECTOR',I3,',',I3,' HAS BEEN CAPTURED') WRITE(3,101)ALIEN,K(I,1),K(I,2) 2 CONTINUE IF(.NOT.TROM1 .OR. TROM2) GOTO 1 40 TYPE 41 41 FORMAT(1X'* ROMULAN PRESENT - exact location & strength unknown') WRITE(3,41) 1 IF(N6.EQ.0) GOTO 3 50 TYPE 51,N6,RBAS,CBAS,FLOAT(STBS(N6,3))/100. 51 FORMAT(1X,'* STARBASE',I2,' IN SECTOR',I3,',',I3,' AT',F6.1,'% SH &IELD STRENGTH') WRITE(3,51)N6,RBAS,CBAS,FLOAT(STBS(N6,3))/100. 180 TYPE 181,N6 181 FORMAT(1X,'* STARBASE',I2,' has ',$) WRITE(3,181)N6 IF(STBS(N6,5).EQ.0)GOTO 200 190 TYPE 191,STBS(N6,5) 191 FORMAT(1H+,I5,$) WRITE(3,191)STBS(N6,5) GOTO 210 200 TYPE 201 201 FORMAT(1H+,'NO',$) WRITE(3,201) 210 TYPE 211 211 FORMAT(1H+,' crew replacements left') WRITE(3,211) 3 IF(.NOT.TALTOW)GOTO 4 ALIEN=KL IF(ICAPV(4).EQ.1)ALIEN=RM IF(ICAPV(5).EQ.1)GOTO 80 70 TYPE 71 71 FORMAT(1X,'* HOSTILE ',$) WRITE(3,71) GOTO 90 80 TYPE 81 81 FORMAT(1X,'* CAPTURED ',$) WRITE(3,81) 90 TYPE 91,ALIEN,ICAPV(1),ICAPV(2) 91 FORMAT(1H+,A8,'VESSEL IN TOW : Sector',I3,',',I3) WRITE(3,91)ALIEN,ICAPV(1),ICAPV(2) IF(ICAPV(5).NE.2)GOTO 4 230 TYPE 231 231 FORMAT(1X,'* VESSEL IN TOW HAS INITIATED SELF-DESTRUCT SEQUENCE') WRITE(3,231) 4 NSD=0 DO 8 I=1,13 IF(STATUS(I).LT.0.)NSD=NSD+1 8 CONTINUE IF(NSD.EQ.0)GOTO 170 EE='s' IF(NSD.EQ.1)EE=ENDB 160 TYPE 161,NSD,EE 161 FORMAT(1X,'*',I3,' system',A1,' inoperative') WRITE(3,161)NSD,EE GOTO 9 170 TYPE 171 171 FORMAT(1X,'* All systems operational') WRITE(3,171) 9 IF(.NOT.TINTRD)GOTO 12 240 TYPE 241 241 FORMAT(1X,'* SECURITY ALERT GQ-4: INTRUDER ABOARD. ',$) WRITE(3,241) IF(ITR(4).EQ.0)GOTO 260 250 TYPE 251,ITR(4) 251 FORMAT(1H+,'Level',I2,$) WRITE(3,251)ITR(4) GOTO 270 260 TYPE 261 261 FORMAT(1H+,'No security',$) WRITE(3,261) 270 TYPE 271 271 FORMAT(1H+,' search in progress.') WRITE(3,271) 12 SWITCH=OFF IF(TALERT)SWITCH=ON DEADLN=IDLN 60 TYPE 61,SHLD,SWITCH,POW,NTORP,NCAS(1)+NCAS(2),DEADLN-DATE,N4, &70-NCAS(2),NPRIS,NBASRM 61 FORMAT(1X'* Shields:',I5,3('/',I4),' (',I4,')',6X,'Auto Alert: ', &A3/1X,'* Power:',I5,2X,'Torpedoes:',I3,3X,'Number of casualties : &',I4,'/500'/1X,'* Stardates left :',F7.2,3X,'Aliens left to des &troy:',I4/1X,'* Space marines left:',I4,6X,'Prisoners on board &:',I4/1X,'* Starbases left:',I2,5X,$) WRITE(3,61)SHLD,SWITCH,POW,NTORP,NCAS(1)+NCAS(2),DEADLN-DATE,N4, &70-NCAS(2),NPRIS,NBASRM DO 7 I=1,NBAS IF(STBS(I,1).EQ.0)GOTO 7 IF(STBS(I,4).EQ.1)GOTO 120 7 CONTINUE 110 TYPE 111 111 FORMAT(1H+,7X,'No starbases under attack'/) WRITE(3,111) RETURN 120 TYPE 121,STBS(I,1),STBS(I,2) 121 FORMAT(1H+,'STARBASE IN QUADRANT',I2,',',I2,' UNDER ATTACK'/) WRITE(3,121)STBS(I,1),STBS(I,2) RETURN END