C C C *********************************** C * * C * NAVIGATION CONTROL SUBROUTINE * C * * C *********************************** C SUBROUTINE NAVIG 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/SBASE/NBAS,RBAS,CBAS,STBS(5,5),NBASRM,NKDESB,KLATK(5) 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 COMMON/RENEG/TRENEG,TSLAP,TSHOOT,TBAN COMMON/NAV/CORSD,WF INTEGER SECT,QUAD,R1,C1,R,C,H1,POW,SHLD,A,B,RBAS,CBAS,DLN,G,A2,B2 INTEGER D9,S9,E9,B9,R9,H,STBS,CMD REAL*8 KL,RM,GRN,RED,DCKD,COND,ALIEN,DEST,DISAB REAL*8 OBJ,OBJECT,ASTAR,STRBS LOGICAL TROM1,TROM2,TDISAB,TDAMC,TWON,TMOVE,TRESC,TDEST,TALTOW,TBO &FF,TALERT,TLOST,TLOOS,TBALEN,TALSD,TINTRD,TEST,TEST1,THYPSP,TFINAL LOGICAL TRENEG,TSLAP,TSHOOT,TBAN LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP EQUIVALENCE (ALIEN,OBJECT) DATA ASTAR,STRBS,OBJ/'a STAR','STARBASE','OBJECT'/ C RAD(ANG)=ANG*0.017453293 C 10 TYPE 11 11 FORMAT(/1X,'NAVIGATION CONTROL') WRITE(3,11) IF(STATUS(1).GE.0.)GOTO 14 TDAMC=.TRUE. CALL DAMCON(1,1,TDAMC) 300 TYPE 301 301 FORMAT(1X,'ACTUAL COURSE MAY DEVIATE 30 DEG. FROM SET COURSE'/) WRITE(3,301) 14 IF(CMD.EQ.8)GOTO 15 20 TYPE 21 21 FORMAT(1X,'COURSE & WARP FACTOR? ',$) 30 READ(5,31,ERR=20)CORSD,WF 31 FORMAT(2F10.0) 15 IF(WF.LE.8.)GOTO 1 40 TYPE 41 41 FORMAT(1X,'ENGINE LIMIT WARP 8') GOTO 20 1 IF(POW.GT.0 .AND. WF.GE.0.)GOTO 53 190 TYPE 191 191 FORMAT(1X,'*** COMMAND CANCELLED ***') WRITE(3,191) RETURN 53 TFINAL=.FALSE. CMD=1 TEST=.FALSE. TYPE 901,CORSD,WF 901 FORMAT(1X,'Helm acknowledges course set of',F7.1,' deg. at Warp F &actor',F6.2) IF(WF.LT.1.)GOTO 2 IF(STATUS(2).GE.0.)GOTO 28 TDAMC=.TRUE. CALL DAMCON(2,1,TDAMC) RETURN 28 IF(.NOT.TINTRD .OR. ITR(4).NE.1)GOTO 60 CALL DAMCON(2,97,.FALSE.) RETURN 60 TYPE 61 61 FORMAT(/1X,'ENGINE ROOM REPORT: Warp Drive on') WRITE(3,61) GOTO 3 2 IF(WF.EQ.0.)GOTO 340 IF(STATUS(3).GE.0.)GOTO 70 TDAMC=.TRUE. CALL DAMCON(3,1,TDAMC) RETURN 70 TYPE 71 71 FORMAT(/1X,'ENGINE ROOM REPORT: Impulse Engines on') WRITE(3,71) GOTO 3 340 TYPE 341 341 FORMAT(/1X,'ENGINE ROOM REPORT: Maneuvering Engines on') WRITE(3,341) 3 IF(TALTOW)CALL FDSHLD(NS1,TEST1,ICAPV(1),ICAPV(2),A,B) IF(ABS(CORSD).GT.360.)GOTO 20 IF(CORSD.LT.0.)CORSD=360.+CORSD DIFF=ABS(CORSD-BEARNG) POW=POW-MIN1(DIFF,360.-DIFF)/10 BEARNG=CORSD IF(POW.LE.0)GOTO 200 IF(POW.GE.WF*10.)GOTO 4 WF=POW GOTO 5 4 WF=WF*10. 5 A2=(R1-1)*10+A B2=(C1-1)*10+B G=0 IF(.NOT.TALTOW)GOTO 42 IA=A IB=B SECT(ICAPV(1),ICAPV(2))=D9 SECTOR(ICAPV(1),ICAPV(2))=DOT 63 CALL FDSHLD(NS,TEST,ICAPV(1),ICAPV(2),A,B) 64 IF(SHLD(NS).EQ.0)GOTO 42 N=1 IF(TEST)N=2 ISHLD=SHLD(NS)/N 57 SHLD(NS1)=ISHLD+SHLD(NS1) IF(.NOT.TEST)GOTO 56 NS2=NS1+1 IF(NS2.EQ.5)NS2=1 IF(NS2.NE.NS)NS1=NS2 TEST=.FALSE. GOTO 57 56 IF(ISHLD*N.NE.SHLD(NS))SHLD(NS1)=SHLD(NS1)+SHLD(NS)-ISHLD*N SHLD(NS)=0 42 IF(TFINAL)GOTO 49 Z2=0. WRITE(3,90001)BEARNG,0.1*WF 90001 FORMAT(1X,'Helm set at bearing of',F7.1,' deg. and Warp Factor', &F6.2) DEV=0. IF(STATUS(1).LT.0.)DEV=RAN(II,JJ)*30.*(-1)**INT(RAN(II,JJ)*10.) BEARNG=BEARNG+DEV IF(BEARNG.LT.0.)BEARNG=360.+BEARNG IF(BEARNG.GE.360.)BEARNG=BEARNG-360. CORS=RAD(BEARNG) NDIVR=-1 IWF=INT(WF) DO 23 IG3=0,IWF IGALR=Z2*-SIN(CORS)+0.5+FLOAT(A2)+0.0001 IGALC=Z2*COS(CORS)+0.5+FLOAT(B2)+0.0001 Z2=Z2+1. THYPSP=.FALSE. IF(STATUS(1).GE.0. .AND. IG3.GT.10.AND.IG3.LT.IWF-10)THYPSP=.TRUE. IF(.NOT.THYPSP .OR. IG3.NE.11)GOTO 43 140 TYPE 141 141 FORMAT(1X,'NAVIGATION COMPUTER REPORT:') WRITE(3,141) NDIVR=0 43 IQR=(IGALR-1)/10 +1 IQC=(IGALC-1)/10 +1 R=IGALR-10*(IQR-1) C=IGALC-10*(IQC-1) IF(IGALR.GT.80 .OR. IGALR.LE.0)GOTO 6 IF(IGALC.GT.80 .OR. IGALC.LE.0)GOTO 6 IF(IQR.NE.R1 .OR. IQC.NE.C1)IG2=2 R1=IQR C1=IQC GOTO 67 6 G=1 R=A C=B 67 IF(IG2.NE.2)GOTO 7 CALL QADSET IF(TDEST)RETURN IF(RAN(II,JJ).LT.0.95 .OR. IWF.LT.20)GOTO 19 180 TYPE 181,R1,C1 181 FORMAT(/1X,'*** SEVERE ION STORM ENCOUNTERED IN QUADRANT',I3,',',I &3) WRITE(3,181)R1,C1 IZ=0 IC=96 CALL DAMCON(IZ,IC,.FALSE.) IF(IZ.EQ.0)GOTO 310 IF(IZ.NE.2)GOTO 19 TYPE 51 51 FORMAT(1X,'SHIP HAS STOPPED DEAD IN SPACE') WRITE(3,51) THYPSP=.FALSE. GOTO 58 310 TYPE 311 311 FORMAT(1X,'NO DAMAGE SUSTAINED') WRITE(3,311) GOTO 19 7 IF(G.EQ.1)GOTO 150 GOTO(24,36,37,44,36,32,52),SECT(R,C)+1 36 IF(COND.EQ.DCKD)GOTO 37 IF(THYPSP)GOTO 35 80 TYPE 81 81 FORMAT(/1X,'*** NAVIGATIONAL ERROR - ',$) WRITE(3,81) GOTO 100 37 IF(G.EQ.0)GOTO 23 150 TYPE 151 151 FORMAT(/1X'*** ATTEMPT TO LEAVE ASSIGNED PATROL QUADRANTS ABORTED' &/1X,'BY ORDERS OF STAR FLEET COMMAND -',$) WRITE(3,151) GOTO 100 32 IF(THYPSP .OR. K(7,1).NE.R .OR. K(7,2).NE.C)GOTO 44 TROM2=.TRUE. SECTOR(K(7,1),K(7,2))=ROM NA=7 GOTO 46 44 IF(THYPSP)GOTO 35 DO 45 NA=1,6 IF(K(NA,1).EQ.R .AND. K(NA,2).EQ.C)GOTO 46 45 CONTINUE 46 IF(K(NA,4).EQ.1 .OR. K(NA,3).LT.100)GOTO 80 90 TYPE 91 91 FORMAT(/1X,'*** COURSE INTERCEPTED BY ALIEN VESSEL -',$) WRITE(3,91) 100 TYPE 101 101 FORMAT(1H+,' ENGINES SHUT DOWN'/) WRITE(3,101) IF(STATUS(1).GE.0.)GOTO 58 IZ=0 IC=96 CALL DAMCON(IZ,IC,.FALSE.) IF(IZ.EQ.0)GOTO 58 320 TYPE 321 321 FORMAT(1X,'Damage sustained due to inability of using'/1X,'navigat &ion computer to shut engines down.'/1X,'Manual shut down used inst &ead.'/) WRITE(3,321) 58 IF(G.EQ.1)GOTO 22 GOTO 25 35 OBJECT=OBJ IF(SECT(R,C).EQ.S9)OBJECT=ASTAR IF(SECT(R,C).EQ.K9)OBJECT=KL IF(SECT(R,C).EQ.R9)OBJECT=RM IF(SECT(R,C).EQ.B9)OBJECT=STRBS CALL CROP(OBJECT,8) 120 TYPE 121,OBJECT,R1,C1 121 FORMAT(1X,'Course diverted to avoid collision with ',A8,' in Quadr &ant',I2,',',I2) WRITE(3,121)OBJECT,R1,C1 NDIVR=NDIVR+1 24 IF(G.EQ.1)GOTO 150 IF(M1.EQ.0 .OR. NTORP.LE.0 .OR. TALTOW)GOTO 22 IF(SECT(A,B).EQ.B9)GOTO 22 SECT(A,B)=M9 SECTOR(A,B)=MINE M1=M1-1 M2=M2+1 NTORP=NTORP-1 GOTO 19 52 M2=M2-1 22 IF(THYPSP .AND. SECT(A,B).NE.E9)GOTO 65 IF(SECT(A,B).EQ.B9)GOTO 19 SECT(A,B)=D9 SECTOR(A,B)=DOT 19 IF(THYPSP .OR. SECT(R,C).EQ.B9)GOTO 65 SECT(R,C)=E9 SECTOR(R,C)=SHP 65 IF(A.EQ.R .AND. B.EQ.C)GOTO 26 IA=A IB=B A=R B=C IF(IG2.NE.2)GOTO 26 A2=(R1-1)*10+R B2=(C1-1)*10+C IG2=IG2+1 Z2=1. 26 IF(G.EQ.1)GOTO 25 23 CONTINUE 25 IF(SECT(A,B).EQ.B9)GOTO 66 IF(G.EQ.0 .OR. SECT(A,B).EQ.D9)GOTO 8 IF(SECT(A,B).EQ.S9)GOTO 13 DO 9 I=1,7 IF(K(I,1).EQ.A .AND. K(I,2).EQ.B)GOTO 12 9 CONTINUE GOTO 8 12 CALL PLACE(IR,IC) SECT(IR,IC)=K9 SECTOR(IR,IC)=KLIN K(I,1)=IR K(I,2)=IC GOTO 8 13 CALL PLACE(IR,IC) SECT(IR,IC)=S9 SECTOR(IR,IC)=STAR 8 SECT(A,B)=E9 SECTOR(A,B)=SHP 66 IF(NDIVR.NE.0)GOTO 59 210 TYPE 211 211 FORMAT(1X,'No course alterations to avoid collisions were needed & in hyperspace') WRITE(3,211) 59 IF(NDIVR.EQ.-1)NDIVR=0 POW=POW-(IG3+NDIVR*5)+1 DATE=DATE+FLOAT(IG3)/100.+NDIVR/10. IF(.NOT.TALTOW)GOTO 38 IF(IG2.NE.1 .OR. (R1-1)*10+A.NE.A2 .OR. (C1-1)*10+B.NE.B2) &GOTO 48 IA=ICAPV(1) IB=ICAPV(2) GOTO 49 48 ICAPV(1)=IA ICAPV(2)=IB IF(SHLD(5).EQ.0)GOTO 49 NS1=NS TFINAL=.TRUE. GOTO 63 49 IF(IABS(A-IA).GT.3 .OR. IABS(B-IB).GT.3)GOTO 38 IF(ICAPV(4).EQ.1)GOTO 39 SECT(IA,IB)=K9 SECTOR(IA,IB)=KLIN GOTO 38 39 SECT(IA,IB)=R9 SECTOR(IA,IB)=ROM 38 IF(POW.GT.0)GOTO 54 200 TYPE 201 201 FORMAT(/1X,'*** POWER RESERVES EXHAUSTED - ENGINES SHUT DOWN'/) WRITE(3,201) POW=0 54 IF(IG2.EQ.1)GOTO 110 CALL NEWQAD IG2=1 RETURN 110 TYPE 111,A,B,BEARNG 111 FORMAT(1X,'NEW POSITION:',I4,',',I3,5X,'BEARING:',F7.1,' DEG.'/) WRITE(3,111)A,B,BEARNG IF(N6.EQ.0 .OR. IABS(A-RBAS).GT.1 .OR. IABS(B-CBAS).GT.1)GOTO 29 IF(COND.EQ.DCKD)GOTO 29 IF(IWF.GE.10)GOTO 170 IF(TBAN)GOTO 330 IF(COND.EQ.GRN)GOTO 55 27 IF(RAN(II,JJ).GT.FLOAT(N3+1)*RANK/50.)GOTO 55 130 TYPE 131,N6 131 FORMAT(/1X,'Starbase',I2,' cannot lower shields at this time due t &o enemy attack.'/1X,'Docking not yet possible.'/) WRITE(3,131)N6 GOTO 29 170 TYPE 171 171 FORMAT(/1X,'Unable to dock with starbase using warp engines'/) WRITE(3,171) GOTO 29 55 TEST=.FALSE. TEST1=.FALSE. CALL DOCKED(TEST,TEST1) GOTO 34 29 IF(COND.NE.DCKD .OR. SECT(A,B).EQ.B9)GOTO 34 COND=GRN IF(TROM1 .OR. N3.GT.0)COND=RED 34 IF(COND.EQ.GRN)RETURN IF(IWF.GT.0)CALL HITS IF(TDISAB .OR. TDEST)RETURN DO 33 I=1,7 CALL ALMOVE(TMOVE,.FALSE.,I) 33 CONTINUE RETURN 330 TYPE 331,N6,SHIP 331 FORMAT(/1X,'** COMMUNICATION FROM STARBASE',I2,':'/5X,'You''ve got & to be kidding, ',16A1,'!'/5X,'There''s no way we will let you doc &k now.'/5X,'GO SUCK YOURSELF INTO A BLACK HOLE!'/) WRITE(3,331)N6,SHIP RETURN END C C C ****************************************** C * * C * SUBROUTINE FOR DOCKING WITH STARBASE * C * * C ****************************************** C SUBROUTINE DOCKED(TDELIV,TINTCP) 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/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,H1,POW,SHLD,A,B,RBAS,CBAS,STBS,DLN,CMD INTEGER D9,S9,E9,B9,R9,H REAL*8 KL,RM,GRN,RED,DCKD,COND,ALIEN,DEST,DISAB LOGICAL TROM1,TROM2,TDISAB,TDAMC,TWON,TMOVE,TRESC,TDEST,TALTOW,TBO &FF,TALERT,TLOST,TLOOS,TBALEN,TALSD,TINTRD,TDELIV,TINTCP LOGICAL*1 DOT,STAR,SHP,KLIN,BASE,ROM,MINE,SECTOR,SHIP,ANS C IF(TDELIV)GOTO 56 IF(TINTCP)GOTO 36 10 TYPE 11 11 FORMAT(/1X,'Do you wish to dock? ',$) READ(5,21,ERR=10)ANS 21 FORMAT(A1) CALL CAPMSK(ANS,1) IF(ANS.EQ.'Y')GOTO 3 IF(ANS.NE.'N')GOTO 10 IF(.NOT.TALTOW)RETURN 30 TYPE 31 31 FORMAT(1X,'Do you wish to deliver vessel in tow? ',$) READ(5,21,ERR=30)ANS CALL CAPMSK(ANS,1) IF(ANS.EQ.'N')RETURN IF(ANS.NE.'Y')GOTO 30 TDELIV=.TRUE. GOTO 56 3 IF(SHLD(5).EQ.0)GOTO 210 120 TYPE 121 121 FORMAT(/1X,'SHIELDS LOWERED FOR DOCKING') WRITE(3,121) 210 TYPE 211 211 FORMAT(/1X,'** DOCKING COMPLETED **') WRITE(3,211) 35 COND=DCKD SECT(A,B)=D9 SECTOR(A,B)=DOT A=RBAS B=CBAS IF(.NOT.TALTOW)GOTO 36 56 IA=ICAPV(1) IB=ICAPV(2) 57 ALIEN='Klingon' IF(ICAPV(4).EQ.1)ALIEN='Romulan' 160 TYPE 161,SHIP,ALIEN,N6 161 FORMAT(/1X'** COMMUNICATION FROM STAR FLEET COMMAND:'/5X,'Congratu &lations ',16A1,' on successful'/5X,'delivery of captured ',A8,'war &ship to'/5X,'Starbase',I2,'.') WRITE(3,161)SHIP,ALIEN,N6 SECT(IA,IB)=D9 SECTOR(IA,IB)=DOT NCAPAL=NCAPAL+1 IF(COND.EQ.DCKD .OR. NPRIS.EQ.0)GOTO 4 NPRTKN=NPRTKN+NPRIS NPRIS=0 ITR(3)=(ITR(3)/10)*10 TYPE 51 51 FORMAT(/1X,'** REPORT FROM SECURITY:'/1X, &'The prisoner transfer to Starbase has been completed.') WRITE(3,51) 4 IF(ICAPV(5).EQ.2)TALSD=.FALSE. IF(ICAPV(5).EQ.1)GOTO 43 N4=N4-1 IF(ALIEN.EQ.'Romulan')NROMD=NROMD+1 IF(N4.LE.0)TWON=.TRUE. IF(STBS(N6,4).NE.1 .OR. N3.GE.1 .OR. TROM1)GOTO 43 STBS(N6,4)=0 TRESC=.TRUE. IF(TWON)RETURN 43 TALTOW=.FALSE. DO 47 I=1,5 ICAPV(I)=0 47 CONTINUE IF(TDELIV)RETURN 36 IF(.NOT.TINTRD)GOTO 59 330 TYPE 331 331 FORMAT(/1X,'** REPORT FROM SECURITY:'/1X,'The intruder ',$) WRITE(3,331) GOTO(340,350,360),INT(RAN(II,JJ)*3.+1.) 340 TYPE 341,MOD(ITR(2),100) 341 FORMAT(1H+,'has been captured on Deck',I3,'.') WRITE(3,341)MOD(ITR(2),100) NPRIS=NPRIS+1 GOTO 5 350 TYPE 351 351 FORMAT(1H+,'killed himself rather than be captured.') WRITE(3,351) GOTO 5 360 TYPE 361,MOD(ITR(2),100) 361 FORMAT(1H+,'was killed on Deck',I3,' while resisting capture.') WRITE(3,361)MOD(ITR(2),100) 5 IF(COND.EQ.DCKD)GOTO 370 ICASL=RAN(II,JJ)*RANK IF(ICASL.EQ.1)ICASL=0 IF(ICASL+NCAS(1).GT.430)ICASL=430-NCAS(1) NCAS(1)=NCAS(1)+ICASL TYPE 41,ICASL 41 FORMAT(1X,'Security personnel suffered',I3,' casualties.') WRITE(3,41)ICASL 370 TYPE 371 371 FORMAT(1X,'It has been confirmed that he was ',$) WRITE(3,371) IF(ITR(3).GE.10)GOTO 2 ALIEN='Klingon' IF(ITR(3).EQ.2)ALIEN='Romulan' 380 TYPE 381,ALIEN 381 FORMAT(1H+,'the escaped ',A8,'prisoner.') WRITE(3,381)ALIEN ITR(3)=(ITR(3)/10)*10 GOTO 400 2 ALIEN='Klingon' IF(ITR(3).GE.20)ALIEN='Romulan' ITR(3)=MOD(ITR(3),10) 390 TYPE 391,ALIEN 391 FORMAT(1H+,'a ',A7,' agent.') WRITE(3,391)ALIEN 400 TYPE 401 401 FORMAT(1X,'** SECURITY ALERT GQ-4 CANCELLED **') WRITE(3,401) DO 62 I=1,4 IF(I.NE.3 .OR. COND.EQ.DCKD .OR. NPRIS.EQ.0)ITR(I)=0 62 CONTINUE IF(COND.EQ.DCKD)ITR(3)=0 TINTRD=.FALSE. IF(TINTCP)RETURN 59 DATE=DATE+2.*RAN(II,JJ) 140 TYPE 141,DATE 141 FORMAT(/1X,'STARDATE:',F8.1/1X,'All systems are operational and re &supply is completed.') WRITE(3,141)DATE POW=5000 NTORP=20 M1=0 GASP=0. TALERT=.TRUE. DO 28 I=1,13 IF(I.LE.4)ITR(I)=0 IF(I.LE.5)SHLD(I)=0 STATUS(I)=0. 28 CONTINUE NPRTKN=NPRTKN+NPRIS NPRIS=0 NTREPL=0 DO 1 I=1,2 NREP=NCAS(I) IF(NREP.GT.STBS(N6,5))NREP=STBS(N6,5) NCAS(I)=NCAS(I)-NREP STBS(N6,5)=STBS(N6,5)-NREP NTREPL=NTREPL+NREP 1 CONTINUE IF(NTREPL.EQ.0)GOTO 230 220 TYPE 221,NTREPL 221 FORMAT(1X,I3,' crew replacements are aboard',$) WRITE(3,221)NTREPL GOTO 240 230 TYPE 231 231 FORMAT(1X,'No crew replacements obtained',$) WRITE(3,231) 240 TYPE 241,500-NCAS(1)-NCAS(2),70-NCAS(2),N6 241 FORMAT(1H+,' - current crew strength is',I4,'.'/1X,'(',I3,' space &marines). Starbase',I2,' has ',$) WRITE(3,241)500-NCAS(1)-NCAS(2),70-NCAS(2),N6 IF(STBS(N6,5).EQ.0)GOTO 280 270 TYPE 271,STBS(N6,5) 271 FORMAT(1H+,I4,$) WRITE(3,271)STBS(N6,5) GOTO 290 280 TYPE 281 281 FORMAT(1H+,'NO',$) WRITE(3,281) 290 TYPE 291 291 FORMAT(1H+,' crew replacements left.') WRITE(3,291) 250 TYPE 251,N6 251 FORMAT(/1X,'All sections reported in - READY TO LEAVE STARBASE',I2,'.' &/) WRITE(3,251)N6 RETURN END