
      SUBROUTINE DLETE(NTYP,NUM)                                        0934

c	include 'tcommon.for'
	%include tcommon.for

      GO TO (100,999,300,400,500,600,700),NTYP                          0964
999   RETURN                                                            0965
C     ...DELETE *.                                                      0966
100   JGAL(ICE,JCE)=JGAL(ICE,JCE)-1                                     0967
      IF(IDMG(6).EQ.0.OR.IDMG(7).EQ.0)      IGAL(ICE,JCE)=JGAL(ICE,JCE) 0968
      X=STARS(NUM,1)                                                    0969
      Y=STARS(NUM,2)                                                    0970
      STARS(NUM,1)=0.                                                   0971
      JJ=1                                                              0972
      DO 110 J=1,NSTARS                                                 0973
      IF(STARS(J,1).EQ.0.)GO TO 110                                     0974
      JJ=0                                                              0975
      GO TO 120                                                         0976
110   CONTINUE                                                          0977
      NSTARS=0                                                          0978
C     ...SHUTTLECRAFT DESTROYED - FINDINGS LOST.                        0979
120   IF(ISTSH.NE.NUM.OR.ISHD.EQ.99)GO TO 200                           0980
      WRITE(6,11)                                                       0981
11    FORMAT(' SHUTTLECRAFT DESTROYED')                                 0982
      ISTSH=0                                                           0983
      ISHD=0                                                            0984
      DO 150    J=1,9                                                   0985
      IF(IFNDS(J).EQ.-1)GO TO 150                                       0986
      IFNDS(J)=0                                                        0987
150   CONTINUE                                                          0988
      DO 151 J=1,10                                                     0989
151   ISHSTR(J)=0                                                       0990
      ISHNUM=ISHNUM-1                                                   0991
      GO TO 888                                                         0992
200   IF(ISTSH.NE.99.OR.ISHD.NE.NUM)GO TO 888                           0993
      WRITE(6,12)                                                       0994
12    FORMAT(' SHUTTLECRAFT OBJECTIVE DESTROYED')                       0995
C     ...FIND NEW OBJECTIVE (NEAREST UNEXPLORED STAR) IF POSSIBLE.      0996
      IF(NSTARS.EQ.0)GO TO 290                                          0997
      JJ=ISHSTR(2)                                                      0998
      IF(JJ.LE.0.OR.STARS(JJ,1).EQ.0.)GO TO 290                         0999
      DO 225 J=2,10                                                     1000
225   ISHSTR(J-1)=ISHSTR(J)                                             1001
      DIST=RANGE(SHX,STARS(JJ,1),SHY,STARS(JJ,2))                       1002
      IF(JJ.EQ.0)GO TO 290                                              1003
      DX=DIST/SHVX/100.                                                 1004
      WRITE(6,230)JJ,DX                                                 1005
