File: AB1.FT of Disk: Disks/MyPDP/m8-1-rka1-rkb1
(Source file text) 
C	DECAYMEASUREMENT AND CALCULATION

	DIMENSION SPE(100)
	DIMENSION TSP(100)
	DIMENSION F(20)
	DIMENSION XK(20)
	DIMENSION IANZ(100)
	DIMENSION AVERAG(100)
	DIMENSION R(100)
	DIMENSION T(100)
	DIMENSION A(5)
	LOGICAL GOON
	IVAL=9999
	IERR=50
	IRASC=1
	MODESC=2
	MODDV=1+8
	WRITE(4,4300)
	READ(4,2200) IRADV
	WRITE(4,3600)
	READ(4,900) SMASS
	WRITE(4,3000)
	READ(4,900) DELTA
	WRITE(4,1700)
	READ(4,900) CONST
	WRITE(4,300)
	READ(4,900) TSC
	WRITE(4,200)
	READ(4,900) STEP
	DO 5000 JJ=1,100
	IANZ(JJ)=0
	AVERAG(JJ)=0.
5000	CONTINUE
9	K=1
	TARGET=0
	WRITE(4,1800)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 6
	WRITE(4,1700)
	READ(4,900) CONST
6	WRITE(4,800)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 7
	WRITE(4,700)
	READ(4,900) STEP
7	WRITE(4,600)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 13
	WRITE(4,300)
	READ(4,900) TSC
13	WRITE(4,2400)
	READ(4,2200) IMP
	WRITE(4,2000)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 19
21	WRITE(4,2100)
	READ(4,2200) IMAX
	CALL BASET(IMAX,RO,MODDV,IRADV,IERR,CONST)
	WRITE(4,2300) RO
	WRITE(4,2500)
	READ(4,1200) GOON
	IF (.NOT.GOON) GOTO 14
22	WRITE(4,2100)
	READ(4,2200) IMAX1
	CALL BASET(IMAX1,RR,MODDV,IRADV,IERR,CONST)
	WRITE(4,2600) RR
	WRITE(4,2700)
	READ(4,2200)L
	IF (L.EQ.1) GOTO 21
	IF (L.EQ.2) GOTO 22
	WRITE(4,2900)
	READ(4,900) TO1
14	WRITE(4,400)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 20
C8	WRITE(4,3700)
C	IOUT=DINP(2,1,IERRDI,INPUT)
C	IF(IOUT.EQ.0)GOTO 8
	OUT=SCINP(MODESC,IRASC,IERR,TARGET)
	CALL DVINP(MODDV,IRADV,IERR,IVAL)
	XZERO=OUT
	TIME=0
	RT=FLOAT(IVAL)*CONST
	T(K)=TIME
	R(K)=RT
	IF (K.EQ.1) GOTO 100
120	K=K+1
	TARGET=XZERO+STEP*FLOAT(K)
	IERR=50
	OUT=SCINP(MODESC,IRASC,IERR,TARGET)
	CALL DVINP(MODDV,IRADV,IERR,IVAL)
	XEFF= OUT+TARGET
	TIME=(XEFF-XZERO)*TSC
	RT=FLOAT(IVAL)*CONST
	R(K)=RT
	T(K)=TIME
100	WRITE(4,1900) TIME,RT
	IF (K-IMP) 120,110,110
110	WRITE(4,1100)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 19
C	EVALUATION
	WRITE(4,2300)RO
	WRITE(4,2600)RR
	CALL CONT(IMP,R,T,IANZ,AVERAG,TO1,DELTA)
19	WRITE(4,1600)
	READ(4,1200) GOON
	IF (GOON) GOTO 9

	WRITE(4,3100)
	READ(4,1200) GOON
	IF (.NOT.GOON) GOTO 20
106	KK=1
101	WRITE(4,3200)
	READ(4,1200) GOON
	IF(.NOT.GOON) GOTO 102
	WRITE(4,3300)
	READ(4,900)XK(KK)
	WRITE(4,3400)
	READ(4,900) FKK
	F(KK)=FKK*0.1E-05
	KK=KK+1
	GOTO 101
