SUBROUTINE STORM 4922 c include 'tcommon.for' %include tcommon.for X=ISTORM 4947 Y=JSTORM 4948 C ...E WITH STORM. BE SURE IT DOESN'T REAPPEAR NEAR STAR OR B. 4949 IF(RANGE(XQE,X,YQE,Y).GT.STMRAD)GO TO 200 4950 50 XX=RAN(IZZ)*10.+.5 4951 YY=RAN(IZZ)*10.+.5 4952 IF(NSTARS.EQ.0)GO TO 150 4953 DO 100 J=1,NSTARS 4954 IF(STARS(J,1).EQ.0.)GO TO 100 4955 IF(RANGE(XX,STARS(J,1),YY,STARS(J,2)).LE.ESDIST)GO TO 50 4956 100 CONTINUE 4957 150 IF(IBASE.EQ.0)GO TO 175 4958 IF(RANGE(XX,BASE(1),YY,BASE(2)).LE.ESDIST)GO TO 50 4959 175 P SP=RAN(IZZ) 4960 PDEG=RAN(IZZ)*360. 4961 DSP=PSP 4962 DDEG=PDEG 4963 WRITE(*,1)LETR(2),XX,YY,PSP,PDEG 4964 1 FORMAT(1X,A1,' CAUGHT IN STORM. MOVED TO: ',F4.1,',',F4.1/' SPEED:4965 1 ',F5.3,'BEARING: ',F4.0) 4966 XQE=XX 4967 YQE=YY 4968 C ...K WITH STORM 4969 200 IF(KLNGNS.EQ.0)GO TO 300 4970 DO 250 J=1,KLNGNS 4971 IF(XKL(J,1).EQ.0.)GO TO 250 4972 IF(RANGE(XKL(J,1),X,XKL(J,2),Y).GT.STMRAD)GO TO 250 4973 XKL(J,1)=RAN(IZZ)*10.+.5 4974 XKL(J,2)=RAN(IZZ)*10.+.5 4975 XKL(J,3)=RAN(IZZ)*VMXKL 4976 XKL(J,4)=RAN(IZZ)*360. 4977 XKL(J,5)=XKL(J,3) 4978 XKL(J,6)=XKL(J,4) 4979 IF(ICNTL(J+1).NE.1)GO TO 250 4980 WRITE(*,2)LETR(3),J,(XKL(J,K),K=1,4) 4981 2 FORMAT(1X,A1,I1,' CAUGHT IN STORM. MOVED TO: ',F4.1,',',F4.1/' SPE4982 1ED: ',F5.3,'BEARING: ',F4.0) 4983 250 CONTINUE 4984 C ...G WITH STORM. 4985 300 IF(IGH.EQ.0)GO TO 400 4986 IF(RANGE(GHOST(1),X,GHOST(2),Y).GT.STMRAD)GO TO 400 4987 GHOST(1)=RAN(IZZ)*10.+.5 4988 GHOST(2)=RAN(IZZ)*10.+.5 4989 GHOST(4)=RAN(IZZ)*GHVMX 4990 GHOST(5)=RAN(IZZ)*360. 4991 GHOST(6)=GHOST(4) 4992 GHOST(7)=GHOST(5) 4993 IF(ICNTL(20).NE.1)GO TO 400 4994 WRITE(*,1)LETR(5),GHOST(1),GHOST(2),GHOST(4),GHOST(5) 4995 C ...R WITH STORM. 4996 400 IF(NROM.EQ.0)GO TO 500 4997 DO 450 J=1,NROM 4998 IF(XROM(J,1).EQ.0.)GO TO 450 4999 IF(XROM(J,1).NE.X.OR.XROM(J,2).NE.Y)GO TO 450 5000 455 I X=RAN(IZZ)*10.+1. 5001 IY=RAN(IZZ)*10.+1. 5002 C ...R CAN'T COME OUT ON *,B, OR OTHER R 5003 IF(NSTARS.EQ.0)GO TO 465 5004 DO 460 K=1,NSTARS 5005 IF(STARS(K,1).EQ.0.)GO TO 460 5006 IF(IX.EQ.STARS(K,1).AND.IY.EQ.STARS(K,2))GO TO 455 5007 460 CONTINUE 5008 465 IF(IBASE.EQ.0)GO TO 470 5009 IF(IX.EQ.BASE(1).AND.IY.EQ.BASE(2))GO TO 455 5010 470 IF(NROM.LE.1)GO TO 490 5011 DO 480 K=1,NROM 5012 IF(J.EQ.K)GO TO 480 5013 IF(XROM(K,1).EQ.0.)GO TO 480 5014 IF(IX.EQ.XROM(K,1).AND.IY.EQ.XROM(K,2))GO TO 455 5015 480 CONTINUE 5016 490 X ROM(J,1)=IX 5017 XROM(J,2)=IY 5018 IF(ICNTL(J+10).NE.1)GO TO 450 5019 WRITE(*,3)LETR(4),J,XROM(J,1),XROM(J,2) 5020 3 FORMAT(1X,A1,I1,' CAUGHT IN STORM. MOVED TO: ',F4.1,',',F4.1/) 5021 450 CONTINUE 5022 C ...S WITH STORM. 5023 500 IF(ISTSH.NE.99)GO TO 600 5024 IF(RANGE(SHX,X,SHY,Y).GT.STMRAD)GO TO 600 5025 SHX=RAN(IZZ)*10.+.5 5026 SHY=RAN(IZZ)*10.+.5 5027 SHDEG=RAN(IZZ)*360. 5028 WRITE(*,1)LETR(12),SHX,SHY,SHVX,SHDEG 5029 ISHD=99 5030 C ...T WITH STORM. 5031 600 IF(NTORPS.EQ.0)GO TO 999 5032 DO 750 J=1,NTORPS 5033 IF(TORPS(J,1).EQ.0.)GO TO 750 5034 IF(RANGE(TORPS(J,1),X,TORPS(J,2),Y).GT.STMRAD)GO TO 750 5035 ZPLUS=0. 5036 IF(TORPS(J,4).LT.0.)ZPLUS=-360. 5037 IF(TORPS(J,4).GE.360.)ZPLUS=360. 5038 TORPS(J,1)=RAN(IZZ)*10.+.5 5039 TORPS(J,2)=RAN(IZZ)*10.+.5 5040 TORPS(J,3)=RAN(IZZ) 5041 TORPS(J,4)=RAN(IZZ)*360.+ZPLUS 5042 750 CONTINUE 5043 999 RETURN 5044 END 5045  4816 1// ' S T A R T R E K'/ ' 48