C C C ************************************************* C * * C * SUBROUTINE TO OPERATE SHIP'S TRANSPORTERS * C * * C ************************************************* C SUBROUTINE TRANSP(TMINBK,TMRTVR,MR,MC) 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/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/ALPHA/ALPH(30) COMMON/TESTS1/TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW, &TBOFF,TALERT,TLOOS,TBALEN,TALSD,TINTRD DIMENSION ITARG(5) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,H,DLN,CMD INTEGER D9,E9,S9,B9,R9,RBAS,CBAS,STBS REAL*8 KL,RM,GRN,RED,DCKD,COND,DEST,DISAB,TARGET,ASTAR,STBASE, &PTMINE LOGICAL TROM1,TROM2,TDISAB,TDEST,TWON,TLOST,TRESC,TALTOW,TBOFF, &TALERT,TDAMC,TLOOS,TBALEN,TALSD,TINTRD,TMINBK,TEST,TEST1,TMOVE LOGICAL TMRTVR LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,ALPH,ANS,BLA,SHIP DATA ASTAR,STBASE,PTMINE/'* STAR *','STARBASE','MINE'/,BLA/1H / C DIST(IA,IB,IR,IC)=SQRT(FLOAT((IA-IR)**2+(IB-IC)**2)) C IF(STATUS(11).GE.0.)GOTO 10 IF(.NOT.TMINBK)GOTO 23 230 TYPE 231 231 FORMAT(1X,'Unable to bring mine aboard') WRITE(3,231) TMINBK=.FALSE. 23 IF(STATUS(11).GE.0.)GOTO 34 TDAMC=.TRUE. CALL DAMCON(11,11,TDAMC) RETURN 34 IF(ITR(4).NE.1)GOTO 10 35 CALL DAMCON(11,97,.FALSE.) RETURN 10 TYPE 11 11 FORMAT(/1X,'TRANSPORTERS CONTROL') WRITE(3,11) IF(TMINBK)GOTO 27 250 TYPE 251 251 FORMAT(1X,'Do you want to use transporters for boarding'/1X,'or tr &ansporting object aboard? ',$) 260 READ(5,261,ERR=250)ANS 261 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.ALPH(20))GOTO 270 IF(ANS.EQ.ALPH(14) .OR. ANS.EQ.ALPH(3) .OR. ANS.EQ.BLA)GOTO 30 IF(ANS.NE.ALPH(2))GOTO 250 IF(TINTRD .AND. (ITR(4).EQ.1 .OR. ITR(4).EQ.2))GOTO 35 IF(COND.NE.GRN .OR. ICAPV(1).NE.0)GOTO 9 20 TYPE 21 21 FORMAT(1X,'No hostile vessels present in Quadrant - transporters u &seless') WRITE(3,21) GOTO 30 9 IF(NCAS(2).LT.66)GOTO 40 220 TYPE 221,NCAS(2) 221 FORMAT(/1X,'Losses to space marines have been excessive, with',I4, &' casualties'/1X,'suffered to date. Not enough personnel are l &eft to attempt'/1X,'capture of enemy vessel.') WRITE(3,221)NCAS(2) GOTO 30 40 TYPE 41,70-NCAS(2) 41 FORMAT(/1XI2,' FEDERATION SPACE MARINES STANDING BY FOR BOARDING') WRITE(3,41)70-NCAS(2) N=0 DO 36 NA=1,7 IF(K(NA,1).LE.0)GOTO 36 KR=K(NA,1) KC=K(NA,2) IF(SECTOR(KR,KC).EQ.DOT)GOTO 36 IF(DIST(A,B,KR,KC).GT.2.)GOTO 36 IR=KR IC=KC N=N+1 36 CONTINUE IF(TALTOW)N=N+1 IF(N.NE.1)GOTO 50 IF(.NOT.TALTOW)GOTO 1 IR=ICAPV(1) IC=ICAPV(2) GOTO 1 50 TYPE 51 51 FORMAT(1X,'Sector location of vessel to be boarded? ',$) 60 READ(5,61,ERR=50)IR,IC 61 FORMAT(2I3) IF(IR.EQ.0 .AND. IC.EQ.0)GOTO 30 IF(IR.LT.1 .OR. IR.GT.10 .OR. IC.LT.1 .OR. IC.GT.10)GOTO 290 IF(SECT(IR,IC).EQ.K9 .OR. SECT(IR,IC).EQ.R9)GOTO 1 70 TYPE 71,IR,IC 71 FORMAT(1X,'No vessel in Sector',I3,',',I3) WRITE(3,71)IR,IC GOTO 30 1 ITOW=0 NA=0 IF(ICAPV(1).NE.IR .OR. ICAPV(2).NE.IC)GOTO 2 ITOW=1 DO 13 I=1,5 ITARG(I)=ICAPV(I) 13 CONTINUE TARGET=KL IF(ICAPV(4).EQ.1)TARGET=RM IF(ICAPV(5).EQ.1)GOTO 80 GOTO 8 80 TYPE 81,TARGET,IR,IC 81 FORMAT(1X,A8,'VESSEL IN SECTOR',I3,',',I3,' HAS ALREADY BEEN CAPTU &RED') WRITE(3,81)TARGET,IR,IC GOTO 30 2 DO 3 NA=1,7 IF(K(NA,1).EQ.IR .AND. K(NA,2).EQ.IC)GOTO 4 3 CONTINUE 90 TYPE 91 91 FORMAT(/1X,'TRANSPORTERS FAILED TO LOCK ON TARGET') WRITE(3,91) GOTO 30 4 TARGET=KL IF(SECT(IR,IC).NE.R9)GOTO 5 TARGET=RM IF(K(NA,4).EQ.1)GOTO 80 IF(.NOT.TROM2)GOTO 90 5 IF(K(NA,3).LT.100)GOTO 15 100 TYPE 101,TARGET,IR,IC 101 FORMAT(1X,A8,'VESSEL IN SECTOR',I3,',',I3,' HAS SHIELDS UP - UNABL &E TO BOARD') WRITE(3,101)TARGET,IR,IC GOTO 30 15 DO 14 I=1,4 ITARG(I)=K(NA,I) 14 CONTINUE ITARG(5)=ITARG(4) 8 DIS=DIST(A,B,IR,IC) IF(DIS.LE.2.)GOTO 25 150 TYPE 151,TARGET,IR,IC 151 FORMAT(1X,A8,'VESSEL IN SECTOR',I3,',',I3,' IS OUT OF TRANSPORTER &RANGE') WRITE(3,151)TARGET,IR,IC GOTO 30 25 IF(.NOT.TALERT .OR. COND.EQ.RED)GOTO 28 IF(SHLD(5).EQ.0)GOTO 26 POW=POW+SHLD(5) DO 12 I=1,5 SHLD(I)=0 12 CONTINUE 200 TYPE 201 201 FORMAT(1X,'DEFLECTOR SHIELDS LOWERED') WRITE(3,201) GOTO 26 28 CALL FDSHLD(NS,TEST1,IR,IC,A,B) IF(.NOT.TEST1)GOTO 29 NS2=NS+1 IF(NS2.EQ.5)NS2=1 IF(SHLD(NS).NE.0 .AND. SHLD(NS2).EQ.0)NS=NS2 NS1=NS2 IF(NS2.EQ.NS)NS1=NS1-1 IF(NS2.GT.NS .OR. (NS2.EQ.1 .AND. NS.EQ.4))NS1=NS 29 IF(SHLD(NS).EQ.0)GOTO 26 170 TYPE 171,NS 171 FORMAT(1X'*** WARNING - SHIELD',I2,' MUST BE LOWERED TO OPERATE TR &ANSPORTERS ***'/) WRITE(3,171)NS 180 TYPE 181 181 FORMAT(1X,'Is command confirmed? ',$) 190 READ(5,191,ERR=180)ANS 191 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.ALPH(14))GOTO 30 IF(ANS.NE.ALPH(25))GOTO 180 360 TYPE 361,NS 361 FORMAT(1X,'DEFENSIVE SHIELD',I2,' LOWERED') WRITE(3,361)NS POW=POW+SHLD(NS) SHLD(5)=SHLD(5)-SHLD(NS) SHLD(NS)=0 IF(TEST1)CALL ADJUST(NS,NS1) 26 IF(TMINBK .OR. TARGET.EQ.PTMINE)GOTO 24 IF(POW.GT.INT(DIS*10.))GOTO 110 160 TYPE 161 161 FORMAT(1X,'Insufficient power available for transporters') WRITE(3,161) GOTO 30 110 TYPE 111,TARGET 111 FORMAT(/1X,'TRANSPORTERS ENERGIZED'/1X,'BOARDING OF ',A8,'VESSEL I &N PROGRESS'/) WRITE(3,111)TARGET CALL PAUSE(4) POW=POW-INT(DIS*10.) 6 IF(RAN(II,JJ).LT.FLOAT(ITARG(3))/120.)GOTO 120 INPRIS=300.*FLOAT(ITARG(3))/500.+RAN(II,JJ)*10. IF(INPRIS.EQ.1)INPRIS=2 140 TYPE 141,TARGET,INPRIS,TARGET 141 FORMAT(1X,'**** ',A8,'VESSEL CAPTURED ****'/1X,I4,1X,A8,'PRISONERS & TAKEN') WRITE(3,141)TARGET,INPRIS,TARGET NPRIS=NPRIS+INPRIS IF(TARGET.EQ.KL)ITR(3)=ITR(3)+1 IF(TARGET.EQ.RM)ITR(3)=ITR(3)+2 IF(ITR(3).EQ.3 .OR. ITR(3).EQ.4)ITR(3)=ITR(3)-2 IF(MOD(ITR(3),10).EQ.3 .OR. MOD(ITR(3),10).EQ.4)ITR(3)=ITR(3)-2 ITARG(5)=1 FAC=30. GOTO 7 120 TYPE 121,TARGET 121 FORMAT(1X,'ATTEMPTED CAPTURE OF ',A8,'VESSEL UNSUCCESSFUL') WRITE(3,121)TARGET FAC=50. 7 IFATAL=RAN(II,JJ)*FLOAT(ITARG(3))/100.*FAC IF(IFATAL.EQ.1)GOTO 7 IF(IFATAL.GT.70-NCAS(2))IFATAL=70-NCAS(2) NCAS(2)=NCAS(2)+IFATAL 130 TYPE 131,IFATAL 131 FORMAT(1X,I3,' casualties suffered by boarding parties'/) WRITE(3,131)IFATAL IF(ITARG(5).NE.1)GOTO 32 IF(ITOW.EQ.1)GOTO 18 IF(TARGET.EQ.KL)GOTO 19 TROM1=.FALSE. GOTO 22 19 QUAD(R1,C1)=QUAD(R1,C1)-100 NGAL(R1,C1)=QUAD(R1,C1) N3=N3-1 IF(TROM1)GOTO 18 22 IF(N3.EQ.0 .AND. COND.NE.DCKD)COND=GRN 18 N4=N4-1 IF(N4.LE.0)TWON=.TRUE. IF(TARGET.EQ.RM)NROMD=NROMD+1 IF(N6.EQ.0 .OR. COND.EQ.RED .OR. N3.GT.0)GOTO 17 IF(STBS(N6,4).NE.1)GOTO 17 STBS(N6,4)=0 TRESC=.TRUE. 17 TEST=.FALSE. IF(ITOW.EQ.0)GOTO 16 IF(ICAPV(5).EQ.2)TEST=.TRUE. ICAPV(5)=1 IF(TEST)GOTO 340 GOTO 32 16 IF(K(NA,4).EQ.2)TEST=.TRUE. K(NA,4)=1 IF(TARGET.EQ.RM)TROM1=.FALSE. IF(.NOT.TEST)GOTO 32 340 TYPE 341 341 FORMAT(/1X,'Our technicians have deactivated the self-destruct mec &hanism') WRITE(3,341) TALSD=.FALSE. GOTO 32 270 TYPE 271 271 FORMAT(/1X,'Target Sector? ',$) 280 READ(5,281,ERR=270)IR,IC 281 FORMAT(2I3) IF(IR.EQ.0 .AND. IC.EQ.0)GOTO 30 IF(IR.GT.10 .OR. IR.LT.1 .OR. IC.GT.10 .OR. IC.LT.1)GOTO 290 IF(SECT(IR,IC).EQ.D9)GOTO 310 IF(SECT(IR,IC).EQ.S9)TARGET=ASTAR IF(SECT(IR,IC).EQ.E9)GOTO 290 IF(SECT(IR,IC).EQ.K9)TARGET=KL IF(SECT(IR,IC).EQ.B9)TARGET=STBASE IF(SECT(IR,IC).EQ.R9)TARGET=RM IF(SECT(IR,IC).EQ.M9)TARGET=PTMINE IF(TARGET.NE.PTMINE)GOTO 300 DIS=DIST(A,B,IR,IC) IF(DIS.LE.2.)GOTO 25 320 TYPE 321,IR,IC 321 FORMAT(1X,'Mine in Sector',I3,',',I3,' is out of transporter range &') WRITE(3,321)IR,IC GOTO 30 27 IR=MR IC=MC DIS=DIST(A,B,IR,IC) 24 IPREQ=5.*DIS IF(POW.LT.IPREQ)GOTO 160 POW=POW-IPREQ 330 TYPE 331 331 FORMAT(1X,'TRANSPORTERS ENERGIZED'/) WRITE(3,331) CALL PAUSE(2) NTORP=NTORP+1 M2=M2-1 SECT(IR,IC)=D9 SECTOR(IR,IC)=DOT 240 TYPE 241,IPREQ,NTORP,M2 241 FORMAT(1X,'Mine has been brought aboard - power used:',I4,' units' &/1X,'Torpedoes now available:',I3,4X,'Mines left:',I3) WRITE(3,241)IPREQ,NTORP,M2 TMINBK=.FALSE. IF(NTORP.LT.30)GOTO 37 TYPE 401 401 FORMAT(/1X,'** NO MORE ROOM LEFT TO STORE MINES **') WRITE(3,401) GOTO 30 37 IF(NTORP.NE.21)GOTO 32 TYPE 391 391 FORMAT(/1X,'** ALL TORPEDO RACKS ARE FULL **'/1X, &'This and subsequent torpedoes will have to be stored'/1X, &'wherever room can be found.') WRITE(3,391) IF(M2.EQ.0)TMRTVR=.FALSE. 32 IF(COND.EQ.GRN)RETURN CALL HITS IF(TDEST .OR. TDISAB)RETURN DO 33 I=1,7 CALL ALMOVE(TMOVE,.FALSE.,I) 33 CONTINUE RETURN 300 TYPE 301,TARGET 301 FORMAT(/1X,'IT IS PHYSICALLY IMPOSSIBLE TO TRANSPORT A ',A8,$) WRITE(3,301)TARGET IF(TARGET.NE.KL .AND. TARGET.NE.RM)GOTO 380 370 TYPE 371 371 FORMAT(1H+,'VESSEL',$) WRITE(3,371) 380 TYPE 381 381 FORMAT(1H+,' ABOARD!!') WRITE(3,381) GOTO 30 310 TYPE 311,IR,IC 311 FORMAT(1X,'Nothing in Sector',I3,',',I3) WRITE(3,311)IR,IC GOTO 30 290 TYPE 291 291 FORMAT(1X,'Illegal Target Sector') WRITE(3,291) GOTO 30 30 TYPE 31 31 FORMAT(1X,'*** COMMAND CANCELLED ***') WRITE(3,31) TMRTVR=.FALSE. RETURN END