Initial revision
This commit is contained in:
cvs
168
difrac/stdmes.f
Normal file
168
difrac/stdmes.f
Normal file
@@ -0,0 +1,168 @@
|
||||
C-----------------------------------------------------------------------
|
||||
C Subroutine to Measure Standard Refletions
|
||||
C Modified to output to ITP for SICS MK
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE STDMES
|
||||
INCLUDE 'COMDIF'
|
||||
DIMENSION ENREFB(10)
|
||||
EQUIVALENCE (NREFB(1),ENREFB(1))
|
||||
IF (NSTAN .EQ. 0) THEN
|
||||
KQFLAG = 1
|
||||
RETURN
|
||||
ENDIF
|
||||
CALL RSW (5,ILPT)
|
||||
C-----------------------------------------------------------------------
|
||||
C Set the standards flag
|
||||
C-----------------------------------------------------------------------
|
||||
100 ISTAN = 1
|
||||
IF (ILPT .EQ. 0) THEN
|
||||
IF (NMSEG .LE. NSEG) THEN
|
||||
WRITE (COT,10000) IH,IK,IL,NREF,NSET,NMSEG,NBLOCK
|
||||
ELSE
|
||||
WRITE (COUT,10100) NSET,NREF,NBLOCK
|
||||
ENDIF
|
||||
CALL GWRITE(ITP,' ')
|
||||
ENDIF
|
||||
C-----------------------------------------------------------------------
|
||||
C Loop to measure NSTAN standards
|
||||
C-----------------------------------------------------------------------
|
||||
JH = IH
|
||||
JK = IK
|
||||
JL = IL
|
||||
DO 120 NN = 1,NSTAN
|
||||
IH = IHSTAN(NN)
|
||||
IK = IKSTAN(NN)
|
||||
IL = ILSTAN(NN)
|
||||
C-----------------------------------------------------------------------
|
||||
C Calculate angles, set the display, set the circles and measure
|
||||
C-----------------------------------------------------------------------
|
||||
IPRVAL = 0
|
||||
CALL ANGCAL
|
||||
CALL HKLN (IHSTAN(NN),IKSTAN(NN),ILSTAN(NN),NREF)
|
||||
110 IF (ISCAN .EQ. 3 .OR. ISCAN .EQ. 4) THEN
|
||||
CALL SAMMES (ITIME,ICC)
|
||||
IF (ICC .EQ. 2) THEN
|
||||
WRITE (COUT,12000) IHSTAN(NN),IKSTAN(NN),ILSTAN(NN)
|
||||
CALL GWRITE(ITP,' ')
|
||||
GO TO 120
|
||||
ENDIF
|
||||
ELSE
|
||||
CALL MESINT (IROFL,ICC)
|
||||
IF (ICC .GE. 4) GO TO 100
|
||||
IF (ICC .EQ. 2) THEN
|
||||
WRITE (COUT,12000) IHSTAN(NN),IKSTAN(NN),ILSTAN(NN)
|
||||
CALL GWRITE(ITP,' ')
|
||||
GO TO 120
|
||||
ENDIF
|
||||
IF (IROFL .NE. 0) GO TO 110
|
||||
ENDIF
|
||||
C-----------------------------------------------------------------------
|
||||
C Pack h&k and l&natt, put psi=999.0 to denote standard
|
||||
C-----------------------------------------------------------------------
|
||||
IHK(NB) = (IHSTAN(NN) + 500)*1000 + IKSTAN(NN) + 500
|
||||
ILA(NB) = (ILSTAN(NN) + 500)*1000 + NATT
|
||||
BCOUNT(NB) = COUNT
|
||||
BBGR1(NB) = BGRD1
|
||||
BBGR2(NB) = BGRD2
|
||||
BTIME(NB) = PRESET
|
||||
IF (IPRFLG .EQ. 0) THEN
|
||||
IF (ISCAN .EQ. 3 .OR. ISCAN .EQ. 4) THEN
|
||||
BTIME(NB) = 10*ITIME + FRAC
|
||||
ELSE
|
||||
BTIME(NB) = FRAC
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENREFB(NB) = NREF
|
||||
BPSI(NB) = 999.0
|
||||
C-----------------------------------------------------------------------
|
||||
C Write a block of intensity data to file
|
||||
C-----------------------------------------------------------------------
|
||||
IF (NB .GE. 10) THEN
|
||||
WRITE (IID,REC=NBLOCK) IHK,ILA,BCOUNT,BBGR1,BBGR2,BTIME,
|
||||
$ ENREFB,BPSI
|
||||
NBLOCK = NBLOCK + 1
|
||||
NB = 0
|
||||
ENDIF
|
||||
NB = NB+1
|
||||
C-----------------------------------------------------------------------
|
||||
C Sort out which attenuators to apply and write standard on terminal
|
||||
C-----------------------------------------------------------------------
|
||||
ATT = ATTEN(NATT+1)
|
||||
IF (ITYPE .EQ. 7 .OR. ITYPE .EQ. 8) THEN
|
||||
IPCT = PRESET
|
||||
IBCT = (PRESET - IPCT)*2000
|
||||
PCOUNT = COUNT/IPCT - (BGRD1 + BGRD2)/IBCT
|
||||
SIG = SQRT(COUNT/(IPCT*IPCT) + (BGRD1 + BGRD2)/(IBCT*IBCT))
|
||||
PCOUNT = PCOUNT*ATT/IPCT
|
||||
SIG = SIG*ATT/IPCT
|
||||
PCT = IPCT
|
||||
IF (ILPT .EQ. 0) THEN
|
||||
WRITE (COUT,16000)
|
||||
$ NN,IHSTAN(NN),IKSTAN(NN),ILSTAN(NN),
|
||||
$ THETA,PCT,NATT,BGRD1,COUNT,BGRD2,PCOUNT,SIG
|
||||
CALL GWRITE(ITP,' ')
|
||||
ENDIF
|
||||
ELSE
|
||||
PCOUNT = COUNT - (BGRD1 + BGRD2)/(2.0*FRAC)
|
||||
PCOUNT = PCOUNT*ATT
|
||||
IF (ILPT .EQ. 0) THEN
|
||||
WRITE (COUT,13000)
|
||||
$ NN,IHSTAN(NN),IKSTAN(NN),ILSTAN(NN),
|
||||
$ THETA,TIME,NATT,BGRD1,COUNT,BGRD2,PCOUNT
|
||||
CALL GWRITE(ITP,' ')
|
||||
ENDIF
|
||||
SIG = SQRT(COUNT + (BGRD1 + BGRD2)/(4.0*FRAC*FRAC))
|
||||
ICOUNT = COUNT + 0.5
|
||||
ISIG = SIG + 0.5
|
||||
IF (NATT .NE. 0) THEN
|
||||
WRITE (COUT,14000) IHSTAN(NN),IKSTAN(NN),ILSTAN(NN),NATT,
|
||||
$ ICOUNT,ISIG,NN
|
||||
ELSE
|
||||
WRITE (COUT,14100) IHSTAN(NN),IKSTAN(NN),ILSTAN(NN),
|
||||
$ ICOUNT,ISIG,NN
|
||||
ENDIF
|
||||
CALL GWRITE (ITP,' ')
|
||||
IATT = NATT + 10
|
||||
C-----------------------------------------------------------------------
|
||||
C Write the profile on the screen
|
||||
C-----------------------------------------------------------------------
|
||||
CALL PROFIL
|
||||
C-----------------------------------------------------------------------
|
||||
C Test for K or Q stop
|
||||
C-----------------------------------------------------------------------
|
||||
ENDIF
|
||||
CALL KORQ (KQFLAG)
|
||||
IF (KQFLAG .EQ. 0) THEN
|
||||
ISTAN = 0
|
||||
KI = 'G3'
|
||||
RETURN
|
||||
ENDIF
|
||||
KQFLGS = 1
|
||||
IF (KQFLAG .EQ. 2) KQFLGS = 2
|
||||
120 CONTINUE
|
||||
C-----------------------------------------------------------------------
|
||||
C Reset standards flag and return with a disguised call to GOLOOP
|
||||
C-----------------------------------------------------------------------
|
||||
ISTAN = 0
|
||||
IH = JH
|
||||
IK = JK
|
||||
IL = JL
|
||||
KI = 'G3'
|
||||
IF(KQFLGS .NE. 0) THEN
|
||||
KQFLAG = KQFLGS
|
||||
ELSE
|
||||
KQFLAG = 1
|
||||
ENDIF
|
||||
RETURN
|
||||
10000 FORMAT (/20X,'Reference Reflection Measurement '/
|
||||
$ ' Next reflection:',3I4,', # ',I4,', Set',I3,
|
||||
$ ', Segment ',I2,', Record ',I4)
|
||||
10100 FORMAT (/20X,'Reference Reflection Measurement at end of set',I3/
|
||||
$ ' Restart at reflection #',I6,', segment 1, record',I5)
|
||||
11000 FORMAT (3I4,' Setting Collision')
|
||||
12000 FORMAT (3I4,' Scan Collision ')
|
||||
13000 FORMAT (2X,I1,3(I3,1X),2(F7.3,1X),I1,F5.0,F7.0,F5.0,10X,F7.0)
|
||||
14000 FORMAT (3I4,I2,I7,'(',I4,')',I2)
|
||||
14100 FORMAT (3I4,2X,I7,'(',I4,')',I2)
|
||||
16000 FORMAT (2X,I1,3(I3,1X),2(F7.3,1X),I1,F5.0,F7.0,F5.0,10X,2F8.2)
|
||||
END
|
||||
Reference in New Issue
Block a user