C-----------------------------------------------------------------------
C  Subroutine to measure a reflection by :--
C    Theta/2Theta scan  (ITYPE=0)     or     Omega scan (ITYPE=1)
C
C    IROFL = 1 Count-rate Overflow;     ICC = 2 indicates a Collision
C
C  Modified for doing step scans at TRICS. 
C  IO to COUT instead LPT for SICS 
C  Mark Koennecke, November 1999
C-----------------------------------------------------------------------
      SUBROUTINE MESINT (IROFL,ICC)
      INCLUDE 'COMDIF'
      INTEGER IHTAGS(4), IRUPT
      REAL SPRESET
      ICPSMX = 45000
      IF (DFMODL .EQ. 'CAD4') ICPSMX = 25000
C-----------------------------------------------------------------------
C Reset the liquid nitrogen loading flag
C-----------------------------------------------------------------------
      IFILN = 0
      SPRESET = PRESET
  100 STIME = PRESET
      ICS = 0
      IROFL = 0
      NATT = 0
      IWARN = 0
      ISIGN = 1
      IF (THETA .LT. 0.0 .OR. THETA .GT. 180.0) ISIGN = -1
      D12 = BS*ABS(TAN(0.5*THETA/DEG))
      TTIME = 0.20*PRESET
  110 CALL SHUTTR (1)
      IF (NATTEN .GT. 0) THEN
	CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
	IF (ICOL .NE. 0) THEN
	  ICC = 2
	  CALL FILLN2 (IFILN,NFLG)
	  IF (NFLG .EQ. 1) GO TO 100
          PRESET = SPRESET
	  RETURN
	ENDIF
  120   CALL CCTIME (TTIME,COUNT)
	IF (COUNT/TTIME .GE. ICPSMX) THEN
	  NATT = NATT + 1
	  CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
	  IF (NATT .LT. NATTEN) GO TO 120
	ENDIF
      ENDIF
      IF ((ITYPE+1)/2 .EQ. 4) STIME = QTIME
      IF (ITYPE .GE. 4) GO TO 160
      IF (ITYPE .EQ. 0 .OR. ITYPE .EQ. 1) THEN
	DEL1 = AS + D12 + CS
	ANG1 = THETA - ISIGN*AS
	ANG2 = OMEGA
      ELSE
	DEL1 = AS + D12/2 + CS
	ANG1 = THETA + ISIGN*D12/3
	ANG2 = OMEGA - ISIGN*(AS + D12/6)
      ENDIF
C-----------------------------------------------------------------------
C  Offset to low angle side of reflection
C-----------------------------------------------------------------------
      ICC = 0
  130 CALL ANGSET (ANG1,ANG2,CHI,PHI,NATT,ICOL)
      IF (ICOL .NE. 0) THEN
	ICC = 2
	CALL FILLN2 (IFILN,NFLG)
	IF (NFLG .EQ. 1) GO TO 100
          PRESET = SPRESET
	RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Measure the low angle background for BGDTIM
C-----------------------------------------------------------------------
      BGDTIM = FRAC*PRESET
      CALL CCTIME (BGDTIM,BGRD1)
C-----------------------------------------------------------------------
C  Do the scan:
C         ITYPE        Type of scan  0 -- theta/2-theta  b-p-b
C                                    1 -- theta/2-theta  precision
C                                    2 -- omega          b-p-b
C                                    3 -- omega          precision
C         DEL1         Range of the scan (2-theta for types 0 & 1)
C         ACOUNT       Array of profile points with sum in ACOUNT(1)
C         TIME         Return value of scan time in secs
C         SPEED        Scan speed in degs/min.
C         NPPTS        No of points in returned profile
C         IERR         Error code 0 -- OK
C                                 1 -- Ratemeter overflow
C                                 2 -- Really bad!
C-----------------------------------------------------------------------
      SDEL1 = ISIGN*DEL1
      CALL TSCAN (ITYPE,SDEL1,ACOUNT(1),PRESET,STEP,NPPTS,IERR)
      CALL KORQ(IRUPT)
      IF(IRUPT .NE. 1)THEN
           WRITE(COUT,11000)
           CALL GWRITE(ITP,' ')
           PRESET = SPRESET
           RETURN
      ENDIF
      MAX = 1
      IEND = 10*NSIZE
      DO 135 I = 2,NPPTS
	IF (MAX .LT. ACOUNT(I)) MAX = ACOUNT(I)
	ACOUNT(IEND - I) = ACOUNT(I)
  135 CONTINUE
