      SUBROUTINE REPAIR                                                 3684

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

	character*8 deflec
      DATA TRKL,TRRM/1.7,2.1/                                           3716

c
c	n.b. idtk may be a local variable with a name corresponding
c	to a common block variable - be prepared to change it!

      ITDK=0
C     ...DAMAGE REPAIR SECTION                                          3718
      data DEFLEC/'DFLECTRS'/
2800  FACTR=1.                                                          3719
      IF(ITRUCE.EQ.1)FACTR=TFACTR                                       3720
      IF(PSP.GE.1.)GO TO 2840                                           3721
C     ...KLINGON REPAIR.                                                3722
      IF(KLNGNS.EQ.0)GO TO 2820                                         3723
      DO 2810    J=1,KLNGNS                                             3724
      IF(XKL(J,1).EQ.0.)GO TO 2810                                      3725
      IF(ICNTL(J+1).EQ.1)GO TO 2805                                     3726
      XKL(J,7)=XKL(J,7)-RPRKL*FACTR *XKL(J,9)/CREWK                     3727
      GO TO 2806                                                        3728
C     ...SLOWER IF UNDER E CONTROL.                                     3729
2805  XKL(J,7)=XKL(J,7)-RPRKL*FACTR*ITRMEN(J+1)/CREWK/TRKL              3730
2806  IF(XKL(J,7).LT.0.)XKL(J,7)=0.                                     3731
2810  CONTINUE                                                          3732
2820  IF(NROM.EQ.0)GO TO 2840                                           3733
C     ...ROMULAN REPAIR.                                                3734
      DO 2830    J=1,NROM                                               3735
      IF(XROM(J,1).EQ.0.)GO TO 2830                                     3736
      IF(ICNTL(J+10).EQ.1)GO TO 2835                                    3737
      XROM(J,3)=XROM(J,3)-RPRRM*FACTR   *CREWR(J)/SCREWR                3738
      GO TO 2836                                                        3739
C     ...SLOWER IF UNDER E CONTROL.                                     3740
2835  XROM(J,3)=XROM(J,3)-RPRRM*FACTR*ITRMEN(J+10)/SCREWR/TRRM          3741
2836  IF(XROM(J,3).LT.0.)XROM(J,3)=0.                                   3742
2830  CONTINUE                                                          3743
C     ...E DAMAGE REPAIR BY CREW.                                       3744
2840  XTRP=0.                                                           3745
      JTRP=0                                                            3746
      DO 2850 J=1,10                                                    3747
      IF(IDMG(J).EQ.0)GO TO 2850                                        3748
      XTRP=XTRP+IPROB1(J)                                               3749
      JTRP=JTRP+1                                                       3750
2850  CONTINUE                                                          3751
      IF(JTRP.EQ.0)GO TO 2860                                           3752
      XTRP=(100.-XTRP)/JTRP                                             3753
      DO 2855 K=1,10                                                    3754
      IF(IDMG(K).EQ.0)GO TO 2855                                        3755
      IF(RAN(IZZ).GT.FLOAT(MEN)/FLOAT(NMEN)*(IPROB1(K)+XTRP)/100.)      3756
     1  GO TO 28                                                        3757
     155                                                                3758
      IDMG(K)=IDMG(K)-FACTR*ERPRRT                                      3759
      IF(IDMG(K).GT.0)GO TO 2855                                        3760
      IDMG(K)=0                                                         3761
      IF(K.EQ.1)IHWARP=0                                                3762
      write(*,2856)NAMD(K)                                              3763
2856  FORMAT(1X,A10,' REPAIRED!')                                       3764
2855  CONTINUE                                                          3765
C     ...G DAMAGE REPAIR BY E TROOPS.                                   3766
2860  IF(IGH.EQ.0.OR.ICNTL(20).NE.1)GO TO 2900                          3767
      FIXR=FLOAT(ITRMEN(20))/FLOAT(MXCRGH)*TFACTR                       3768
      GHOST(3)=GHOST(3)-RPRGH*FACTR*FIXR                                3769
      IF(GHOST(3).LT.0.)GHOST(3)=0.                                     3770
      IF(IGHPH.EQ.1)GO TO 2881                                          3771
      IF(RAN(IZZ).GT.FIXR*PPHASD*PPHASD)GO TO 2881                      3772
      write(*,2885)LETR(5),NAMD(3)                                      3773
