home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / DOCK.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  7.4 KB  |  103 lines
  1.  
  2.       SUBROUTINE DOCK                                                   1100
  3.     character*4 isave
  4.  
  5. c    include 'tcommon.for'
  6.     %include tcommon.for
  7.  
  8. C     ...DOCKING PROCEDURE.                                             1127
  9.       write(*,2901)                                                     1128
  10. 2901  FORMAT(' DOCKED!!'/' TEMPORARY MAINTENANCE CREW BOARDED')         1129
  11. C     ...REENFORCEMENTS?.                                               1130
  12.       write(*,2902)IBMENR                                               1131
  13. 2902  FORMAT(1X,I4,' TROOP REINFORCEMENTS')                             1132
  14.       IF(MEN.EQ.NMEN)GO TO 2910                                         1133
  15.       MCREW=0                                                           1134
  16.       IF(RAN(IZZ).GT.PRREEN)GO TO 2905                                  1135
  17.       IF(MAXRQ.EQ.1)GO TO 2905                                          1136
  18.       RMEN=MEN                                                          1137
  19.       REUP=SBMNR*((400.-RMEN)/400.)                                     1138
  20.       REINF=AMAX1(REEN,REUP)                                            1139
  21.       MCREW=RAN(IZZ)*REINF+1.                                           1140
  22.       IF(MEN+MCREW.GT.NMEN)MCREW=NMEN-MEN                               1141
  23. 2905  MEN=MEN+MCREW                                                     1142
  24.       write(*,2903)MCREW                                                1143
  25. 2903  FORMAT(1X,I4,' CREW REPLACEMENTS')                                1144
  26. 2910  ITRMEN(1)=ITRMEN(1)+IBMENR                                        1145
  27.       IBMENR=0                                                          1146
  28. C     ...REFUEL AND DROP DEFLECTORS                                     1147
  29. 2915  ENERGY=ENERGY+DEFL                                                1148
  30.       MAXRQ=1                                                           1149
  31.       ENERGY=AMAX1(ENERGY,SENRGY)                                       1150
  32.       ITORP=MAX0(ITORP,NTRP)                                            1151
  33.       DEFL=0.                                                           1152
  34. C     ...SHUTTLECRAFT REPLACEMENT?                                      1153
  35.       IF(ISHNUM.EQ.2)GO TO 2925                                         1154
  36.       IF(RAN(IZZ).GT.PRXSH)GO TO 2925                                   1155
  37.       ISHNUM=ISHNUM+1                                                   1156
  38.       write(*,2921)                                                     1157
  39. 2921  FORMAT(' SHUTTLECRAFT REPLACED')                                  1158
  40. C     ...REPAIRS ALL DAMAGE QUICKLY.                                    1159
  41. 2925  JJ=0                                                              1160
  42.       TOTAL=0.                                                          1161
  43. 30091 FORMAT(' DAMAGE REPORT')                                          1162
  44.       DO 2940 J=1,10                                                    1163
  45.       IPROB1(J)=0                                                       1164
  46.       IF(IDMG(J).EQ.0)GO TO 2940                                        1165
  47.       SDAYS=IDMG(J)/100./ERPRRT                                         1166
  48.       IF(JJ.EQ.0)CALL BPAGE                                             1167
  49.       IF(JJ.EQ.0)write(*,30091)                                         1168
  50.       JJ=1                                                              1169
  51.       write(*,30093)J,NAMD(J),SDAYS                                     1170
  52. 30093 FORMAT(1X,I2,1X,A8,2X,'-',F5.2,' STARDAYS')                       1171
  53. 2940  CONTINUE                                                          1172
  54.       IF(JJ.EQ.0)GO TO 2941                                             1173
  55. 3009  write(*,77701)                                                    1174
  56. 77701 FORMAT(' WHICH ITEMS TO REPAIR? ')                                1175
  57.       read(*,*,ERR=3000,END=4000)IPROB1                                 1176
  58.       IF(IPROB1(1).EQ.XHELP)GO TO 3000                                  1177
  59.       JJ=0                                                              1178
  60. 2941  DO 2942 J=1,10                                                    1179
  61.       IF(IPROB1(J).LE.0)GO TO 2942                                      1180
  62.       IF(IPROB1(J).GT.10)GO TO 2942                                     1181
  63.       IF(IDMG(IPROB1(J)).EQ.0)GO TO 2942                                1182
  64.       TOTAL=TOTAL+IDMG(IPROB1(J))/100.                                  1183
  65.       IDMG(IPROB1(J))=0                                                 1184
  66.       JJ=1                                                              1185
  67. 2942  IPROB1(J)=10                                                      1186
  68.       IF(JJ.EQ.0)GO TO 2950                                             1187
  69.       TOTAL=TOTAL/ ((TFACTR*ERPRRT)**(1.+RAN(IZZ)))                     1188
  70.       NHOLD=NHOLD+TOTAL*100*ITFCTR                                      1189
  71.       XTIME=XTIME-TOTAL                                                 1190
  72.       ICLOAK=ICLOAK+TOTAL*100                                           1191
  73.       write(*,2945) TOTAL                                               1192
  74. 2945  FORMAT(' ALL DAMAGE REPAIRED IN ',F5.2,' STARDAYS')               1193
  75. 2950  PSP=0.                                                            1194
  76.       write(*,3010)                                                     1195
  77. 3010  FORMAT(' DAMAGE CONTROL PRIORITIES RESET TO ALL 10''S')           1196
  78.       IF(DDEG.LT.0.)DDEG=DDEG+360.                                      1197
  79.       PDEG=DDEG                                                         1198
  80.       DSP=0.                                                            1199
  81. C     ...CHECK TO SEE IF OK TO SAVE GAME                                1200
  82.       JJ=0                                                              1201
  83.       DO 52000 J=1,10                                                   1202
  84.       IF(IDMG(J).EQ.0)GO TO 52000                                       1203
  85.       JJ=1                                                              1204
  86. 52000 CONTINUE                                                          1205
  87.       IF(NRW.EQ.1.AND.JJ.EQ.0.AND.KLNGNS.EQ.0.AND.NROM.EQ.0.AND.        1206
  88.      1  ISTSH.EQ.0)GO TO 52004                                          1207
  89.       GO TO 52001                                                       1208
  90. 52004 write(*,52002)                                                    1209
  91. 52002 FORMAT(' WOULD YOU LIKE TO SAVE THE GAME (Y OR N)?')              1210
  92.       read(*,52003)ISAVE                                                1211
  93. 52003 FORMAT(A1)                                                        1212
  94.       IF(ISAVE.NE.IYES)GO TO 52001                                      1213
  95.       CALL RSTART(2)                                                    1214
  96. C     ...SET IDOCK TO INDICATE DOCKING MANEUVERS COMPLETED              1215
  97. 52001 IDOCK=2                                                           1216
  98. 2000  RETURN                                                            1217
  99. 3000  CALL HELP(37)                                                     1218
  100.       GO TO 3009                                                        1219
  101. 4000  STOP                                                              1220
  102.       END                                                               1221
  103.