150 lines
5.1 KiB
Fortran
150 lines
5.1 KiB
Fortran
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 CCTIME (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 CCTIME (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 CCTIME (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
|