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

---