C C C *************************************************************** C * * C * SUBROUTINE TO REPORT KNOWN INFORMATION ON ALL STARBASES * C * * C *************************************************************** C SUBROUTINE BASRPT 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/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) INTEGER SECT,QUAD,R1,C1,R,C,H1,POW,SHLD,A,B,H,RBAS,CBAS,STBS C 10 TYPE 11 11 FORMAT(/1X,'** STARBASES STATUS REPORT:'/) WRITE(3,11) DO 1 I=1,NBAS 20 TYPE 21,I 21 FORMAT(1X,'* STARBASE',I2,$) WRITE(3,21)I IF(STBS(I,1).NE.0)GOTO 2 30 TYPE 31 31 FORMAT(1H+,' HAS BEEN DESTROYED') WRITE(3,31) GOTO 1 2 IF(NGAL(STBS(I,1),STBS(I,2)).NE.-1)GOTO 50 40 TYPE 41 41 FORMAT(1H+,' - LOCATION and STATUS UNKNOWN') WRITE(3,41) GOTO 1 50 TYPE 51,(STBS(I,J),J=1,2),FLOAT(STBS(I,3))/100.,STBS(I,5) 51 FORMAT(1H+,' in Quadrant',I2,',',I2,' - Strength:',F6.1,'%',2X,'Re &placements left:',I4) WRITE(3,51)(STBS(I,J),J=1,2),FLOAT(STBS(I,3))/100.,STBS(I,5) 1 CONTINUE RETURN END C C C *********************************************** C * * C * SUBROUTINE FOR INTERNAL SHIP SECURITY * C * * C *********************************************** C SUBROUTINE SECURE(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/SHIPS/SHIPSN(16,30),DECKS(24) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD REAL*8 SRCH,MAN,CMP INTEGER SECT,QUAD,R1,C1,R,C,H1,POW,SHLD,A,B,H INTEGER SEARCH,ABORT,CANCEL,DISPLA LOGICAL TABORT,TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD LOGICAL*1 ANS(2),N,Y,SHIPSN DATA MAN,CMP/'MANUAL','COMPUTER'/,N,Y/'N','Y'/ DATA SEARCH,ABORT,CANCEL,DISPLA/'SE','AB','CA','DI'/,IANS/' '/ C C CALL SPLFNC("16) 10 TYPE 11 11 FORMAT(/1X,'** SHIP''S INTERNAL SECURITY CONTROL'/) WRITE(3,11) IF(TINTRD)GOTO 30 20 TYPE 21 21 FORMAT(1X,'* There is no evidence of an intruder being aboard') IF(IANS.EQ.SEARCH)GOTO 1 WRITE(3,21) GOTO 200 30 TYPE 31 31 FORMAT(1X,'* SHIP ON SECURITY ALERT GQ-4: INTRUDER ABOARD') WRITE(3,31) 250 TYPE 251,ITR(1) 251 FORMAT(1X,'* Intruder last detected on Deck',I3,$) WRITE(3,251)ITR(1) IF(ITR(1).GT.12)GOTO 50 40 TYPE 41 41 FORMAT(1H+,' (primary hull)') WRITE(3,41) GOTO 2 50 TYPE 51 51 FORMAT(1H+,' (secondary hull)') WRITE(3,51) 2 GOTO(60,70,70,80),ITR(4)+1 60 TYPE 61 61 FORMAT(1X,'* No security searches',$) WRITE(3,61) GOTO 90 70 TYPE 71,ITR(4) 71 FORMAT(1X,'* Level',I2,' internal computer scan of ship',$) WRITE(3,71)ITR(4) GOTO 90 80 TYPE 81 81 FORMAT(1X,'* Level 3 manual search by security personnel',$) WRITE(3,81) 90 TYPE 91 91 FORMAT(1H+' in progress') WRITE(3,91) 200 TYPE 201 201 FORMAT(/1X,'SECURITY OPTION? ',$) 190 READ(5,191,ERR=200)IANS 191 FORMAT(A2) ENCODE(2,191,ANS,ERR=200)IANS CALL CAPMSK(ANS,2) DECODE(2,191,ANS,ERR=200)IANS IF(IANS.EQ.SEARCH)GOTO 3 IF(IANS.EQ.DISPLA)GOTO 4 IF(IANS.EQ.'MA')GOTO 6 IF(IANS.EQ.CANCEL .OR. IANS.EQ.ABORT)GOTO 1 210 TYPE 211 211 FORMAT(/1X,'AVAILABLE OPTIONS:'/ &1X,'SEARCH - To initiate (or stop) security search of ship'/ &1X,'DISPLAY - To display the functions and vulnerable systems'/ &12X,'of each deck in the ship'/ &1X,'MAX - Maximum Security Deck. Directs all Space Marines'/ &12X,'and most Security Personnel to specified deck'/ &12X,'for protection of vulnerable systems and to'/ &12X,'increase chances of capture on that deck,'/ &12X,'at expense of chances on other decks.'/ &1X,'CANCEL or ABORT') GOTO 200 3 IF(.NOT.TINTRD)GOTO 20 IF(ITR(4).EQ.0)GOTO 140 110 TYPE 111,ITR(4) 111 FORMAT(1X,'Do you want to stop the Level',I2,' search in progress? & ',$) 120 READ(5,121,ERR=110)ANS(1) 121 FORMAT(A1) CALL CAPMSK(ANS(1),1) IF(ANS(1).EQ.N)GOTO 1 IF(ANS(1).NE.Y)GOTO 110 SRCH=CMP IF(ITR(4).EQ.3)SRCH=MAN 130 TYPE 131,ITR(4),SRCH 131 FORMAT(/1X,'* THE LEVEL',I2,1X,A8,' SEARCH HAS BEEN STOPPED') WRITE(3,131)ITR(4),SRCH ITR(4)=0 140 TYPE 141 141 FORMAT(/1X,'LEVEL OF SECURITY SEARCH DESIRED? ',$) 150 READ(5,151,ERR=140)NC,ANS 151 FORMAT(Q,2A1) IF(NC.EQ.0)GOTO 100 CALL CAPMSK(ANS,2) IF(ANS(1).EQ.'C')GOTO 1 IF(ANS(1).NE.'O')GOTO 5 100 TYPE 101 101 FORMAT(/1X,'* AVAILABLE LEVELS OF INTERNAL SECURITY SEARCHES:'/1X, &'* LEVEL 1 - Primary computers devoted entirely to search for alie &n'/13X,'life forms aboard; also employs all personnel except'/13X, &'skeleton crew. Fastest level search, but severely'/13X,'restricts & other activities - power needed: 100 units'/1X,'* LEVEL 2 - Prima &ry computers only partially used in search for'/13X,'intruder; als &o not as many crew personnel used. Some'/13X,'activities restricte &d - power needed: 50 units'/1X,'* LEVEL 3 - Manual search by secur &ity personnel only (slowest)'/1X,'* "C" TO CANCEL') GOTO 140 5 MASK=ANS(1).AND."100 IF(MASK.EQ."100)GOTO 100 DECODE(1,301,ANS(1),ERR=140)LDES 301 FORMAT(I2) IF(LDES.LE.0)GOTO 1 IF(LDES.GT.3)GOTO 100 ITR(4)=LDES IF(ITR(4).EQ.0)GOTO 1 IF(ITR(4).EQ.3)GOTO 180 IF(POW.LT.100/ITR(4))GOTO 170 160 TYPE 161,ITR(4) 161 FORMAT(/1X,'* A LEVEL',I2,' COMPUTER SECURITY SEARCH OF THE SHIP H &AS BEEN INITIATED') WRITE(3,161)ITR(4) POW=POW-100/ITR(4) GOTO 200 170 TYPE 171,ITR(4) 171 FORMAT(/1X,'* Insufficient power available for a Level',I2,' secur &ity search') WRITE(3,171)ITR(4) GOTO 140 180 TYPE 181 181 FORMAT(/1X,'* A LEVEL 3 MANUAL SEARCH OF SHIP HAS BEEN INITIATED') WRITE(3,181) GOTO 200 C 4 CALL SPLFNC("16) 4 CONTINUE 390 TYPE 391 391 FORMAT(1X,'Primary or Secondary hull? ',$) READ(5,121,ERR=390)ANS(1) CALL CAPMSK(ANS(1),1) IF(ANS(1).EQ.'S')GOTO 280 IF(ANS(1).NE.'P' .AND. ANS(1).NE.'B')GOTO 390 220 TYPE 221 221 FORMAT(/1X,'* List of ship''s decks, their primary functions and v &ulnerable systems') TYPE 401 401 FORMAT(/1X,'PART A: PRIMARY HULL') 230 TYPE 231 231 FORMAT(1X,'DECK',T19,'PRIMARY FUNCTIONS',T52,'VULNERABLE SYSTEMS'/ &1X,'----',T9,38('-'),T51,22('-')) 240 TYPE 241 241 FORMAT(2X,'0',T9,'Upper Sensor Platform',T51,'S. & L. Range Sensor &s'/2X,'1',T9,'Main Bridge',T51,'None'/2X,'2',T9,'Science Labs',T51 &,'None'/2X,'3',T9,'Photon Torpedo Bank, Science Labs',T51,'Photon &Torpedoes'/2X,'4',T9,'Junior Officers Quarters',T51,'Primary Life &Support'/2X,'5',T9,'Senior Officers Quarters, Gallery',T51,'Phaser &s, P.L.S.'/2X,'6',T9,'Crews Quarters, Engineering, Messrooms',T51, &'Impulse Engines'/2X,'7',T9,'Emergency Bridge, Computer, Medical,' &,T51,'Im. En., Transporters,'/15X,'Engineering',T53,'Navigation Co &mputer'/2X,'8',T9,'Computer, Life Support Facilities',T51,'Nav. Co &mp., P.L.S.'/2X,'9',T9,'Cargo, Maintenance, Aux. Machinery',T51,'N &one'/1X,'10',T9,'Cargo, Maint.',T51,'None'/1X,'11',T9,'Phasers, Au &x. Fire Control',T51,'Phasers'/1X,'12',T9,'Lower Sensors Platform' &,T51,'S. & L. Range Sensors'/) IF(TINTRD .AND. ITR(1).LE.12)TYPE 251,ITR(1) 260 TYPE 261 261 FORMAT(1X/1X,'TO CONTINUE THE LISTING FOR THE SECONDARY HULL, HIT &'/1X,'TO PREVENT THE LISTING, ENTER "CA" OR "CANCEL"') 270 READ(5,191,ERR=260)IANS ENCODE(2,191,ANS,ERR=200)IANS CALL CAPMSK(ANS,2) DECODE(2,191,ANS,ERR=200)IANS IF(IANS.EQ.CANCEL)GOTO 200 280 TYPE 281 281 FORMAT(//1X,'PART B: SECONDARY HULL') TYPE 231 290 TYPE 291 291 FORMAT(1X,'13',T9,'Lounges (In Dorsal)',T51,'None'/1X,'14',T9,'Lou &nges (In Dorsal)',T51,'None'/1X,'15',T9,'Visicons, Air Conditionin &g Machinery',T51,'Nav. Comp., P.L.S.'/1X,'16',T9,'Medical, Enginee &ring',T51,'Warp Engines'/1X,'17',T9,'Crews Quarters',T51,'None'/1X &,'18',T9,'Crews Quarters',T51,'None'/1X,'19',T9,'Bridge, Shuttlecr &aft Hangar',T51,'None'/1X,'20',T9,'Recreation Area',T51,'None'/1X, &'21',T9,'Food Preparation, Waste Recovery',T51,'None'/1X,'22',T9,' &Fabrication Facilities',T51,'None'/1X,'23',T9,'Tractor Beam, Stowa &ge Cargo Holds',T51,'Tractor Beams') IF(TINTRD .AND. ITR(1).GE.13)TYPE 251,ITR(1) GOTO 200 6 MDECK=ITR(2)/100-1 IF(MDECK.LT.0)GOTO 320 TYPE 311,MDECK 311 FORMAT(1X,'* Deck',I3,$) WRITE(3,311)MDECK GOTO 330 320 TYPE 321 321 FORMAT(1X,'* No deck',$) WRITE(3,321) 330 TYPE 331 331 FORMAT(1H+,' is currently a Maximum Security Deck') WRITE(3,331) 340 TYPE 341 341 FORMAT(1X,'Do you wish to specify a deck for Maximum Security? ', &$) READ(5,151,ERR=340)NC,ANS IF(NC.EQ.0)GOTO 200 CALL CAPMSK(ANS,2) IF(ANS(1).EQ.'N')GOTO 200 IF(ANS(1).NE.'Y')GOTO 340 350 TYPE 351 351 FORMAT(1X,'Which deck? ',$) READ(5,301,ERR=350)MD IF(MD.GE.0 .AND. MD.LE.23)GOTO 7 TYPE 361,MD 361 FORMAT(1X,'*** ERROR - There is no Deck',I3,' aboard this ship!') WRITE(3,361)MD GOTO 200 7 IF(MDECK.LT.0)GOTO 380 TYPE 371,MDECK,MD 371 FORMAT(/1X,'* SECURITY IS SWITCHING MAXIMUM SECURITY FROM DECK',I3, &' TO DECK',I3) WRITE(3,371)MDECK,MD GOTO 8 380 TYPE 381,MD 381 FORMAT(/1X,'* DECK',I3,' HAS BEEN DESIGNATED FOR MAXIMUM SECURITY' &/1X,' Marines and Security Personnel are on their way') WRITE(3,381)MD 8 INLOC=MOD(ITR(2),100) IF(INLOC.NE.MD)GOTO 12 9 IX=RAN(II,JJ)*10+1 IND=INLOC+(-1)**IX IF(IND.LT.0 .OR. IND.GT.23)GOTO 9 INLOC=IND 12 ITR(2)=INLOC+(MD+1)*100 RETURN 1 TABORT=.TRUE. RETURN END