File: TEMPA1.FT of Disk: Disks/MyPDP/m8-1-rka1-rkb1
(Source file text)
SUBROUTINE TEMPA1
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
PBARA=.0
C
100 WRITE(ITERM,2000)
110 CALL DINP(1,1,IERRDI,INPUT)
IT=1
GOTO 200
120 WRITE(ITERM,2001) PBARA,TEXP,TREG
IF(IERRDI.NE.0) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,8)
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) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,7)
WRITE(ITERM,2002)
130 WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,8)
IF(INPUT.EQ.0) GOTO 130
C
140 IWRITE=0
150 IF(NT.LT.100) GOTO 160
WRITE(ITERM,2003)
GOTO 100
160 CONTINUE
IT=2
GOTO 200
170 IF(TREG.LT..5.OR.TREG.GT.5.)
$ CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,6)
DELT=TEXP-TSET
DELTP=-DELT/10.
DELTI=DELTI-DELT/10.
REGSET=DELTP+DELTI
C FOR GAS FLOW CRYOSTAT ONLY
C IF(REGSET.LT..8) REGSET=2.
IF(REGSET.GT.4.) REGSET=4.
IDATA=INT(51.2*REGSET)
IOUT=DAC(1,4095,IERRDA,IDATA)
IF(IERRDA.NE.0) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,7)
C
NT=NT+1
IF(IWRITE.EQ.0) WRITE(ITERM,2004) PBARA,TEXP,TREG
IF(ABS(DELT).GT..002) GOTO 140
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) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,8)
IF(INPUT.EQ.0) GOTO 150
WRITE(ITERM,2006)
PM=.0
PV=.0
TM=.0
TV=.0
C
RETURN
C
C BARATRON
C
200 IF(VAPRE) GOTO 210
MASK=64+128
IDATA=64
CALL DOUT(1,MASK,IERRDO,IDATA)
IPBARA=DVINP(1+8,4,IERRDV,DUMMY)
IF((IERRDO+IERRDV).NE.0)
$ CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,0)
IF(IBARA.EQ.125000) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,1)
PBARA=FLOAT(IPBARA)/1.E3
C
C TEMPERATURE SrTiO3 (EXP)
C
210 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 TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,2)
IF(ITEXP.EQ.12500) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,3)
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)
$ CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,4)
IF(ITREG.EQ.12500) CALL TPERR1(IERRDO,IERRDV,IERRDA,IERRDI,5)
TREG=FLOAT(ITREG)/1.E3
GOTO(120,170),IT
2000 FORMAT (/1X,'REGULATE TEMPERATURE, SET REG INT'//)
2001 FORMAT (1H+,'PBARA=',F8.3,' [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.3,' [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 FORMAT 2500 CTRL B (BELL)
END