230   FORMAT(' GOING ON TO STAR SYSTEM ',I1,' ARRIVAL IN ',F4.2,' STARDA1006
     1YS')                                                              1007
      ISHD=JJ                                                           1008
      GO TO 888                                                         1009
290   WRITE(6,295)                                                      1010
295   FORMAT(' TURNING BACK')                                           1011
      ISHD=99                                                           1012
      DO 296 I=1,10                                                     1013
296   ISHSTR(I)=0                                                       1014
      GO TO 888                                                         1015
C     ...DELETE K.                                                      1016
300   LEFTK=LEFTK-1                                                     1017
      JGAL(ICE,JCE)=JGAL(ICE,JCE)-100                                   1018
      IF(IDMG(6).EQ.0.OR.IDMG(7).EQ.0)      IGAL(ICE,JCE)=JGAL(ICE,JCE) 1019
      X=XKL(NUM,1)                                                      1020
      Y=XKL(NUM,2)                                                      1021
      XKL(NUM,1)=0.                                                     1022
      JJ=1                                                              1023
      DO 310 J=1,KLNGNS                                                 1024
      IF(XKL(J,1).EQ.0.)GO TO 310                                       1025
      JJ=0                                                              1026
      GO TO 320                                                         1027
310   CONTINUE                                                          1028
      KLNGNS=0                                                          1029
320   IF(ITRMEN(NUM+1).EQ.0)GO TO 330                                   1030
      WRITE(6,301)ITRMEN(NUM+1)                                         1031
301   FORMAT(I4,' TROOPS ON BOARDS LOST')                               1032
      ITRMEN(NUM+1)=0                                                   1033
      IF(ISTAT.EQ.0)GO TO 330                                           1034
C     ...SET ISTAT TO STOP BEAMING                                      1035
      IF(JUP.EQ.3.AND.JFROM.EQ.NUM.OR.JDOWN.EQ.3.AND.JTO.EQ.NUM)ISTAT=991036
     199                                                                1037
330   ICNTL(NUM+1)=0                                                    1038
      GO TO 888                                                         1039
C     ...DELETE ROMULAN.                                                1040
400   LEFTR=LEFTR-1                                                     1041
      JGAL(ICE,JCE)=JGAL(ICE,JCE)-1000                                  1042
      IF(IDMG(6).EQ.0.OR.IDMG(7).EQ.0)      IGAL(ICE,JCE)=JGAL(ICE,JCE) 1043
      X=XROM(NUM,1)                                                     1044
      Y=XROM(NUM,2)                                                     1045
      XROM(NUM,1)=0.                                                    1046
      IF(ICLOAK.EQ.2.AND.NUM.EQ.1)ICLOAK=1                              1047
      JJ=1                                                              1048
      DO 410 J=1,NROM                                                   1049
      IF(XROM(J,1).EQ.0.)GO TO 410                                      1050
      JJ=0                                                              1051
      GO TO 420                                                         1052
410   CONTINUE                                                          1053
      NROM=0                                                            1054
420   IF(ITRMEN(NUM+10).EQ.0)GO TO 430                                  1055
      WRITE(6,301)ITRMEN(NUM+10)                                        1056
      ITRMEN(NUM+10)=0                                                  1057
      IF(ISTAT.EQ.0)GO TO 430                                           1058
C     ...SET ISTAT TO STOP BEAMING                                      1059
      IF(JUP.EQ.4.AND.JFROM.EQ.NUM.OR.JDOWN.EQ.4.AND.JTO.EQ.NUM)ISTAT=991060
     199                                                                1061
430   ICNTL(NUM+10)=0                                                   1062
      GO TO 888                                                         1063
C     ...DELETE G.                                                      1064
500   IGH=0                                                             1065
      X=GHOST(1)                                                        1066
      IF(ITRMEN(20).EQ.0)GO TO 530                                      1067
      WRITE(6,301)ITRMEN(20)                                            1068
      ITRMEN(20)=0                                                      1069
      IF(ISTAT.EQ.0)GO TO 530                                           1070
C     ...SET ISTAT TO STOP BEAMING                                      1071
      IF(JUP.EQ.5.OR.JDOWN.EQ.5)ISTAT=9999                              1072
530   ICNTL(20)=0                                                       1073
      Y=GHOST(2)                                                        1074
      GO TO 888                                                         1075
C     ...DELETE B.                                                      1076
600   IBASE=0                                                           1077
      X=BASE(1)                                                         1078
      Y=BASE(2)                                                         1079
      IBMENR=0                                                          1080
      JGAL(ICE,JCE)=JGAL(ICE,JCE)-10                                    1081
      IF(IDMG(6).EQ.0.OR.IDMG(7).EQ.0)      IGAL(ICE,JCE)=JGAL(ICE,JCE) 1082
      GO TO 888                                                         1083
C     ...DELETE T.                                                      1084
700   TORPS(NUM,1)=0.                                                   1085
      JJ=1                                                              1086
      DO 710 J=1,NTORPS                                                 1087
      IF(TORPS(J,1).EQ.0.)GO TO 710                                     1088
      JJ=0                                                              1089
      GO TO 999                                                         1090
710   CONTINUE                                                          1091
      NTORPS=0                                                          1092
      GO TO 999                                                         1093
C     ...PRINT MESSAGE                                                  1094
888   WRITE(6,1)LETR(NTYP),NUM,X,Y                                      1095
1     FORMAT(1X,A1,I1,' AT ',F4.1,',',F4.1,' DESTROYED')                1096
      IF(LEFTR.EQ.0.AND.LEFTK.EQ.0)CALL RATING(4)                       1097
      GO TO 999                                                         1098
      END                                                               1099
