home *** CD-ROM | disk | FTP | other *** search
-
- SUBROUTINE ROMLN 3827
-
- c include 'tcommon.for'
- %include tcommon.for
-
- DIMENSION RMOVES(3,3) 3855
- DATA PRRMV/.111/ 3856
- DATA WNDESC,WEDGEM,WT,WGH,WK,WKO/-20.,10.,8.,15.,10.,10./ 3857
- DATA WSAMSQ/5./ 3858
- C ...JSCAN WILL BE USED TO ASSURE THAT WE DON'T CALL SCAN 3859
- C ...MORE THAN ONCE. 3860
- DO 2750 J=1,NROM 3861
- IF(XROM(J,1).EQ.0.)GO TO 2750 3862
- C ...R MOVES (JUMPS) IN INCREMENTS OF 1 PARSEC IN ANY OF 8 3863
- C ...DIRECTIONS. 3864
- 2710 IF(ICNTL(J+10).EQ.1)GO TO 2725 3865
- C ...ROMULAN MOVEMENT. MOVES TO 1 OF 8 ADJACENT POINTS IN QUAD. 3866
- IF(RAN(IZZ).GT.PRRMV.OR.LEVEL.EQ.1)GO TO 2725 3867
- IF(JSCAN.EQ.1)GO TO 27101 3868
- IHERE=2 3869
- C ...SET UP IPQ SO WE CAN TELL WHICH POINTS ARE OCCUPIED. 3870
- CALL SCAN 3871
- 27101 IX=XROM(J,1) 3872
- IY=XROM(J,2) 3873
- C ...RMOVES USED TO SELECTIVELY WEIGHT EACH OF THE 9 POINTS. 3874
- IDIR=-2 3875
- DO 1000 K=1,3 3876
- IDIR=IDIR+1 3877
- JDIR=-2 3878
- DO 990 L=1,3 3879
- JDIR=JDIR+1 3880
- RMOVES(K,L)=0. 3881
- MM=IX+IDIR 3882
- NN=IY+JDIR 3883
- XK=MM 3884
- YK=NN 3885
- IF(MM.GE.1.AND.MM.LE.10)GO TO 980 3886
- C ...DO NOT LEAVE QUAD UNLESS DAMAGED OR TO AVOID TORPS. 3887
- 985 RMOVES(K,L)=WNDESC 3888
- IF(XROM(J,3).LT.THITR*XRMHIT.AND.MROM/LEFTR.LT.7)GO TO 990 3889
- KCE=2*MM/11-1+ICE 3890
- IF(KCE.GE.1.AND.KCE.LE.NQUAD)GO TO 987 3891
- C ...BIG PENALTY FOR LEAVING GALAXY. 3892
- 988 RMOVES(K,L)=-1000. 3893
- GO TO 990 3894
- 986 RMOVES(K,L)=WNDESC 3895
- IF(XROM(J,3).LT.THITR*XRMHIT.AND.MROM/LEFTR.LT.7)GO TO 990 3896
- KCE=2*NN/11-1+JCE 3897
- IF(KCE.LT.1.OR.KCE.GT.NQUAD)GO TO 988 3898
- 987 RMOVES(K,L)=1000. 3899
- GO TO 990 3900
- 980 IF(NN.LT.1.OR.NN.GT.10)GO TO 986 3901
- C ...DON'T GO THERE IF OCCUPIED UNLESS BY SELF. 3902
- IF(IPQ(MM,NN).EQ.LETR(8).AND.(ICLOAK.NE.2.OR.(MM.NE.XROM(1,1).AND.3903
- 1NN.NE.XROM(1,2))))GO TO 970 3904
- IF(IDIR.EQ.0.AND.JDIR.EQ.0)GO TO 975 3905
- RMOVES(K,L)=-1.E13 3906
- GO TO 990 3907
- C ...TENDS NOT TO SIT STILL IF NO OTHER CONSIDERATIONS. 3908
- 975 RMOVES(K,L)=WSAMSQ 3909
- C ...AVOID KLINGONS. 3910
- 970 IF(KLNGNS.EQ.0)GO TO 950 3911
- DO 960 M=1,KLNGNS 3912
- IF(XKL(M,1).EQ.0.)GO TO 960 3913
- W=WK 3914
- C ...BETTER TO HIT THEM IF CAPTURED OR ABOUT TO BE. 3915
- IF(ITRMEN(K+1).GE.50)W=WKO 3916
- RMOVES(K,L)=RMOVES(K,L)-W/RANGE(XK,XKL(M,1),YK,XKL(M,2)) 3917
- 960 CONTINUE 3918
- C ...AVOID TORPS BY CALCULATING EACH SQUARE'S DISTANCE FROM 3919
- C ...ALL ENEMY TORPEDO PATHS HEADED THIS WAY. 3920
- 950 IF(NTORPS.EQ.0)GO TO 930 3921
- DO 940 M=1,NTORPS 3922
- IF(TORPS(M,1).EQ.0..OR.TORPS(M,4).GE.0..AND.TORPS(M,4).LT.360.)GO 3923
- 1TO 940 3924
- CALL GETBRG(DELTA,XK,TORPS(M,1),YK,TORPS(M,2),VPX,VPY) 3925
- DELV=TORPS(M,4) 3926
- IF(DELV.LT.0.)DELV=DELV+360. 3927
- IF(DELV.GE.360.)DELV=DELV-360. 3928
- VPX=DELTA+90. 3929
- IF(VPX.GE.360.)VPX=VPX-360. 3930
- VPY=DELTA-90. 3931
- IF(VPY.LT.0.)VPY=VPY+360. 3932
- IF(DELV.LE.VPX.OR.DELV.GE.VPY)GO TO 940 3933
- VPX=COSD(DELV) 3934
- VPY=SIND(DELV) 3935
- S=9.E17 3936
- IF(VPY.LT.0.)S=-9.E17 3937
- IF(ABS(VPY).GT.1./9.E17)S=VPX/VPY 3938
- IF(S.LT.0.)GO TO 4510 3939
- IF(S.LT.1./9.E17)S=1./9.E17 3940
- GO TO 4520 3941
- 4510 IF(S.GT.-1./9.E17)S=-1./9.E17 3942
- 4520 C1=TORPS(M,2)-S*TORPS(M,1) 3943
- C2=YK+XK/S 3944
- VPX=(C2-C1)/(S+1./S) 3945
- VPY=S*VPX+C1 3946
- RMOVES(K,L)=RMOVES(K,L)-WT/RANGE(XK,VPX,YK,VPY) 3947
- 940 CONTINUE 3948
- C ...AVOID GHOSTSHIPS. 3949
- 930 IF(IGH.EQ.0)GO TO 920 3950
- RMOVES(K,L)=RMOVES(K,L)-WGH/RANGE(XK,GHOST(1),YK,GHOST(2)) 3951
- C ...BONUS FOR MOVING TOWARDS EDGE IF DAMAGED. 3952
- 920 IF(XROM(J,3).LT.THITR*XRMHIT/3.)GO TO 990 3953
- IF(IX.GT.5.AND.MM.LE.IX.OR.IX.LE.5.AND.MM.GE.IX)GO TO 910 3954
- 915 R MOVES(K,L)=RMOVES(K,L)+WEDGEM 3955
- GO TO 990 3956
- 910 IF(IY.GT.5.AND.NN.LE.IY.OR.IY.LE.5.AND.NN.GE.IY)GO TO 990 3957
- GO TO 915 3958
- 990 CONTINUE 3959
- 1000 CONTINUE 3960
- C ...BEST SQ. TO MOVE TO WILL BE ONE WITH HIGHEST TOTAL WEIGHT. 3961
- WMAX=-1.E13 3962
- JJ=2 3963
- KK=2 3964
- DO 800 K=1,3 3965
- DO 800 L=1,3 3966
- IF(RMOVES(K,L).LT.WMAX)GO TO 800 3967
- WMAX=RMOVES(K,L) 3968
- JJ=K 3969
- KK=L 3970
- 800 CONTINUE 3971
- K=IX 3972
- L=IY 3973
- IX=IX+JJ-2 3974
- IY=IY+KK-2 3975
- XROM(J,1)=IX 3976
- XROM(J,2)=IY 3977
- IF(IX.GE.1.AND.IX.LE.10.AND.IY.GE.1.AND.IY.LE.10)GO TO 27248 3978
- C ...LEAVING QUADRANT AND/OR GALAXY. 3979
- 2720 JX=0 3980
- IF(IX.LT.1)JX=-1 3981
- IF(IX.GT.10)JX=1 3982
- JY=0 3983
- IF(IY.LT.1)JY=-1 3984
- IF(IY.GT.10)JY=1 3985
- KCE=ICE+JX 3986
- LCE=JCE+JY 3987
- IRG=(JGAL(KCE,LCE)) 3988
- IF(IRG.GE.9000)GO TO 27260 3989
- IF(IPQ(K,L).EQ.LETR(4))IPQ(K,L)=LETR(8) 3990
- JSCAN=1 3991
- IF(KCE.LE.NQUAD.AND.KCE.GE.1.AND.LCE.LE.NQUAD.AND.LCE.GE.1)GO TO 23992
- 1722 3993
- WRITE(*,2721)LETR(4),J 3994
- 2721 FORMAT(1X,A1,I1,' LEAVING GALAXY') 3995
- CALL DLETE(4,J) 3996
- GO TO 2750 3997
- 2722 WRITE(*,2723)LETR(4),J,KCE,LCE 3998
- 2723 FORMAT(1X,A1,I1,' ESCAPED TO QUADRANT ',I2,',',I2) 3999
- 27245 JGAL(ICE,JCE)=JGAL(ICE,JCE)-1000 4000
- IF(IGAL(ICE,JCE).NE.-1.AND.(IDMG(6).NE.0.OR.IDMG(7).NE.0))IGAL(ICE4001
- 1,JCE)=JGAL(ICE,JCE) 4002
- JGAL(KCE,LCE)=JGAL(KCE,LCE)+1000 4003
- ICNTL(J+10)=0 4004
- IF(ITRMEN(J+10).EQ.0)GO TO 27232 4005
- IF(XROM(J,1).EQ.0.)GO TO 27244 4006
- WRITE(*,101)ITRMEN(J+10) 4007
- 101 FORMAT(I4,' TROOPS CAPTURED BY ENEMY') 4008
- GO TO 27243 4009
- 27244 WRITE(*,29242)ITRMEN(J+10) 4010
- 29242 FORMAT(I4,' TROOPS ON BOARD LOST') 4011
- 27243 ITRMEN(J+10)=0 4012
- 27232 XROM(J,1)=0. 4013
- IF(ISTAT.EQ.0)GO TO 2750 4014
- IF(JUP.EQ.4.AND.JFROM.EQ.J.OR.JDOWN.EQ.4.AND.JTO.EQ.J)ISTAT=9999 4015
- IF(NROM.GT.1)GO TO 2750 4016
- GO TO 2999 4017
- 27260 IF(XROM(J,1).LT.1)XROM(J,1)=1 4018
- IF(XROM(J,2).LT.1)XROM(J,2)=1 4019
- IF(XROM(J,1).GT.10)XROM(J,1)=10 4020
- IF(XROM(J,2).GT.10)XROM(J,2)=10 4021
- C ...ENTERING HOLE? 4022
- 27248 IF(LEVEL.NE.3.OR.IHOLE.EQ.0)GO TO 27242 4023
- IF(IX.NE.IHOLE.OR.IY.NE.JHOLE)GO TO 27242 4024
- 27249 KCE=IBL(ICE,JCE)/100 4025
- LCE=IBL(ICE,JCE)-KCE*100 4026
- IF(JGAL(KCE,LCE).GE.9000)GO TO 27247 4027
- GO TO 2722 4028
- 27247 WRITE(*,27246)LETR(4),J 4029
- 27246 FORMAT(1X,A1,I1,' CAPTURED BY BLACK HOLE') 4030
- CALL DLETE(4,J) 4031
- GO TO 2750 4032
- 27242 GO TO 2724 4033
- C ...CHANGE IPQ ARRAY IF MOVED TO SAVE CALL TO SCAN. 4034
- 2724 JSCAN=1 4035
- IF(K.EQ.IX.AND.L.EQ.IY)GO TO 2725 4036
- 27252 IF(IPQ(K,L).EQ.LETR(4))IPQ(K,L)=LETR(8) 4037
- 27255 IF(IPQ(IX,IY).EQ.LETR(8))IPQ(IX,IY)=LETR(4) 4038
- C ...R FIRES T. 4039
- 2725 IF(XROM(J,4).GT.NTSTPS.OR.XROM(J,4).EQ.0.)GO TO 2750 4040
- IF(ICLOAK.LT.0.AND.ION.EQ.1)GO TO 2750 4041
- IF(ICNTL(J+10).NE.1)GO TO 2760 4042
- C ...R UNDER E CONTROL FIRES T. 4043
- WRITE(*,38644)J 4044
- 38644 FORMAT(' R',I1,' LAUNCHED TORPEDO') 4045
- DELTA=RTBRG(1)-360. 4046
- RTBRG(1)=-1. 4047
- XROM(J,4)=0. 4048
- IF(RTBRG(2).LT.0.)GO TO 2730 4049
- XROM(J,4)=NTSTPS+1+(SCREWR/ITRMEN(J+10)*SRDLY+RAN (IZZ)*XRFTS4050
- 1)*XRMHIT/(XRMHIT-XROM(J,3)) 4051
- DO 2758 K=1,4 4052
- 2758 RTBRG(K)=RTBRG(K+1) 4053
- RTBRG(5)=-1. 4054
- GO TO 2730 4055
- 2760 CALL GETBRG(DELTA,XROM(J,1),XQE,XROM(J,2),YQE,VPX,VPY) 4056
- IF(PSP.EQ.0.)GO TO 2730 4057
- C ...CALCULATE ANGLE FOR FIRING TO REACH E IF IT IS MOVING. 4058
- DX=SIND(PDEG-DELTA)*PSP/RTV 4059
- IF(DX*DX.GT.1.)GO TO 2740 4060
- DY=SQRT(1.-DX*DX) 4061
- DX=ATAN2(DX,DY)*RADEGC 4062
- DELTA=DX+DELTA 4063
- IF(DELTA.LT.0.)DELTA=DELTA+360. 4064
- IF(DELTA.GE.360.)DELTA=DELTA-360. 4065
- C ...FIND SPOT IN TORPS ARRAY TO PUT THE NEW ONE. 4066
- 2730 IF(NTORPS.NE.0)GO TO 2732 4067
- NT=1 4068
- NTORPS=30 4069
- GO TO 2735 4070
- 2732 DO 2733 K=1,NTORPS 4071
- IF(TORPS(K,1).EQ.0.)GO TO 2734 4072
- 2733 CONTINUE 4073
- GO TO 2750 4074
- 2734 NT=K 4075
- 2735 TORPS(NT,3)=RTV 4076
- TORPS(NT,4)=DELTA 4077
- VSX=COSD(DELTA)*RTV+XROM(J,1) 4078
- VSY=SIND(DELTA)*RTV+XROM(J,2) 4079
- 2739 TORPS(NT,1)= VSX 4080
- TORPS(NT,2)= VSY 4081
- IF(ICNTL(J+10).EQ.1)GO TO 2750 4082
- C ...RESET FIRING 4083
- 2740 XROM(J,4)=NTSTPS+RAN(IZZ)*XRFTS*XRMHIT/(XRMHIT-XROM(J,3))+1. 4084
- 2750 CONTINUE 4085
- 2800 RETURN 4086
- 2999 NROM=0 4087
- GO TO 2800 4088
- END 4089
