C-----------------------------------------------------------------------
C  RALF Routines for TRICS running SICS
C       interface.
C
C  Mark Koennecke, November 1999
C
C-----------------------------------------------------------------------
      SUBROUTINE HKLN (I1, I2, I3, I4)
      J1 = I1
      J2 = I2
      J3 = I3
      J4 = I4
      RETURN
      END
C-----------------------------------------------------------------------
C  INTON This routine must be called before any others and may be 
C        used to initialise the diffractometer
C-----------------------------------------------------------------------
      SUBROUTINE INTON
      RETURN
      END
C-----------------------------------------------------------------------
C  INTOFF -- clean up the interface
C-----------------------------------------------------------------------
      SUBROUTINE INTOFF
      return
      end
C-----------------------------------------------------------------------
C  ZERODF In case of an error this routine returns the diffractometer
C         to a known state
C-----------------------------------------------------------------------
      SUBROUTINE ZERODF
      RETURN
      END
C-----------------------------------------------------------------------
C  CTIME  Count for a fixed time
C-----------------------------------------------------------------------
      SUBROUTINE CCTIME (XTIME, XCOUNT)
      REAL XTIME, XCOUNT
      INCLUDE 'COMDIF'
      call setslt (icadsl,icol)
      CALL SICSCOUNT(XTIME,XCOUNT)
      RETURN
      END
C-----------------------------------------------------------------------
C  ANGET  Read the angles
C-----------------------------------------------------------------------
      SUBROUTINE ANGET (WTWOTH, WOMEGA, WCHI, WPHI)
      include 'COMDIF'
      CALL SICSANGET(WTWOTH,WOMEGA,WCHI,WPHI)
      wtwoth = wtwoth - dtheta
      womega = womega - wtwoth/2. - domega 
      wchi   = wchi   - dchi
      wphi   = wphi   - dphi
      if (wtwoth .lt. 0.0) wtwoth = wtwoth + 360.00
      if (womega .lt. 0.0) womega = womega + 360.00
      if (wchi   .lt. 0.0) wchi   = wchi   + 360.00
      if (wphi   .lt. 0.0) wphi   = wphi   + 360.00
      RETURN
      END
C----------------------------------------------------------------------
C ANGCHECK check the angles against hardware or software limits
C----------------------------------------------------------------------- 
      SUBROUTINE ANGCHECK (WTHETA, WOMEGA, WCHI, WPHI, INVALID)
      include 'COMDIF'
      atheta = wtheta + dtheta
      aomega = womega + domega + wtheta/2.0
      achi   = wchi   + dchi
      aphi   = wphi   + dphi  
      if (atheta .gt. 180.00) atheta = atheta - 360.00
      if (aomega .gt. 180.00) aomega = aomega - 360.00
      IF(ACHI .LT. 0)ACHI = ACHI + 360.
      IF(APHI .GT. 360.)APHI = APHI - 360.
      IF(APHI .LT. 0) APHI = APHI + 360.
      CALL SICSANGCHECK(ATHETA,AOMEGA,ACHI,APHI,INVALID)
      RETURN
      END
C-----------------------------------------------------------------------
C  ANGSET Set the angles
C-----------------------------------------------------------------------
      SUBROUTINE ANGSET (WTHETA, WOMEGA, WCHI, WPHI, NATTW, ICOL)
      include 'COMDIF'
      ishutf = 0
      if (nattw .gt. 0) then
        iattf = 1
      else
        iattf = 0
      endif
      atheta = wtheta + dtheta
      aomega = womega + wtheta/2. + domega
      achi   = wchi   + dchi
      aphi   = wphi   + dphi  
      if (atheta .gt. 180.00) atheta = atheta - 360.00
      if (aomega .gt. 180.00) aomega = aomega - 360.00
      IF(ACHI .LT. 0)ACHI = ACHI + 360.
      IF(APHI .GT. 360.)APHI = APHI - 360.
      IF(APHI .LT. 0) APHI = APHI + 360.
      CALL SICSANGSET(ATHETA,AOMEGA,ACHI,APHI,ICOL)
      RETURN
      END
C-----------------------------------------------------------------------
C  SHUTR  Open or close the shutter
C         IOC = 1 open, 2 close
C         INF = 0 OK
C-----------------------------------------------------------------------
      SUBROUTINE SHUTR (IOC, INF)
      INF = 0
      IF (IOC .EQ. 1) THEN
         ISHUTF = 1
      ELSE
         ISHUTF = 0
      ENDIF
      RETURN
      END

      SUBROUTINE ONEBEP(R1,R2)
      CHARACTER CTRLG*1
      RETURN
      END

