SUBROUTINE DOCK 1100 character*4 isave c include 'tcommon.for' %include tcommon.for C ...DOCKING PROCEDURE. 1127 write(*,2901) 1128 2901 FORMAT(' DOCKED!!'/' TEMPORARY MAINTENANCE CREW BOARDED') 1129 C ...REENFORCEMENTS?. 1130 write(*,2902)IBMENR 1131 2902 FORMAT(1X,I4,' TROOP REINFORCEMENTS') 1132 IF(MEN.EQ.NMEN)GO TO 2910 1133 MCREW=0 1134 IF(RAN(IZZ).GT.PRREEN)GO TO 2905 1135 IF(MAXRQ.EQ.1)GO TO 2905 1136 RMEN=MEN 1137 REUP=SBMNR*((400.-RMEN)/400.) 1138 REINF=AMAX1(REEN,REUP) 1139 MCREW=RAN(IZZ)*REINF+1. 1140 IF(MEN+MCREW.GT.NMEN)MCREW=NMEN-MEN 1141 2905 MEN=MEN+MCREW 1142 write(*,2903)MCREW 1143 2903 FORMAT(1X,I4,' CREW REPLACEMENTS') 1144 2910 ITRMEN(1)=ITRMEN(1)+IBMENR 1145 IBMENR=0 1146 C ...REFUEL AND DROP DEFLECTORS 1147 2915 ENERGY=ENERGY+DEFL 1148 MAXRQ=1 1149 ENERGY=AMAX1(ENERGY,SENRGY) 1150 ITORP=MAX0(ITORP,NTRP) 1151 DEFL=0. 1152 C ...SHUTTLECRAFT REPLACEMENT? 1153 IF(ISHNUM.EQ.2)GO TO 2925 1154 IF(RAN(IZZ).GT.PRXSH)GO TO 2925 1155 ISHNUM=ISHNUM+1 1156 write(*,2921) 1157 2921 FORMAT(' SHUTTLECRAFT REPLACED') 1158 C ...REPAIRS ALL DAMAGE QUICKLY. 1159 2925 JJ=0 1160 TOTAL=0. 1161 30091 FORMAT(' DAMAGE REPORT') 1162 DO 2940 J=1,10 1163 IPROB1(J)=0 1164 IF(IDMG(J).EQ.0)GO TO 2940 1165 SDAYS=IDMG(J)/100./ERPRRT 1166 IF(JJ.EQ.0)CALL BPAGE 1167 IF(JJ.EQ.0)write(*,30091) 1168 JJ=1 1169 write(*,30093)J,NAMD(J),SDAYS 1170 30093 FORMAT(1X,I2,1X,A8,2X,'-',F5.2,' STARDAYS') 1171 2940 CONTINUE 1172 IF(JJ.EQ.0)GO TO 2941 1173 3009 write(*,77701) 1174 77701 FORMAT(' WHICH ITEMS TO REPAIR? ') 1175 read(*,*,ERR=3000,END=4000)IPROB1 1176 IF(IPROB1(1).EQ.XHELP)GO TO 3000 1177 JJ=0 1178 2941 DO 2942 J=1,10 1179 IF(IPROB1(J).LE.0)GO TO 2942 1180 IF(IPROB1(J).GT.10)GO TO 2942 1181 IF(IDMG(IPROB1(J)).EQ.0)GO TO 2942 1182 TOTAL=TOTAL+IDMG(IPROB1(J))/100. 1183 IDMG(IPROB1(J))=0 1184 JJ=1 1185 2942 IPROB1(J)=10 1186 IF(JJ.EQ.0)GO TO 2950 1187 TOTAL=TOTAL/ ((TFACTR*ERPRRT)**(1.+RAN(IZZ))) 1188 NHOLD=NHOLD+TOTAL*100*ITFCTR 1189 XTIME=XTIME-TOTAL 1190 ICLOAK=ICLOAK+TOTAL*100 1191 write(*,2945) TOTAL 1192 2945 FORMAT(' ALL DAMAGE REPAIRED IN ',F5.2,' STARDAYS') 1193 2950 PSP=0. 1194 write(*,3010) 1195 3010 FORMAT(' DAMAGE CONTROL PRIORITIES RESET TO ALL 10''S') 1196 IF(DDEG.LT.0.)DDEG=DDEG+360. 1197 PDEG=DDEG 1198 DSP=0. 1199 C ...CHECK TO SEE IF OK TO SAVE GAME 1200 JJ=0 1201 DO 52000 J=1,10 1202 IF(IDMG(J).EQ.0)GO TO 52000 1203 JJ=1 1204 52000 CONTINUE 1205 IF(NRW.EQ.1.AND.JJ.EQ.0.AND.KLNGNS.EQ.0.AND.NROM.EQ.0.AND. 1206 1 ISTSH.EQ.0)GO TO 52004 1207 GO TO 52001 1208 52004 write(*,52002) 1209 52002 FORMAT(' WOULD YOU LIKE TO SAVE THE GAME (Y OR N)?') 1210 read(*,52003)ISAVE 1211 52003 FORMAT(A1) 1212 IF(ISAVE.NE.IYES)GO TO 52001 1213 CALL RSTART(2) 1214 C ...SET IDOCK TO INDICATE DOCKING MANEUVERS COMPLETED 1215 52001 IDOCK=2 1216 2000 RETURN 1217 3000 CALL HELP(37) 1218 GO TO 3009 1219 4000 STOP 1220 END 1221  2182 DIST=ABS(VPY)**POWER 2183