C C C *********************************************** C * * C * SUBROUTINE TO ISSUE ORDERS FOR MISSION * C * * C *********************************************** C SUBROUTINE ORDERS(TEST,SDLN,TLOG) 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,STDT,IDLN,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/WRDS/COND,KL,RM,GRN,RED,DCKD,DEST(2),DISAB(2),SHIP(16) COMMON/ALPHA/ALPH(30) COMMON/NEWDAT/REGION,RONUM COMMON/PERS/NAME1(16),NPL,NG,AVGTOT,PSWRD,IRNK,NSHP,IUIC(4) DIMENSION RMNM(4),DATEM(3) INTEGER SECT,QUAD,R1,C1,R,C,SHLD,H1,A,B,POW,RBAS,CBAS,H,STBS,CMD REAL*8 COND,KL,RM,GRN,RED,DCKD,DEST,DISAB,REGN8,REGNS(8),PSWRD LOGICAL TEST,TLOG LOGICAL*1 EE,ENDS,ENDB,DUMMY(4),ALPH,ZERO,REGION(8),SHIP,IMAGE(72) LOGICAL*1 NAME1,PRANK(13),DUM3(3) EQUIVALENCE (DUMMY(1),DUM3(1)) DATA ENDS,ENDB/1Hs,1H /,RIS,ARE/4His ,4Hare /,ZERO/'0'/ DATA AFILE,CFILE/'AUTO','LOG.',"0,"0,'CAPT','LOG.',"0,"0/ DATA REGNS,RMNM/'ANTARES','SIRIUS','RIGEL','DENEB','PROCYON','ALT &AIR','MENGEN','SALAYNA','I','II','III','IV'/ C IF(TEST)GOTO 39 5 SDATE=INT(RAN(II,JJ)*100.)*100. IF(SDATE.LT.1000.)GOTO 5 C CALL SPLFNC("16) ! N245 VERSION ONLY 100 TYPE 101,SDATE 101 FORMAT(1H1,13X,'****** UNITED FEDERATION OF PLANETS ******'/ 1X,'O &RDERS FROM STAR FLEET COMMAND:'//1X,'It is Stardate',F7.1,' - Fle &ets of Klingon and Romulan warships'/1X,'are invading the Federati &on from several different directions.'/1X,'Their apparent goal is &Star Fleet Headquarters. Defensive zones'/1X'have been established &, each under the command of a Starship'/1X,'Cruiser. It is the du &ty of each zone to deplete the enemy fleets'/1X,'sufficiently so t &hat the United Federation Fleet will be able to'/1X,'defeat them b &efore they reach their goal.') 39 XX=N5 SDLN=(1.6-RANK*0.02)*XX**0.9339 IF(N5.LT.10)SDLN=XX*ALOG10(XX)+1 EE=ENDB IF(N5.GT.1)EE=ENDS 6 IRX=RAN(II,JJ)*10.+1. IF(IRX.GT.8)GOTO 6 REGN8=REGNS(IRX) CALL A8TOA1(REGN8,REGION) CALL CROP(REGION,8) 14 IRY=RAN(II,JJ)*10.+1. IF(IRY.GT.4)GOTO 14 RONUM=RMNM(IRY) CALL CROP(RONUM,4) 20 TYPE 21,SHIP,REGION,RONUM,INT(SDLN),EE,N5,EE 21 FORMAT(/1X'You will command the United Starship Cruiser ',16A1/1X, &'which is assigned to defend the 64 Galactic Quadrants'/1X'of the &',8A1,1X,A4,' Region.'//1X,'You have',I4,' Stardate',A1,' to &destroy or capture at least'/1X,I3,' alien vessel',A1,'. ',$) IDLN=SDATE+SDLN STDT=SDATE CALL SETRNK(IRNK,PRANK,0) EE="0 VRB=RIS CALL CROP(VRB,4) IF(NBAS.EQ.1)GOTO 30 EE=ENDS VRB=ARE 30 TYPE 31,VRB,NBAS,EE,PRANK 31 FORMAT(1H+,'There ',A3,I2,' starbase',A1,' for resupply'/1X,'locat &ed in your region.'// 1X,'Bon Voyage and Good Luck, ',13A1,'!'// &1X,'When you are ready to start, hit ') 110 READ(5,111,ERR=110)X 111 FORMAT(A4) C IF(.NOT.TEST)TYPE 201 C 201 FORMAT(/1X,'PLEASE STANDBY -- the working files are being initiate C &d') C CALL SPLFNC("16) ! N245 VERSION ONLY IF(TEST)CALL CLOSE(3) IF(TEST)GOTO 3 CALL FDBSET(1,'UNKNOWN') CALL ASSIGN(1,'[200,200]STARFLEET.NUM') REWIND 1 50 READ(1,51)DUM3 51 FORMAT(3A1) DECODE(3,61,DUM3)NUM 61 FORMAT(I3) NUM=NUM+1 IF(NUM.GT.999)NUM=0 ENCODE(3,61,DUM3)NUM DO 1 I=1,3 IF(DUMMY(I).EQ.ENDB)DUMMY(I)=ZERO 1 CONTINUE DUMMY(4)="0 DECODE(4,41,DUMMY)AFILE(3) IF(TLOG)DECODE(4,41,DUMMY)CFILE(3) 41 FORMAT(A4) REWIND 1 WRITE(1,81)DUMMY 81 FORMAT(4A1) CALL CLOSE(1) 3 OPEN(UNIT=3,NAME=AFILE,TYPE='UNKNOWN') REWIND 3 1000 WRITE(3,1001)SHIP,PRANK,NAME1,RANK,SDATE 1001 FORMAT(13X,'****** UNITED FEDERATION OF PLANETS ******'/20X,'AUTO- &ENTRIES - SHIP''S LOG'//1X,'STARSHIP',T15,':',2X,16A1/1X, &'IN COMMAND',T15,':',2X,13A1,1X,16A1/1X,'MISSION RANK',T15,':', &F6.0/1X,'STARDATE',T15,':',F8.1//1X,72(1H-)/) CALL CLOSE(3) OPEN(UNIT=3,NAME=AFILE,TYPE='OLD',ACCESS='APPEND') TYPE 201,AFILE(3) 201 FORMAT(/1X,'YOUR MISSION SEQUENCE NUMBER IS ',A4) CALL PAUSE(5) IF(TEST .OR. RANK.LT.FLOAT(IRNK))RETURN CALL STRDAT(DATEM) CALL RUNMCR('[200,200]OUTMIS.DAT',18,'U') OPEN(UNIT=1,NAME='[200,200]OUTMIS.DAT',TYPE='OLD', &ACCESS='APPEND',FORM='UNFORMATTED',ERR=999) WRITE(1)NPL,AFILE(3),DATEM,0 CALL CLOSE(1) 999 RETURN END