C-----------------------------------------------------------------------
C  KORQ -- Read the keyboard buffer
C          If it contains K|k|Q|q return: 0 = K
C                                         1 = nothing found
C                                         2 = Q
C
C          KORQ will toggle the switch registers 1-9,0 if the numeric
C          keys are found in the buffer.
C-----------------------------------------------------------------------
      SUBROUTINE KORQ (I1)
      INCLUDE 'COMDIF'
      CHARACTER STRING*80
      LOGICAL SWFND,SAVED,SWCALL
      DATA SAVED/.FALSE./
      SWFND = .FALSE.
C-----------------------------------------------------------------------
C  First check if we are making a regular call after a K or Q has been
C  found from a call from RSW.
C-----------------------------------------------------------------------
      CALL CHECKINT(I1) 
      RETURN
      END
C-----------------------------------------------------------------------
C  RSW  Read the switch register
C-----------------------------------------------------------------------
      SUBROUTINE RSW (N,IVALUE)
      INCLUDE 'COMDIF'
      IVALUE = ISREG(N)
      RETURN
      END
C-----------------------------------------------------------------------
C Initialise the Program
C-----------------------------------------------------------------------
      SUBROUTINE INITL(R1,R2,R3,R4)
      A1 = R1
      A2 = R2
      A3 = R3
      A4 = R4
      RETURN
      END
C--------------------------------------------------------------------
C  Routine to perform scans.
C       ITYPE     Scan type --  0 or 2  Omega/2-theta
C                               1 or 3  Omega
C       SCNANG    Angle to scan in degrees.  This should be the
C                 2theta range for an omega-2theta scan and the
C                 omega range for an omega scan.
C       ACOUNT    Returns total intensity in ACOUNT(1) and profile
C                 in ACOUNT(2)-ACOUNT(NPPTS+1)
C       TIME      Total scan time in secs
C       SPEED     Scan speed in degs/min.
C       NPPTS     Number of points in the profile on output
C       IERR      Error code  0 -- O.K.
C                             1 -- Collision
C                             2 or more really bad!
C--------------------------------------------------------------------
      SUBROUTINE TSCAN (ITYPE,SCNANG,ACOUNT,PRESET,STEP,NPPTS,IERR)
      COMMON /DFMACH/ ISCDEF,ICDDEF,IDTDEF,IDODEF,IDCDEF,IFRDEF,NRC,
     $                NATTEN,STEPDG,ICADSL,ICADSW
      DIMENSION ACOUNT(*)
      REAL THSTART, OMSTART, CHI, PHI, TH, OM
      INTEGER ICOL, IT
C--------------------------------------------------------------------
C  Version 0.50  Supports itype = 0 or 1 omega-2theta and
C                                 2 or 3 omega
C                in both cases IANGLE is omega at the end of the scan
C
C  Version 0.6   Modified to be a generic routine using ANGSET and
C                CTIME for doing the scans. This ammounts to a simple
C                step scan. This is the only useful thing for TRICS
C                at SINQ.
C                PRESET is the preset for counting. 
C                STEP is the scan step width.
C--------------------------------------------------------------------
      IERR = 0
C--------------------------------------------------------------------
C  The diffractometer should have been positioned at the beginning
C  position for the scan.
C--------------------------------------------------------------------
      CALL SETSLT (ICADSL,ICOL)
      isense = 1
      if (scnang .lt. 0.0) then
        isense = -1
        scnang = - scnang
      endif
      NPPTS = INT(SCNANG/STEP)
      CALL ANGET(THSTART,OMSTART,CHI,PHI)
      IF (ITYPE .EQ. 0 .OR. ITYPE .EQ. 1) THEN
         MODE = 0
C--------------------------------------------------------------------
C  Omega scan
C--------------------------------------------------------------------
      ELSE IF (ITYPE .EQ. 2 .OR. ITYPE .EQ. 3) THEN
         MODE = 2
      ELSE
         IERR = 2
         RETURN
      ENDIF
C--------------------------------------------------------------------
C  Setup complete -- do the scan
C--------------------------------------------------------------------
      ACOUNT(1) = 0.
      DO 200, I = 1, NPPTS
C----- position 
        IF(MODE .EQ. 0) THEN
          TH = THSTART + ISENSE*I*STEP
          OM = 0
        ELSE IF(MODE .EQ. 2)THEN
          TH = THSTART
          OM = OMSTART + ISENSE*I*STEP
        ENDIF   
        CALL ANGSET(TH,OM,CHI,PHI,1,ICOL)
        IF(ICOL .GT. 0)THEN
          IERR = 2
          RETURN
        ENDIF
