        SUBROUTINE DAMGED
C** DAMAGE CONTROL ROUTINE
        COMMON /GENDTA/SDATE,COND(2),KLING,TMLEFT,ITORP,ENERGY,SHELDS
        COMMON /DAMAGS/IRPARS(10,2),IRAND,IRATE,IDMGD,TSTRT,GTIME
        COMMON /RMULN/IRMLN,IRMX,IRMY,IHTMS
C** IRATE INDICATES IF THERE IS DAMAGE
C** IDMGD = 2 - BUY REPAIRS
C**         1 - ESTABLISH DAMAGE
C**         0 - UPDATE DAMAGE
C**         3 - ADVANCED GAME MOVEMENT DAMAGES
         IF(IDMGD .EQ. 3)GO TO 300
        IF(IDMGD .EQ. 2)GO TO 299
        IF(IDMGD .EQ. 0)GO TO 500
C** DETERMINE DAMAGE BY A RANDOM NUMBER
        HURT = RANDOM(IRAND)
        IHURT = HURT*7.0 + 1.0
        IF(IHURT .GT. 6)GO TO 152
        ADMGED = RANDOM(IRAND)*200. + 1.0
        ADMGED = AMAX1(100.0,ADMGED)
        IRPARS(IHURT,1) = ADMGED
C** SET TIME WHEN REPAIRS WILL BE CONPLETE
        IRPARS(IHURT,2) = SECNDS(TSTRT) + ADMGED
 152     CALL ADVICE(4)
        GO TO 999
C**  DAMAGES
C** IHURT = 1  COMPUTER DAMAGE
C**         2  PHASER DAMAGE
C**         3  TORPEDO TUBES DAMAGED
C**         4  S.R. SENSORS
C**         5  L.R. SENSORS
C**         6  WARP ENGINES
 500    ITMEX = SECNDS(TSTRT) + 10.0
        IRATE = 0
 199    DO 100 I=1,6
        IF(IRPARS(I,1) .EQ. 0)GO TO 100
        IF(IRPARS(I,2) .LE. ITMEX)GO TO 75
C**  REDUCE DAMAGE VALUE
       IRPARS(I,1) = IRPARS(I,2) - SECNDS(TSTRT)
       IF(IRPARS(I,1) .LE. 0)GO TO 75
       IRATE = 1
       GO TO 100
C** REPAIRS HAVE BEEN COMPLETED
 75    IRPARS(I,1) = 0
       IRPARS(I,2) = 0
 100   CONTINUE
       GO TO 999
C** BUY REPAIRS
C**
 299   TYPE *,' '
       TYPE *,' ITEMS THAT CAN BE REPAIRED'
       TYPE *,'   1 = COMPUTER'
       TYPE *,'   2 = PHASERS'
       TYPE *,'   3 = TORPEDO TUBES'
       TYPE *,'   4 = S.R. SENSORS'
       TYPE *,'   5 = L.R. SENSORS'
       TYPE *,'   6 = WARP ENGINES'
       TYPE 2001
 2001  FORMAT(' INPUT ITEM NO. TO REPAIR> ',$)
       ACCEPT *,ITEM
       TYPE 2002,IRPARS(ITEM,1)
 2002  FORMAT(' UNITS NEEDED TO COMPLETE REPAIRS =',I5)
       TYPE 2003
 2003  FORMAT(' INPUT UNITS TO ALLOCATE TO REPAIRS>',$)
       ACCEPT *,VALUE
       IRPARS(ITEM,1) = IRPARS(ITEM,1) - VALUE
       IRPARS(ITEM,2) = IRPARS(ITEM,2) - VALUE
       GTIME = GTIME - VALUE*0.5
       GO TO 998
C**
C** ADVANCED GAME DAMAGES
C**
 300   IF(COND(1) .EQ. 'DOCK')GO TO 998
       IDO = RANDOM(IRAND)*10.0 + 1.0
       IF(IDO .LT. 6 .OR. IDO .GT. 7)GO TO 999
       IF(IDO .EQ. 7)GO TO 350
       TYPE *,' *** SHORT RANGE SENSORS DAMAGED BY ***'
       TYPE *,' ***         METEOR SHOWER          ***'
       IRPARS(4,1) = 60.0
       IRPARS(4,2) = SECNDS(TSTRT) + 60.
       GO TO 998
 350   TYPE *,' *** LONG RANGE SENSORS REPORTED NOT FUNCTIONING ***'
       TYPE *,' ***        BECAUSE OF GALACTIC STORM            ***'
       IRPARS(5,1) = 60.
       IRPARS(5,2) = SECNDS(TSTRT) + 60.
 998   IDMGD = 0
 999   RETURN
       END