C-----------------------------------------------------------------------
C  For the CAD-4 at -ve 2theta the profile is delivered backwards.
C-----------------------------------------------------------------------
      IF (DFMODL .EQ. 'CAD4' .AND. 
     $    (THETA .LT. 0.0 .OR. THETA .GT. 180.0)) THEN
	J = IEND - NPPTS - 2
	DO 138 I = 2,NPPTS
	  ACOUNT(I) = ACOUNT(J + I)
  138   CONTINUE
      ENDIF
C      WRITE (COUT,99999) MAX,NPPTS,TIME
C      CALL GWRITE (ITP,' ')
C99999 FORMAT (I6,I4,F8.3)
C-----------------------------------------------------------------------
C  For the CAD-4 at high 2theta and chi near 90 there can be no profile,
C  because the interface detects a potential collision.
C  Then TIME = 0, and the profile analysis should not be done IDEL < 10
C-----------------------------------------------------------------------
      IF (DFMODL .EQ. 'CAD4') THEN
	RTIME = ABS(60*DEL1/SPEED)        
	IF (TIME .LT. RTIME/3) THEN
	  WRITE (LPT,12200) IH,IK,IL
	  WRITE (COUT,12200) IH,IK,IL
	  CALL GWRITE (ITP,' ')
	  IDEL = 5
	  GO TO 150
	ENDIF
      ENDIF
      IF (MAX*NPPTS/PRESET .GT. ICPSMX) IROFL = 1
      IF (IERR .GE. 2) THEN
	 WRITE (LPT,16000) IH,IK,IL
	 WRITE (COUT,16000) IH,IK,IL
	 CALL GWRITE (ITP,' ')
	 CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
	 GO TO 110
      ENDIF
C-----------------------------------------------------------------------
C  Test for low angle count too high near direct beam
C-----------------------------------------------------------------------
      IF (IROFL .NE. 0 .AND. PRESET .LT. 10) THEN
	WRITE (COUT,12000) IH,IK,IL
        CALL GWRITE(ITP,' ')
	GO TO 150
      ENDIF
C-----------------------------------------------------------------------
C  Plot the last reflection if SR2 is ON
C  For details of the profile plotting see PROFIL
C-----------------------------------------------------------------------
      ISTEP = 1000.0/DEL1
      IDEL = NPPTS + 1
C-----------------------------------------------------------------------
C  Test for -ve 2theta scan problem with SIERAY 145D
C-----------------------------------------------------------------------
      IF (IDEL .LT. 10) THEN
	WRITE (COUT,12100) IH,IK,IL
	CALL GWRITE (ITP,' ')
	GO TO 150
      ENDIF
C-----------------------------------------------------------------------
C  Possibly draw the raw data profile
C-----------------------------------------------------------------------
      CALL RSW (0,I)
      IF (I .EQ. 1) THEN
	DO 140 I = 1,4
	   IHTAGS(I) = 0
  140   CONTINUE
	IHTAGS(2) = AS*STEPDG
	CALL PTPREP (NPPTS,ACOUNT(2),IHTAGS)
      ENDIF
C-----------------------------------------------------------------------
C  Check that the scan time is reasonably close to the calculated value
C-----------------------------------------------------------------------
      COUNT = ACOUNT(1)
      IF (ICOL .NE. 0) THEN
	ICS = ICS + 1
	IF (ICS .LT. 2) GO TO 130
	ICC = 2
	CALL FILLN2 (IFILN,NFLG)
	IF (NFLG .EQ. 1) GO TO 100
        PRESET = SPRESET
	RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Change the attenuator if necessary and try again.
C-----------------------------------------------------------------------
      IF (IROFL .NE. 0) THEN
	IF (NATTEN .GT. 0 .AND. NATT .LT. NATTEN) THEN
	  NATT = NATT + 1
	  GO TO 130
	ENDIF
      ENDIF