C----- count
        CALL CCTIME(PRESET,COUNT)
        CALL KORQ(IT)
        IF(IT .NE. 1)THEN
           IERR = 2
           RETURN
        ENDIF
        ACOUNT(I+1) = COUNT
        ACOUNT(1) = ACOUNT(1) + COUNT
 200  CONTINUE   
      return
      end
C--------------------------------------------------------------------
C  Routine to display a peak profile in the current graphics window.
C  The arguments are:
C
C  NHIST     The number of points to be plotted
C  HIST      An array of points
C  IHTAGS(4) The calculated peak position, the experimental position,
C            low background limit and high background limit.
C--------------------------------------------------------------------
      SUBROUTINE PTPREP (NHIST,HIST,IHTAGS)
      INTEGER   IHTAGS(4)
      REAL      HIST(*)
      INTEGER   IX,IY,IZ
      CHARACTER STRING*80
      RETURN
      END
C-------------------------------------------------------------------
C     RPSCAN  Ralf support for PSCAN routine
C PHI scan from -90 to 90 with a step of 2.
C-------------------------------------------------------------------
      SUBROUTINE RPSCAN (NPTS,ICOL,SPRESET)
      INCLUDE 'COMDIF'
      INTEGER IDIR,I,IT
      REAL WTH,WOM,WCHI,WPHI, STEP, PHI,SPRESET
      STEP = 2.
C-------------------------------------------------------------------
C     Get the current angles and decide which direction to scan
C-------------------------------------------------------------------
      CALL ANGET (WTH,WOM,WCHI,WPHI)
C------------------------------------------------------------------
C have the scan go always from 270 - 90 region as TRICS may have 
C restrictions around 0.
C------------------------------------------------------------------ 
      WPHI    = 270.00
      TARGET  =  90.00
      IDIR   = -1
      NPTS = 90
C-------------------------------------------------------------------
C     Now do the scan
C-------------------------------------------------------------------
      ACOUNT(1) = 0.
      DO 200, I = 1, NPTS
C----- position 
        PHI = WPHI + I*IDIR*STEP
        CALL ANGSET(WTH,WOM,WCHI,PHI,1,ICOL)
        IF(ICOL .GT. 0)THEN
          IERR = 2
          RETURN
        ENDIF
C----- count
        CALL CCTIME(SPRESET,COUNT)
        CALL KORQ(IT)
        IF(IT .NE. 1)THEN
           IERR = 2
           RETURN
        ENDIF
        ACOUNT(I) = COUNT
        ACOUNT(5*NSIZE+I) = PHI
 200  CONTINUE   
      RETURN
      END
C-------------------------------------------------------------------
C special to some strange diffractometer, just keep the linker happy
C-------------------------------------------------------------------
      SUBROUTINE MAXPOINT (IAXIS,WIDTH,STEPS,ANGLE)
      RETURN
      END
C-----------------------------------------------------------------------
C  GENSCN Routine to perform a scan of a given motor
C         ICIRCL  1 -- 2-theta       ISLIT   0 -- Nothing       
C                 2 -- omega                 1 -- Vertical
C                 3 -- kappa                 2 -- Horizontal
C                 4 -- phi                   3 -- +45 deg
C                                            4 -- -45 deg
C                                            5 -- Upper 1/2 circle
C                                            6 -- Lower 1/2 circle
C                                     10 to 59 -- horiz. aperture in mms
C         SPEED Speed in degrees per minute
C         STEP  Step width in degrees, NPTS number of steps
C         ICOL  0 -- OK
C         GENSCN is also only valid for CAD4
C-----------------------------------------------------------------------
      SUBROUTINE GENSCN (ICIRCL, WSPEED, WSTEP, NPTS, ISLIT, ICOL)
      return
      end
C-----------------------------------------------------------------------
C  SETSLT -- Set the slits
C cannot set slits at TRICS: NOT motorized
C-----------------------------------------------------------------------
      subroutine setslt (islt,icol)
      return
      end
C-----------------------------------------------------------------------
C  Set the microscope viewing position (CAD-4 version)
C-----------------------------------------------------------------------
      SUBROUTINE VUPOS (VTH,VOM,VCH,VPH)
      CALL ANGSET(VTH,VOM,VCH,VPH,1,1)
      RETURN
      END