File: TEMP2.FT of Tape: Sources/Multi8/m8-mprog-f
(Source file text)
SUBROUTINE TEMP1
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
C
100 WRITE(ITERM,2000)
110 CALL DINP(1,1,IERRDI,INPUT)
C
C 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 900
IF(IBARA.EQ.125000) GOTO 901
PBARA=FLOAT(IPBARA)/1.E3
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 902
IF(ITEXP.EQ.12500) GOTO 903
TEXP=FLOAT(ITEXP)/1.E3
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 904
IF(ITREG.EQ.12500) GOTO 905
TREG=FLOAT(ITREG)/1.E3
C
WRITE(ITERM,2001) PBARA,TEXP,TREG
IF(IERRDI.NE.0) GOTO 908
IF(INPUT.EQ.0) GOTO 110
NT=0
TSET=TEXP
DELTI=TREG
REGSET=TREG
IDATA=INT(51.2*REGSET)
IOUT=DAC(1,4095,IERRDA,IDATA)
IF(IERRDA.NE.0) GOTO 907
WRITE(ITERM,2002)
120 WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) GOTO 908
IF(INPUT.EQ.0) GOTO 120
C
130 IWRITE=0
140 IF(NT.LT.100) GOTO 150
WRITE(ITERM,2003)
GOTO 100
150 CONTINUE
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 900
IF(IPBARA.EQ.125000) GOTO 901
PBARA=FLOAT(IPBARA)/1.E3
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 902
IF(ITEXP.EQ.12500) GOTO 903
TEXP=FLOAT(ITEXP)/1.E3
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 904
IF(ITREG.EQ.12500) GOTO 905
TREG=FLOAT(ITREG)/1.E3
IF(TREG.LT.1..OR.TREG.GT.4.) GOTO 906
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 907
C
NT=NT+1
IF(IWRITE.EQ.0) WRITE(ITERM,2004) PBARA,TEXP,TREG
IF(ABS(DELT).GT..002) GOTO 130
NT=0
H=HHI+0.01
IF(IWRITE.EQ.0) WRITE(ITERM,2005) H,VIND,IMIN,ISEC
IWRITE=1
WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) GOTO 908
IF(INPUT.EQ.0) GOTO 140
WRITE(ITERM,2006)
PM=.0
PV=.0
TM=.0
TV=.0
C
RETURN
900 WRITE(ITERM,2900) IERRDO,IERRDV
STOP
901 WRITE(ITERM,2901)
STOP
902 WRITE(ITERM,2902) IERRDO,IERRDV
STOP
903 WRITE(ITERM,2903)
STOP
904 WRITE(ITERM,2904) IERRDO,IERRDV
STOP
905 WRITE(ITERM,2905)
STOP
906 WRITE(ITERM,2906)
STOP
907 WRITE(ITERM,2907) IERRDA
STOP
908 WRITE(ITERM,2908) IERRDI
STOP
2000 FORMAT (/1X,'REGULATE TEMPERATURE, SET REG INT'//)
2001 FORMAT (1H+,'PBARA=',F8.4,' [Torr]',T24,'TEXP =',F8.3,' [V]',
$ T46,'TREG =',F8.3,' [V] OK ?')
2002 FORMAT (1X,'SET REG EXT'/)
2003 FORMAT (1X,'TEMPERATURE UNSTABLE')
2004 FORMAT (1H+,'PBARA=',F8.4,' [Torr]',T24,'TEXP =',F8.3,' [V]',
$ T46,'TREG =',F8.3,' [V]')
2005 FORMAT (/1X,'START SWEEP AT:',T40,'H =',
$ F8.4,' [T]'/T5,'SET INDUCED VOLTAGE',T40,'VIND<=',
$ F8.2,' [V]'/T5,'SMALLEST SWEEP TIME',T40,'TIME =',
$ I3,3H ' ,I2,3H ''//)
2006 FORMAT (1X,'RUN BEGINS'/)
C
2500 FORMAT (1H+,T60,'')
C
2900 FORMAT (1X,'BARATRON:',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'DVINP:',T40,'IERR =',6X,I2)
2901 FORMAT (1X,'BARATRON:',T16,'OVERFLOW IN DVM MODE')
2902 FORMAT (1X,'SrTiO3 (EXP):',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'DVINP:',T40,'IERR =',6X,I2)
2903 FORMAT (1X,'SrTiO3 (EXP):',T16,'OVERFLOW IN DVM MODE')
2904 FORMAT (1X,'SrTiO3 (REG):',T16,'SUBROUTINE DOUT:',T40,
$ 'IERR =',6X,I2/T27,'DVINP:',T40,'IERR =',6X,I2)
2905 FORMAT (1X,'SrTiO3 (REG):',T16,'OVERFLOW IN DVM MODE')
2906 FORMAT (1X,'CHECK TEMPERATURE CONTROLLER !')
2907 FORMAT (1X,'TEMP REG:',T16,'SUBROUTINE DAC',T40,
$ 'IERR =',6X,I2)
2908 FORMAT (1X,'SUBROUTINE DINP:',T40,'IERR =',6X,I2)
C
END