C-----------------------------------------------------------------------
C  The scan is OK.
C  Correct the low angle background to the time FRAC*TIME, measure the
C  high angle background and then return.
C-----------------------------------------------------------------------
      I = BGRD1*PRESET*FRAC/BGDTIM + 0.5
      BGRD1 = I
      BGDTIM = PRESET*FRAC
      CALL CCTIME (BGDTIM,BGRD2)
      IF (BGRD1 + BGRD2 .GT. 4.0*COUNT) THEN
         WRITE (COUT,11000) IH,IK,IL
         CALL GWRITE(ITP,' ')
      ENDIF
      CALL FILLN2 (IFILN,NFLG)
      IF (NFLG .EQ. 1) GO TO 100
      PRESET = SPRESET
      RETURN
C-----------------------------------------------------------------------
C  Return if there are counting problems
C-----------------------------------------------------------------------
  150 COUNT = 2
      SUM = 2
      BGRD1 = 1
      BGRD2 = 1
      FRAC = 0.1
      PRESET = SPRESET
      NATT = 0
      ICC = 0
      IROFL = 0
      IWARN = 1
      CALL FILLN2 (IFILN,NFLG)
      IF (NFLG .EQ. 1) GO TO 100
      RETURN
C-----------------------------------------------------------------------
C  Set up peak top counting for appropriate angles
C-----------------------------------------------------------------------
  160 IF (ITYPE .EQ. 4 .OR. ITYPE .EQ. 6) THEN
	ANG1 = THETA - AS
	ANG2 = OMEGA
	ANG3 = THETA + BS*TAN(0.5*THETA/DEG) + CS
	ANG4 = OMEGA
	PRESET= STIME
      ELSE
	ANG1 = THETA
	ANG2 = OMEGA - AS
	ANG3 = THETA
	ANG4 = OMEGA + CS
      ENDIF
  170 CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
      IF (ICOL .NE. 0) THEN
	WRITE (COUT,13000) IH,IK,IL
        CALL GWRITE(ITP,' ')
	GO TO 150
      ENDIF
C-----------------------------------------------------------------------
C  Count at peak for time TIME
C-----------------------------------------------------------------------
  420 CALL CCTIME (PRESET,COUNT)
C      C = COUNT/PRESET
      IF (C .GE. ICPSMX .AND. NATTEN .GT. 0 .AND. NATT .LT. NATTEN) THEN
	NATT = NATT + 1
	GO TO 170
      ENDIF
C-----------------------------------------------------------------------
C  Drive to high angle background position and count
C-----------------------------------------------------------------------
      CALL ANGSET (ANG3,ANG4,CHI,PHI,NATT,ICOL)
      IF (ICOL .NE. 0) THEN
	WRITE (COUT,13000) IH,IK,IL
        CALL GWRITE(ITP,' ')
	GO TO 150
      ENDIF
C-----------------------------------------------------------------------
C  Measure the backgrounds
C-----------------------------------------------------------------------
      IF (ITYPE .EQ. 5 .OR. ITYPE .EQ. 6) THEN
	BGDTIM = FRAC*PRESET
	CALL CCTIME (BGDTIM,BGRD2)
	CALL ANGSET (ANG1,ANG2,CHI,PHI,NATT,ICOL)
	CALL CCTIME (BGDTIM,BGRD1)
	IF (BGRD1 + BGRD2 .GT. 4.0*COUNT) THEN
           WRITE (COUT,11000) IH,IK,IL
           CALL GWRITE(LPT,' ')
        ENDIF
	CALL FILLN2 (IFILN,NFLG)
        PRESET = SPRESET
	IF (NFLG .EQ. 1) GO TO 100
	RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Sample background on high side
C-----------------------------------------------------------------------
      PRESET = STIME*0.5
      CALL CCTIME (PRESET,BGRD2)
C-----------------------------------------------------------------------
C  Evaluate rough Peak/Background ratio and Time required to
C   accumulate a preset number FRAC of counts on the peak.
C-----------------------------------------------------------------------
      RRAT = COUNT/(2*BGRD2 + 1.0)
      IF (RRAT .LT. 1.05) RRAT = 1.05
      RTIM = FRAC*STIME/(COUNT + 1.0)