102	N=KK-1
	J=1
	I=1
105	IF(IANZ(J)) 104,103,104
104	AVERAG(J)=AVERAG(J)/FLOAT(IANZ(J))
	TH =TO1+FLOAT(J)*DELTA+DELTA/2.
	CALL POWER(N,TH,XK,F,P)
	SPEZ=-P*AVERAG(J)/SMASS
	WRITE(4,3500) J,TH,AVERAG(J),P,SPEZ
	WRITE(3,3500) J,TH,AVERAG(J),P,SPEZ
	SPE(I)=SPEZ
	TSP(I)=TH
	I=I+1
103	J=J+1
	IF (J-100) 105,107,107
107 	WRITE(3,3900)
	DO 555 I1=1,I-1
	SP2=SPE(I1)/TSP(I1)
	TS2=TSP(I1)**2
	WRITE(3,3800) TSP(I1),TS2,SP2
555	CONTINUE
	WRITE(4,3100)
	READ(4,1200) GOON
	IF(GOON) GOTO 106
3700	FORMAT(1H+,T70,'')
200	FORMAT(/1X,'STEP= ',T60,$)
300	FORMAT(/1X,'TIME SCALE (SEC/VOLTS): ',T60,$)
400	FORMAT(1X,'START OF MEASUREMENT (T/F):',T60,$)
500	FORMAT(/1X,'NEW TIME SCALE (T/F):',T60,$
600	FORMAT(/1X,'NEW TIME SCALE WANTED? (T/F):',T60,$)
700	FORMAT(/1X,'NEW STEP :',T60,$)
800	FORMAT(/1X,'STEP CHANGE WANTED ?(T/F):'T60,$)
900	FORMAT(E16.8)
1100	FORMAT(/1X,'CALCULATION WANTED?(T/F)',T60,$)
1200	FORMAT(L1)
1300	FORMAT(1X,I3)
1600	FORMAT(/1X,'ONE MORE POINT? (T/F):',T60,$)
1700	FORMAT(/1X,'DVM-CONSTANT:',T60,$)
1800	FORMAT(/1X,'NEW DVM-CONSTANT WANTED? (T/F):',T60,$)
1900	FORMAT(1X,F8.4,E16.5)
2000	FORMAT(/1X,'START READING BASETEMPERATURE? (T/F):',T60,$)
2100	FORMAT(/1X,'AVERAGE OVER IMAX POINTS:IMAX=:',T60,$)
2200	FORMAT(I3)
2300	FORMAT(/1X,'BASETEMPERATURE-RESISTANCE: RO=',T60,E16.8,' KOHMS')
2400	FORMAT(/1X,'NUMBER OF POINTS (DECAY):',T60,$)
2500	FORMAT(/1X,'MEASUREMENT OF RAISED TEMPERATURE?(T/F):',T60,$)
2600	FORMAT(/1X,'RES.AT RAISED TEMPERATURE: RR=',T60,E16.8,' KOHMS')
2700	FORMAT(/1X,'ONE MORE READING OF RO(1),RR(2) OR GO ON?(O)',T60,$)
2800	FORMAT(/1X,'RO=',T60,$)
2900	FORMAT(/1X,'BASETEMPERATURE TO1=',T60,$)
3000	FORMAT(/1X,'STEP(CHANNEL)=',T60,$)
3100	FORMAT(/1X,'EVALUATION? (T/F)',T60,$)
3200	FORMAT(/1X,'STUETZSTELLE? (T/F)',T60,$)
3300	FORMAT(/1X,'X(K) =',T60,$)
3400	FORMAT(/1X,'F(K) =',T60,$)
3500	FORMAT(1X,I3,E16.4,'  ',E16.4,'  'E16.4,'  ',E16.5)
3600	FORMAT(/1X,'SAMPLE MASS =',T60,$)
3900	FORMAT(//,'    T             T**2           C/T'//)
3800	FORMAT(3E15.4)
4300	FORMAT(/1X,'DVM - IRANGE CONSTANT:',T60,$)

20	STOP
	END