Initial revision
This commit is contained in:
cvs
149
difrac/pcount.f
Normal file
149
difrac/pcount.f
Normal file
@@ -0,0 +1,149 @@
|
||||
C-----------------------------------------------------------------------
|
||||
C Subroutine to take a count for a given time
|
||||
C-----------------------------------------------------------------------
|
||||
SUBROUTINE PCOUNT
|
||||
INCLUDE 'COMDIF'
|
||||
DIMENSION C(20),IDEV(20),IFREQ(4),FREQ(4)
|
||||
REAL MPRESET
|
||||
CHARACTER TAG(20)*1
|
||||
DATA TAG/20*' '/
|
||||
WRITE (COUT,10000)
|
||||
CALL YESNO ('Y',ANS)
|
||||
IF (ANS .EQ. 'N') THEN
|
||||
KI = ' '
|
||||
RETURN
|
||||
ENDIF
|
||||
IF (NATTEN .NE. 0) THEN
|
||||
WRITE (COUT,11000)
|
||||
ELSE
|
||||
WRITE (COUT,12000)
|
||||
ENDIF
|
||||
CALL FREEFM (ITR)
|
||||
MPRESET = RFREE(1)
|
||||
IF (MPRESET .EQ. 0.0) MPRESET = 1000.0
|
||||
JFLAG = 0
|
||||
IF (NATT .NE. IFREE(2)) THEN
|
||||
JFLAG = 1
|
||||
NATT = IFREE(2)
|
||||
ENDIF
|
||||
IF (NATT .GT. NATTEN) NATT = NATTEN
|
||||
WRITE (COUT,14000)
|
||||
CALL YESNO ('N',ANS)
|
||||
C-----------------------------------------------------------------------
|
||||
C Get current angle values
|
||||
C-----------------------------------------------------------------------
|
||||
C CALL ANGET (THETA,OMEGA,CHI,PHI)
|
||||
ICC = 0
|
||||
C-----------------------------------------------------------------------
|
||||
C Use ANGSET to set the attenuator
|
||||
C-----------------------------------------------------------------------
|
||||
IF (JFLAG .EQ. 1) CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
|
||||
IF (ICOL .NE. 0) THEN
|
||||
WRITE (COUT,13000)
|
||||
CALL GWRITE (ITP,' ')
|
||||
KI = ' '
|
||||
RETURN
|
||||
ENDIF
|
||||
CALL SHUTTR (99)
|
||||
C-----------------------------------------------------------------------
|
||||
C Single count only
|
||||
C-----------------------------------------------------------------------
|
||||
IF (ANS .EQ. 'N') THEN
|
||||
CALL CTIME (MPRESET,COUNT)
|
||||
IF (NATTEN .NE. 0) THEN
|
||||
WRITE (COUT,15000) MPRESET,NATT,COUNT
|
||||
CALL GWRITE (ITP,' ')
|
||||
ELSE
|
||||
WRITE (COUT,16000) MPRESET,COUNT
|
||||
CALL GWRITE (ITP,' ')
|
||||
ENDIF
|
||||
CALL SHUTTR (-99)
|
||||
KI = ' '
|
||||
RETURN
|
||||
ENDIF
|
||||
C-----------------------------------------------------------------------
|
||||
C Repetitive counting, deriving counter preformance statistics.
|
||||
C-----------------------------------------------------------------------
|
||||
100 DO 110 I = 1,4
|
||||
IFREQ(I) = 0
|
||||
110 CONTINUE
|
||||
BIGTIM = MPRESET * 5.
|
||||
WRITE (LPT,17000) BIGTIM
|
||||
CALL CTIME (BIGTIM,COUNT)
|
||||
COUNT = COUNT*MPRESET/BIGTIM
|
||||
SIGM = SQRT(COUNT)
|
||||
AVC = COUNT + 0.5
|
||||
IF (NATTEN .NE. 0) THEN
|
||||
WRITE (LPT,18000) MPRESET,NATT,AVC,SIGM
|
||||
ELSE
|
||||
WRITE (LPT,19000) MPRESET,AVC,SIGM
|
||||
ENDIF
|
||||
WRITE (LPT,20000)
|
||||
DO 150 N = 1,50
|
||||
DO 120 I = 1,10
|
||||
CALL CTIME (MPRESET,COUNT)
|
||||
C(I) = COUNT
|
||||
120 CONTINUE
|
||||
DO 130 I = 1,10
|
||||
IDEV(I) = C(I) - AVC
|
||||
130 CONTINUE
|
||||
DO 140 I = 1,10
|
||||
TAG(I) = ' '
|
||||
IF (ABS(IDEV(I)) .GT. 0.674*SIGM) IFREQ(1) = IFREQ(1) + 1
|
||||
IF (ABS(IDEV(I)) .GT. SIGM) THEN
|
||||
TAG(I) = 'A'
|
||||
IFREQ(2) = IFREQ(2) + 1
|
||||
ENDIF
|
||||
IF (ABS(IDEV(I)) .GT. 2.*SIGM) THEN
|
||||
TAG(I) = 'B'
|
||||
IFREQ(3) = IFREQ(3) + 1
|
||||
ENDIF
|
||||
IF (ABS(IDEV(I)) .GT. 3.*SIGM) THEN
|
||||
TAG(I) = 'C'
|
||||
IFREQ(4) = IFREQ(4) + 1
|
||||
ENDIF
|
||||
140 CONTINUE
|
||||
WRITE (LPT,21000) (IDEV(I),TAG(I),I = 1,10)
|
||||
CALL KORQ (KQFLAG)
|
||||
IF (KQFLAG .NE. 1) GO TO 155
|
||||
150 CONTINUE
|
||||
I = 50
|
||||
155 BOT = 0.1*N
|
||||
DO 160 I = 1,4
|
||||
FREQ(I) = IFREQ(I)/BOT
|
||||
160 CONTINUE
|
||||
WRITE (LPT,22000) FREQ
|
||||
WRITE (COUT,23000)
|
||||
CALL YESNO ('N',ANS)
|
||||
IF (ANS .EQ. 'Y') GO TO 100
|
||||
CALL SHUTTR (-99)
|
||||
KI = ' '
|
||||
RETURN
|
||||
10000 FORMAT (' Timed Count at a Point (Y) ? '$)
|
||||
11000 FORMAT (' Type the Count Preset and the attenuator',
|
||||
$ ' number (1000.0,0) ',$)
|
||||
12000 FORMAT (' Type the Count Preset (1000.0) ',$)
|
||||
13000 FORMAT (' Setting Collision')
|
||||
14000 FORMAT (' Do you wish to repeat the counting for a stability',
|
||||
$ ' test (N) ? ',$)
|
||||
15000 FORMAT (' Time ',F8.3,', Attenuator',I2,', Count ',F7.0)
|
||||
16000 FORMAT (' Time ',F8.3,', Count ',F7.0)
|
||||
17000 FORMAT (' A count is taken for',F7.2,'secs to establish a',
|
||||
$ ' reasonable mean.'/
|
||||
$ ' Counts are then repeated 500 times and a statistical',
|
||||
$ ' summary printed.'/)
|
||||
18000 FORMAT (/,' Time ',F6.2,', Attn.',I2,', Mean Count ',F7.0,
|
||||
$ ' Sigma(Mean)',F7.1)
|
||||
19000 FORMAT (/,' Time ',F6.2,', Mean Count ',F7.0,
|
||||
$ ' Sigma(Mean)',F7.1)
|
||||
20000 FORMAT (' The deviations from the Mean Count are printed',
|
||||
$ ' followed by A, B or C,',/,
|
||||
$ ' if the deviation is more than 1, 2 or 3 Sigma(Mean).')
|
||||
21000 FORMAT (1X,10(I6,A1))
|
||||
22000 FORMAT (/' Distribution of Counts Observed Theoretical'/
|
||||
$ ' .GT. 0.674*Sigma ',F5.1,'% 50.0%'/
|
||||
$ ' .GT. 1.000*Sigma ',F5.1,'% 31.7%'/
|
||||
$ ' .GT. 2.000*Sigma ',F5.1,'% 4.6%'/
|
||||
$ ' .GT. 3.000*Sigma ',F5.1,'% 0.3%'/)
|
||||
23000 FORMAT (' Do you want to repeat the procedure (N) ? ',$)
|
||||
END
|
||||
Reference in New Issue
Block a user