File: MEAS1.FT of Disk: Disks/MyPDP/m8-1-rka1-rkb1

(Source file text) 

---

     	SUBROUTINE MEAS1
	COMMON/TITLE/FNAME(6),MOTODI,IRUN
	COMMON/SAMPLE/SPL,SPA,SPV,HANG
	COMMON/FIELD/NP,HHI,HLO,DRHE3,DRH,DELDRH,VIND,IMIN,ISEC

	COMMON/PARAM/PS(2),PT(2),PF(2),CALI(2)
	COMMON/TEMP/TMEAN,TVAR,PM,PV,TM,TV,TSET,DELTP,DELTI,VAPRE
C
	INTEGER ERRDO1,ERRDO2,ERRDV1,ERRDV2
	LOGICAL VAPRE
C
	ITERM=4
	IFILE=6
	PBARA=.0
C
	H=HHI
	RH=1./HHI
	IMAX=(8*(IMIN*60+ISEC))/ NP
	DO 100 I=1,NP
	REALI=FLOAT(I)
110	MASK=16+32+64+2048
	CALL DOUT(1,MASK,ERRDO1,0)
	IERRSC=IMAX
	TARGET=0.1*H
	OUT=SCINP(3,0,IERRSC,TARGET)
	ITORQ=DVINP(1+8,2+4,ERRDV1,DUMMY)
	IF(MOTODI.NE.68) GOTO 120
	CALL DOUT(1,MASK,ERRDO2,16+32)
	IDILA=DVINP(1+8,1+4,ERRDV2,DUMMY)
120	IF(IERRSC.NE.2) GOTO 130
	WRITE(ITERM,2000)
	GOTO 110
130	IF(ERRDV1.NE.4) GOTO 140
	WRITE(ITERM,2500) I
	ITORQ=0
	ERRDV1=ERRDV1-4
140	IF((ERRDO1+IERRSC+ERRDV1).NE.0)
     $	CALL MSERR1(ERRDO1,IERRSC,ERRDV1,IERRDA,0,0)
	IF(MOTODI.NE.68) GOTO 160
	IF(ERRDV2.NE.4) GOTO 150
	WRITE(ITERM,2501) I
	IDILA=0
	ERRDV2=ERRDV2-4
150	IF((ERRDV2+IERRSC+ERRDV2).NE.0)
     $	CALL MSERR1(ERRDO2,IERRSC,ERRDV2,IERRDA,0,1)
160	HMEAS=(OUT+TARGET)*10.
	IDH=INT(-OUT*1.E5+0.1)
	IDELH=INT(DELDRH*HMEAS*H*1.E4+0.5)
	IF(IDH.LE.(IDELH+1)) GOTO 180
	IF(IDH.GT.(IDELH+2)) GOTO 170
	WRITE(ITERM,2001) I
	GOTO 180
170	WRITE(ITERM,2002) H
	IERRSC=IMAX
	TARGET=0.1*H
	OUT=SCINP(2,0,IERRSC,TARGET)
	IF(IERRSC.EQ.2) GOTO 170
	WRITE(ITERM,2000)
	GOTO 110
180	IF(ITORQ.EQ.12500) WRITE(ITERM,2502) I
	TORQ=FLOAT(ITORQ)/1.E2-5.76
	IF(MOTODI.EQ.68) GOTO 190
	IF(MOTODI.EQ.84) TORQ=TORQ*HMEAS/HHI
	WRITE(IFILE,3000) TORQ
	GOTO 200
190	TORQ=TORQ*HMEAS/HHI
	DILA=FLOAT(IDILA)/1.E3-5.76
	WRITE(IFILE,3001) TORQ,DILA
200	IF(VAPRE) GOTO 300
C
C	TEMPERATURE BARATRON
C
	MASK=64+128
	IDATA=64
	CALL DOUT(1,MASK,IERRDO,IDATA)
	IPBARA=DVINP(1+8,4,IERRDV,DUMMY)
	IF((IERRDO+IERRDV).NE.0) CALL
     $	MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,1,0)
	IF(IPBARA.EQ.125000) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,2,0)
	PBARA=FLOAT(IPBARA)/1.E3
	PV=PV+((PBARA-PM)**2)*(REALI-1.)/REALI
	PM=PM+(PBARA-PM)/REALI
C
C	TEMPERATURE SrTiO3 (EXP)       	
C
300	MASK=64+128+256
	IDATA=64+128
	CALL DOUT(1,MASK,IERRDO,IDATA)
	ITEXP=DVINP(1+8,1+4,IERRDV,DUMMY)
	IF((IERRDO+IERRDV).NE.0)
     $	CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,3,0)
	IF(ITEXP.EQ.12500) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,4,0)
	TEXP=FLOAT(ITEXP)/1.E3
	TV=TV+((TEXP-TM)**2)*(REALI-1.)/REALI
	TM=TM+(TEXP-TM)/REALI
C
C	TEMPERATURE SrTiO3 (REG)
C
	MASK=64+128+256
	IDATA=64+128+256
	CALL DOUT(1,MASK,IERRDO,IDATA)
	ITREG=DVINP(1+8,1+4,IERRDV,DUMMY)
	IF((IERRDO+IERRDV).NE.0)
     $	CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,5,0)
	IF(ITREG.EQ.12500) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,6,0)
	TREG=FLOAT(ITREG)/1.E3
	IF(TREG.LT..5.OR.TREG.GT.5.)
     $	CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,7,0)
	DELT=TEXP-TSET
	DELTP=-DELT/10.
	DELTI=DELTI-DELT/10.
	REGSET=DELTP+DELTI
C	FOR GAS FLOW CRYOSTAT ONLY
C	IF(REGSET.LT.1.) REGSET=2.
	IF(REGSET.GT.4.) REGSET=4.
	IDATA=INT(51.2*REGSET)
	IOUT=DAC(1,4095,IERRDA,IDATA)
	IF(IERRDA.NE.0) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,8,0)
C
	IF(MOTODI.NE.68)
     $	WRITE(ITERM,2504) I,H,IDH,IDELH,TORQ,PBARA,TEXP,TREG
	IF(MOTODI.EQ.68)
     $	WRITE(ITERM,2504) I,H,IDH,IDELH,TORQ,DILA,PBARA,TEXP,TREG
C
	RH=RH+DRH
	H=1./RH
100	CONTINUE
C
	RETURN

2000	FORMAT	(1X,'SWEEP DOWN !')
2001	FORMAT	(1X,'FIELD INACCURATE AT',T40,'I    =',4X,I4)
2002	FORMAT	(1X,'SWEEP UP TO:',T40,'H    =',F8.4,' [T]'))
C
2500	FORMAT	(1X,'TORQUE OR MODULATION: SIGN-CHANGE IN DVM MODE',
     $		T60,'I    =',4X,I4)
2501	FORMAT	(1X,'DILATION: SIGN-CHANGE IN DVM MODE',
     $		T60,'I    =',4X,I4)
2502	FORMAT	(1X,'TORQUE OR MODULATION: OVERFLOW IN DVM MODE',
     $		T60,'I    =',4X,I4)
2503	FORMAT	(1X,'DILATION: OVERFLOW IN DVM MODE',
     $		T60,'I    =',4X,I4)
2504	FORMAT	(1X,I4,F10.4,2I5,5F10.3)
C
3000	FORMAT	(F8.3)
3001	FORMAT	(2F8.3)
C
	END

---