File: INIT1.FT of Tape: Test/Tests/Blank-Tape-Unit1
(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