home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / c / civil-ab.zip / MNDOTHYD.ZIP / IRRCHANL.BAS < prev    next >
BASIC Source File  |  1984-12-04  |  17KB  |  515 lines
  1. 10    REM  WRITTEN BY JOE LINN , MODIFIED 10/27/80 , TRANSFERED TO IBM PC 7/84
  2. 20    REM  HYDRAULICS BY WALLY MARUSENKO    ROOM 718 C.O.
  3. 30   DIM XX(21),YX(21),NX(21)
  4. 40   DIM KX(20),AX(20),RX(20,20),GX(3,3),HX(3,1),IX(3,1),CX(3,23),EX(2,6)
  5. 50   DIM BX(20,20),PX(9)
  6. 60   DIM A,A0,A1,A2,A3,A4,A7,A8,A9,B,B0,B1,B2,B3,B4,B7,B9,C,C3,C9
  7. 70   DIM D,D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,E,E0,E1,E2,ET,F,FO$,G,H,H0,H1,H2,H9
  8. 80   DIM I,I1,J,K,K1,L,L1,L2,M,M1,N,N1,N1$,N2$,O9,P0,P8,Q,Q0,Q1,Q7,Q8,Q9
  9. 90   DIM R,S,S1,S2,S3,S4,S5,S6,S7,S9,T,V,V0,V1,V2,V3,V4,V9,X1,X2,X3,X4
  10. 100  DIM X8,X9,Y2,Y7,Y8,Y9,Z,Z0
  11. 110   FORMAT1$="POINT NO## ###### ###### ###### ###### ###### ###### ###### ###### ###### ######"
  12. 120  FORMAT2$="X:  #####- #####- #####- #####- #####- #####- #####- #####- #####- #####- #####-"
  13. 130  FORMAT3$="X:         #####- #####- #####- #####- #####- #####- #####- #####- ####- #####-"
  14. 140  FORMAT4$="Y:  ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.#"
  15. 150  FORMAT5$="Y:         ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.# ####.#"
  16. 160  FORMAT6$="N:  0.0000 #.#### #.#### #.#### #.#### #.#### #.#### #.#### #.#### #.#### #.####"
  17. 170  FORMAT7$="N:         #.#### #.#### #.#### #.#### #.#### #.#### #.#### #.#### #.#### #.####"
  18. 180  FORMAT8$="POINT NO.  ###### ###### ###### ###### ###### ###### ###### ###### ###### ######"
  19. 190  FORMAT9$="######.##    ###### ##### ##### #####    ##### #### #### ####    ###.# ##.# ##.#"
  20. 200  FORMAT10$="######.##  ####.## ###.## ###.## ###.## ###.##  ######## ####### ####### #######"
  21. 210  FORMAT11$="'N' FOR MAIN CHANNEL =##.####"
  22. 220  FORMAT12$="SLOPE =##.######"
  23. 230  FORMAT13$="MINIMUM LEFT X VALUE  =#####     SLOPE =####:1"
  24. 240  FORMAT14$="MAXIMUM RIGHT X VALUE =#####     SLOPE =####:1"
  25. 250  C1LEAR$=CHR$(12):FORMFEED$=CHR$(12)
  26. 260 WIDTH "lpt1:",120
  27. 270  PI=3.14159
  28. 275  OPEN "O",#3,"LPT1:"
  29. 280  DEF FNCOMM(ARG)=65535!-ARG
  30. 290  REM CLOSE #3:INPUT "DO YOU WANT PRINTOUT ON   (SCREEN=0  PRINTER=1)  ",Q9:IF Q9<>0 AND Q9<>1 THEN 170
  31. 295 REM NA$="scrn:":IF Q9=1 THEN NA$="lpt1:":OPEN "O",#3,NA$:ELSE OPEN "O",#3,NA$
  32. 300  FO$="  ======================================"
  33. 310  FO$=FO$  +  "======================================"
  34. 320  PRINT C1LEAR$
  35. 330  ON ERROR GOTO 55000
  36. 340  PRINT #3," "
  37. 350  PRINT #3,FORMFEED$
  38. 360  PRINT #3," " 
  39. 370  PRINT #3," " 
  40. 380  O9=0
  41. 390  PRINT #3,FO$
  42. 400  PRINT #3,TAB(10);"# # # # # #  IRREGULAR CHANNEL, STAGE-DISCHARGE  # # # # # #"
  43. 410  PRINT #3,FO$
  44. 420  PRINT #3," " 
  45. 430  PRINT #3,"          RUN  DATE  ";DATE$
  46. 440  PRINT #3," "
  47. 450  PRINT C1LEAR$
  48. 460  PRINT "IRREGULAR CHANNEL, STAGE DISCHARGE PROGRAM"
  49. 470  PRINT
  50. 500  PRINT
  51. 510  PRINT "IS X-SECTION ON DISK 0=YES 1=NO";
  52. 520  INPUT Q9
  53. 530  IF Q9=1 THEN 630
  54. 540  PRINT
  55. 550 N4$=" X-SECTION TO BE LOADED FROM DISK " : GOSUB 50010
  56. 560  OPEN "I",#1,N2$
  57. 570  FOR I=1 TO 21
  58. 580  INPUT #1,XX(I),YX(I),NX(I)
  59. 590  NEXT I
  60. 600  CLOSE #1
  61. 610  F=NX(1)
  62. 620  GOTO 740
  63. 630  PRINT "ENTER NO. OF PTS. ON X-SECTION";
  64. 640  INPUT F
  65. 650  FOR I=1 TO 21
  66. 660  XX(I)=0
  67. 670  YX(I)=0
  68. 680  NX(I)=0
  69. 690  NEXT I
  70. 700  FOR A=1 TO F
  71. 710  PRINT "ENTER NO.";A;"X,Y,'N'";
  72. 720  INPUT XX(A),YX(A),NX(A)
  73. 730  NEXT A
  74. 740  C9=0
  75. 750  S9=0
  76. 760  PRINT #3,USING FORMAT1$;1,2,3,4,5,6,7,8,9,10,11
  77. 761  PRINT USING FORMAT1$;1,2,3,4,5,6,7,8,9,10,11
  78. 770  PRINT #3,USING FORMAT2$;XX(1),XX(2),XX(3),XX(4),XX(5),XX(6),XX(7),XX(8),XX(9),XX(10),XX(11)
  79. 771  PRINT USING FORMAT2$;XX(1),XX(2),XX(3),XX(4),XX(5),XX(6),XX(7),XX(8),XX(9),XX(10),XX(11)
  80. 780  PRINT #3,USING FORMAT4$;YX(1),YX(2),YX(3),YX(4),YX(5),YX(6),YX(7),YX(8),YX(9),YX(10),YX(11)
  81. 781  PRINT USING FORMAT4$;YX(1),YX(2),YX(3),YX(4),YX(5),YX(6),YX(7),YX(8),YX(9),YX(10),YX(11)
  82. 790 PRINT #3,USING FORMAT6$;NX(2),NX(3),NX(4),NX(5),NX(6),NX(7),NX(8),NX(9),NX(10),NX(11)
  83. 791 PRINT USING FORMAT6$;NX(2),NX(3),NX(4),NX(5),NX(6),NX(7),NX(8),NX(9),NX(10),NX(11)
  84. 800 IF F<12 THEN 860
  85. 810 PRINT #3," " 
  86. 811 PRINT " "
  87. 820 PRINT #3,USING FORMAT8$;12,13,14,15,16,17,18,19,20,21
  88. 821 PRINT USING FORMAT8$;12,13,14,15,16,17,18,19,20,21
  89. 830 PRINT #3,USING FORMAT3$;XX(12),XX(13),XX(14),XX(15),XX(16),XX(17),XX(18),XX(19),XX(20),XX(21)
  90. 831 PRINT USING FORMAT3$;XX(12),XX(13),XX(14),XX(15),XX(16),XX(17),XX(18),XX(19),XX(20),XX(21)
  91. 840 PRINT #3,USING FORMAT5$;YX(12),YX(13),YX(14),YX(15),YX(16),YX(17),YX(18),YX(19),YX(20),YX(21)
  92. 841 PRINT USING FORMAT5$;YX(12),YX(13),YX(14),YX(15),YX(16),YX(17),YX(18),YX(19),YX(20),YX(21)
  93. 850 PRINT #3,USING FORMAT7$;NX(12),NX(13),NX(14),NX(15),NX(16),NX(17),NX(18),NX(19),NX(20),NX(21)
  94. 851 PRINT USING FORMAT7$;NX(12),NX(13),NX(14),NX(15),NX(16),NX(17),NX(18),NX(19),NX(20),NX(21)
  95. 860 FO$="  --------------------------------------"
  96. 870 FO$=FO$  +  "--------------------------------------"
  97. 880 PRINT #3," "
  98. 890 PRINT #3,FO$
  99. 900 PRINT #3," "
  100. 910 IF O9=3 THEN 3230
  101. 920 IF C9=0 THEN 950
  102. 930 C9=0
  103. 940 GOTO 2300
  104. 950 PRINT "IS DATA CORRECT? YES=0, NO=1";
  105. 960 INPUT Q9
  106. 970 IF Q9=0 THEN 1040
  107. 980 PRINT "ENTER NO. OF THE POINT IN ERROR";
  108. 990 INPUT L
  109. 1000 IF L>F THEN 980
  110. 1010 PRINT "ENTER NO.";L;"X, Y, 'N'";
  111. 1020 INPUT XX(L),YX(L),NX(L)
  112. 1030 GOTO 760
  113. 1040 D0=YX(1)
  114. 1050 PRINT C1LEAR$
  115. 1060 FOR A=1 TO F-1
  116. 1070 IF YX(A)>D0 THEN 1090
  117. 1080 D0=YX(A)
  118. 1090 NEXT A
  119. 1100 Q8=1
  120. 1110 PRINT #3," " 
  121. 1120 PRINT "ENTER MAIN CHANNEL 'N'";
  122. 1130 INPUT N1
  123. 1140 PRINT #3,USING FORMAT11$;N1
  124. 1150 PRINT #3," "
  125. 1160 PRINT "ENTER INITIAL STAGE ELEVATION";
  126. 1170 INPUT D1
  127. 1180 IF D1>D0 THEN 1210
  128. 1190 PRINT "ELEV. MUST BE > X-SECTION LOW PT"
  129. 1200 GOTO 1160
  130. 1210 PRINT "ENTER FINAL STAGE ELEVATION";
  131. 1220 INPUT D2
  132. 1230 IF D2>D0 THEN 1260
  133. 1240 PRINT "ELEV. MUST BE > X-SECTION LOW PT"
  134. 1250 GOTO 1210
  135. 1260 PRINT "ENTER ELEVATION INCREMENT";
  136. 1270 INPUT D3
  137. 1280 V9=0
  138. 1290 IF D2>D1 THEN 1330
  139. 1300 T=D1
  140. 1310 D1=D2
  141. 1320 D2=T
  142. 1330 B1=(D2-D1)/D3+1
  143. 1340 IF B1<21 THEN 1370
  144. 1350 PRINT "NO. OF OUTPUT STAGES EXCEEDED"
  145. 1360 GOTO 1110
  146. 1370 FOR I=1 TO 20
  147. 1380 FOR J=1 TO 20
  148. 1390 BX(I,J)=0
  149. 1400 NEXT J
  150. 1410 NEXT I
  151. 1420 GOTO 1570
  152. 1430 A0=0
  153. 1440 P0=0
  154. 1450 IF Y8 >= D4 AND Y9 >= D4 THEN 1560
  155. 1460 P0=((X9-X8)^2+(Y9-Y8)^2)^.5
  156. 1470 IF Y8 >= D4 THEN 1510
  157. 1480 IF Y9 >= D4 THEN 1540
  158. 1490 A0=(2*D4-Y8-Y9)/2*(X9-X8)
  159. 1500 GOTO 1560
  160. 1510 A0=(D4-Y9)^2*(X9-X8)/2/(Y8-Y9)
  161. 1520 P0=P0/(Y8-Y9)*(D4-Y9)
  162. 1530 GOTO 1560
  163. 1540 A0=(D4-Y8)^2*(X9-X8)/2/(Y9-Y8)
  164. 1550 P0=P0*(D4-Y8)/(Y9-Y8)
  165. 1560 RETURN
  166. 1570 FO$="  =STAGE=      =====AREA (SQ FT)=====      =WETTED PER (FT)=="
  167. 1580 FO$=FO$  +  "      ===HYD RAD==="
  168. 1590 PRINT #3,FO$
  169. 1591 PRINT FO$
  170. 1600 FO$="     FEET      LEFT  MAIN RIGHT TOTAL       LT MAIN   RT  TOT"
  171. 1610 FO$=FO$  +  "       LT MAIN   RT"
  172. 1620 PRINT #3,FO$
  173. 1621 PRINT FO$
  174. 1630 D4=D1
  175. 1640 FOR I=1 TO 20
  176. 1650 FOR J=1 TO 20
  177. 1660 RX(I,J)=0
  178. 1670 NEXT J
  179. 1680 NEXT I
  180. 1690 FOR C=1 TO B1
  181. 1700 Z=1
  182. 1710 FOR I=1 TO 9
  183. 1720 PX(I)=0
  184. 1730 NEXT I
  185. 1740 IF D4 <= YX(1) AND D4 <= YX(F) THEN 1790
  186. 1750 IF V9=1 THEN 1790
  187. 1760 PRINT #3,"ELEVATION EXCEEDS WATERWAY CONFINEMENT. ";
  188. 1761 PRINT "ELEVATION EXCEEDS WATERWAY CONFINEMENT. ";
  189. 1770 PRINT #3,"SIDES HAVE BEEN EXTENDED VERTICALLY."
  190. 1771 PRINT "SIDES HAVE BEEN EXTENDED VERTICALLY."
  191. 1780 V9=1
  192. 1790 Q7=0
  193. 1800 B7=0
  194. 1810 A9=0
  195. 1820 B9=0
  196. 1830 FOR A=1 TO F-1
  197. 1840 IF Z<>2 OR ABS(NX(A+1)-N1)<.0001 THEN 1870
  198. 1850 Z=3
  199. 1860 GOTO 1890
  200. 1870 IF ABS(NX(A+1)-N1)>.0001 THEN 1890
  201. 1880 Z=2
  202. 1890 A8=0
  203. 1900 P8=0
  204. 1910 X8=XX(A)
  205. 1920 X9=XX(A+1)
  206. 1930 Y8=YX(A)
  207. 1940 Y9=YX(A+1)
  208. 1950 GOSUB 1430
  209. 1960 A8=A8+A0
  210. 1970 PX(Z)=PX(Z)+A0
  211. 1980 IF A8=0 THEN 2120
  212. 1990 P8=P8+P0
  213. 2000 PX(Z+3)=PX(Z+3)+P0
  214. 2010 R=A8/P8
  215. 2020 IF A=F-1 THEN 2060
  216. 2030 IF NX(A+1)<>NX(A+2) THEN 2060
  217. 2040 A=A+1
  218. 2050 GOTO 1910
  219. 2060 BX(C,A)=A8
  220. 2070 FOR B=A TO 1 STEP -1
  221. 2080 IF RX(C,B)<>0 THEN 2120
  222. 2090 RX(C,B)=R
  223. 2100 IF NX(B)<>NX(B+1) THEN 2120
  224. 2110 NEXT B
  225. 2120 NEXT A
  226. 2130 IF PX(4)=0 THEN 2150
  227. 2140 PX(7)=PX(1)/PX(4)
  228. 2150 IF PX(5)=0 THEN 2170
  229. 2160 PX(8)=PX(2)/PX(5)
  230. 2170 IF PX(6)=0 THEN 2190
  231. 2180 PX(9)=PX(3)/PX(6)
  232. 2190 Q9=PX(4)+PX(5)+PX(6)
  233. 2200 A9=PX(1)+PX(2)+PX(3)
  234. 2210 PRINT #3,USING FORMAT9$;D4,PX(1),PX(2),PX(3),A9,PX(4),PX(5),PX(6),Q9,PX(7),PX(8),PX(9)
  235. 2211 PRINT USING FORMAT9$;D4,PX(1),PX(2),PX(3),A9,PX(4),PX(5),PX(6),Q9,PX(7),PX(8),PX(9)
  236. 2220 D4=D4+D3
  237. 2230 NEXT C
  238. 2240 PRINT #3," "
  239. 2250 IF S9=1 THEN 2300
  240. 2260 S9=1
  241. 2270 PRINT "ENTER SLOPE";
  242. 2280 INPUT S
  243. 2290 S1=S^.5
  244. 2300 PRINT #3,USING FORMAT12$;S
  245. 2301 PRINT USING FORMAT12$;S
  246. 2310 PRINT #3," "
  247. 2311 PRINT " "
  248. 2320 PRINT #3,"=STAGE=     ========VELOCITY (FT/SEC)=======      ======DISCHARGE (CFS)======="
  249. 2321 PRINT "=STAGE=     ========VELOCITY (FT/SEC)=======      ======DISCHARGE (CFS)======="
  250. 2330 FO$="     FEET     LEFT   MAIN  RIGHT    AVE   MEAN      "
  251. 2340 FO$=FO$  +  "LEFT    MAIN   RIGHT   TOTAL"
  252. 2345 PRINT #3,FO$
  253. 2346 PRINT FO$
  254. 2350 D4=D1
  255. 2360 FOR C=1 TO B1
  256. 2370 FOR I=1 TO 9
  257. 2380 PX(I)=0
  258. 2390 NEXT I
  259. 2400 Z=1
  260. 2410 Q7=0
  261. 2420 A9=0
  262. 2430 FOR A=1 TO F-1
  263. 2440 IF BX(C,A)=0 THEN 2550
  264. 2450 A9=A9+BX(C,A)
  265. 2460 IF Z<>2 OR ABS(NX(A+1)-N1)<.0001 THEN 2490
  266. 2470 Z=3
  267. 2480 GOTO 2510
  268. 2490 IF ABS(NX(A+1)-N1)>.0001 THEN 2510
  269. 2500 Z=2
  270. 2510 V=1.49*RX(C,A)^(2/3)*S^.5/NX(A+1)
  271. 2520 Q1=V*BX(C,A)
  272. 2530 PX(Z+4)=PX(Z+4)+Q1
  273. 2540 PX(Z)=PX(Z)+Q1*V
  274. 2550 NEXT A
  275. 2560 PX(4)=PX(1)+PX(2)+PX(3)
  276. 2570 PX(8)=PX(5)+PX(6)+PX(7)
  277. 2580 PX(4)=PX(4)/PX(8)
  278. 2590 IF PX(5)=0 THEN 2610
  279. 2600 PX(1)=PX(1)/PX(5)
  280. 2610 IF PX(6)=0 THEN 2630
  281. 2620 PX(2)=PX(2)/PX(6)
  282. 2630 IF PX(7)=0 THEN 2650
  283. 2640 PX(3)=PX(3)/PX(7)
  284. 2650 PRINT #3,USING FORMAT10$;D4,PX(1),PX(2),PX(3),PX(4),PX(8)/A9,PX(5),PX(6),PX(7),PX(8)
  285. 2651 PRINT USING FORMAT10$;D4,PX(1),PX(2),PX(3),PX(4),PX(8)/A9,PX(5),PX(6),PX(7),PX(8)
  286. 2660 D4=D4+D3
  287. 2670 NEXT C
  288. 2680 FO$="----------------------------------------"
  289. 2690 FO$=FO$  +  FO$
  290. 2700 PRINT #3," "
  291. 2710 PRINT #3," "
  292. 2711 PRINT " "
  293. 2720 PRINT #3,FO$
  294. 2721 PRINT FO$
  295. 2730 PRINT #3," "
  296. 2731 PRINT " "
  297. 2740 PRINT #3," "
  298. 2750 PRINT "CHANGE 'N'   0=%  1=NO  2=POINT";
  299. 2760 INPUT Q9
  300. 2770 IF Q9=1 THEN 3110
  301. 2780 IF Q9=0 THEN 2850
  302. 2790 PRINT "POINT # OR 0 (NO MORE CHANGES)";
  303. 2800 INPUT Q9
  304. 2810 IF Q9=0 THEN 760
  305. 2820 PRINT "POINT #";Q9;" N";
  306. 2830 INPUT NX(Q9)
  307. 2840 GOTO 2790
  308. 2850 C=1
  309. 2860 Z=1
  310. 2870 PRINT "% CHANGE IN LEFT 'N' (+, -, 0)";
  311. 2880 INPUT Q9
  312. 2890 GOTO 2960
  313. 2900 PRINT "% CHANGE IN MAIN 'N' (+, -, 0)";
  314. 2910 INPUT Q9
  315. 2920 GOTO 2960
  316. 2930 N1=N1*(Q9+100)/100
  317. 2940 PRINT "% CHANGE IN RIGHT 'N' (+ ,-, 0)";
  318. 2950 INPUT Q9
  319. 2960 FOR A=C TO F-1
  320. 2970 C=A
  321. 2980 IF Z<>2 OR ABS(NX(A+1)-N1)<.0001 THEN 3010
  322. 2990 Z=3
  323. 3000 GOTO 2930
  324. 3010 IF Z=2 THEN 3050
  325. 3020 IF ABS(NX(A+1)-N1)>.0001 THEN 3050
  326. 3030 Z=2
  327. 3040 GOTO 2900
  328. 3050 NX(A+1)=NX(A+1)*(Q9+100)/100
  329. 3060 NEXT A
  330. 3070 IF Z<>2 THEN 3090
  331. 3080 N1=N1*(Q9+100)/100
  332. 3090 C9=1
  333. 3100 GOTO 760
  334. 3110 PRINT "NEW SLOPE?  YES=0 NO=1";
  335. 3120 INPUT Q9
  336. 3130 IF Q9=0 THEN 2270
  337. 3140 PRINT "NEW CALC. INTERVAL?  YES=0 NO=1";
  338. 3150 INPUT Q9
  339. 3160 IF Q9=0 THEN 1160
  340. 3170 IF O9<>2 THEN 3230
  341. 3180 PRINT "LOAD X-SECT OFF DISK? 0=YES 1=NO";
  342. 3190 INPUT Q9
  343. 3200 IF Q9=1 THEN 3230
  344. 3210 O9=3
  345. 3220 GOTO 540
  346. 3230 PRINT "NARROWER OVERBANK  0=YES 1=NO";
  347. 3240 INPUT Q9
  348. 3250 IF O9<>3 THEN 3270
  349. 3260 O9=2
  350. 3270 IF Q9=1 THEN 4420
  351. 3280 IF O9<>0 THEN 3350
  352. 3290 PRINT "STORE ORIG X-SECTION 0=YES 1=NO";
  353. 3300 INPUT Q9
  354. 3310 O9=1
  355. 3320 IF Q9=1 THEN 3350
  356. 3330 O9=2
  357. 3340 GOSUB 4470
  358. 3350 PRINT "ENTER MIN. LEFT X VALUE (OR 0)";
  359. 3360 INPUT X1
  360. 3370 PRINT "ENTER LEFT OVERBANK SLOPE  X:1";
  361. 3380 INPUT X3
  362. 3390 PRINT "ENTER MAX. RIGHT X VALUE (OR 0)";
  363. 3400 INPUT X2
  364. 3410 PRINT "ENTER RIGHT OVERBANK SLOPE  X:1";
  365. 3420 INPUT X4
  366. 3430 PRINT #3," "
  367. 3440 PRINT #3,USING FORMAT13$;X1,X3
  368. 3450 PRINT #3,USING FORMAT14$;X2,X4
  369. 3460 PRINT #3," "
  370. 3470 IF X2<>0 AND X2<>XX(F) THEN 3490
  371. 3480 X2=XX(F)+100
  372. 3490 FOR I=1 TO 3
  373. 3500 FOR J=1 TO 23
  374. 3510 CX(I,J)=0
  375. 3520 NEXT J
  376. 3530 NEXT I
  377. 3540 FOR A=1 TO F-1
  378. 3550 IF XX(A)>X1 OR XX(A+1) <= X1 THEN 3600
  379. 3560 CX(1,A+1)=X1
  380. 3570 CX(2,A+1)=YX(A)+(YX(A+1)-YX(A))*(X1-XX(A))/(XX(A+1)-XX(A))
  381. 3580 CX(2,A)=YX(1)
  382. 3590 CX(1,A)=X1-(YX(1)-CX(2,A+1))*X3
  383. 3600 IF XX(A)<X1 OR XX(A)>X2 THEN 3630
  384. 3610 CX(1,A+1)=XX(A)
  385. 3620 CX(2,A+1)=YX(A)
  386. 3630 IF XX(A+1)<X2 THEN 3690
  387. 3640 CX(1,A+2)=X2
  388. 3650 CX(2,A+2)=YX(A)+(YX(A+1)-YX(A))*(X2-XX(A))/(XX(A+1)-XX(A))
  389. 3660 CX(2,A+3)=YX(F)
  390. 3670 CX(1,A+3)=X2+(YX(F)-CX(2,A+2))*X4
  391. 3680 GOTO 3720
  392. 3690 NEXT A
  393. 3700 CX(1,F+2)=XX(F)
  394. 3710 CX(2,F+2)=YX(F)
  395. 3720 F=0
  396. 3730 FOR A=1 TO 23
  397. 3740 IF CX(1,A)=0 AND CX(2,A)=0 THEN 3890
  398. 3750 IF F<>21 THEN 3860
  399. 3760 PRINT "RESULTANT X-SECTION CONTAINS MORE THAN 21 POINTS.  TRY AGAIN."
  400. 3770 PRINT  
  401. 3780 PRINT #3,"RESULTANT X-SECTION CONTAINS MORE THAN 21 POINTS.  TRY AGAIN."
  402. 3790 PRINT #3," "
  403. 3800 F=0
  404. 3810 FOR A=1 TO 21
  405. 3820 IF XX(A)=0 AND YX(A)=0 THEN 3850
  406. 3830 F=F+1
  407. 3840 NEXT A
  408. 3850 GOTO 3230
  409. 3860 F=F+1
  410. 3870 CX(1,F)=CX(1,A)
  411. 3880 CX(2,F)=CX(2,A)
  412. 3890 NEXT A
  413. 3900 FOR A=2 TO F
  414. 3910 FOR B=2 TO 21
  415. 3920 IF CX(1,A)<>XX(B) THEN 3950
  416. 3930 CX(3,A)=NX(B)
  417. 3940 GOTO 3990
  418. 3950 IF CX(1,A)>XX(B-1) AND CX(1,A)<XX(B) THEN 3930
  419. 3960 IF CX(1,A)>XX(B) AND B=21 THEN 3930
  420. 3970 IF CX(1,A)>XX(B) AND XX(B+1)<XX(B) THEN 3930
  421. 3980 NEXT B
  422. 3990 NEXT A
  423. 4000 FOR A=F+1 TO 23
  424. 4010 CX(1,A)=0
  425. 4020 CX(2,A)=0
  426. 4030 CX(3,A)=0
  427. 4040 NEXT A
  428. 4050 FOR A=21 TO 2 STEP -1
  429. 4060 IF XX(A) >= CX(1,2) OR XX(A) <= CX(1,1) THEN 4180
  430. 4070 IF NX(A)=CX(3,2) THEN 4180
  431. 4080 FOR B=F TO 2 STEP -1
  432. 4090 CX(1,B+1)=CX(1,B)
  433. 4100 CX(2,B+1)=CX(2,B)
  434. 4110 CX(3,B+1)=CX(3,B)
  435. 4120 NEXT B
  436. 4130 F=F+1
  437. 4140 IF F>21 THEN 3760
  438. 4150 CX(1,2)=XX(A)
  439. 4160 CX(2,2)=(CX(2,1)-CX(2,3))*(XX(A)-CX(1,3))/(CX(1,1)-CX(1,3))+CX(2,3)
  440. 4170 CX(3,2)=NX(A)
  441. 4180 NEXT A
  442. 4190 FOR A=2 TO 21
  443. 4200 IF XX(A) >= CX(1,F) OR XX(A) <= CX(1,F-1) THEN 4300
  444. 4210 IF NX(A)=CX(3,F) THEN 4300
  445. 4220 CX(1,F+1)=CX(1,F)
  446. 4230 CX(2,F+1)=CX(2,F)
  447. 4240 CX(3,F+1)=CX(3,F)
  448. 4250 F=F+1
  449. 4260 IF F>21 THEN 3760
  450. 4270 CX(1,F-1)=XX(A)
  451. 4280 CX(2,F-1)=(CX(2,F-2)-CX(2,F))*(XX(A)-CX(1,F))/(CX(1,F-2)-CX(1,F))+CX(2,F)
  452. 4290 CX(3,F-1)=NX(A)
  453. 4300 NEXT A
  454. 4310 FOR A=1 TO F
  455. 4320 NX(A)=CX(3,A)
  456. 4330 XX(A)=CX(1,A)
  457. 4340 YX(A)=CX(2,A)
  458. 4350 NEXT A
  459. 4360 FOR A=F+1 TO 21
  460. 4370 NX(A)=0
  461. 4380 XX(A)=0
  462. 4390 YX(A)=0
  463. 4400 NEXT A
  464. 4410 GOTO 740
  465. 4420 GOSUB 4440
  466. 4430 GOTO 4560
  467. 4440 PRINT "STORE X-SECTION  0=YES 1=NO";
  468. 4450 INPUT Q9
  469. 4460 IF Q9=1 THEN 4560
  470. 4470 NX(1)=F
  471. 4480 PRINT
  472. 4490 N4$=" X-SECTION TO BE STORED ON DISK " : GOSUB 50010
  473. 4500 OPEN "O",#2,N2$
  474. 4510 FOR I=1 TO 21
  475. 4520 WRITE #2,XX(I),YX(I),NX(I)
  476. 4530 NEXT I
  477. 4540 CLOSE #2
  478. 4550 RETURN 
  479. 4560 PRINT
  480. 4640 CLOSE #3:CHAIN "menu"
  481. 4650 GOTO 55280 ' END OF IRR1                                                                                                                                  '
  482. 50000 REM ******************   ROUTINE FOR ENTERING DATA FILE NAME   ******************************************************************                        '
  483. 50010 PRINT C1LEAR$:PRINT:PRINT N4$
  484. 50020 PRINT:COLOR 24,7:PRINT"   MAKE SURE DATA DISK IS IN DRIVE 2   ":COLOR 7,0
  485. 50030 PRINT:INPUT "WHAT IS THE NAME OF THE DATA FILE  ",N1$:N2$="B:"  +  N1$  +  ".DAT":RETURN                                                                 '
  486. 55000 REM **************    ERROR   TRAPING   ROUTINE    ******************************************************************************                        '
  487. 55010 ET=ERR
  488. 55020 PRINT:PRINT:PRINT
  489. 55030 IF ET=52 OR ET=53 OR ET=67 THEN 55210:REM bad file name
  490. 55040 IF ET=61 THEN 55110:REM disk full
  491. 55050 IF ET>=70 AND ET <=72 THEN 55150:REM disk error (write prot.,not ready,media  error)
  492. 55060 IF ET=25 THEN PRINT"PRINTER IS NOT READY":GOTO 55080
  493. 55070 ON ERROR GOTO 0:PRINT ET:GOTO 55260
  494. 55080 PRINT "Turn on printer. Make sure  'ON LINE '  light is on.":PRINT:PRINT:PRINT "PRESS ANY KEY TO CONTINUE"
  495. 55090 AA$=INKEY$:IF AA$="" THEN 55090
  496. 55100 GOTO 55260
  497. 55110 PRINT"DISK FULL REPLACE DATA DISK AND TRY AGAIN"
  498. 55120 PRINT:PRINT:PRINT "PRESS ANY KEY TO CONTINUE"
  499. 55130 AA$=INKEY$:IF AA$="" THEN 55130
  500. 55140 GOTO 55260
  501. 55150 PRINT"****************************  YOU HAVE A DISK ERROR  *************************"
  502. 55160 PRINT"MAKE SURE THAT YOUR DATA DISK IS IN DRIVE 1 AND SEE IF DISK DOOR IS CLOSED"
  503. 55170 PRINT"IF DISK IS IN DRIVE 1 AND DOOR IS CLOSED YOUR DISK IS WRITE PROTECTED OR FAULTY"
  504. 55180 PRINT:PRINT:PRINT "REPLACE DISK AND PRESS ANY KEY TO CONTINUE"
  505. 55190 AA$=INKEY$:IF AA$="" THEN 55190
  506. 55200 GOTO 55260
  507. 55210 PRINT "FILE NOT FOUND OR NAME NOT VALID - MUST BE LETTERS A-Z AND DIGITS O-9"
  508. 55220 PRINT "FILE NAME CANNOT BE MORE THAN EIGHT DIGITS LONG"
  509. 55230 PRINT:PRINT:PRINT "PRESS ANY KEY TO CONTINUE"
  510. 55240 AA$=INKEY$:IF AA$="" THEN 55240
  511. 55250 GOSUB 50010
  512. 55260 RESUME
  513. 55270 REM **********************************************************************
  514. 55280 END
  515.