File: FITC.BA of Tape: Various/ETH/ba1
(Source file text)
10 DIM F1(256) 20 DIM Q(5,4) 30 DIM D1(5,4) 40 DIM P1(20,20) 50 DIM C1(20) 60 DIM C3(20) 70 DIM C2(20,20) 80 DIM Z(20) 90 DIM L1(20) 100 DIM L2(5,13) 105 DIM D9(16) 110 DIM A$(15) 120 DIM B$(15) 130 DIM C$(15) 140 DIM D$(15) 150 DIM E$(15) 160 P9=3.14159 170 PRINT\PRINT 180 GOTO 200 190 CLOSE #1 200 PRINT "FIT WITH CORR. COEFFS."; 210 INPUT A$ 220 L7=1 230 IF A$="YES" THEN 250 240 L7=0 250 PRINT "FILENAME: 'YYYDXX.FD'" 260 PRINT "YYY"; 270 INPUT A$ 280 A$=SEG$(A$,1,3) 290 PRINT "FROM XX="; 300 INPUT Y1 310 IF Y1<=0 THEN 250 320 PRINT " TO XX="; 330 INPUT Y2 340 IF Y2>99 THEN 250 350 IF Y2-Y1>=0 THEN 370 360 Y2=Y1 370 Y3=Y1-1 380 Y3=Y3+1 390 C$="0" 400 IF Y3<10 THEN 420 410 C$=SEG$(C$,1,-1) 420 B$=A$&"D"&C$&STR$(Y3)&".FD" 430 PRINT "DATA FILE: "&B$ 440 FILE #1:B$ 450 INPUT #1:D$ 460 E$=SEG$(D$,1,1) 470 IF E$<>"D" THEN 880 480 E$=SEG$(D$,4,5) 490 IF VAL(E$)><Y3 THEN 880 500 GOSUB 3120 510 IF D1>256 THEN 880 520 P3=D1 530 FOR I=0 TO P3-1 540 GOSUB 3120 550 F1(I)=D1 560 NEXT I 570 GOSUB 3120 580 I9=D1 590 FOR I=1 TO I9 600 GOSUB 3120 605 D9(I)=D1 610 NEXT I 612 A1=D9(1)*D9(3)*1E-7 620 K=1 630 FOR K1=1 TO 4 640 GOSUB 3120 650 IF D1=0 THEN 790 660 K=K+1 670 PRINT D1, 680 Q(K1,0)=D1*P9/256 690 GOSUB 3120 700 PRINT D1, 710 Q(K1,1)=D1*P9/180 720 GOSUB 3120 730 PRINT D1, 740 Q(K1,2)=D1 750 GOSUB 3120 760 PRINT D1 770 Q(K1,3)=-D1*P9/256 780 NEXT K1 790 IF K=1 THEN 880 795 K1=K 800 K2=K1*4 801 FOR L=0 TO 3 802 Q(0,L)=0 803 NEXT L 805 Q(K1,0)=0 806 FOR L=0 TO 13 807 L2(0,L)=0 808 NEXT L 810 GOSUB 910 820 PRINT 830 PRINT 840 IF Y3>=Y2 THEN 190 850 CLOSE #1 860 PRINT "NEXT FILE" 870 GOTO 380 880 PRINT "BAD FILE,TAKING NEXT" 890 GOTO 830 910 K3=SQR(K2) 920 S8=.0001 930 C5=10000 940 C6=0 950 D5=0 960 D3=1 970 I8=1\REM START OF LOOP 980 L8=1 990 FOR L=1 TO K1-1 1000 D1(L,0)=D3/(K3*P3) 1010 D1(L,1)=D3/K3 1020 D1(L,2)=D3*Q(L,2)/K3 1030 D1(L,3)=D3*2/(K3*P3) 1040 NEXT L 1041 FOR L=0 TO 3 1042 D1(0,L)=D3/10 1043 NEXT L 1050 D1(K1,0)=D3/50 1070 D5=D5+1 1080 FOR I=0 TO K2 1090 C1(I)=0 1100 FOR J=0 TO K2 1110 C2(I,J)=0 1120 NEXT J 1130 NEXT I 1140 C4=0 1150 FOR H=0 TO P3-1 1160 L1(K2)=0\B2=0 1170 H1=H*(1-Q(K1,0)*H*A1) 1175 H2=H1/P3 1180 R1=-F1(H)+Q(0,0)+Q(0,1)*H2+Q(0,2)*H2*H2+Q(0,3)*H2*H2*H2 1181 L1(0)=D1(0,0) 1182 L1(1)=H2*D1(0,1) 1183 L1(2)=H2*H2*D1(0,2) 1184 L1(3)=H2*H2*H2*D1(0,3) 1190 FOR L=1 TO K1-1 1210 C=COS(H1*Q(L,0)-Q(L,1)) 1220 S=SIN(H1*Q(L,0)-Q(L,1)) 1230 A=Q(L,2) 1240 E=EXP(H1*Q(L,3)) 1250 E1=H1*E 1260 T9=A1*H*H*Q(L,0)*D1(K1,0) 1270 R1=R1+A*C*E 1280 L1(L*4)=-S*A*E1*D1(L,0) 1290 L1(L*4+1)=S*A*E*D1(L,1) 1300 L1(L*4+2)=C*E*D1(L,2) 1310 L1(L*4+3)=E1*A*C*D1(L,3) 1320 L1(K2)=L1(K2)+T9*A*S*E 1330 L2(L,0)=-H1*C*A*E1*D1(L,0)*D1(L,0) 1340 L2(L,1)=C*A*E1*D1(L,0)*D1(L,1) 1350 L2(L,2)=-C*A*E*D1(L,1)*D1(L,1) 1360 L2(L,3)=-S*E1*D1(L,0)*D1(L,2) 1370 L2(L,4)=S*E*D1(L,1)*D1(L,2) 1380 L2(L,5)=0 1390 L2(L,6)=-H1*S*A*E1*D1(L,0)*D1(L,3) 1400 L2(L,7)=S*A*E1*D1(L,1)*D1(L,3) 1410 L2(L,8)=C*E1*D1(L,2)*D1(L,3) 1420 L2(L,9)=H1*E1*A*C*D1(L,3)*D1(L,3) 1430 L2(L,10)=T9*A*C*E1*D1(L,0) 1440 L2(L,11)=-T9*A*C*E*D1(L,1) 1450 L2(L,12)=T9*S*E*D1(L,2) 1460 L2(L,13)=T9*A*S*E1*D1(L,3) 1470 B2=B2+T9*T9*A*C*E 1480 NEXT L 1490 C4=C4+R1*R1 1500 FOR L=0 TO K1-1 1510 M1=-1 1520 FOR N=0 TO 3 1530 I=N+4*L 1540 C1(I)=C1(I)-L1(I)*R1 1550 FOR J=0 TO L*4-1 1560 C2(J,I)=C2(J,I)+L1(J)*L1(I) 1570 NEXT J 1580 GOSUB 1670 1590 NEXT N 1600 I=K2 1610 GOSUB 1670 1620 NEXT L 1630 C2(K2,K2)=C2(K2,K2)+L1(K2)*L1(K2)+R1*B2 1640 C1(K2)=C1(K2)-L1(K2)*R1 1650 NEXT H 1660 GOTO 1720 1670 FOR M=0 TO N 1680 J=M+4*L\M1=M1+1 1690 C2(J,I)=C2(J,I)+L1(J)*L1(I)+R1*L2(L,M1) 1700 NEXT M 1710 RETURN 1720 C4=C4/(P3-K2) 1730 PRINT "CHI=";SQR(C4) 1740 PRINT 1750 M=K2 1760 IF C4<=C5 THEN 1870 1770 C5=C5*1.001 1780 D3=D3/2\I8=I8*2 1790 PRINT "REDUCED LINEARITY RANGE";D3 1800 FOR J=0 TO K2 1810 J1=INT(J/4)\J2=J-J1*4 1820 Q(J1,J2)=Q(J1,J2)-C3(J) 1830 C3(J)=0 1840 NEXT J 1850 IF I8>100 THEN 1870 1860 GOTO 980 1870 GOSUB 2530 1880 FOR J=0 TO K2 1890 Z(J)=0 1900 FOR K=0 TO K2 1910 Z(J)=Z(J)+P1(K,J)*C1(K) 1920 NEXT K 1930 L1(J)=C2(J,J) 1940 IF ABS(Z(J))<L1(J) THEN 1970 1950 Z(J)=SGN(Z(J))\L8=0 1960 PRINT "MAX";J\GOTO 1980 1970 Z(J)=Z(J)/L1(J) 1980 NEXT J 1990 L9=L1(0)+L1(K2) 2000 S9=0 2010 FOR J=0 TO K2 2020 C3(J)=0\T1=0 2030 FOR K=0 TO K2 2040 IF L8=0 THEN 2060 2050 T1=T1+P1(J,K)*P1(J,K)/L1(K) 2060 C3(J)=C3(J)+P1(J,K)*Z(K) 2070 NEXT K 2080 IF L8=0 THEN 2100 2090 S9=S9+C3(J)*C3(J)/T1 2100 J1=INT(J/4)\J2=J-J1*4 2110 C3(J)=C3(J)*D1(J1,J2) 2120 Q(J1,J2)=Q(J1,J2)+C3(J) 2130 C2(J,J)=T1*C4*D1(J1,J2)*D1(J1,J2) 2135 NEXT J 2140 PRINT Q(0,0),Q(0,1),Q(0,2),Q(0,3) 2150 FOR L=1 TO K1-1 2160 PRINT Q(L,0)*256/(P9*(1-Q(K1,0))),Q(L,1)*180/P9, 2170 PRINT Q(L,2)*D9(6),-Q(L,3)*256/(P9*(1-Q(K1,0))) 2180 NEXT L 2190 PRINT Q(K1,0)*(D9(3)-D9(4)) 2200 C5=C4 2210 IF L9<>L1(K2-1) THEN 2230 2220 PRINT "ILL CONDITIONED" 2230 IF L8=0 THEN 2250 2240 IF S9<S8 THEN 2270 2250 IF D5>20 THEN 2270 2260 GOTO 970 2270 PRINT\PRINT "CURVE SHIFTED BY";C6/P3 2280 PRINT\PRINT "STANDARD DEVIATIONS" 2285 PRINT SQR(C2(0,0)),SQR(C2(0,1)),SQR(C2(0,2)),SQR(C2(0,3)) 2290 FOR J=1 TO K1-1 2300 PRINT SQR(C2(J*4,J*4))*256/P9, 2310 PRINT SQR(C2(J*4+1,J*4+1))*180/P9, 2320 PRINT SQR(C2(J*4+2,J*4+2))*D9(6), 2330 PRINT SQR(C2(J*4+3,J*4+3))*256/P9 2340 NEXT J 2345 PRINT SQR(C2(K2,K2))*(D9(3)-D9(4)) 2350 IF L7=0 THEN 2520 2360 IF L8=0 THEN 2520 2370 PRINT\PRINT "CORRELATION COEFFS" 2380 FOR J=1 TO K2-1 2390 PRINT 2400 FOR K=0 TO J-1 2410 T1=0 2420 FOR I=0 TO K2-1 2430 T1=T1+P1(J,I)*P1(K,I)/L1(I) 2440 NEXT I 2450 C2(K,J)=T1*D1(INT(J/4),J-4*INT(J/4))*D1(INT(K/4),K-4*INT(K/4))*C4 2460 PRINT C2(K,J)/(K2*SQR(C2(K,K)*C2(J,J))), 2470 IF K-4*INT(K/4)<>3 THEN 2490 2480 PRINT 2490 NEXT K 2500 PRINT "--";J;"--" 2510 NEXT J 2520 RETURN 2530 FOR J=0 TO M 2540 FOR K=0 TO M 2550 P1(J,K)=0 2560 NEXT K 2570 P1(J,J)=1 2580 NEXT J 2590 FOR L=1 TO 50 2600 S9=0 2610 FOR J=0 TO M-1 2620 FOR K=J+1 TO M 2630 S9=S9+C2(J,K)*C2(J,K) 2640 NEXT K 2650 NEXT J 2660 T9=0 2670 IF L>3 THEN 2690 2680 T9=.2*SQR(2*S9)/(M+1) 2690 FOR J=0 TO M-1 2700 FOR K=J+1 TO M 2710 IF C2(J,J)+C2(J,K)<>C2(J,J) THEN 2730 2720 IF C2(K,K)+C2(J,K)=C2(K,K) THEN 2820 2730 IF C2(J,K)*C2(J,K)=0 THEN 2820 2740 IF ABS(C2(J,K))<=T9 THEN 3070 2750 T8=.5*(C2(K,K)-C2(J,J))/C2(J,K) 2760 IF .1/(T8*T8)=0 THEN 2810 2770 T=1/(ABS(T8)+SQR(1+T8*T8)) 2780 IF T8>0 THEN 2800 2790 T=-T 2800 C=1/SQR(1+T*T)\S=T*C\GOTO 2860 2810 S=.5/T8\C=1\GOTO 2860 2820 C2(J,K)=0 2830 IF C2(J,J)>=C2(K,K) THEN 3070 2840 C=0 2850 S=1 2860 H=C*C*C2(J,J)-2*C*S*C2(J,K)+S*S*C2(K,K) 2870 G=S*S*C2(J,J)+2*C*S*C2(J,K)+C*C*C2(K,K) 2880 C2(J,K)=C*S*(C2(J,J)-C2(K,K))+C2(J,K)*(C*C-S*S) 2890 C2(J,J)=H\C2(K,K)=G 2900 FOR I=0 TO J-1 2910 H=C*C2(I,J)-S*C2(I,K) 2920 C2(I,K)=S*C2(I,J)+C*C2(I,K)\C2(I,J)=H 2930 NEXT I 2940 FOR I=J+1 TO K-1 2950 H=C*C2(J,I)-S*C2(I,K) 2960 C2(I,K)=S*C2(J,I)+C*C2(I,K)\C2(J,I)=H 2970 NEXT I 2980 FOR I=K+1 TO M 2990 H=C*C2(J,I)-S*C2(K,I) 3000 C2(K,I)=S*C2(J,I)+C*C2(K,I)\C2(J,I)=H 3010 NEXT I 3020 FOR I=0 TO M 3030 H=C*P1(I,J)-S*P1(I,K) 3040 P1(I,K)=S*P1(I,J)+C*P1(I,K)\P1(I,J)=H 3050 NEXT I 3060 C2(J,K)=0 3070 NEXT K 3080 NEXT J 3090 IF S9=0 THEN 3110 3100 NEXT L 3110 RETURN 3120 INPUT #1:D2,D1 3130 IF END #1 THEN 880 3140 RETURN 3150 END