home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / EPHIT.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  4.0 KB  |  57 lines
  1.       SUBROUTINE EPHIT(A1,A2,A3,TMXH,ITYPE,NUM)                         1343
  2.  
  3. c    include 'tcommon.for'
  4.     %include tcommon.for
  5.  
  6.       DATA GETHRU/.8/                                                   1366
  7. C     ...PHASER FIRING ROUTINE FOR E AND G.                             1370
  8.       NDX=(ITYPE-3)*9+NUM+1                                             1371
  9.       IF(ICNTL(NDX).EQ.1)GO TO 99                                       1372
  10.       CALL GETBRG(DELV,XQE,A1,YQE,A2,VPX,VPY)                           1373
  11.       DELTA=360.                                                        1374
  12.       IF(EFP(2).EQ.3.)DELTA=180.                                        1375
  13.       DELV=DELTA-PDEG+DELV                                              1376
  14.       IF(DELV.GE.360.)DELV=DELV-360.                                    1377
  15.       IF(DELV.LT.0.)DELV=DELV+360.                                      1378
  16.       IF(DELV.GT.90..AND.DELV.LE.270.)DELV=90.                          1379
  17.       IF(DELV.GT.270.)DELV=360.-DELV                                    1380
  18.       IF(DELV.GE.90.)GO TO 99                                           1381
  19. C     ...CALCULATE STRENGTH OF HIT DEPENDING ON BEARING                 1382
  20. C     ...TO TARGET AND DISTANCE.                                        1383
  21.       DELV=COSD(DELV)*COSD(DELV)*DISTPE*EFP(3)/(VPX*VPX+VPY*VPY)        1384
  22. C     ...MASKING EFFECTS. 80 PERCENT GETS THROUGH ANYWAY                1385
  23.       IF(LEVEL.EQ.1)GO TO 2310                                          1386
  24.       CALL MASKEF(A1,A2,XQE,YQE,VPY)                                    1387
  25.       DELV=DELV-VPY*DELV*GETHRU                                         1388
  26. 2310  IF( ITYPE.EQ.4.AND.ICLOAK.EQ.2.AND.NUM.EQ.1)GO TO 2311            1389
  27.       WRITE(6,2314)DELV,LETR(ITYPE),NUM,A1,A2                           1390
  28. 2314  FORMAT(1X,F7.1,' UNIT HIT ON ',A1,I1,' AT ',F4.1,',',F4.1)        1391
  29.       GO TO 2315                                                        1392
  30. 2311  WRITE(6,2312)DELV,LETR(ITYPE),NUM                                 1393
  31. 2312  FORMAT(1X,F7.1,' UNIT HIT ON ',A1,I1)                             1394
  32. 2315  A3=A3+DELV                                                        1395
  33. C     ...CHECK IF TOTAL HITS=DESTRUCTION.                               1396
  34.       IF(A3.LT.TMXH)GO TO 100                                           1397
  35. 50    CALL DLETE(ITYPE,NUM)                                             1398
  36.       IF(ITYPE.EQ.3)A1=XKL(NUM,1)                                       1399
  37.       IF(ITYPE.EQ.4)A1=XROM(NUM,1)                                      1400
  38. 99    RETURN                                                            1401
  39. C     ...HITS AFFECT CREW AND ANY TROOPS ON BOARD ALSO.                 1402
  40. 100   IF(ITRMEN(NDX).EQ.0)GO TO 60                                      1403
  41.       IX=RAN(IZZ)*SQRT(DELV)*2.5                                        1404
  42.       IF(IX.GT.ITRMEN(NDX))IX=ITRMEN(NDX)                               1405
  43.       ITRMEN(NDX)=ITRMEN(NDX)-IX                                        1406
  44.       ITKL(NDX-1)=ITKL(NDX-1)+IX                                        1407
  45. 60    IF(ITYPE.EQ.4)GO TO 200                                           1408
  46.       IX=RAN(IZZ)*2.5*SQRT(DELV)                                        1409
  47.       XKL(NUM,9)=XKL(NUM,9)-IX                                          1410
  48.       IF(XKL(NUM,9).LE.0.)GO TO 50                                      1411
  49.       JTKL(NUM)=JTKL(NUM)+IX                                            1412
  50.       GO TO 99                                                          1413
  51. 200   IX=RAN(IZZ)*2.5*SQRT(DELV)                                        1414
  52.       CREWR(NUM)=CREWR(NUM)-IX                                          1415
  53.       IF(CREWR(NUM).LE.0.)GO TO 50                                      1416
  54.       JTKL(NUM+9)=JTKL(NUM+9)+IX                                        1417
  55.       GO TO 99                                                          1418
  56.       END                                                               1419
  57.