2885  FORMAT(1X,A1,1X,A10,' REPAIRED')                                  3774
      IGHPH=1                                                           3775
      GO TO 2900                                                        3776
2881  IF(RAN(IZZ).GT.FIXR*PTORPD*PTORPD)GO TO 2882                      3777
      IF(IGHTR.EQ.1)GO TO 2882                                          3778
      write(*,2885)LETR(5),NAMD(4)                                      3779
      IGHTR=1                                                           3780
      GO TO 2900                                                        3781
2882  IF(RAN(IZZ).GT.FIXR*PDRVD*PDRVD)GO TO 2883                        3782
      IF(IGHDR.EQ.1)GO TO 2883                                          3783
      write(*,2885)LETR(5),NAMD(2)                                      3784
      IGHDR=1                                                           3785
      GO TO 2900                                                        3786
2883  IF(RAN(IZZ).GT.FIXR*PDEFD*PDEFD)GO TO 2900                        3787
      IF(IGHDE.EQ.1)GO TO 2900                                          3788
      write(*,2885)LETR(5),DEFLEC                                       3789
      IGHDE=1                                                           3790
C     ...DISEASE ACTIVE AREA.                                           3791
2900  IF(IDSES.EQ.0)GO TO 2929                                          3792
45    KLED=MULTK1*VDSES*RAN(IZZ)*FLOAT(MEN+ITRMEN(1))/FLOAT(NMEN+IFGHTM)3793
      KKLED=RAN(IZZ)*KLED                                               3794
      LKLED=MIN0(KLED-KKLED,MEN)                                        3795
      KKLED=MIN0(KLED-LKLED,ITRMEN(1))                                  3796
      KLED=LKLED+KKLED                                                  3797
      MEN=MEN-LKLED                                                     3798
      ITRMEN(1)=ITRMEN(1)-KKLED                                         3799
      IF(ITRMEN(1).LT.0)ITRMEN(1)=0                                     3800
      IF(KLED.EQ.0)GO TO 55                                             3801
      write(*,2901)                                                     3802
2901  FORMAT(' DISEASE LOSSES -')                                       3803
      IF(MEN.GT.6)GO TO 50                                              3804
      CALL RATING(5)                                                    3805
50    write(*,2)KLED,MEN, ITRMEN(1)                                     3806
      ITDK=ITDK+KLED                                                    3807
2     FORMAT(' MEN KILLED: ',I4,' CREW LEFT: ',I4,' TROOPS LEFT: ',I4)  3808
55    IF(RAN(IZZ).GT.VSTRDS)GO TO 2929                                  3809
      IDSES=0                                                           3810
      write(*,2802)ITDK                                                 3811
2802  FORMAT(' DISEASE CURE FOUND AFTER ',I3,' FATALITIES ')            3812
      ITDK=0                                                            3813
C     ...ALIEN BEINGS DRAINING E ENERGY BANKS.                          3814
2929  IF(IALSS.EQ.0)GO TO 3000                                          3815
      IF(IALIC.NE.ICE.OR.IALJC.NE.JCE)GO TO 2950                        3816
      IF(NSTARS.EQ.0.OR.STARS(IALSS,1).EQ.0.)GO TO 2950                 3817
      ENERGY=ENERGY-ALEDR                                               3818
      IF(ENERGY.LE.0.)CALL RATING(2)                                    3819
      GO TO 3000                                                        3820
2950  IALSS=0                                                           3821
C     ...USING UP CLOAKING DEVICE FREE TIME.                            3822
3000  IF(ICLOAK.GE.0)GO TO 3100                                         3823
      ICLOAK=ICLOAK+1                                                   3824
3100  RETURN                                                            3825
      END                                                               3826
  ' cutbacks for the space academy and elim4830
     1