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