home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / KLQ.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  3.4 KB  |  49 lines
  1.       SUBROUTINE KLQ(JJ,IR)                                             2339
  2.  
  3. c    include 'tcommon.for'
  4.     %include tcommon.for
  5.  
  6.       IN=0                                                              2364
  7.       JN=0                                                              2365
  8. C     ...CHECK WHICH WAY K LEFT QUAD.                                   2366
  9.       IF(XKL(JJ,1).LT..5)IN=-1                                          2367
  10.       IF(XKL(JJ,2).LT..5)JN=-1                                          2368
  11.       IF(XKL(JJ,1).GE.10.5)IN=1                                         2369
  12.       IF(XKL(JJ,2).GE.10.5)JN=1                                         2370
  13.       IR=0                                                              2371
  14.       IF(IN.EQ.0.AND.JN.EQ.0)RETURN                                     2372
  15.       IR=1                                                              2373
  16.       IN=IN+ICE                                                         2374
  17.       JN=JN+JCE                                                         2375
  18.       IKG=(JGAL(IN,JN))                                                 2376
  19.       IF(IKG-IKG/1000*1000.GE.900)GO TO 2471                            2377
  20. C     ...CHECK IF LEAVING GALAXY.                                       2378
  21.       IF(IN.LT.1.OR.JN.LT.1.OR.IN.GT.NQUAD.OR.JN.GT.NQUAD)GO TO 2468    2379
  22.       WRITE(6,2467)LETR(3),JJ,IN,JN                                     2380
  23. 2467  FORMAT(1X,A1,I1,' ESCAPED TO QUADRANT ',I2,',',I2)                2381
  24.       JGAL(ICE,JCE)=JGAL(ICE,JCE)-100                                   2382
  25.       IF(IDMG(6).NE.0.OR.IDMG(7).NE.0)     IGAL(ICE,JCE)=JGAL(ICE,JCE)  2383
  26.       IF(ITRMEN(JJ+1).EQ.0)GO TO 100                                    2384
  27.       WRITE(6,101)ITRMEN(JJ+1)                                          2385
  28. 101   FORMAT(I4,' TROOPS CAPTURED BY ENEMY')                            2386
  29.       ITRMEN(JJ+1)=0                                                    2387
  30.       IF(ISTAT.EQ.0)GO TO 100                                           2388
  31. C     ...STOP BEAMING.                                                  2389
  32.       IF(JUP.EQ.3.AND.JFROM.EQ.JJ.OR.JDOWN.EQ.3.AND.JTO.EQ.JJ)ISTAT=99992390
  33. 100   ICNTL(JJ+1)=0                                                     2391
  34.       JGAL(IN,JN)=JGAL(IN,JN)+100                                       2392
  35.       XKL(JJ,1)=0.                                                      2393
  36.       RETURN                                                            2394
  37. 2468  WRITE(6,2469)LETR(3),JJ                                           2395
  38. 2469  FORMAT(1X,A1,I1,' EXCEEDED GALACTIC LIMITS')                      2396
  39.       IN=3                                                              2397
  40.       CALL DLETE(IN,JJ)                                                 2398
  41.       IR=2                                                              2399
  42.       RETURN                                                            2400
  43. 2471  IF(XKL(JJ,1).LT..5)XKL(JJ,1)=.6                                   2401
  44.       IF(XKL(JJ,2).LT..5)XKL(JJ,2)=.6                                   2402
  45.       IF(XKL(JJ,1).GT.10.5)XKL(JJ,1)=10.4                               2403
  46.       IF(XKL(JJ,2).GT.10.5)XKL(JJ,2)=10.4                               2404
  47.       RETURN                                                            2405
  48.       END                                                               2406
  49.