Files
sics/difrac/comptn.f
2000-02-18 15:54:23 +00:00

70 lines
2.4 KiB
Fortran

C-----------------------------------------------------------------------
C Count for a given time at a point within a defined Brillouin zone
C-----------------------------------------------------------------------
SUBROUTINE COMPTN(IBZ)
INCLUDE 'COMDIF'
IF (IBZ .EQ. 1) THEN
C-----------------------------------------------------------------------
C Test if point within B.Z. limits. Return with IBZ=3 for invalid
C-----------------------------------------------------------------------
JTEMP = IH*JA(NMSEG) + IK*JB(NMSEG) + IL*JC(NMSEG)
JMN = JMIN(NMSEG)
JMX = JMAX(NMSEG)
IF (JTEMP .LT. JMN .OR. JTEMP .GT. JMX) IBZ = 3
RETURN
ENDIF
C-----------------------------------------------------------------------
C Point measurement
C-----------------------------------------------------------------------
NATT = 0
C-----------------------------------------------------------------------
C Count for 1 sec to set correct attenuator
C No attenuator at TRICS, commented out, MK
C-----------------------------------------------------------------------
C ATIME = 1000.0
C CALL CTIME (ATIME,ATCOUN)
C IF (ATCOUN .GT. 10000.0) THEN
C NATT = NATT + 1
C IF (NATT .LT. 6) THEN
C CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
C IF (ICOL .NE. 0) THEN
C WRITE (COUT,10000) IH,IK,IL
C CALL GWRITE (ITP,' ')
C RETURN
C ENDIF
C ENDIF
C ENDIF
C-----------------------------------------------------------------------
C QTIME,TMAX
C-----------------------------------------------------------------------
SAVEQ = QTIME
STMAX = TMAX
QTIME = QTIME
TMAX = TMAX
C-----------------------------------------------------------------------
C Sample count at point to find suitable counting time, then measure
C-----------------------------------------------------------------------
CALL CCTIME (QTIME,ENQ)
COUNT = ENQ
ENQD = ENQ - 2.0*SQRT(ENQ)
IF (ENQD .LE. 0.0) ENQD = ENQ
F = ((100.0/PA)**2)/ENQD
PRESET = QTIME*F
IF (PRESET .GT. QTIME) THEN
IF (PRESET .GT. PRESET) PRESET = TMAX
TIMED = PRESET - QTIME
CALL CCTIME (TIMED,EN)
ELSE
PRESET = QTIME
EN = 0
ENDIF
COUNT = COUNT + EN
BGRD1 = 0.0
BGRD2 = 0.0
PSI = 0.0
QTIME = SAVEQ
TMAX = STMAX
RETURN
10000 FORMAT (3I4,' Collision')
END