home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / QQMOVE.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  4.4 KB  |  62 lines
  1.       SUBROUTINE QQMOVE                                                 3391
  2.  
  3. c    include 'tcommon.for'
  4.     %include tcommon.for
  5.  
  6. C     ...ROMULANS AND KLINGONS MOVE FROM QUADRANT TO QUADRANT TOWARDS   3411
  7. C     ...BASES.                                                         3412
  8.       XTOT=NKL+MROM                                                     3413
  9.       YTOT=LEFTK+LEFTR                                                  3414
  10.       PRQMV=SQRT(1.-YTOT/XTOT)                                          3415
  11. C     ...PRQMV IS PROBABILITY THAT ENEMY WILL MOVE OUT OF A QUADRANT.   3416
  12. C     ...DON'T SELECT QUADRANTS WITH BASES IN THEM OR E IN.             3417
  13.       DO 1000 I=1,NQUAD                                                 3418
  14.       DO 1000 J=1,NQUAD                                                 3419
  15.       IF(I.EQ.ICE.AND.J.EQ.JCE)GO TO 1000                               3420
  16.       IK=JGAL(I,J)                                                      3421
  17.       IF(IK.LE.99)GO TO 1000                                            3422
  18.       IF(IK-IK/100*100.GT.9)GO TO 1000                                  3423
  19.       IF(RAN(IZZ).GT.PRQMV)GO TO 1000                                   3424
  20. C     ...MOVE MAX OF 1K + 1R.                                           3425
  21.       X=I                                                               3426
  22.       Y=J                                                               3427
  23.       M=99                                                              3428
  24.       N=99                                                              3429
  25. C     ...FIND NEAREST QUAD WITH BASE.                                   3430
  26.       DIST=1.E9                                                         3431
  27.       DO 100 K=1,NQUAD                                                  3432
  28.       DO 100 L=1,NQUAD                                                  3433
  29.       IF(JGAL(K,L)-JGAL(K,L)/100*100.LE.9)GO TO 100                     3434
  30.       U=K                                                               3435
  31.       V=L                                                               3436
  32.       Z=RANGE(X,U,Y,V)                                                  3437
  33.       IF(Z.GE.DIST)GO TO 100                                            3438
  34.       DIST=Z                                                            3439
  35.       M=K                                                               3440
  36.       N=L                                                               3441
  37. 100   CONTINUE                                                          3442
  38.       IF(M.EQ.99)GO TO 9999                                             3443
  39.       M=M-I                                                             3444
  40.       N=N-J                                                             3445
  41.       IM=1                                                              3446
  42.       JM=1                                                              3447
  43.       K=ISIGN(1,M)+I                                                    3448
  44.       IF(M.EQ.0)K=I                                                     3449
  45.       L=ISIGN(1,N)+J                                                    3450
  46.       IF(N.EQ.0)L=J                                                     3451
  47.       IF(K.EQ.ICE.AND.L.EQ.JCE)GO TO 1000                               3452
  48.       JK=JGAL(K,L)                                                      3453
  49. C     ...ROMULANS FIRST, THEN KLINGONS. NOTE THAT IGAL IS NOT UPDATED!  3454
  50. C     ...NO MORE THAN 99XX IN A QUADRANT.                               3455
  51.       IF(IK.LT.1000)GO TO 200                                           3456
  52.       IF(JK.GE.9000)GO TO 200                                           3457
  53.       JGAL(I,J)=JGAL(I,J)-1000                                          3458
  54.       JGAL(K,L)=JGAL(K,L)+1000                                          3459
  55. 200   IF(IK-IK/1000*1000.LT.100)GO TO 1000                              3460
  56.       IF(JK-JK/1000*1000.GE.900)GO TO 1000                              3461
  57.       JGAL(I,J)=JGAL(I,J)-100                                           3462
  58.       JGAL(K,L)=JGAL(K,L)+100                                           3463
  59. 1000  CONTINUE                                                          3464
  60. 9999  RETURN                                                            3465
  61.       END                                                               3466
  62.