File: MEAS2.FT of Tape: Sources/Multi8/m8-mprog-f
(Source file text)
SUBROUTINE MEAS1
COMMON/TITLE/ADENT,DITOMO,IRUN,ICHAR
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/PM,PV,TM,TV,TSET,DELTP,DELTI
C
ITERM=4
IFILE=6
C
H=HHI
RH=1./HHI
DO 100 I=1,NP
REALI=FLOAT(I)
110 MASK=16+32+64+2048
CALL DOUT(1,MASK,IERRDO,0)
IERRSC=1000
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=IEERDV-4
130 IF((IERRDO+IERRSC+IERRDV).NE.0) GOTO 900
HMEAS=(OUT+TARGET)*10.
C TEST
OU=OUT*10.
DEL=DELDRH*HMEAS/RH
WRITE(ITERM,1110) I,OU,DEL
1110 FORMAT (I5,2F8.4)
C
IF((1./HMEAS-RH).LE.DELDRH) GOTO 150
140 WRITE(ITERM,2001)
IERRSC=1000
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
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) GOTO 901
IF(IPBARA.EQ.125000) GOTO 902
PBARA=FLOAT(IPBARA)/1.E3
PV=PV+((PBARA-PM)**2)*(REALI-1.)/REALI
PM=PM+(PBARA-PM)/REALI
C
C TEMPERATURE SrTiO3 (EXP)
C
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) GOTO 903
IF(ITEXP.EQ.12500) GOTO 904
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) GOTO 905
IF(ITREG.EQ.12500) GOTO 906
TREG=FLOAT(ITREG)/1.E3
IF(TREG.LT.1..OR.TREG.GT.4.) GOTO 907
DELT=TEXP-TSET
DELTP=-DELT/10.
DELTI=DELTI-DELT/10.
REGSET=DELTP+DELTI
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) GOTO 908
C TEST
WRITE(ITERM,1111) I,H,HMEAS,PBARA,TEXP,TREG
1111 FORMAT (1X,I4,5F15.4)
C
RH=RH+DRH
H=1./RH
100 CONTINUE
C
RETURN
900 WRITE(ITERM,2900) IERRDO,IERRSC,IERRDV
STOP
901 WRITE(ITERM,2901) IERRDO,IERRDV
STOP
902 WRITE(ITERM,2902)
STOP
903 WRITE(ITERM,2903) IERRDO,IERRDV
STOP
904 WRITE(ITERM,2904)
STOP
905 WRITE(ITERM,2905) IERRDO,IERRDV
STOP
906 WRITE(ITERM,2906)
STOP
907 WRITE(ITERM,2907)
STOP
908 WRITE(ITERM,2908) IERRDA
STOP
2000 FORMAT (1X,'SWEEP DOWN !')
2001 FORMAT (1X,'SWEEP UP !')
C
2500 FORMAT (1X,'SIGN-CHANGE IN DVM MODE',T40,'I =',4X,I4)
2501 FORMAT (1X,'OVERFLOW IN DVM MODE',T40,'I =',4X,I4)
C
2900 FORMAT (1X,'TORQUE:',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'SCINP:',T40,'IERR =',6X,I2/
$ T27,'DVINP:',T40,'IERR =',6X,I2)
2901 FORMAT (1X,'BARATRON:',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'DVINP:',T40,'IERR =',6X,I2)
2902 FORMAT (1X,'BARATRON:',T16,'OVERFLOW IN DVM MODE')
2903 FORMAT (1X,'SrTiO3 (EXP):',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'DVINP:',T40,'IERR =',6X,I2)
2904 FORMAT (1X,'SrTiO3 (EXP):',T16,'OVERFLOW IN DVM MODE')
2905 FORMAT (1X,'SrTiO3 (REG):',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'DVINP:',T40,'IERR =',6X,I2)
2906 FORMAT (1X,'SrTiO3 (REG):',T16,'OVERFLOW IN DVM MODE')
2907 FORMAT (1X,'CHECK TEMPERATURE CONTROLLER !')
2908 FORMAT (1X,'TEMP REG:',T16,'SUBROUTINE DAC',T40,
$ 'IERR =',6X,I2)
3000 FORMAT (F8.3)
C
END