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

(Source file text) 

---

C	MESSPROGRAMM
 
	COMMON X,T,R
	LOGICAL GOON
	REAL LN
	STEP =.25
	CONST=1.E-09

	DIMENSION T(50)
	DIMENSION R(50)
	DIMENSION ITAU(50)
	DIMENSION A(5)
	DIMENSION HEAT(50)

	WRITE(4,11900)
	READ(4,12000) SMASS
	WRITE(4,12100)
	READ(4,12000) ATMASS
	RATIO = ATMASS/SMASS
	WRITE(4,12200)
	READ(4,12000) RES
	WRITE(4,12300)
	READ(4,12400) IMFIT
	WRITE(4,12500)
	READ(4,12000) TSCALE
	WRITE(4,12600)
	READ(4,12700) GOON
	IF (.NOT.GOON) GOTO 5
6	WRITE(4,12800)
	READ(4,12400) IPOINT
	WRITE(4,12900)
	READ(4,12000) R(IPOINT)
	WRITE(4,503) R(IPOINT)
503	FORMAT(2X,E16.5)
	WRITE(4,13000)
	READ(4,12000) T(IPOINT)
	WRITE(4,503) T(IPOINT)
4	WRITE(4,13200)
	READ(4,12700) GOON
	IF (.NOT.GOON) GOTO 5
	WRITE(4,13300)
	READ(4,12400) K
	WRITE(4,12900)
	READ(4,12000) R(K)
	WRITE(4,13000)
	READ(4,12000) T(K)
	GOTO 4

	WRITE(4,35000)
	READ(4,12700) GOON
	IF(.NOT.GOON) GOTO 5
	WRITE(4,12200)
	READ(4,12000) RES
5	IERR=100
	IVAL=9999
	IRANGE =1
	MODE =2
	K=1
	TARGET =0
	WRITE(4,36000)
	READ(4,12700) GOON
	IF (.NOT.GOON) GOTO 1005
	INPUT=0
8	WRITE(4,37000)
	IOUT=DINP(1,1,IERRDI,INPUT)
	IF (IOUT.EQ.0) GOTO 8
	OUT=SCINP(MODE,IRANGE,IERR,TARGET)
	MODE =1+8
	IRANGE=0+4
	CALL DVINP(MODE,IRANGE,IERR,IVAL)
	XZERO=OUT
	TIME =0
	RT=FLOAT(IVAL)
	RR=RT
	GOTO 1001
1002	MODE =2
	IRANGE=1
	TARGET=XZERO+FLOAT(K)*STEP
	OUT=SCINP(MODE,IRANGE,IERR,TARGET)
	MODE =1+8
	IRANGE=0+4
	CALL DVINP(MODE,IRANGE,IERR,IVAL)
	XEFF=OUT+TARGET
	TIME=(XEFF-XZERO)*TSCALE
	RT=FLOAT(IVAL)
1001	WRITE(4,11800) K,TARGET,XEFF,TIME,RT
	WRITE(5,42000) IPOINT,K,RT,TIME
	K=K+1
	ABKRIT=(RT-RO)/(RR-RO)
C	IF (ABKRIT-.2) 1003,1002,1002
	IF (K-4) 1002,1003,1003
1003	ITAU(IPOINT)= K-1
	WRITE(4,32000)
	READ(4,12000) HEAT(IPOINT)
	WRITE(4,34000)
	READ(4,12700) GOON
	IF(GOON) GOTO 6
1005	WRITE(4,33000)
	READ(4,12700) GOON
	IF (.NOT.GOON) GOTO 1010

C	EVALUATION

1004	WRITE(4,40000)
	READ(4,12400) ICENT
	DO 500 J4=1,3
500	WRITE(4,501) R(J4),T(J4)
501	FORMAT(2X,2E15.4)
	CALL FITR(IMFIT,ICENT,R,T)
	RB = R(ICENT)
	CALL KELVIN(IMFIT,X,RB,TO)
	WRITE(4,505) TO
505	FORMAT(2X,E16.5)
	DO 110 I=1,5
110	A(I) = 0
112	CONTINUE
104	READ(5,42000) JO,J,RATT,TIME
	IHELP=JO-ICENT
	IF(IHELP) 104,105,108
105	CALL KELVIN(IMFIT,X,RATT,TAT1)
	WRITE(4,503) TO
	IF(J-0)  106,107,106
