SUBROUTINE EPMOVE(IS) 1420 c include 'tcommon.for' %include tcommon.for IF(IS.LT.0)GO TO 8001 1448 IS=0 1449 PRSPD=PSP 1450 C ...DETERMINE WHICH DRIVE TO USE DEPENDING ON DAMAGE IF ANY 1451 ACCE=EWRP 1452 DCHG=DGWP 1453 DVEL=DVWP 1454 C ...IF UNDER ALIEN CONTROL, USE W DRIVE EVEN IF DAMAGED. 1455 IF(NDRA.EQ.1)GO TO 2005 1456 IF(NBASES.EQ.99)DVEL=DVWP*2. 1457 IF(IDMG(1).EQ.0)GO TO 2005 1458 DSP=AMIN1(DSP,AMAX1(PSP,SIM)) 1459 NBASES=0 1460 ACCE=EIMP 1461 DCHG=DGIMP 1462 DVEL=DVIMP 1463 C ...IF BOTH DAMAGED, COME TO DEAD STOP. 1464 IF(IDMG(2).NE.0)DSP=PSP 1465 C ...E MOVEMENT. CHECK WHETHER ACCELERATING OR NOT. 1466 2005 IF(PSP.EQ.DSP.AND.PDEG.EQ.DDEG)GO TO 2090 1467 C ...ACCELERATION. DCHG IS DEGREES CHANGE PER STEP; DVEL-VEL. CHG. 1468 DELTA=0. 1469 IF(DDEG.EQ.PDEG)GO TO 2010 1470 DELTA=DDEG-PDEG 1471 IF(ABS(DELTA).GT.180.)DELTA=DELTA-SIGN(360.,DELTA) 1472 IF(ABS(DELTA).GT.DCHG)DELTA=SIGN(DCHG,DELTA) 1473 PDEG=PDEG+DELTA 1474 IF(PDEG.GE.360.)PDEG=PDEG-360. 1475 IF(PDEG.LT.0.)PDEG=PDEG+360. 1476 IF(PDEG.NE.DDEG)GO TO 2010 1477 WRITE(6,2009)PDEG 1478 2009 FORMAT(' A DESIRED BEARING OF ',F4.0,' HAS BEEN ATTAINED') 1479 2010 DELV=0. 1480 IF(PSP.EQ.DSP)GO TO 2020 1481 DELV=SIGN(DVEL,DSP-PSP) 1482 IF(ABS(DSP-PSP).LT.ABS(DELV))DELV=DSP-PSP 1483 PSP=PSP+DELV 1484 IF(PSP.NE.DSP)GO TO 2020 1485 WRITE(6,2019)PSP 1486 2019 FORMAT(' A DESIRED SPEED OF ',F5.3,' HAS BEEN ATTAINED') 1487 2020 IF(PRSPD.GE.1..OR.PSP.LT.1.)GO TO 2017 1488 WRITE(6,2018) 1489 2018 FORMAT(' ENTERING HYPERSPACE') 1490 C ...DELETE SCHEDULED ACTIVITIES IF ENTERING HYPERSPACE 1491 ETR(1)=0. 1492 EFP(1)=0. 1493 EFT(1,1)=0. 1494 IHERE=0 1495 ITORP=ITORP+ITFIRE 1496 ITFIRE=0 1497 C ...CALCULATE ENERGY USAGE. PROP TO CHG IN VEL SQRD. 1498 2017 ENERGY=ENERGY-((((PSP-DELV)/2.)**2)*(2.-2.*COSD(ABS(DELTA)))+DELV*1499 1DELV)*ACCE 1500 IF(ENERGY.LE.0.)CALL RATING(2) 1501 C ...CALCULATE POSITION CHANGE 1502 DX=COSD(PDEG-DELTA/2.)*(PSP-DELV/2.) 1503 DY=SIND(PDEG-DELTA/2.)*(PSP-DELV/2.) 1504 C ...E UNDER ALIEN CONTROL. RANDOM COURSE AND SPEED 1505 C ...CHANGES AT WARP SPEEDS. 1506 IF(NDRA.NE.1)GO TO 20231 1507 20237 IF(RAN(IZZ).GE..3)GO TO 20232 1508 DDEG=RAN(IZZ)*360. 1509 DSP=1.+RAN(IZZ) 1510 20232 IF(RAN(IZZ).GE.DRL)GO TO 20231 1511 SDAYS=RAN(IZZ)*DRD+.5 1512 IDMG(1)=IDMG(1)+SDAYS*100. 1513 WRITE(6,2998)NAMD(1),PSP 1514 2998 FORMAT(' CHIEF SURGEON DESTROYS ENERGY FORMS WITH ANTIMATTER VIRUS1515 1'/ ' BUT ',A10,' DAMAGED. DRIFTING...PRESENT SPEED: ',F5.3) 1516 DSP=PSP 1517 NDRA=0 1518 GO TO 2021 1519 20231 IF(NBASES.NE.99)GO TO 2021 1520 IF(PSP.NE.1.1)GO TO 2021 1521 NBASES=0 1522 C ...CHECK IF DAMAGED IN EMERG. EVSV. MANEUVERS. 1523 IF(RAN(IZZ).GT.XKTIME)GO TO 2021 1524 SDAYS=RAN(IZZ)*XKTIME*5. 1525 IDMG(1)=IDMG(1)+SDAYS*100. 1526 WRITE(6,2999)NAMD(1) 1527 2999 FORMAT(1X,A10,' DAMAGED DURING EMERGENCY EVASIVE MANEUVERS.') 1528 C ...MOVE E. 1529 2021 XQE=XQE+DX 1530 YQE=YQE+DY 1531 IF(IDOCK.NE.2)GO TO 2022 1532 IS=1 1533 IF(RANGE(XQE,BASE(1),YQE,BASE(2)).GT.RADEB)IDOCK=0 1534 C ...CHECK IF LEAVING QUADRANT OR GALAXY 1535 2022 IF(XQE.LT.10.5)GO TO 2030 1536 L=ICE 1537 ICE=ICE+1 1538 IF(ICE.GT.NQUAD)GO TO 8001 1539 CALL BPAGE 1540 WRITE(6,2029)L,JCE,ICE,JCE 1541 2029 FORMAT(' LEAVING QUADRANT ',I2,',',I2/' ENTERING QUADRANT ', 1542 1 I2,',',I2) 1543 C ...CORRECT POSITION IN NEW QUADRANT. SET SCAN POINTER TO GENERATE 1544 C RS. 1545 XQE=XQE-10. 1546 ISCAN=1 1547 IHERE=0 1548 GO TO 2040 1549 2030 IF(XQE.GE..5)GO TO 2040 1550 L=ICE 1551 ICE=ICE-1 1552 IF(ICE.EQ.0)GO TO 8001 1553 CALL BPAGE 1554 WRITE(6,2029)L,JCE,ICE,JCE 1555 XQE=XQE+10. 1556 ISCAN=1 1557 IHERE=0 1558 2040 IF(YQE.LT.10.5)GO TO 2050 1559 L=JCE 1560 JCE=JCE+1 1561 IF(JCE.GT.NQUAD)GO TO 8001 1562 CALL BPAGE 1563 WRITE(6,2029)ICE,L,ICE,JCE 1564 YQE=YQE-10. 1565 ISCAN=1 1566 IHERE=0 1567 GO TO 2100 1568 2050 IF(YQE.GE..5)GO TO 2100 1569 L=JCE 1570 JCE=JCE-1 1571 IF(JCE.EQ.0)GO TO 8001 1572 CALL BPAGE 1573 WRITE(6,2029)ICE,L,ICE,JCE 1574 YQE=YQE+10. 1575 ISCAN=1 1576 IHERE=0 1577 GO TO 2100 1578 C ...MOVEMENT WITHOUT ACCELERATION. 1579 2090 DX=COSD(PDEG)*PSP 1580 DY=SIND(PDEG)*PSP 1581 IF(NDRA.EQ.1)GO TO 20237 1582 GO TO 2021 1583 C ...END OF E MOVEMENT. IF WARP 1 OR HIGHER, NO ACT. EXC. E DMG RPR.1584 C ..BE SURE TO SET SCAN POINTER IF REMATERIALIZING IN SAME QUAD. 1585 2100 IF(PSP.GE.1..OR.PRSPD.LT.1.)GO TO 2105 1586 IF(ISCAN.EQ.1)GO TO 2110 1587 IHERE=1 1588 GO TO 2110 1589 2105 IF(PSP.GE.1.)GO TO 2800 1590 C ...GENERATE SCAN IF NECESSARY. 1591 IF(ISCAN.EQ.0)GO TO 2150 1592 2110 ISCAN=0 1593 CALL SCAN 1594 CALL QTIME(JTIME) 1595 ISTART=JTIME 1596 2800 IS=1 1597 2150 RETURN 1598 8001 WRITE(6,8002) 1599 8002 FORMAT(' GALACTIC LIMITS EXCEEDED! SPACE-TIME WARP!!') 1600 Y=DEFL 1601 X=PSP*ZMIN 1602 CALL DAMAGE(0,X) 1603 DEFL=Y 1604 C ...YOU MAY GAIN OR LOSE TIME. 1605 Y=RAN(IZZ)*3. 1606 IF(RAN(IZZ).LE.XKTIME)Y=-Y 1607 XTIME=XTIME-Y 1608 IF(XTIME.LE.0.)CALL RATING(3) 1609 SDATE=SDATE+Y 1610 IF(IS.GE.0)GO TO 8003 1611 KCE=IBL(ICE,JCE)/100 1612 LCE=IBL(ICE,JCE)-(KCE*100) 1613 GO TO 8035 1614 8003 KCE=RAN(IZZ)*NQUAD+1. 1615 LCE=RAN(IZZ)*NQUAD+1. 1616 IF(ICE.EQ.KCE.AND.LCE.EQ.JCE)GO TO 8003 1617 8035 ICE=KCE 1618 JCE=LCE 1619 WRITE(6,8004)ICE,JCE 1620 8004 FORMAT(' NOW IN QUADRANT ',I2,',',I2) 1621 IHERE=0 1622 EFT(1,1)=0. 1623 ETR(1)=0. 1624 EFP(1)=0. 1625 PNRGY=0. 1626 ITORP=ITORP+ITFIRE 1627 ITFIRE=0 1628 IX=AMIN1(RAN(IZZ)*10.+1.,10.) 1629 IY=AMIN1(RAN(IZZ)*10.+1.,10.) 1630 XQE=IX 1631 YQE=IY 1632 CALL SCAN 1633 IF(NDRA.EQ.1)DSP=1.+RAN(IZZ) 1634 IS=2 1635 GO TO 2150 1636 END 1637 CALL DLETE(7,J)