File: FIBENN.FT of Disk: Disks/MyPDP/m8-2-rka1-rkb1

(Source file text) 

---

C PGM TIMAFI CP-NAEHERUNG
C FIT FUER DATEN AUS MESSUNG DER SPEZ. WAERME UM THERMOMETER ZU EICHEN

	DIMENSION R1(10),R2(10),Q(10),A(10,6),X(6),B(10),S(6),DN(6)
	INTEGER FRAGE
	ITERM=4
	WRITE(ITERM,1000)
	READ(ITERM,2000) NP
	DO 10 I=1,NP
	WRITE(ITERM,1001) I
	READ(ITERM,2001) R1(I)
	WRITE(ITERM,1002) I
	READ(ITERM,2001) R2(I)
	WRITE(ITERM,1003) I
	READ(ITERM,2001) Q(I)
 10	CONTINUE
	DO 30 I=1,10
 30	WRITE(4,40)R1(I),R2(I),Q(I)
 40	FORMAT(1X,3F12.2)
	S(1)=0.25
	S(2)=0.01
	S(3)=0.5
	S(4)=-0.1
	S(5)=0.05
	S(6)=0.0005
	WRITE(3,45)
 45	FORMAT(1X,'NAEHERUNGSWERTE:')
	DO 48 I=1,6
	WRITE(3,50)I,S(I)
 50	FORMAT(1X,'X(',I1,') =',E14.8)
 48 	CONTINUE
	DO 60 I=1,10
	LN1=ALOG(R1(I))
	LN2=ALOG(R2(I))
	T1=1./(S(3)/LN1+S(4)+S(5)*LN1+S(6)*LN1*LN1)
	T2=1./(S(3)/LN2+S(4)+S(5)*LN2+S(6)*LN2*LN2)
	Q(I)=.5*Q(I)
	B(I)=1./(T2-T1)-S(1)/Q(I)*(T1+T2)-S(2)/(4.*Q(I))*(T1+T2)**3
	A(I,1)=1./(Q(I)*(T1+T2))
	A(I,2)=1./(4.*Q(I))*(T1+T2)**3
	A(I,3)=(T1*T1/LN1+T2*T2/LN2)*
     $		(S(1)/Q(I)+(3./4.)*S(2)/Q(I)*(T1+T2)**2)
	A(I,3)=-(T2*T2/LN2-T1*T1/LN1)/(T2-T1)**2+A(I,3)
	A(I,4)=(T1*T1+T2*T2)*
     $		(S(1)/Q(I)+(3./4.)*S(2)/Q(I)*(T1+T2)**2)
	A(I,4)=-(T2*T2-T1*T1)/(T2-T1)**2+A(I,4)
	A(I,5)=(T1*T1*LN1+T2*T2*LN2)*
     $		(S(1)/Q(I)+(3./4.)*S(2)/Q(I)*(T1+T2)**2)
	A(I,5)=-(T2*T2*LN2-T1*T1*LN1)/(T2-T1)**2+A(I,5)
	A(I,6)=((T1*LN1)**2*(T2*LN2)**2)*
     $		(S(1)/Q(I)+(3./4.)*S(2)/Q(I)*(T1+T2)**2)
	A(I,6)=-((T2*LN2)**2-(T1*LN1)**2)/(T2-T1)**2+A(I,6)
 60	CONTINUE
	CALL HLS(A,B,6,1,IER,AUX,IPIV,ERS,X)
	WRITE(3,70)
 70	FORMAT(///,1X'BERECHNETE WERTE UND FEHLER IN PROZENT')
	DO 75 I=1,6
	DN(I)=(X(I)-S(I))*100
	WRITE(3,77)I,S(I),DN(I)
 77	FORMAT(1X,I2,E14.8,E6.3)
 75 	CONTINUE
	WRITE(4,80)
 80	FORMAT(1X,'NEUER FIT, FALLS JA 1 EINGEBEN SONST 0:',T70,$)
	READ(4,90) FRAGE
 90	FORMAT(I1)
	DO 95 I=1,6
 95	S(I)=X(I)
	IF (FRAGE.EQ.1) GOTO 48


1000	FORMAT	(1X,'NUMBER OF DATAPOINTS NP =',T30,$)
1001	FORMAT	(/T5,'R1(',I2,') =',T15,$)
1002	FORMAT	(T5,'R2(',I2,') =',T15,$)
1003	FORMAT	(T5,'Q (',I2,') =',T15,$)

2000	FORMAT	(I3)
2001	FORMAT	(F12.0)

	END

---