File: OBEICH.FC of Tape: Various/ETH/prog1

(.FC,.FO Focal format converted to 'WRITE' listing) 

---

C-ABEICH.FC NOV-70

01.01 G 15.01
01.10 F R=600,200,12000;T !,%5,R;D 2
01.20 Q

02.10 S Q=0;F K=0,N;S Q=Q+X(K)*FLOG(R)^K
02.20 T :10,%6.03,FLOG(R)^(N/2)/Q

15.01 E
15.10 T !,"A-B EICHUNG",!,"WERTEPAARE VON T UND R EINGEBEN",!
15.20 T "EIN 0 WERT FUER T HEISST SCHLUSS",!
15.30 A "TERME 3,5 OD. 7?",L;S N=L-1;S SW=-1;S ZZ=0
15.35 S IN=1
15.40 T !"TE(",%2,IN,")";A TE(IN);I (TE(IN)) 0,18.1;T !"RE(",%2,IN,")";A RE(IN)
15.50 S PR=FLOG(R);S PT=FEXP((N/2)*FLOG(PR))/T
15.60 F J=0,N;S ZY=PT*PT+ZY;S Z(J)=Z(J)+PT*PR^J;S A(J+L*L)=Z(J);D 15.7
15.70 F K=0,N;S A(J+L*K)=A(J+L*K)+PR^(J+K)
15.80 S Q=0;F K=0,N;S Q=Q+X(K)*Z(K)
15.85 T !"MITT. FEHLER =",%6.04,FSQT((ZY-Q)/(ZZ-L-1))
15.87 T !"ENTER TEST VALUES FOR R"
15.88 A !,"R=",R
15.90 S Q=0;F K=0,N;S Q=Q+X(K)*FLOG(R)^K
15.92 T :10,"T=",%6.03,FLOG(R)^(N/2)/Q
15.94 G 15.88

20.01 E
20.02 T !"LOESUNG DER MATRIZENGLEICHUNG AX=B FUER X"!
20.04 A "GEBEN SIE DIE GROESSE VON A AN, DANACH
20.05 T !"DIE KOEFFIZIENTEN A(J,K)...A(J,N) UND B(J)=A(J,N+1)"!
20.10 A "N",L,!;
20.11 S N=L-1;
20.12 F J=0,N;T !;F K=0,L;T "A(",%2,(J+1)*10+K+1,")";A A(J+L*K)
20.13 F K=0,N;S R(K)=K+1;S I=-1
20.14 S M=1E-6;T !
20.16 F J=0,N;F K=0,N;D 24
20.17 S R(P)=0
20.18 F K=0,L;S A(P+L*K)=A(P+L*K)/M
20.20 F J=0,N;D 25
20.22 S I=I+1
20.23 I (I-N)20.14,20.26,20.14
20.26 F J=0,N;F K=0,N;D 27
20.28 F K=0,N;T !%1,"X("K,")=",%+6,X(K)
20.30 I (SW)15.8;
20.40 T !!;Q

24.05 I (R(J))0,24.3,24.1
24.10 I (FABS(A(J+L*K))-FABS(M))24.3;
24.20 S M=A(J+L*K)
24.22 S P=J;S Q=K
24.30 R

25.10 I (J-P)25.2,25.4,25.2
25.20 S D=A(J+L*Q)
25.30 F K=0,L;S A(J+L*K)=A(J+L*K)-A(P+L*K)*D
25.40 R

27.10 I (1E-6-FABS(A(J+L*K)))27.2;R
27.20 S X(K)=A(J+L*L)

---