Path: uunet!elroy.jpl.nasa.gov!decwrl!concert!lester.appstate.edu!pembvax1.pembroke.edu!rennie
From: rennie@pembvax1.pembroke.edu
Newsgroups: vmsnet.sources.games
Subject: Star Trek - Part [10/18]
Date: 7 Apr 93 10:56:24 EDT
Organization: Pembroke State University
Lines: 436
Message-ID: <1993Apr7.105624.1@pembvax1.pembroke.edu>
NNTP-Posting-Host: papa.pembroke.edu
Xref: uunet vmsnet.sources.games:652

-+-+-+-+-+-+-+-+ START OF PART 10 -+-+-+-+-+-+-+-+
X      IF(ENERGY .LE. 30.0) GO TO 5
X      CALL GETCD
X      IF(DIREC .LT. 0) RETURN`20
XC--------MAKE SURE STARSHIP HAS SUFFICIENT ENERGY FOR TRIP
X      POWER=20.0+100.0*DIST`20
X      IF(POWER .LT. ENERGY) GO TO 20
X 5    CALL SKIP(1)
X      CALL PROUT(`20
X     +   51HFIRST OFFICER SPOCK:  "CAPTAIN, THE IMPULSE ENGINES,51)
X      CALL PROUT(`20
X     +   51HREQUIRE 20.0 UNITS TO ENGAGE, PLUS 100.0 UNITS PER  ,51)`20
X      IF(ENERGY .GT. 30.0) GO TO 10`20
X      CALL PROUT(`20
X     +   41HQUADRANT.  THEY ARE, THEREFORE, USELESS.",41)
X      RETURN
X 10   CALL CRAM(46HQUADRANT.  WE CAN GO, THEREFORE, A MAXIMUM OF )
X      CALL CRAMF(0.01*(ENERGY-20.0)-0.05,0,1)`20
X      CALL CREND
X      CALL PROUT(11HQUADRANTS.",11)
X      RETURN
XC--------MAKE SURE ENOUGH TIME IS LEFT FOR THE TRIP`20
X 20   TIME=DIST/0.095`20
X      IF(TIME .LT. REMTIME) GO TO 30
X      CALL PROUT(`20
X     +   55HFIRST OFFICER SPOCK:  "CAPTAIN, OUR SPEED UNDER IMPULSE,55)
X      CALL PROUT(`20
X     +   54HPOWER IS ONLY 0.95 SECTORS PER STARDATE.  ARE YOU SURE,54)`20
X      CALL PROUT(24HWE DARE SPEND THE TIME?",24)`20
X      IF(JA(DUMMY)) GO TO 30
X      RETURN
XC--------ACTIVATE IMPULSE ENGINES AND PAY THE COST
X 30   CALL MOVE`20
X      IDIDIT=1
X      IF(ALLDONE.NE.0) RETURN`20
X      POWER=20.0+100.0*DIST`20
X      ENERGY=ENERGY-POWER`20
X      TIME=DIST/0.095`20
X      IF(ENERGY .GT. 0) RETURN
X      CALL FINISH(4)
X      RETURN
X 40   CALL SKIP(1)
X      CALL PROUT(24HIMPULSE ENGINES DAMAGED.,24)`20
X      RETURN
X      END`20
$ CALL UNPACK TRIMPULSE.FOR;1 1145252184
$ create 'f'
X      SUBROUTINE IRAN8(II,JJ)`20
X      II=RANF(0)*8.+1.
X      JJ=RANF(0)*8.+1.
X      RETURN
XC*`20
X      ENTRY IRAN10
XC*`20
X      II=RANF(0)*10.+1.`20
X      JJ=RANF(0)*10.+1.`20
X      RETURN     `20
X      END`20
$ CALL UNPACK TRIRAN8.FOR;1 1769629508
$ create 'f'
X`09FUNCTION JA(DUMMY)
X`09BYTE BITEM
X`09REAL*8 AITEM
X`09COMMON/SCANBF/KEY,AITEM
X`09EQUIVALENCE (AITEM,BITEM)
X10`09CALL SCAN
X`09JA=0
X`09IF(BITEM .EQ. 1HN) RETURN
X`09JA=-1
X`09IF(BITEM .EQ. 1HY) RETURN
X`09CALL PROMPT(29HPLEASE ANSWER WITH YES OR NO:,29)
X`09GO TO 10
X`09END
$ CALL UNPACK TRJA.FOR;1 897077176
$ create 'f'
X      SUBROUTINE LRSCAN`20
X`09INCLUDE 'TREKCOM/NOLIST'
X      IF(DAMAGE(2) .NE. 0 .AND. CONDIT .NE. IHDOCKD) GOTO 40
X      CALL SKIP(1)
X      CALL CRAM(14HL. R. SCAN FOR)
X      CALL CRAMLOC(1,QUADX,QUADY)`20
X      CALL CREND
X      I=QUADX-1`20
X      II=QUADX+1
X      J=QUADY-1`20
X      JJ=QUADY+1
X      DO 30 L=I,II
X      DO 20 LL=J,JJ`20
X      IVAL=-1`20
X      IF(L .EQ. 0 .OR. L .GT. 8) GO TO 10`20
X      IF(LL .EQ. 0 .OR. LL .GT. 8) GO TO 10`20
X      IVAL=GALAXY(L,LL)`20
X      STARCH(L,LL)=1
X 10   CALL CRAMI(IVAL,5)
X 20   CONTINUE
X      CALL CREND
X 30   CONTINUE
X      RETURN
X 40   CALL PROUT(22HL. R. SENSORS DAMAGED.,22)`20
X      RETURN
X      END`20
$ CALL UNPACK TRLRSCAN.FOR;1 375549319
$ create 'f'
X      SUBROUTINE MOVE`20
X`09INCLUDE 'TREKCOM/NOLIST'
X`09LOGICAL*1 IQUAD,ISHIP
X      INTEGER TRBEAM
X      EQUIVALENCE (CRACKS(6),KDIDIT),(SHIP,ISHIP)
X      IF(INORBIT .EQ. 0) GO TO 1
X      CALL PROUT(32HSULU:  "LEAVING STANDARD ORBIT.",32)`20
X      INORBIT=0`20
X 1    ANGLE=((15.0-DIREC)*0.5235988)
X      DELTAX=-SIN(ANGLE)
X      DELTAY=COS(ANGLE)`20
X      BIGGER=AMAX1(ABS(DELTAX),ABS(DELTAY))`20
X      DELTAX=DELTAX/BIGGER
X      DELTAY=DELTAY/BIGGER
X      TRBEAM=0
XC--------IF TRACTOR BEAM IS TO OCCUR, DO NOT MOVE FULL DISTANCE`20
X      IF(DATE+TIME .LT. FUTURE(2)) GO TO 5
X      TRBEAM=1
X      CONDIT=IHRED
X      DIST=DIST*(FUTURE(2)-DATE)/TIME+0.1`20
X      TIME=FUTURE(2)-DATE + 1E-5
XC--------MOVE WITHIN QUADRANT`20
X 5    QUAD(SECTX,SECTY)=IHDOT`20
X      X=SECTX`20
X      Y=SECTY`20
X      N=10.0*DIST*BIGGER+0.5
X      IF(N .EQ. 0) GO TO 100
X      DO 10 L=1,N`20
X      X=X+DELTAX
X      IX=X+0.5
X      Y=Y+DELTAY
X      IY=Y+0.5
X      IF(IX .LT. 1 .OR. IX .GT. 10) GO TO 40
X      IF(IY .LT. 1 .OR. IY .GT. 10) GO TO 40
X      IQUAD=QUAD(IX,IY)`20
X      IF(IQUAD .NE. IHDOT) GO TO 20`20
X 10   CONTINUE
X      DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2))`20
X      SECTX=IX
X      SECTY=IY
X      GO TO 100`20
XC--------OBJECT ENCOUNTERED ALONG FLIGHT PATH`20
X 20   STOPEGY=50.0*DIST/TIME
X      DIST=0.1*SQRT(FLOAT((SECTX-IX)**2 + (SECTY-IY)**2))`20
X      IF(IQUAD.EQ.IHK .OR. IQUAD.EQ.IHC .OR. IQUAD.EQ.IHS .OR.
X     +  IQUAD.EQ.IHR)  GO TO 30`20
X      IF(IQUAD.EQ.IHT) GO TO 30      `20
X      IF(IQUAD .EQ. '@') GO TO 25`20
XC--------OBJECT IS NOT AN ENEMY VESSEL, OR BLACK HOLE.
X      CALL SKIP(1)
X      CALL CRAMSHP
X      IF(IQUAD.NE.IHNUM) CALL CRAM(21H BLOCKED BY OBJECT AT)
X      IF(IQUAD.EQ.IHNUM) CALL CRAM(26H ENCOUNTERS THOLIAN WEB AT  )`20
X      CALL CRAMLOC(2,IX,IY)`20
X      CALL CRAMDMP(1H;)`20
X      CALL CRAM(24HEMERGENCY STOP REQUIRED )
X      CALL CRAMF(STOPEGY,0,2)`20
X      CALL CRAMDMP(17H UNITS OF ENERGY.)
X      ENERGY=ENERGY-STOPEGY`20
X      SECTX=X-DELTAX+0.5
X      SECTY=Y-DELTAY+0.5
X      IF(ENERGY .GT. 0) GO TO 100`20
X      CALL FINISH(4)
X      RETURN
XC--------OBJECT IS A BLACK HOLE.  SWALLOW SHIP.`20
X 25   CALL REDALRT
X      CALL SKIP(1)
X      CALL CRAM3AS
X      CALL CRAMSHP
X      CALL CRAM(26H PULLED INTO BLACK HOLE AT)
X      CALL CRAMLOC(2,IX,IY)`20
X      CALL CREND
X      IF(RANF(0).GT.0.50) GO TO 27   `20
X      CALL IRAN8(QUADX,QUADY)`20
X      CALL IRAN10(SECTX,SECTY)
X      CALL PROUT(`20
X     $55HSPOCK: "CAPTAIN, INSTRUMENTS INDICATE WE HAVE UNDERGONE   ,55)
X      CALL CRAM(15H        A SPACE     )
X      XTIMEW=RANF(0)
X      IF(XTIMEW.GT.0.65) CALL CRAM(5H-TIME )   `20
X      CALL CRAMDMP(14H PHASE SHIFT."  )`20
X      IF(XTIMEW.GT.0.65) CALL TIMEWRP`20
X      IF(XTIMEW.GT.0.65) KSTUF(4)=1  `20
X      GO TO 95   `20
X27    CALL FINISH(21)      `20
X      RETURN     `20
XC--------OBJECT IS AN ENEMY VESSEL; RAM HIM.
X 30   SECTX=IX
X      SECTY=IY
X      CALL RAM(0,IQUAD,SECTX,SECTY)`20
X      GO TO 100`20
XC--------COMPUTE FINAL POSITION--NEW QUADRANT, NEW SECTOR`20
X 40   X=10*(QUADX-1)+SECTX
X      Y=10*(QUADY-1)+SECTY
X      IX=X+10.0*DIST*BIGGER*DELTAX+0.5
X      IY=Y+10.0*DIST*BIGGER*DELTAY+0.5
XC--------CHECK FOR EDGE OF GALAXY`20
X      KINKS=0`20
X 45   KINK=0
X      IF(IX .GT. 0) GO TO 50
X      IX=-IX+1
X      KINK=1
X 50   IF(IY .GT. 0) GO TO 55
X      IY=-IY+1
X      KINK=1
X 55   IF(IX .LE. 80) GO TO 60`20
X      IX=161-IX`20
X      KINK=1
X 60   IF(IY .LE. 80) GO TO 65`20
X      IY=161-IY`20
X      KINK=1
X 65   IF(KINK .EQ. 0) GO TO 70
X      KINKS=1`20
X      GO TO 45
X 70   IF(KINKS .EQ. 0) GO TO 90`20
X      NKINKS=NKINKS+1`20
X      IF(NKINKS .EQ. 3) GO TO 80
XC--------ISSUE REPRIMAND FOR HITTING EDGE OF GALAXY`20
X      CALL SKIP(1)
X      CALL PROUT(`20
X     +   55HYOU HAVE ATTEMPTED TO CROSS THE NEGATIVE ENERGY BARRIER,55)
X      CALL PROUT(`20
X     +   56HAT THE EDGE OF THE GALAXY.  THE THIRD TIME YOU TRY THIS,,56)`20
X      CALL PROUT(22HYOU WILL BE DESTROYED.,22)`20
X      GO TO 90
XC--------ONE, TWO, THREE STRIKES, YOU'RE OUT   `20
X 80   CALL FINISH(6)
X      RETURN
XC--------COMPUTE FINAL POSITION OF STARSHIP IN NEW QUADRANT`20
X90`09CONTINUE
X      QUADX=(IX+9)/10`20
X      QUADY=(IY+9)/10`20
X      SECTX=IX-10*(QUADX-1)`20
X      SECTY=IY-10*(QUADY-1)`20
X`09IF(TRBEAM.NE.0) RETURN
X95    CALL SKIP(1)
X      CALL CRAM(8HENTERING)`20
X      CALL CRAMLOC(1,QUADX,QUADY)`20
X      CALL CREND
X      QUAD(SECTX,SECTY)=ISHIP
X      CALL NEWQUAD
X      RETURN
XC--------NO QUADRANT CHANGE; COMPUTE NEW ENEMY DISTANCES
X 100  QUAD(SECTX,SECTY)=ISHIP
X      CALL RESETD`20
X      IF(KDIDIT .EQ. 0) CALL SORTKL`20
X      RETURN
X      END`20
$ CALL UNPACK TRMOVE.FOR;1 122498841
$ create 'f'
X      SUBROUTINE MOVECOM
XC
XC`0920-APR-79
XC`09MOVE RESETTING OF IRUN INTO THE LOOP.  THIS KEEPS A ROMULAN
XC`09ACCOMPANYING THE SUPER-COMMANDER FROM ESCAPING, A SITUATION
XC`09THAT RESULTS IN LOSING BASES, MESSING UP THE KLINGON
XC`09BOOKKEEPING, ETC.
XC
X`09INCLUDE 'TREKCOM/NOLIST'
X`09LOGICAL*1 ISHIP,IENM,IQUAD
X      INTEGER COMX,COMY,SUPX,SUPY`20
X`09EQUIVALENCE (CRACKS(5),LOCCOM),(SHIP,ISHIP)
X      DATA KRAWLX,KRAWLY/1,1/`20
X      IF((NENHERE.EQ.0).OR.(JUSTIN.EQ.1)) RETURN
X      NBADDYS=COMHERE+ISHERE
XC--------THIS CONTINUE STATEMENT IS FOR MNF    `20
X      CONTINUE   `20
X      IF(KSTUF(5).NE.0) NBADDYS=((COMHERE*2)+(ISHERE*2)+ `20
X     $  (FLOAT(KLHERE)*1.23) + (FLOAT(IRHERE)*1.5)) / 2.0`20
XC-------LOOP FOR MOVING ENEMIES BEGINS HERE.   `20
X`09I=1
X1`09IRUN=0
X`09IX=KX(I)
X`09IY=KY(I)
X`09IENM=QUAD(IX,IY)
X`09COMX=IX
X`09COMY=IY
X`09LOCCOM=I
X      IF((KSTUF(5).EQ.0).AND.((IENM.NE.IHS).OR.(IENM.NE.IHC))) GO TO 500
X      IF(IENM.NE.IHS) GO TO 3`20
XC--------CHECK WITH SPY TO SEE IF S.C. SHOULD HI-TAIL IT.`20
X      IF((KPOWER(LOCCOM).GT.500.) .AND. ((CONDIT.NE.IHDOCKD)
X     +  .OR. (DAMAGE(4).NE.0.)))  GO TO 3`20
X`09IRUN=1
X`09MOTION=-10
X      GO TO 8`20
XC--------DECIDE WHETHER TO ADVANCE, RETREAT, OR HOLD POSITION`20
XC        AND BY HOW MUCH
X3`09MOTION=0
X`09DIST1=KDIST(LOCCOM)
X`09MDIST=DIST1+0.5
X      FORCES=KPOWER(LOCCOM)+100.0*NENHERE +400.*(NBADDYS-1)`20
X      IF(SHLDUP .EQ. 0) FORCES=FORCES+1000.`20
X      IF((DAMAGE(3) .EQ. 0) .OR. (DAMAGE(4) .EQ. 0)) GO TO 4
X      FORCES=FORCES+1000.`20
X`09GO TO 7
X4`09EFAC=1.
X`09TFAC=1.
X      IF(DAMAGE(3) .EQ. 0) GO TO 5
X`09EFAC=0.
X`09FORCES=FORCES+300.
X 5    IF(DAMAGE(4) .EQ. 0) GO TO 6
X`09TFAC=0.
X`09FORCES=FORCES+300.
X 6    FORCES=FORCES-50.*TORPS*TFAC+0.2*(2500.-ENERGY)*EFAC
X     C   +0.6*(1250.-SHLD)*SHLDUP`20
X 7    IF(FORCES .GT. 1000.0) MOTION=(1.-RANF(0)**2)*DIST1+1.0`20
X      IF(CONDIT .EQ. IHDOCKD ) MOTION=MOTION-SKILL*(2.-RANF(0)**2)
X      IF(MOTION .EQ. 0) MOTION=((FORCES+200.0*RANF(0))/150.0)-5.0`20
X      IF(MOTION .EQ. 0) GO TO 500`20
X      IF(IABS(MOTION) .GT. SKILL) MOTION=ISIGN(SKILL,MOTION)
XC--------CALCULATE PREFERRED NUMBER OF STEPS TO MOVE COMMANDER
X 8    NSTEPS=IABS(MOTION)`20
X      IF((MOTION .GT. 0) .AND. (NSTEPS .GT. MDIST)) NSTEPS=MDIST
X      NSTEPS=MIN0(10,NSTEPS)
X      NSTEPS=MAX0(1,NSTEPS)`20
XC--------COMPUTE PREFERRED VALUES OF DELTA X AND DELTA Y
X      MX=SECTX-COMX`20
X      MY=SECTY-COMY`20
X      IF(2*IABS(MX) .LT. IABS(MY)) MX=0`20
X      IF(2*IABS(MY) .LT. IABS(MX)) MY=0`20
X      IF(MX .NE. 0) MX=ISIGN(1,MX*MOTION)`20
X      IF(MY .NE. 0) MY=ISIGN(1,MY*MOTION)`20
XC--------MAIN LOOP TO ATTEMPT TO MOVE COMMANDER <NSTEPS> STEPS
X      NEXTX=COMX
X      NEXTY=COMY
X      QUAD(COMX,COMY)=IHDOT`20
X      DO 60 LL=1,NSTEPS`20
XC--------TEST IF PREFERRED POSITION IS AVAILABLE
X      LOOKX=NEXTX+MX
X      LOOKY=NEXTY+MY
X1111  CONTINUE   `20
X2222  CONTINUE   `20
X      ASSIGN 10 TO NOEXIT`20
X      IF(LOOKX.LE.0 .OR. LOOKX.GT.10) IF(MOTION)70,30,30
X      IF(LOOKY.LE.0 .OR. LOOKY.GT.10) IF(MOTION)70,10,10
X      IQUAD=QUAD(LOOKX,LOOKY)`20
XC--------DECIDE IF COMMANDER SHOULD RAM`20
X      IF(IQUAD .NE. ISHIP) GO TO 9010
XC--------ONLY LET COMMANDERS RAM THE SHIP.     `20
X      IF((IENM.NE.IHC).AND.(IENM.NE.IHS)) GO TO 9010
XC--------WHAMO!  `20
X      CALL RAM(1,IENM,COMX,COMY)
X`09GO TO 500
X 9010 IF(IQUAD .EQ. IHDOT) GO TO 50
X`09GO TO 10
XC--------TRY TO FUDGE ON Y COORDINATE`20
X 10   IF(MY.EQ.KRAWLY .OR. MX.EQ.0) GO TO 30
X      LOOKY=NEXTY+KRAWLY
X      ASSIGN 20 TO NOEXIT`20
X      IF(LOOKY.LE.0 .OR. LOOKY.GT.10) IF(MOTION)70,20,20
X      IF(LOOKX .LE. 0 .OR. LOOKX .GT. 10) IF(MOTION)70,20,20
X      IF(QUAD(LOOKX,LOOKY) .EQ. IHDOT) GO TO 50`20
X 20   KRAWLY=-KRAWLY
XC--------TRY TO FUDGE X COORDINATE
X 30   IF(MX.EQ.KRAWLX .OR. MY.EQ.0) GO TO 60
X      LOOKX=NEXTX+KRAWLX
X      ASSIGN 40 TO NOEXIT`20
X      IF(LOOKX.LE.0 .OR. LOOKX.GT.10) IF(MOTION)70,40,40
X      IF(LOOKY .LE. 0 .OR. LOOKY .GT. 10) IF(MOTION) 70,40,40`20
X      IF(QUAD(LOOKX,LOOKY) .EQ. IHDOT) GO TO 50`20
X 40   KRAWLX=-KRAWLX
X      GO TO 60
X 50   NEXTX=LOOKX`20
X      NEXTY=LOOKY`20
X 60   CONTINUE
XC--------PUT COMMANDER IN NEW PLACE WITHIN SAME QUADRANT
X      QUAD(NEXTX,NEXTY)=IENM
X      IF(NEXTX.EQ.COMX .AND. NEXTY.EQ.COMY) GO TO 500`20
X      KX(LOCCOM)=NEXTX
X      KY(LOCCOM)=NEXTY
X      KDIST(LOCCOM)=
X     +   SQRT(FLOAT((SECTX-NEXTX)**2 + (SECTY-NEXTY)**2))`20
X`09MOTION=-1
X`09IF(KDIST(LOCCOM) .LT. DIST1) MOTION=1
X`09CALL CRAM3AS
X`09CALL CRAMEN(IENM)
X      IF(MOTION .GT. 0) CALL CRAM(12H ADVANCES TO)
X      IF(MOTION .LT. 0) CALL CRAM(12H RETREATS TO)
X      CALL CRAMLOC(2,NEXTX,NEXTY)`20
X      CALL CREND
X      GO TO 500`20
XC--------TRY TO MOVE INTO ADJACENT QUADRANT, AVOIDING NEGATIVE ENERGY`20
XC        BARRIER, SUPERNOVAE, AND QUADRANTS WITH MORE THAN 8 KLINGONS.
X 70   IQX=QUADX+(LOOKX+9)/10-1
X      IQY=QUADY+(LOOKY+9)/10-1
X      IF(IQX.LT.1 .OR. IQX.GT.8) GO TO NOEXIT`20
X      IF(IQY.LT.1 .OR. IQY.GT.8) GO TO NOEXIT`20
X      IF(GALAXY(IQX,IQY) .GT. 899) GO TO NOEXIT`20
XC--------ALSO AVOID INTRUDING ON ANOTHER COMMANDERS TERRITORY (UNLESS S.C.)`
V20
X      IF(IRUN.NE.0) GO TO 86
X      IF(IENM .EQ. IHS) GO TO 85
X      DO 80 L=1,REMCOM
X      IF(CX(L).EQ.IQX .AND. CY(L).EQ.IQY) GO TO NOEXIT
X 80   CONTINUE
XC------DON'T LET ROMULANS LEAVE.     `20
X      IF(IENM.EQ.IHR) GO TO NOEXIT   `20
XC--------ALSO, REFUSE TO LEAVE IF CURRENTLY ATTACKING STARBASE (UNLESS S.C.)
X      IF(BATX.EQ.QUADX .AND. BATY.EQ.QUADY) GO TO NOEXIT
XC--------FINALLY, DON'T LEAVE WITH OVER 1000 UNITS OF ENERGY.      `20
X 85   IF(KPOWER(LOCCOM) .GT. 1000.) GO TO NOEXIT
XC--------PRINT ESCAPE MESSAGE AND MOVE COMMANDER TO ADJACENT QUADRANT`20
X86`09CALL CRAM3AS
X`09CALL CRAMEN(IENM)
X      CALL CRAM(11H ESCAPES TO)`20
X      CALL CRAMLOC(1,IQX,IQY)`20
X      CALL CRAMDMP(23H (AND REGAINS STRENGTH))
XC--------HANDLE LOCAL MATTERS RELATING TO COMMANDERS ESCAPE`20
X      CALL LEAVE
X`09I=I-1`09`09!NUMBER OF KLINGONS HAS BEEN REDUCED (IN QUAD)
XC--------HANDLE GLOBAL MATTERS RELATING TO COMMANDERS ESCAPE
X      GALAXY(QUADX,QUADY)=GALAXY(QUADX,QUADY)-100`20
X      GALAXY(IQX,IQY)=GALAXY(IQX,IQY)+100`20
X      IF(IENM .EQ. IHC) GO TO 87
X      IF(IENM .NE. IHS) GO TO 500    `20
X`09ISHERE=0
X`09ISCATE=0
X`09IENTESC=0
X`09ISATB=0
X      FUTURE(6)=0.2777+DATE`20
X      FUTURE(7)=1E38`20
X`09ISX=IQX
X`09ISY=IQY
X`09GO TO 500
X 87   DO 90 L=1,REMCOM
X      IF(CX(L).EQ.QUADX .AND. CY(L).EQ.QUADY) GO TO 100`20
X 90   CONTINUE
X 100  CX(L)=IQX`20
X      CY(L)=IQY`20
X      COMHERE=0`20
X500`09I=I+1
+-+-+-+-+-+-+-+-  END  OF PART 10 +-+-+-+-+-+-+-+-