107	TR=TAT1
106	A(1)=A(1) +TIME
	DATT=TAT1-TO
	LN=ALOG(DATT)
	A(5)=A(5)+LN*LN
	A(2)=A(2)+TIME*TIME
	A(3)=A(3)+LN*TIME
	A(4)=A(4)+LN
	GOTO 112
108	IH=ICENT+1
	DO 109 I1=IH,IPOINT
	DO 109 I2=1,ITAU(IH)
109	READ(5,42000)
	CONTINUE

C	CALCULATION OF TAU,A,B,DELTA

	ANZ= 1./FLOAT(J+1)
	DET=A(2)-A(1)*A(1)*ANZ
	TAU1=(A(3)-ANZ*A(1)*A(4))/DET
	DFIT=EXP(A(4)*ANZ-TAU1*A(1)*ANZ)
	B=A(3)-ANZ*A(1)*A(4)
	C=A(2)-A(1)*A(1)*ANZ
	D=A(5) - A(4)*A(4)*ANZ
	RQOU = B*B/(D*C)
	CO=CONST*HEAT(ICENT)*HEAT(ICENT)*RES/DELTA
	TAU=-1./TAU1
	SPEC=TAU*CO*RATIO
	TEMP=(TO+TR)/2.

C	OUTPUT

	WRITE(4,2023) TEMP
	WRITE(4,2020) DELTA
	WRITE(4,2021) DFIT
	WRITE(4,2022) CO
	WRITE(4,2024) TAU
	WRITE(4,2025) RQOU
	WRITE(4,2026) SPEC

	WRITE(4,34000)
	READ(4,12700) GOON
	IF (GOON) GOTO 6

2023	FORMAT(/1X,30H MITTLERE TEMPERATUR        = E14.4,'  K')
2021	FORMAT(/1X,30H DELTA AUS FIT FUER TAU     = E14.4,'  K')
2025	FORMAT(/1X,30H STANDARTABWEICHUNG         = E14.4)
2020	FORMAT(/1X,30H DELTA-T AUS TEM-FIT        = E14.4,'  K')
2022	FORMAT(/1X,30H THERMAL CONDUCTIVITY       = E14.4,'W/K')
2024	FORMAT(/1X,30H TIME CONSTANT              = E14.4,'  SEC')
2026	FORMAT(/1X,30H SPECIFIC HEAT              = E14.4,'  J/(MOL*K)')

11800	FORMAT(2X,I3,4E16.6)
11900	FORMAT(/1X,'SAMPLE MASS:',T60,$)
12000	FORMAT(E16.6)
12100	FORMAT(/1X,'ATOM-MASS:',T60,$)
12200	FORMAT(/1X,'HEATERRESISTOR (KOHM) :',T60,$)
12300	FORMAT(/1X,'NUMBER OF TERMS:R-T EXPANSION:',T60,$)
12400	FORMAT(I3)
12500	FORMAT(/1X,'TIMEBASE-CONSTANT (SEC/VOLTS) :',T60,$)
12600	FORMAT(/1X,'POINT FOR R-T CALIBRATION:(T/F) :',T60,$)
12700	FORMAT(L1)
12800	FORMAT(/1X,'NUMBER OF POINT (I3) :',T60,$)
12900	FORMAT(/1X,'R  (KOHM) =',T60,$)
13000	FORMAT(/1X,'T  (K)    =',T60,$)
13200	FORMAT(/1X,'CORRECTION OF POINT WANTED (T/F):',T60,$)
13300	FORMAT(/1X,'NUMBER FO POINT TO BE CORRECTED :(I3):',T60,$)
33000	FORMAT(/1X,'CALCULATION OF POINT (T/F)',T60,$)
40000 	FORMAT(/1X,'NUMBER OF POINT TO BE CALCULATED :',T60,$)
42000	FORMAT(2X,2I5,2E16.6)
32000	FORMAT(/1X,'THE HEATERCURRENT WAS (MICROAMPS) :',T60,$)
34000	FORMAT(/1X,'ONE MORE MEASUREMENT OF A POINT? (T/F)',T60,$)
35000	FORMAT(/1X,'CHANGE OF RESISTORVALUE? (T/F):',T60,$)
36000	FORMAT(/1X,'RUN BEGINS (T/F) ',T60,$)
37000	FORMAT(1H+,T60,'')
38000	FORMAT(/1X,'END ??? (T/F)',T60,$)

1010	WRITE(4,38000)
	READ(4,12700) GOON
	IF(.NOT.GOON) GOTO 6

	STOP
	END

---