C C C ***************************************** C * * C * SHORT RANGE SENSOR SCAN SUBROUTINE * C * * C ***************************************** C SUBROUTINE SSCAN 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/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/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,DLN,CMD REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB,SMODE(3),LFSPT LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TDAMC,TLOOS,TBALEN,TALSD,TINTRD,TEST LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP LOGICAL*1 DUMSEC(10,10) DATA ON,OFF,SWITCH/'ON','OFF',' '/,TEST/.FALSE./ DATA SMODE/'SHORT RA','NGE SENS','OR SCAN'/ C 1 IF(STATUS(4).GE.0.)GOTO 2 TEST=.TRUE. TDAMC=.TRUE. CALL DAMCON(4,2,TDAMC) TYPE 121 121 FORMAT(1X,'SWITCHING TO VISUAL SCAN') WRITE(3,121) 2 DO 3 I=1,10 DO 3 J=1,10 IF(STATUS(4).GE.0.)GOTO 4 DUMSEC(I,J)=' ' IF(SECTOR(I,J).EQ.'*' .OR. SECTOR(I,J).EQ.'#')GOTO 4 IF(IABS(A-I).GT.2 .OR. IABS(B-J).GT.2)GOTO 3 4 DUMSEC(I,J)=SECTOR(I,J) 3 CONTINUE SWITCH=OFF IF(TALERT)SWITCH=ON LFSPT='PRIMARY' IF(STATUS(12).LT.0.)LFSPT='BACKUP' IF(.NOT.TEST)GOTO 5 SMODE(1)=' VI' SMODE(2)='SUAL SCA' SMODE(3)='N' 5 IF(CMD.NE.2)GOTO 10 WRITE(3,11),SMODE,R1,C1,A,B WRITE(3,111)1,(DUMSEC(1,I),I=1,10),COND WRITE(3,21)2,(DUMSEC(2,I),I=1,10),BEARNG WRITE(3,31)3,(DUMSEC(3,I),I=1,10),DATE WRITE(3,41)4,(DUMSEC(4,I),I=1,10),POW WRITE(3,51)5,(DUMSEC(5,I),I=1,10),(SHLD(J),J=1,4) WRITE(3,61)6,(DUMSEC(6,I),I=1,10),SWITCH WRITE(3,71)7,(DUMSEC(7,I),I=1,10),LFSPT WRITE(3,81)8,(DUMSEC(8,I),I=1,10),NCAS(1)+NCAS(2) WRITE(3,91)9,(DUMSEC(9,I),I=1,10),NTORP WRITE(3,101)10,(DUMSEC(10,I),I=1,10),N5-N4,N5 C CALL SPLFNC("16) ! N245 VERSION ONLY 10 TYPE 11,SMODE,R1,C1,A,B 11 FORMAT(/1X,3A8,9X,'Quadrant: ',I3,',',I3/ &4X,'1 2 3 4 5 6 7 8 9 10',10X,'Sector: ',2X,I3,',',I3) 110 TYPE 111,1,(DUMSEC(1,I),I=1,10),COND 111 FORMAT(1X,I2,1X,10(A1,1X),10X,'Condition: ',A8) 20 TYPE 21,2,(DUMSEC(2,I),I=1,10),BEARNG 21 FORMAT(1X,I2,1X,10(A1,1X),10X,'Bearing: ',F7.1) 30 TYPE 31,3,(DUMSEC(3,I),I=1,10),DATE 31 FORMAT(1X,I2,1X,10(A1,1X),10X,'Stardate: ',F8.1) 40 TYPE 41,4,(DUMSEC(4,I),I=1,10),POW 41 FORMAT(1X,I2,1X,10(A1,1X),10X,'Power:',6X,I5) 50 TYPE 51,5,(DUMSEC(5,I),I=1,10),(SHLD(J),J=1,4) 51 FORMAT(1X,I2,1X,10(A1,1X),10X,'Shields:'I5,3('/',I4)) 60 TYPE 61,6,(DUMSEC(6,I),I=1,10),SWITCH 61 FORMAT(1X,I2,1X,10(A1,1X),10X,'Auto Alert: ',A3) 70 TYPE 71,7,(DUMSEC(7,I),I=1,10),LFSPT 71 FORMAT(1X,I2,1X,10(A1,1X),10X,'Life Support: ',A8) 80 TYPE 81,8,(DUMSEC(8,I),I=1,10),NCAS(1)+NCAS(2) 81 FORMAT(1X,I2,1X,10(A1,1X),10X,'Crew Losses: ',I4,'/500') 90 TYPE 91,9,(DUMSEC(9,I),I=1,10),NTORP 91 FORMAT(1X,I2,1X,10(A1,1X),10X,'Photon Torpedoes: ',I3) 100 TYPE 101,10,(DUMSEC(10,I),I=1,10),N5-N4,N5 101 FORMAT(1X,I2,1X,10(A1,1X),10X,'Aliens Eliminated: ',I3,' /',I3) RETURN END C C C **************************************** C * * C * LONG RANGE SENSOR SCAN SUBROUTINE * C * * C **************************************** C SUBROUTINE LSCAN 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) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H LOGICAL TDAMC C IF (STATUS(5).GE.0.) GOTO 10 TDAMC=.TRUE. CALL DAMCON(5,3,TDAMC) RETURN 10 TYPE 11 11 FORMAT(/1X,'LONG RANGE SENSOR SCAN') 1000 WRITE(3,11) IR=R1-2 IC=C1-2 DO 1 J=1,3 20 TYPE 21 21 FORMAT(4X,16(1H-)/4X,':',$) 2000 WRITE(3,21) DO 2 I=1,3 IF(IR+J.LT.1 .OR. IR+J.GT.8 .OR. IC+I.LT.1 .OR. IC+I.GT.8)GOTO 40 30 TYPE 31,QUAD(IR+J,IC+I) 31 FORMAT(1H+,I4,':',$) 3000 WRITE(3,31)QUAD(IR+J,IC+I) NGAL(IR+J,IC+I)=QUAD(IR+J,IC+I) GOTO 2 40 TYPE 41 41 FORMAT(1H+,' XX :',$) 4000 WRITE(3,41) 2 CONTINUE 50 TYPE 51 51 FORMAT(1H+,1X) 5000 WRITE(3,51) 1 CONTINUE 60 TYPE 61,R1,C1 61 FORMAT(4X,16(1H-)/4X,'QUADRANT:',I3,',',I3) 6000 WRITE(3,61)R1,C1 RETURN END C C C ****************************** C * * C * MINE CONTROL SUBROUTINE * C * * C ****************************** C SUBROUTINE MINCON(TNAV,TMRTVR,NM) 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/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,DLN,CMD LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TDAMC,TLOOS,TBALEN,TALSD,TNAV,TINTRD,TMRTVR LOGICAL*1 INPUT(3),DUMMY(3) C REAL*8 SYST(2) LOGICAL*1 ANS C TNAV=.FALSE. IF(STATUS(9).GE.0.)GOTO 1 TDAMC=.TRUE. CALL DAMCON(9,9,TDAMC) RETURN 1 IF(.NOT.TINTRD)GOTO 10 IF(ITR(4).NE.1 .AND. ITR(4).NE.2)GOTO 10 CALL DAMCON(9,97,.FALSE.) RETURN 10 TYPE 11 11 FORMAT(/1X'MINE CONTROL') WRITE(3,11) IF(RANK.EQ.1.)GOTO 40 IF(TALTOW)GOTO 50 IF(M2.LE.0)GOTO 30 70 TYPE 71 71 FORMAT(1X,'Do you wish to lay or retrieve mines? ',$) READ(5,81,ERR=70)ANS 81 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.'L')GOTO 30 IF(ANS.EQ.'C')GOTO 60 IF(ANS.NE.'R')GOTO 70 IF(STATUS(10).GE.0.)GOTO 2 SYST(1)='TRACTOR ' SYST(2)='BEAM ' GOTO 90 2 IF(STATUS(11).GE.0.)GOTO 3 SYST(1)='TRANSPOR' SYST(2)='TERS ' GOTO 90 3 IF(STATUS(4).GE.0.)GOTO 6 SYST(1)='SH-RANGE' SYST(2)=' SENSORS' 90 TYPE 91,SYST 91 FORMAT(1X,'*** UNABLE TO USE AUTOMATIC MINE RETRIEVAL DUE TO'/ &5X,'INOPERATIVE ',2A8) WRITE(3,91)SYST GOTO 60 6 IF(NTORP.LT.30)GOTO 110 TYPE 151 151 FORMAT(1X,'** WE ALREADY HAVE AS MANY TORPEDOES AS WE CAN STORE * &*') WRITE(3,151) GOTO 60 110 TYPE 111,M2 111 FORMAT(1X,'There are currently',I3,' mines in Quadrant'/1X, &'How many do you want retrieved? ',$) READ(5,121,ERR=110)INPUT 121 FORMAT(3A1) CALL CAPMSK(INPUT,3) IF(INPUT(1).EQ.'C' .OR. INPUT(1).EQ.'N')GOTO 60 IF(INPUT(1).EQ.'A')GOTO 5 N=0 DO 4 I=1,3 IF(INPUT(I).EQ.' ')GOTO 4 MASK=INPUT(I).AND."100 IF(MASK.EQ."100)GOTO 110 N=N+1 DUMMY(N)=INPUT(I) 4 CONTINUE DECODE(N,131,DUMMY,ERR=110)NM 131 FORMAT(I3) IF(NM.LE.0)GOTO 60 IF(NM.LE.M2)GOTO 100 TYPE 141,M2 141 FORMAT(1X,'TOO MANY MINES REQUESTED -- ',I3,' assumed') WRITE(3,141)M2 5 NM=M2 100 TYPE 101 101 FORMAT(/1X,'** AUTOMATIC MINE RETRIEVAL SEQUENCER INITIATED **') WRITE(3,101) TMRTVR=.TRUE. RETURN 30 TYPE 31,NTORP-M1 31 FORMAT(1X,'Mines available:',I3/1X,'MINES ALLOCATED? ',$) 20 READ(5,21,ERR=30)M3 21 FORMAT(I3) IF(M1+M3.LT.0 .OR. M1+M3.GT.NTORP)GOTO 10 IF(M3.EQ.0)GOTO 60 M1=M1+M3 TNAV=.TRUE. RETURN 40 TYPE 41 41 FORMAT(1X,'Mines are useless at Rank 1') GOTO 60 50 TYPE 51 51 FORMAT(1X,'UNABLE TO LAY MINES WITH VESSEL IN TOW') WRITE(3,51) 60 TYPE 61 61 FORMAT(1X,'*** COMMAND CANCELLED ***') WRITE(3,61) RETURN END