File: FIT.BA of Tape: Various/ETH/ba1

(Source file text) 

---

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

---