C-----------------------------------------------------------------------
C  Optimum time splitting and required total time
C-----------------------------------------------------------------------
      OPT = (RRAT - SQRT(RRAT))/(RRAT - 1.0)
      TOT = RTIM/OPT
      IF (TOT .GT. TMAX) TOT = TMAX
      IBCT = (TOT*(1.0 - OPT) + 1.0)/2.0
      IPCT = (TOT*OPT) + 1
C-----------------------------------------------------------------------
C  Finish measurement of high background
C-----------------------------------------------------------------------
      BCT = (IBCT - (STIME/2.0))
      IF (BCT .GT. 0.) THEN
	CALL CCTIME (BCT,BKG2)
	BGRD2 = BGRD2 + BKG2
	BCT = IBCT
	ICC = 0
      ELSE
	BCT = STIME/2.0
      ENDIF
      PCT = IPCT - STIME
      IF (PCT .GT. 0.) THEN
	CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
	IF (ICOL .NE. 0) THEN
	  ICC = 2
	  CALL FILLN2 (IFILN,NFLG)
          PRESET = SPRESET
	  IF (NFLG .EQ. 1) GO TO 100
	  RETURN
	ENDIF
	PPCT = PCT
	PCT = IPCT
	CALL CCTIME (PPCT,PC)
	COUNT = COUNT + PC
      ELSE
	PCT = STIME
      ENDIF
      CALL ANGSET (ANG1,ANG2,CHI,PHI,NATT,ICOL)
      IF (ICOL .NE. 0) THEN
	ICC = 2
	CALL FILLN2 (IFILN,NFLG)
        PRESET = SPRESET
	IF (NFLG .EQ. 1) GO TO 100
	RETURN
      ENDIF
      PRESET = BCT
      CALL CCTIME (PRESET,BGRD1)
      PRESET = PCT + BCT
      CALL FILLN2 (IFILN,NFLG)
      IF (NFLG .EQ. 1) GO TO 100
      PRESET = SPRESET
      RETURN
10000 FORMAT (' Clock Problems in reflection ',3I4)
11000 FORMAT (' Trouble Warning in reflection ',3I4)
12000 FORMAT (' Low Angle Problem in ',3I4)
12100 FORMAT (' Scan problem in ',3I4)
12200 FORMAT (' Potential CAD4 scan collision in',3I4)
13000 FORMAT (' Collision in reflection ',3I4)
16000 FORMAT (' Scan error in ',3I4,' Trying again')
      END
C-----------------------------------------------------------------------
C  Finish the measurement, with or without low temperature.
C-----------------------------------------------------------------------
      SUBROUTINE FILLN2 (IFILN,NFLG)
      INCLUDE 'COMDIF'
      NFLG = 0
      IF (ILN .EQ. 0) THEN
	CALL SHUTTR (-1)
	RETURN
      ENDIF
      DUM1 = 1.0/16.0
      DUM2 = 0.5
      CALL ONEBEP (DUM1,DUM2)
      IF (DUM2 .GT. 1) THEN
	TMIN = 0
	WRITE (COUT,10000)
	CALL GWRITE (ITP,' ')
  100   TIM1 = 1500
	CALL CCTIME (TIM1,CONT)
	DUM1 = 1.0/16.0
	DUM2 = 0.5
	CALL ONEBEP (DUM1,DUM2)
	IF (DUM2 .GE. 1.0) THEN
	  TMIN = TMIN + 0.25
	  GO TO 100
	ENDIF
	WRITE (COUT,11000) IH,IK,IL,NREF,TMIN,DELAY
	CALL GWRITE (ITP,' ')
	TMIN = DELAY*6000
	IF (TMIN .LE. 1) TMIN = 1
	CALL CCTIME (TMIN,DUM2)
	IFILN = 1
	NFLG = 1
      ENDIF
      IF (IFILN .NE. 0) ICC = ICC + 4
      CALL SHUTTR (-1)
      RETURN
10000 FORMAT (' Liquid Nitrogen fillup. Waiting...')
11000 FORMAT (' Liquid Nitrogen Tank now full',/,
     $        ' Reflection',3I3,' # ',I5,'.  Filling lasted',F6.2,
     $        ' minutes.',/,
     $        ' Now starting a ',F5.2,' minutes delay before',
     $        ' resuming data collection.')
      END