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