home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / STORM.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  7.7 KB  |  105 lines
  1.       SUBROUTINE STORM                                                  4922
  2.  
  3. c    include 'tcommon.for'
  4.     %include tcommon.for
  5.  
  6.       X=ISTORM                                                          4947
  7.       Y=JSTORM                                                          4948
  8. C     ...E WITH STORM. BE SURE IT DOESN'T REAPPEAR NEAR STAR OR B.      4949
  9.       IF(RANGE(XQE,X,YQE,Y).GT.STMRAD)GO TO 200                         4950
  10. 50    XX=RAN(IZZ)*10.+.5                                                4951
  11.       YY=RAN(IZZ)*10.+.5                                                4952
  12.       IF(NSTARS.EQ.0)GO TO 150                                          4953
  13.       DO 100 J=1,NSTARS                                                 4954
  14.       IF(STARS(J,1).EQ.0.)GO TO 100                                     4955
  15.       IF(RANGE(XX,STARS(J,1),YY,STARS(J,2)).LE.ESDIST)GO TO 50          4956
  16. 100   CONTINUE                                                          4957
  17. 150   IF(IBASE.EQ.0)GO TO 175                                           4958
  18.       IF(RANGE(XX,BASE(1),YY,BASE(2)).LE.ESDIST)GO TO 50                4959
  19. 175   P  SP=RAN(IZZ)                                                    4960
  20.       PDEG=RAN(IZZ)*360.                                                4961
  21.       DSP=PSP                                                           4962
  22.       DDEG=PDEG                                                         4963
  23.       WRITE(*,1)LETR(2),XX,YY,PSP,PDEG                                  4964
  24. 1     FORMAT(1X,A1,' CAUGHT IN STORM. MOVED TO: ',F4.1,',',F4.1/' SPEED:4965
  25.      1 ',F5.3,'BEARING: ',F4.0)                                         4966
  26.       XQE=XX                                                            4967
  27.       YQE=YY                                                            4968
  28. C     ...K WITH STORM                                                   4969
  29. 200   IF(KLNGNS.EQ.0)GO TO 300                                          4970
  30.       DO 250 J=1,KLNGNS                                                 4971
  31.       IF(XKL(J,1).EQ.0.)GO TO 250                                       4972
  32.       IF(RANGE(XKL(J,1),X,XKL(J,2),Y).GT.STMRAD)GO TO 250               4973
  33.       XKL(J,1)=RAN(IZZ)*10.+.5                                          4974
  34.       XKL(J,2)=RAN(IZZ)*10.+.5                                          4975
  35.       XKL(J,3)=RAN(IZZ)*VMXKL                                           4976
  36.       XKL(J,4)=RAN(IZZ)*360.                                            4977
  37.       XKL(J,5)=XKL(J,3)                                                 4978
  38.       XKL(J,6)=XKL(J,4)                                                 4979
  39.       IF(ICNTL(J+1).NE.1)GO TO 250                                      4980
  40.       WRITE(*,2)LETR(3),J,(XKL(J,K),K=1,4)                              4981
  41. 2     FORMAT(1X,A1,I1,' CAUGHT IN STORM. MOVED TO: ',F4.1,',',F4.1/' SPE4982
  42.      1ED: ',F5.3,'BEARING: ',F4.0)                                      4983
  43. 250   CONTINUE                                                          4984
  44. C     ...G WITH STORM.                                                  4985
  45. 300   IF(IGH.EQ.0)GO TO 400                                             4986
  46.       IF(RANGE(GHOST(1),X,GHOST(2),Y).GT.STMRAD)GO TO 400               4987
  47.       GHOST(1)=RAN(IZZ)*10.+.5                                          4988
  48.       GHOST(2)=RAN(IZZ)*10.+.5                                          4989
  49.       GHOST(4)=RAN(IZZ)*GHVMX                                           4990
  50.       GHOST(5)=RAN(IZZ)*360.                                            4991
  51.       GHOST(6)=GHOST(4)                                                 4992
  52.       GHOST(7)=GHOST(5)                                                 4993
  53.       IF(ICNTL(20).NE.1)GO TO 400                                       4994
  54.       WRITE(*,1)LETR(5),GHOST(1),GHOST(2),GHOST(4),GHOST(5)             4995
  55. C     ...R WITH STORM.                                                  4996
  56. 400   IF(NROM.EQ.0)GO TO 500                                            4997
  57.       DO 450 J=1,NROM                                                   4998
  58.       IF(XROM(J,1).EQ.0.)GO TO 450                                      4999
  59.       IF(XROM(J,1).NE.X.OR.XROM(J,2).NE.Y)GO TO 450                     5000
  60. 455   I  X=RAN(IZZ)*10.+1.                                              5001
  61.       IY=RAN(IZZ)*10.+1.                                                5002
  62. C     ...R CAN'T COME OUT ON *,B, OR OTHER R                            5003
  63.       IF(NSTARS.EQ.0)GO TO 465                                          5004
  64.       DO 460 K=1,NSTARS                                                 5005
  65.       IF(STARS(K,1).EQ.0.)GO TO 460                                     5006
  66.       IF(IX.EQ.STARS(K,1).AND.IY.EQ.STARS(K,2))GO TO 455                5007
  67. 460   CONTINUE                                                          5008
  68. 465   IF(IBASE.EQ.0)GO TO 470                                           5009
  69.       IF(IX.EQ.BASE(1).AND.IY.EQ.BASE(2))GO TO 455                      5010
  70. 470   IF(NROM.LE.1)GO TO 490                                            5011
  71.       DO 480 K=1,NROM                                                   5012
  72.       IF(J.EQ.K)GO TO 480                                               5013
  73.       IF(XROM(K,1).EQ.0.)GO TO 480                                      5014
  74.       IF(IX.EQ.XROM(K,1).AND.IY.EQ.XROM(K,2))GO TO 455                  5015
  75. 480   CONTINUE                                                          5016
  76. 490   X  ROM(J,1)=IX                                                    5017
  77.       XROM(J,2)=IY                                                      5018
  78.       IF(ICNTL(J+10).NE.1)GO TO 450                                     5019
  79.       WRITE(*,3)LETR(4),J,XROM(J,1),XROM(J,2)                           5020
  80. 3     FORMAT(1X,A1,I1,' CAUGHT IN STORM. MOVED TO: ',F4.1,',',F4.1/)    5021
  81. 450   CONTINUE                                                          5022
  82. C     ...S WITH STORM.                                                  5023
  83. 500   IF(ISTSH.NE.99)GO TO 600                                          5024
  84.       IF(RANGE(SHX,X,SHY,Y).GT.STMRAD)GO TO 600                         5025
  85.       SHX=RAN(IZZ)*10.+.5                                               5026
  86.       SHY=RAN(IZZ)*10.+.5                                               5027
  87.       SHDEG=RAN(IZZ)*360.                                               5028
  88.       WRITE(*,1)LETR(12),SHX,SHY,SHVX,SHDEG                             5029
  89.       ISHD=99                                                           5030
  90. C     ...T WITH STORM.                                                  5031
  91. 600   IF(NTORPS.EQ.0)GO TO 999                                          5032
  92.       DO 750 J=1,NTORPS                                                 5033
  93.       IF(TORPS(J,1).EQ.0.)GO TO 750                                     5034
  94.       IF(RANGE(TORPS(J,1),X,TORPS(J,2),Y).GT.STMRAD)GO TO 750           5035
  95.       ZPLUS=0.                                                          5036
  96.       IF(TORPS(J,4).LT.0.)ZPLUS=-360.                                   5037
  97.       IF(TORPS(J,4).GE.360.)ZPLUS=360.                                  5038
  98.       TORPS(J,1)=RAN(IZZ)*10.+.5                                        5039
  99.       TORPS(J,2)=RAN(IZZ)*10.+.5                                        5040
  100.       TORPS(J,3)=RAN(IZZ)                                               5041
  101.       TORPS(J,4)=RAN(IZZ)*360.+ZPLUS                                    5042
  102. 750   CONTINUE                                                          5043
  103. 999   RETURN                                                            5044
  104.       END                                                               5045
  105.