File: INIT1.FT of Tape: Various/Tests/dsk1c
(Source file text)
C MAIN INIT1
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,NEW,YES
C
ITERM=4
IPARA=5
PI=3.14159
SIG=.0
SRATE=4.
SPL=.0
SPA=.0
SPV=.0
DO 1 I=1,6
DO 1 II=1,3
1 CALL CPUT3(FNAME(I),II,32)
C
10 REWIND IPARA
WRITE(ITERM,2000)
READ(ITERM,1000) NEW
IF(.NOT.NEW) GOTO 200
CALL CPUT3(FNAME(5),1,46)
CALL CPUT3(FNAME(5),2,70)
CALL CPUT3(FNAME(5),3,68)
WRITE(ITERM,2001)
READ(ITERM,1006) FNAME(1),FNAM
CALL CGET3(FNAM,1,NAM)
CALL CPUT3(FNAME(2),1,NAM)
IF(NAM.EQ.58) GOTO 20
CALL CGET3(FNAM,2,NAM)
CALL CPUT3(FNAME(2),2,NAM)
IF(NAM.EQ.58) GOTO 20
CALL CGET3(FNAM,3,NAM)
CALL CPUT3(FNAME(2),3,NAM)
20 WRITE(ITERM,2002)
READ(ITERM,1001) FNAME(3)
WRITE(ITERM,2003)
READ(ITERM,1002) DITOMO
CALL CGET3(DITOMO,1,MOTODI)
CALL CPUT3(FNAME(4),1,MOTODI)
IF(MOTODI.EQ.77) GOTO 140
WRITE(ITERM,2004)
MASK=16+32+64+2048
CALL DOUT(1,MASK,IERRDO,0)
IF(IERRDO.NE.0) GOTO 900
100 WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) GOTO 901
IF(INPUT.EQ.0) GOTO 100
ITORQH=DVINP(1+8,0+4,IERRDV,DUMMY)
IF(IERRDV.NE.4) GOTO 110
WRITE(ITERM,2501)
IERRDV=IERRDV-4
110 IF(IERRDV.NE.0) GOTO 902
IF(IABS(ITORQH).EQ.125000) WRITE(ITERM,2502)
WRITE(ITERM,2005)
120 WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) GOTO 901
IF(INPUT.EQ.0) GOTO 120
ITORQL=DVINP(1+8,0+4,IERRDV,DUMMY)
IF(IERRDV.NE.4) GOTO 130
WRITE(ITERM,2501)
IERRDV=IERRDV-4
130 IF(IERRDV.NE.0) GOTO 902
IF(IABS(ITORQL).EQ.125000) WRITE(ITERM,2502)
SIG=FLOAT(ITORQH-ITORQL)
SIG=SIGN(1.,SIG)
WRITE(ITERM,2006) SIG
140 WRITE(ITERM,2007)
READ(ITERM,1003) SPV
IF(MOTODI.NE.68) GOTO 150
WRITE(ITERM,2008)
READ(ITERM,1003) SPL
WRITE(ITERM,2009)
READ(ITERM,1003) SPA
150 WRITE(ITERM,2010)
READ(ITERM,1004) IRUN
GOTO 220
200 READ(IPARA,3000) (FNAME(I),I=1,6),MOTODI,IRUN
READ(IPARA,3001) SPL,SPA,SPV,HANG,VAPRE
READ(IPARA,3002) NP,HHI,HLO,DRHE3,PREC
READ(IPARA,3003) VIND,IMIN,ISEC
IF(MOTODI.EQ.68) READ(IPARA,3004) PS(1),PT(1),PF(1),CALI(1)
IF(MOTODI.EQ.68.OR.MOTODI.EQ.84) READ(IPARA,3004)
$ PS(2),PT(2),PF(2),CALI(2),SIG
DRH=DRHE3*1.E-3
FMAX=1./(2.*DRH)
DELDRH=DRH*PREC/100.
IRUN=IRUN+1
WRITE(ITERM,2011) IRUN
READ(ITERM,1000) YES
IF(YES) GOTO 210
WRITE(ITERM,2010)
READ(ITERM,1004) IRUN
210 WRITE(ITERM,2012) HANG
READ(ITERM,1000) YES
IF(YES) GOTO 400
220 WRITE(ITERM,2013)
READ(ITERM,1003) HANG
IF(NEW) GOTO 230
WRITE(ITERM,2014) NP
WRITE(ITERM,2015) HHI,HLO,DRHE3,FMAX,PREC
READ(ITERM,1000) YES
IF(YES) GOTO 260
230 WRITE(ITERM,2016)
READ(ITERM,1005) NP
WRITE(ITERM,2017)
READ(ITERM,1003) HHI
WRITE(ITERM,2018)
READ(ITERM,1003) DRHE3
IF(DRHE3.LT.1.E-6) GOTO 240
DRH=DRHE3*1.E-3
HLO=HHI/(1.+NP*DRH*HHI)
FMAX=1./(2.*DRH)
WRITE(ITERM,2019) HLO,FMAX
GOTO 250
240 WRITE(ITERM,2020)
READ(ITERM,1003) HLO
DRH=(HHI-HLO)/(HHI*HLO*NP)
DRHE3=DRH*1.E3
FMAX=1./(2.*DRH)
WRITE(ITERM,2021) DRHE3,FMAX
250 WRITE(ITERM,2022)
READ(ITERM,1003) PREC
DELDRH=DRH*PREC/100.
VIND=SRATE*DELDRH*HHI**2
WRITE(ITERM,2023) VIND
VIND=52.*VIND/.1472
ITIME=INT(NP*DRH/(SRATE*DELDRH)+.5)
IMIN=ITIME/60
ISEC=ITIME-IMIN*60
WRITE(ITERM,2024) VIND,IMIN,ISEC
WRITE(ITERM,2025)
READ(ITERM,1000) YES
IF(.NOT.YES) GOTO 230
260 IF(MOTODI.NE.68) GOTO 310
WRITE(ITERM,2026)
WRITE(ITERM,2027)
READ(ITERM,1003) PS(1)
WRITE(ITERM,2028)
READ(ITERM,1003) PT(1)
WRITE(ITERM,2029)
READ(ITERM,1003) PF(1)
WRITE(ITERM,2030)
READ(ITERM,1003) DCAP
WRITE(ITERM,2031)
MASK=16+32+64+2048
CALL DOUT(1,MASK,IERRDO,16+32)
IF(IERRDO.NE.0) GOTO 900
270 WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) GOTO 901
IF(INPUT.EQ.0) GOTO 270
IDILAH=DVINP(1+8,0+4,IERRDV,DUMMY)
IF(IERRDV.NE.4) GOTO 280
WRITE(ITERM,2501)
IERRDV=IERRDV-4
280 IF(IERRDV.NE.0) GOTO 902
IF(IABS(IDILAH).EQ.125000) WRITE(ITERM,2502)
WRITE(ITERM,2032)
290 WRITE(ITERM,2500)
CALL DINP(1,1,IERRDI,INPUT)
IF(IERRDI.NE.0) GOTO 901
IF(INPUT.EQ.0) GOTO 290
IDILAL=DVINP(1+8,0+4,IERRDV,DUMMY)
IF(IERRDV.NE.4) GOTO 300
WRITE(ITERM,2501)
IERRDV=IERRDV-4
300 IF(IERRDV.NE.0) GOTO 902
IF(IABS(IDILAL).EQ.125000) WRITE(ITERM,2502)
CALI(1)=8.859*SPA*DCAP*1000./(FLOAT(IDILAL-IDILAH)*PF**2)
WRITE(ITERM,2032) CALI(1)
C
310 IF(MOTODI.EQ.77) GOTO 330
WRITE(ITERM,2034)
WRITE(ITERM,2027)
READ(ITERM,1003) PS(2)
WRITE(ITERM,2028)
READ(ITERM,1003) PT(2)
WRITE(ITERM,2029)
READ(ITERM,1003) PF(2)
WRITE(ITERM,2035)
READ(ITERM,1004) ISHUNT
IEXP=(ISHUNT-1)/3
IPRO=ISHUNT-3*IEXP
IF(IPRO.GE.3) IPRO=5
ISHUNT=IPRO*10**(IEXP+1)
WRITE(ITERM,2036) ISHUNT
WRITE(ITERM,2037)
READ(ITERM,1004) ICOIL
AEFF=37.55*1.E-4
ANG=.0
IF(ICOIL.EQ.1) GOTO 320
AEFF=12.63*1.E-4
ANG=85.
320 AEFF=AEFF*ABS(SIN((HANG-ANG)*PI/180.))
CALI(2)=SIG*AEFF*HHI*1.E7/(5.19*FLOAT(ISHUNT))
WRITE(ITERM,2038) CALI(2)
330 IF(MOTODI.NE.77) GOTO 400
C MODULATION
400 WRITE(ITERM,2039)
READ(ITERM,1000) VAPRE
ITEN=IRUN/10
IONE=IRUN-ITEN*10
ITEN=ITEN+48
IONE=IONE+48
CALL CPUT3(FNAME(4),2,ITEN)
CALL CPUT3(FNAME(4),3,IONE)
C
REWIND IPARA
WRITE(IPARA,3000) (FNAME(I),I=1,6),MOTODI,IRUN
WRITE(IPARA,3001) SPL,SPA,SPV,HANG,VAPRE
WRITE(IPARA,3002) NP,HHI,HLO,DRHE3,PREC
WRITE(IPARA,3003) VIND,IMIN,ISEC
IF(MOTODI.EQ.68) WRITE(IPARA,3004) PS(1),PT(1),PF(1),CALI(1)
IF(MOTODI.EQ.68.OR.MOTODI.EQ.84) WRITE(IPARA,3004)
$ PS(2),PT(2),PF(2),CALI(2),SIG
C
WRITE(ITERM,4000) (FNAME(I),I=1,6)
WRITE(ITERM,4001) SPL,SPA,SPV,HANG
WRITE(ITERM,4002) NP,HHI,HLO,DRHE3,PREC,VIND,IMIN,ISEC,
IF(MOTODI.EQ.68) WRITE(ITERM,4003) PS(1),PT(1),PF(1),CALI(1)
IF(ICAR.EQ.68.OR.MOTODI.EQ.84) WRITE(ITERM,4004)
$ PS(2),PT(2),PF(2),CALI(2)
C
WRITE(ITERM,2040)
READ(ITERM,1000) YES
IF(.NOT.YES) GOTO 10
WRITE(ITERM,2041)
STOP
C
900 WRITE(ITERM,2900) IERRDO
STOP
901 WRITE(ITERM,2901) IERRDI
STOP
902 WRITE(ITERM,2902) IERRDV
STOP
1000 FORMAT (L1)
1001 FORMAT (A3)
1002 FORMAT (A1)
1003 FORMAT (F8.4)
1004 FORMAT (I2)
1005 FORMAT (I4)
1006 FORMAT (2A3)
C
2000 FORMAT (/1X,'NEW SET OF MEASUREMENTS (T OR F):',T70,$)
2001 FORMAT (/1X,'OUTPUT DEVICE (e.g. RKA1:,DSK:,...):',T70,$)
2002 FORMAT (/1X,'SAMPLE:',T70,$)
2003 FORMAT (1X,'DILA (D), TORQUE (T) OR MOD (M):',T70,$)
2004 FORMAT (1X,'TORQUE SIGN TEST'/T5,'UPPER C:'/)
2005 FORMAT (1H+,T5,'LOWER C:'/)
2006 FORMAT (1H+,T5,'SIGN',T40,'SIG =',F8.1)
2007 FORMAT (/1X,'SAMPLE:'/T5'VOLUME [CCM]:',T70,$)
2008 FORMAT (T5,'LENGTH [CM]:',T70,$)
2009 FORMAT (T5,'FACE [SCM]:',T70,$)
2010 FORMAT (/1X,'RUN NUMBER:',T70,$)
2011 FORMAT (/1X,'RUN NUMBER',T40,'IRUN =',6X,I2,' ? (T OR F)',T70,$)
2012 FORMAT (1X,'ANGLE',T40,'HANG =',F8.1,' ? (T OR F)',T70,$)
2013 FORMAT (1X,'ANGLE:',T70,$)
2014 FORMAT (1X,'NUMBER OF DATA POINTS',T40,'NP =',4X,I4)
2015 FORMAT (1X,'LARGEST FIELD',T40,'HHI =',F8.4,' [T]'/
$ 1X,'SMALLEST FIELD',T40,'HLO =',F8.4,' [T]'/
$ 1X,'INCREMENT IN 1/H',T40,'DRH =',F8.4,' [1E-3/T]'/
$ 1X,'LARGEST FREQUENCY IN SPECTRUM',T40,'FMAX =',F8.1,' [T]'/
$ 1X,'PRECISION OF DRH',T40,'PREC =',F8.2,' % ? (T/F)',T70,$)
2016 FORMAT (1X,'NUMBER OF DATA POINTS:',T70,$)
2017 FORMAT (1X,'LARGEST FIELD [T]:',T70,$)
2018 FORMAT (1X,'INCREMENT IN 1/H [1E-3/T]:',T70,$)
2019 FORMAT (1X,'SMALLEST FIELD',T40,'HLO =',F8.4,' [T]'/
$ 1X,'LARGEST FREQUENCY IN SPECTRUM',T40,'FMAX =',F8.1,' [T]')
2020 FORMAT (1X,'SMALLEST FIELD [T]:',T70,$)
2021 FORMAT (1X,'INCREMENT IN 1/H',T40,'DRH =',F8.4,' [1E-3/T]'/
$ 1X,'LARGEST FREQUENCY IN SPECTRUM',T40,'FMAX =',F8.1,' [T]')
2022 FORMAT (1X,'PRECISION OF DRH [%] (MAX 12 %):',T70,$)
2023 FORMAT (1X,'INITIAL SWEEP SPEED',T40,'v =',F8.4,' [T/s]')
2024 FORMAT (1X,'SET INDUCED VOLTAGE',T40,'Vind<=',F8.2,' [V];'/
$ 1X,'SMALLEST SWEEP TIME',T40,'TIME =',I3,3H ' ,I2,3H '')
2025 FORMAT (/1X,'NUMBER OF DATA POINTS, FIELD VALUES'/
$ 1X,'AND SWEEP VELOCITY OK ? (T OR F)',T70,$)
2026 FORMAT (/1X,'DILATION:')
2027 FORMAT (T5,'PAR SENSITIVITY [mmV]:',T70,$)
2028 FORMAT (T5,'PAR TIME CONSTANT [s]:',T70,$)
2029 FORMAT (T5,'CAPACITANCE [pF]:',T70,$)
2030 FORMAT (T5,'CALIBRATION [1E-3 pF]:',T70,$)
2031 FORMAT (T8,'UPPER C:'/)
2032 FORMAT (1H+,T8,'LOWER C:'/)
2033 FORMAT (1H+,T5,'CALIBRATION FACTOR',T40,'CALI =',
$ F8.2,' [1E-8 m/V]')
2034 FORMAT (/1X,'TORQUE:')
2035 FORMAT (T5,'SHUNT NUMBER:',T70,$)
2036 FORMAT (T5,'SHUNT',T40,'R =',2X,I6,' OHM')
2037 FORMAT (T5,'COIL NUMBER:',T70,$)
2038 FORMAT (T5,'CALIBRATION FACTOR',T40,'CALI =',F8.2,
$ ' [1E-7 Nm/V]')
2039 FORMAT (/1X,'VAPOUR PRESSURE ABOVE 125 Torr ? (T OR F):',
$ T70,$)
2040 FORMAT (/1X,'ALL OK ? (T OR F):',T70,$)
2041 FORMAT (/)
C
2500 FORMAT (1H+,T60,'')
2501 FORMAT (1X,'SIGN-CHANGE IN DVM MODE')
2502 FORMAT (1X,'OVERFLOW IN DVM MODE')
C
2900 FORMAT (1X,'SUBROUTINE DOUT:',T40,'IERR =',4X,I4)
2901 FORMAT (1X,'SUBROUTINE DINP:',T40,'IERR =',4X,I4)
2902 FORMAT (1X,'SUBROUTINE DVINP:',T40,'IERR =',4X,I4)
3000 FORMAT (6A3,2X,2I10)
3001 FORMAT (4E15.6,14X,L1)
3002 FORMAT (10X,I5,4E15.6)
3003 FORMAT (E15.6,10X,I5,10X,I5)
3004 FORMAT (5E15.6)
C
4000 FORMAT (//1X,6A3,':'/)
4001 FORMAT (1X,'SAMPLE:',T12,'SPL =',F8.4,' [CM]',T36,'SPA =',F8.4,
$ ' [SCM]',T60,'SPV =',F8.4,' [CCM]'/T12,'HANG =',F8.1)
4002 FORMAT (1X,'FIELD:',T12,'NP =',4X,I4,T36,'HHI =',F8.4,
$ ' [T]',T60,'HLO =',F8.4,' [T]'/
$ T36,'DRH =',F8.4,' [1E-3/T]',T60,'PREC =',F8.2,' %'/
$ T36,'VIND<=',F8.2,' [V]',T60,'TIME =',I3,3H ' ,I2,3H '')
4003 FORMAT (1X,'DILATION:',T12,'PS =',F8.1,' [mmV]',T36,'PT =',
$ F8.3,' [s]'/
$ T12,'PF =',F8.4,' [pF]',T36,'CALI =',F8.2,' [1E-8 m/V]')
4004 FORMAT (1X,'TORQUE:',T12,'PS =',F8.1,' [mmV]',T36,'PT =',F8.3,
$ ' [s]'/
$ T12,'PF =',F8.4,' [pF]',T36,'CALI =',F8.2,' [1E-7 Nm/V]')
C
END