C C C ****************************************** C * * C * DEFENSIVE SHIELDS CONTROL SUBROUTINE * C * * C ****************************************** C SUBROUTINE SHIELD 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 COMMON/ALPHA/ALPH(30) DIMENSION IS3(4),IA(7) 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,TINTRD,TEST,TEST1,TEST2,TEST3, &TBEC LOGICAL*1 ANS,ENDB,ALPH,IMAGE(40),DUMMY(4),STR,COL DATA ENDB,STR,COL/1H ,1H*,1H:/ C TLOOS=.FALSE. IF(STATUS(6).GE.0.) GOTO 10 TDAMC=.TRUE. CALL DAMCON(6,4,TDAMC) RETURN 10 TYPE 11 11 FORMAT(/1X,'SHIELD CONTROL') 1000 WRITE(3,11) IF(.NOT.TALTOW)GOTO 24 CALL FDSHLD(NS,TEST3,ICAPV(1),ICAPV(2),A,B) 50 TYPE 51,NS 51 FORMAT(/1X,'** WARNING - Raising shield',I2,' will disconnect trac &tor beam **'/) 5000 WRITE(3,51)NS 60 TYPE 61 61 FORMAT(1X,'Is command confirmed? ',$) 70 READ(5,71,ERR=60)ANS 71 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.ALPH(25))GOTO 24 IF(ANS.NE.ALPH(14))GOTO 60 180 TYPE 181 181 FORMAT(1X,'*** Command cancelled ***') WRITE(3,181) RETURN 24 IF(SHLD(5).GT.0)GOTO 190 210 TYPE 211 211 FORMAT(1X,'Shields are down') WRITE(3,211) GOTO 20 190 TYPE 191,SHLD(5),(SHLD(I),I=1,4) 191 FORMAT(1X,'Total shield power is',I5,' units'/1X,'distributed as f &ollows: ',I4,3('/',I4)) 20 TYPE 21,POW+SHLD(5) 21 FORMAT(/1X,'Power Available: ',I5,' units') 30 TYPE 31 31 FORMAT(1X,'New shield power allocation ("OP" for options)?') 40 READ(5,41,ERR=30)NC,IMAGE 41 FORMAT(Q,40A1) IF(NC.GT.40)NC=40 IF(NC.EQ.0)GOTO 180 CALL CAPMSK(IMAGE,NC) IF(IMAGE(1).NE.ALPH(15))GOTO 17 160 TYPE 161 161 FORMAT(/1X,'AVAILABLE OPTIONS:'//1X, 'D - Diagram showing shield l &ocations and orientation'/1X,'L - Lower shields'/1X,'B - Battle en &try configuration; 2#/#/0/#'/1X,'M - Maximum Strength; same as B, & but even distribution'/1X,': - Number following is total shield &power allocated; 1/4 to each'/1X,'* - Number following is power &allocated to each shield'/1X,'#/#/#/# or #,#,#,# - Power allocated &to each shield separately'/1X,' alone to cancel command'/) GOTO 30 17 IF(IMAGE(1).EQ.ALPH(4))GOTO 12 IF(IMAGE(1).NE.ALPH(12))GOTO 14 POW=POW+SHLD(5) DO 15 I=1,5 SHLD(I)=0 15 CONTINUE 120 TYPE 121,POW 121 FORMAT(/1X,'SHIELDS LOWERED - main power supply is now',I5,' units &') WRITE(3,121)POW TBALEN=.FALSE. GOTO 22 14 IF(IMAGE(1).NE.'B' .AND. IMAGE(1).NE.'M')GOTO 18 IF(POW+SHLD(5).GE.29)GOTO 23 200 TYPE 201 201 FORMAT(1X,'Insufficient power available for Maximum or Battle Entr &y Configuration') WRITE(3,201) GOTO 180 23 POW=POW+SHLD(5) SHLD(5)=0 TBEC=.FALSE. IF(IMAGE(1).EQ.'B')TBEC=.TRUE. IST=1000 IF(POW.LT.4100)IST=(POW-100)/4 IF(POW.LT.200)IST=(POW-25)/4 DO 19 I=1,4 SHLD(I)=0 IF(.NOT.TBEC .OR. I.NE.3)SHLD(I)=IST 19 CONTINUE IF(TBEC)SHLD(1)=SHLD(1)+IST SHLD(5)=4*IST POW=POW-SHLD(5) 170 TYPE 171 171 FORMAT(/1X,'** SHIELDS NOW IN ',$) WRITE(3,171) IF(TBEC)GOTO 260 TYPE 251 251 FORMAT(1H+,'MAXIMUM STRENGTH',$) WRITE(3,251) GOTO 270 260 TYPE 261 261 FORMAT(1H+,'BATTLE ENTRY',$) WRITE(3,261) 270 TYPE 271,(SHLD(I),I=1,4) 271 FORMAT(1H+,' CONFIGURATION **'//1X, &'Allocation: ',I5,3('/',I4)) WRITE(3,271)(SHLD(I),I=1,4) TBALEN=.TRUE. GOTO 150 18 TEST=.FALSE. TEST1=.FALSE. TEST2=.FALSE. IF(IMAGE(1).EQ.STR)TEST=.TRUE. IF(IMAGE(1).EQ.COL)TEST1=.TRUE. IF(TEST .OR. TEST1)TEST2=.TRUE. J=1 IST=0 NN=0 DO 2 I=1,39 IF(IMAGE(I).EQ.ENDB .AND. IMAGE(I+1).EQ.ENDB)GOTO 7 IF(IMAGE(I).NE.ALPH(27))GOTO 3 80 TYPE 81 81 FORMAT(1X,'*** INPUT ERROR - Integer variables only ***'/) GOTO 30 7 IF(J.EQ.4)GOTO 100 IF(TEST2 .AND. J.EQ.1)GOTO 100 IF(.NOT.TEST2 .AND. I.EQ.1)GOTO 180 IF(TEST2 .AND. I.EQ.2)GOTO 180 130 TYPE 131 131 FORMAT(1X,'*** INPUT ERROR - Four values needed unless using ":" o &r "*" ***'/) GOTO 30 3 IF(TEST2 .AND. I.EQ.1)GOTO 2 IF(IMAGE(I).NE.ALPH(28) .AND. IMAGE(I).NE.ALPH(30))GOTO 4 IF(.NOT.TEST2)GOTO 100 90 TYPE 91 91 FORMAT(1X,'*** INPUT ERROR - Only one value when using ":" or "*" &***'/) GOTO 30 4 NN=NN+1 DUMMY(NN)=IMAGE(I) GOTO 2 100 DECODE(NN,101,DUMMY,ERR=80)IS3(J) 101 FORMAT(I4) IST=IST+IS3(J) IF(.NOT.TEST2)GOTO 8 IX=IST IF(TEST1)IX=IST/4 IF(TEST)IST=IST*4 DO 9 I1=1,4 IS3(I1)=IX IF(IX.GT.2000)GOTO 240 9 CONTINUE GOTO 5 8 IF(IS3(J).GT.2000)GOTO 240 J=J+1 NN=0 IF(J.EQ.5)GOTO 5 2 CONTINUE 5 IF(IST.GT.4000)GOTO 220 IF(POW-IST+SHLD(5).GE.0 .AND. IST.GE.0)GOTO 16 140 TYPE 141 141 FORMAT(/1X'INSUFFICIENT POWER',$) GOTO 230 220 TYPE 221 221 FORMAT(/1X,'** POWER REQUESTED EXCEEDS MAXIMUM CAPACITY OF SHIELDS & **'/1X,'Max. capacity of shields is 4000 units',$) 230 TYPE 231,IST 231 FORMAT(1H+,' -- power requested:',I5,' units') GOTO 20 240 TYPE 241 241 FORMAT(/1X,'** EXCESSIVE POWER REQUESTED FOR AN INDIVIDUAL SHIELD &**'/1X,'Each shield has a maximum capacity of 2000 units') GOTO 20 16 POW=POW-IST+SHLD(5) SHLD(5)=0 DO 6 I=1,4 SHLD(I)=IS3(I) SHLD(5)=SHLD(5)+SHLD(I) 6 CONTINUE TBALEN=.FALSE. 150 TYPE 151,SHLD(5) 151 FORMAT(1X,'Total shield power is now:',I5,' units') WRITE(3,151)SHLD(5) WRITE(3,90001)(SHLD(I),I=1,4) 90001 FORMAT(1X,'Distibuted as follows: ',I4,3('/',I4)) IF(.NOT.TALTOW)GOTO 22 IF(SHLD(NS).GT.0)TLOOS=.TRUE. IF(.NOT.TEST3)GOTO 22 NS2=NS+1 IF(NS2.EQ.5)NS2=1 IF(SHLD(NS).GT.0 .OR. SHLD(NS2).GT.0)TLOOS=.TRUE. 22 IF(STATUS(12).GE.0. .OR. POW.LE.0)RETURN IF(STATUS(12).GT.-5.)RETURN STATUS(12)=0. GASP=0. RETURN 12 THETA=BEARNG DO 13 I=1,7 X=I IA(I)=THETA+X*45. IF(IA(I).GE.360)IA(I)=IA(I)-360 13 CONTINUE IY=THETA C CALL SPLFNC("16) 110 TYPE 111,IA(1),IY,IA(7),IA(2),IA(6),IA(3),IA(5) 111 FORMAT( 1X,T11,I3,T26,'BEARING(',I3,')',T46,I3/1X,T15,'.',T30,'!', &T45,'.'/1X,T18,'.',T26,'SHIELD 1',T42,'.'/1X,T21,'.',T30,'!',T39, &'.'/1X,T24,'. ',9(1H*),' .'/1X,T23,15(1H*)/1X,T11,'SHIELD',T22,17( &1H*),T43,'SHIELD'/1X,T6,I3,1X,11(1H-),1X,8(1H*),'+',8(1H*),1X,11(1 &H-),1X,I3/1X,T13,'2',T22,17(1H*),T45,'4'/1X,T23,15(1H*)/1X,T24,'. &',9(1H*),' .'/1X,T22,'.',T29,'***',T38,'.'/1X,T20,'. CD',4X,'***' &,4X,'CD .'/1X,T18,'.',T23,'IIXXXX***XXXXII',T42,'.'/1X,T16,'.',T2 &3,'II',4X,'***',4X,'II',T44,'.'/1X,T14,'.',T23,'II',T30,'*',T36,'I &I',T46,'.'/1X,T12,'.',T23,'II',T30,'!',T36,'II',T48,'.'/1X,T10,'.' &,T23,'II',T30,'!',T36,'II',T50,'.'/1X,T8,I3,T23,'II',T30,'!',T36,' &II',T50,I3/1X,T26,'SHIELD 3'/) TYPE 901 901 FORMAT(/1X,'Hit to continue') READ(5,911,ERR=190)IX 911 FORMAT(A2) GOTO 190 END C C C ************************************************************* C * * C * SUBROUTINE TO RELEASE TOWED ALIEN WHEN TRACTOR BEAM * C * IS SWITCHED OFF * C * * C ************************************************************* C SUBROUTINE LOOSAL 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/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 REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,DLN,H,CMD INTEGER E9,D9,S9,B9,R9 LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TLOOS,TBALEN,TALSD,TINTRD LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP C DEGCON(ANGLE)=ANGLE*0.017453293 C IF(STATUS(10).LT.0.)GOTO 80 IF(TBOFF)GOTO 20 10 TYPE 11 11 FORMAT(/1X'** UNABLE TO MAINTAIN TRACTOR BEAM THROUGH DEFENSIVE SH &IELDS **') WRITE(3,11) 20 TYPE 21 21 FORMAT(1X,'Tractor Beam switched off') WRITE(3,21) GOTO 16 80 TYPE 81 81 FORMAT(/1X,'** TRACTOR BEAM HAS CUT OFF DUE TO DAMAGED CONTROL') WRITE(3,81) 16 TALTOW=.FALSE. TBOFF=.FALSE. TLOOS=.FALSE. IF(ICAPV(1).EQ.0)RETURN IFACR=0 IFACC=0 IF(IABS(A-ICAPV(1)).GT.3 .OR. IABS(B-ICAPV(2)).GT.3)GOTO 3 IF(ICAPV(4).EQ.0 .OR. ICAPV(5).EQ.1)GOTO 9 NA=7 TROM1=.TRUE. TROM2=.TRUE. GOTO 13 9 DO 12 NA=1,6 IF(K(NA,1).EQ.0)GOTO 13 12 CONTINUE IF(ICAPV(5).EQ.0)GOTO 50 SECTOR(ICAPV(1),ICAPV(2))=DOT SECT(ICAPV(1),ICAPV(2))=D9 GOTO 40 50 TYPE 51 51 FORMAT(/1X,'RELEASED ALIEN VESSEL HAS SELF-DESTRUCTED - NO DAMAGE &SUSTAINED') WRITE(3,51) N4=N4-1 IF(NA.EQ.7)NROMD=NROMD+1 SECTOR(ICAPV(1),ICAPV(2))=DOT SECT(ICAPV(1),ICAPV(2))=D9 IF(N4.LE.0)TWON=.TRUE. GOTO 6 13 K(NA,4)=ICAPV(5) IF(ICAPV(5).NE.1)GOTO 15 IFACR=2 GOTO 6 15 IF(NA.EQ.7)GOTO 14 QUAD(R1,C1)=QUAD(R1,C1)+100 NGAL(R1,C1)=QUAD(R1,C1) N3=N3+1 N2=N2+1 14 IF(COND.EQ.GRN)COND=RED IFACR=2 6 DO 1 I=1,5 IF(I.GT.3 .OR. IFACR.NE.2)GOTO 2 K(NA,I)=ICAPV(I) 2 ICAPV(I)=0 1 CONTINUE RETURN 3 IF(ICAPV(4).EQ.1 .OR. ICAPV(5).EQ.1)GOTO 8 IF(A.EQ.1 .AND. (B.EQ.1 .OR. B.EQ.10))GOTO 4 IF(A.NE.10 .OR. B.NE.1 .AND. B.NE.10)GOTO 5 4 IF(ABS(BEARNG).GE.30. .AND. ABS(BEARNG).LE.60.)GOTO 7 IF(ABS(BEARNG).GE.120. .AND. ABS(BEARNG).LE.150.)GOTO 7 IF(BEARNG.LT.210. .OR. BEARNG.GT.240.)GOTO 5 7 IF(A.EQ.1)IFACR=-1 IF(A.EQ.10)IFACR=1 IF(B.EQ.1)IFACC=-1 IF(B.EQ.10)IFACC=1 5 CORS=DEGCON(BEARNG) IR1=R1-INT(-SIN(CORS))+IFACR IC1=C1-INT(COS(CORS))+IFACC IF(QUAD(IR1,IC1).GE.600)GOTO 30 QUAD(IR1,IC1)=QUAD(IR1,IC1)+100 NGAL(IR1,IC1)=QUAD(IR1,IC1) 60 TYPE 61 61 FORMAT(/1X,'Towed alien vessel has escaped') WRITE(3,61) IF(ICAPV(5).NE.2)GOTO 6 70 TYPE 71 71 FORMAT(1X,'They apparently have halted their self-destruct sequenc &e') TALSD=.FALSE. GOTO 6 8 IF(ICAPV(5).EQ.1)GOTO 40 30 TYPE 31 31 FORMAT(/1X,'All contact with towed alien vessel has been lost') WRITE(3,31) GOTO 6 40 TYPE 41 41 FORMAT(/1X'Captured alien vessel has been destroyed by charges'/1X &'left aboard by the security teams before their return') WRITE(3,41) GOTO 6 END