File: TIMA.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 LOGICAL NEW ITERM=4 IPARA=5 WRITE(ITERM,1000) READ(ITERM,2000) NEW IF(NEW) GOTO 5 READ(IPARA,3000) NP DO 1 I=1,NP READ(IPARA,3001) R1(I),R2(I),Q(I) 1 CONTINUE GOTO 20 5 WRITE(ITERM,1001) READ(ITERM,2001) NP DO 10 I=1,NP WRITE(ITERM,1002) I READ(ITERM,2002) R1(I) WRITE(ITERM,1003) I READ(ITERM,2002) R2(I) WRITE(ITERM,1004) I READ(ITERM,2002) Q(I) 10 CONTINUE GOTO 111 20 REWIND IPARA WRITE(IPARA,3000) NP DO 30 I=1,NP WRITE(IPARA,3001) R1(I),R2(I),Q(I) 30 WRITE(4,40) R1(I),R2(I),Q(I) 40 FORMAT(1X,3F12.2) GOTO 111 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,'NEW DATA SET (T/F)?',T30,$) 1001 FORMAT (1X,'NUMBER OF DATAPOINTS NP =',T30,$) 1002 FORMAT (/T5,'R1(',I2,') =',T15,$) 1003 FORMAT (T5,'R2(',I2,') =',T15,$) 1004 FORMAT (T5,'Q (',I2,') =',T15,$) 2000 FORMAT (L1) 2001 FORMAT (I3) 2002 FORMAT (F12.0) 3000 FORMAT (I3) 3001 FORMAT (3F20.2) 111 CONTINUE END