File: MEAS1.FT of Tape: Various/Disk-backup/dsk10

(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
	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,IERRDO,0)
	IERRSC=IMAX
	TARGET=0.1*H
	OUT=SCINP(3,0,IERRSC,TARGET)
	ITORQ=DVINP(1+8,1+4,IERRDV,DUMMY)
	IF(IERRSC.NE.2) GOTO 120
	WRITE(ITERM,2000)
	GOTO 110
120	IF(IERRDV.NE.4) GOTO 130
	WRITE(ITERM,2500) I
	IERRDV=IERRDV-4
130	IF((IERRDO+IERRSC+IERRDV).NE.0)
     $	CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,0)
	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 150
	IF(IDH.GT.(IDELH+2)) GOTO 140
	WRITE(ITERM,2001) I
	GOTO 150
140	WRITE(ITERM,2002) H
	IERRSC=IMAX
	TARGET=0.1*H
	OUT=SCINP(2,0,IERRSC,TARGET)
	IF(IERRSC.EQ.2) GOTO 140
	WRITE(ITERM,2000)
	GOTO 110
150	IF(ITORQ.EQ.12500) WRITE(ITERM,2501) I
	TORQ=(FLOAT(ITORQ)/1.E3-5.76)*HMEAS/HHI
	WRITE(IFILE,3000) TORQ
	IF(VAPRE) GOTO 160
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)
	IF(IPBARA.EQ.125000) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,2)
	PBARA=FLOAT(IPBARA)/1.E3
	PV=PV+((PBARA-PM)**2)*(REALI-1.)/REALI
	PM=PM+(PBARA-PM)/REALI
C
C	TEMPERATURE SrTiO3 (EXP)       	
C
160	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)
	IF(ITEXP.EQ.12500) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,4)
	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)
	IF(ITREG.EQ.12500) CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,6)
	TREG=FLOAT(ITREG)/1.E3
C	IF(TREG.LT..8.OR.TREG.GT.4.)
C     $	CALL MSERR1(IERRDO,IERRSC,IERRDV,IERRDA,7)
	DELT=TEXP-TSET
	DELTP=-DELT/10.
	DELTI=DELTI-DELT/10.
	REGSET=DELTP+DELTI
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)
C
	WRITE(ITERM,2502) I,H,IDH,IDELH,TORQ,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,'SIGN-CHANGE IN DVM MODE',T40,'I    =',4X,I4)
2501	FORMAT	(1X,'OVERFLOW IN DVM MODE',T40,'I    =',4X,I4)
2502	FORMAT	(1X,I4,F10.4,2I5,5F10.3)
C
3000	FORMAT	(F8.3)
C
	END

---