home *** CD-ROM | disk | FTP | other *** search
- 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
