
CD-Section: Interface for XDL_VIEW Laue Simulations
C Special routines are available for interfacing to the XDL_VIEW X-windows
C toolkit Laue simulations view-object.
CD-end

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LRL_XDLSIM       **
C**************************
C
CD-Routine: Interface to X-windows Laue Simulation - LRL_XDLSIM
C This routine provides an interface the the XDL_VIEW Laue simulation
C view-object routine xdlf_laue_sim. Its use enables the internal arrays 
C storing the reflection data to be accessed directly and hence saves the user
C having to duplicate such information.
CD-end
CD-Fortran:
      SUBROUTINE LRL_XDLSIM (IVH, IVHPARENT, IX, IY, ICSET, ITYPE,
     +                       ISIZE, IREPL, MINW, MINH, IERR)
CD-end
      INCLUDE 'implicit_none.finc'
C
C Purpose: Interface to xdl_laue_sim routine
C
C          Note: This routine is supplied with the 'LRL' routines in
C                order to allow access to the internal 'LRL' data
C                structures which may not be accessed directly by
C                users' programs.
C
C Author:  John W. Campbell, July 1993
C
C Arguments:
C
      INTEGER IVH
      INTEGER IVHPARENT
      INTEGER IX
      INTEGER IY
      INTEGER ICSET
      INTEGER ITYPE
      INTEGER ISIZE
      INTEGER IREPL
      INTEGER MINW
      INTEGER MINH
      INTEGER IERR
CD-Parameters:   
C IVH        i (R)  View object handle for laue simulations view-object
C IVHPARENT  i (R)  View-object handle for parent, 0 if none
C IX         i (R)  X position (may be -1 if no parent to give default)
C IY         i (R)  Y position (may be -1 if no parent to give default)
C ICSET      i (R)  Colorset number
C ITYPE      i (R)  Type of simulation = 1, colour
C                                      = 2, interactive (b/w with sliders)
C ISIZE      i (R)  Halfwidth size in pixels
C IREPL      i (R)  =0 new simulation, =1 replace an existing one
C MINW       i (R)  Minimum width for view-object or 0 if no minimum
C MINH       i (R)  Minimum height for view-object or 0 if no minimum
C IERR       i (W)  Error flag =  0, OK
C                              = -1, no spots in list
C                              >  0, error code from xdl_laue_sim function
CD-end
C====== Parameter statements
C 
C
C====== GLOBALS:
C
      INCLUDE 'lrl_data.finc'
C
C====== LOCALS:
C
      CHARACTER*1 VALSTR
      CHARACTER*1 ERRSTR
      INTEGER I
      INTEGER LATT(4)
      INTEGER IFLAG
      INTEGER KERR
      INTEGER ND
      REAL  FILMR
      REAL  CELL(6)
      REAL  PHIS(4)
      REAL  CTOF
      REAL  WMIN
      REAL  WMAX
      REAL  DMIN
      REAL  D_LMIN
      REAL  D_LMAX
      REAL  D_DMIN
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      IF (NUM_SPOTS.EQ.0) THEN
         IERR = -1
         RETURN
      END IF
      D_LMIN = 0.05
      D_LMAX = 0.05
      D_DMIN = 0.05
C
C====== Get sort index arrays
C
      IF (ISORT.NE.2) CALL LRL_SORT(2)
      CALL INDXRV (DMIN_THR2, NUM_SPOTS, IWORK1)
      DO 10 I = 1, NUM_SPOTS
         IWORK2(I) = IWORK1(NUM_SPOTS-I+1)
10    CONTINUE
      CALL INDXRV (LAMBDAS, NUM_SPOTS, IWORK1)
C
C====== Get LDM data values
C         
      CALL LDM_GET_RMAX (FILMR, IFLAG, ND)
      CALL LDM_GET_LMIN (IPK, WMIN, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_LMAX (IPK, WMAX, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_DMIN (IPK, DMIN, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_A (CELL(1), IFLAG, ND)
      CALL LDM_GET_B (CELL(2), IFLAG, ND)
      CALL LDM_GET_C (CELL(3), IFLAG, ND)
      CALL LDM_GET_ALPHA (CELL(4), IFLAG, ND)
      CALL LDM_GET_BETA (CELL(5), IFLAG, ND)
      CALL LDM_GET_GAMMA (CELL(6), IFLAG, ND)
      CALL LDM_GET_SYST (VALSTR, LATT(1), IFLAG)
      CALL LDM_GET_LATT (VALSTR, LATT(2), IFLAG)
      CALL LDM_GET_BEAM (VALSTR, LATT(3), IFLAG)
      CALL LDM_GET_ROT (VALSTR, LATT(4), IFLAG)
      CALL LDM_GET_PHIX (IPK, PHIS(1), IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_PHIY (IPK, PHIS(2), IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_PHIZ (IPK, PHIS(3), IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_SPIN (IPK, PHIS(4), IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_CTOF (IPK, IPL, CTOF, IFLAG, ND, KERR, ERRSTR)
C
C====== Call Laue simulation routine
C
      IF (IREPL.EQ.0) THEN
         CALL XDLF_LAUE_SIM (IVH, IVHPARENT, IX, IY, ICSET, ITYPE,
     +     ISIZE, NUM_SPOTS, HKL, XF_D, YF_D, LAMBDAS, DMIN_THR2, 
     +     MULTS, FLAGS, NOD_HKL, IWORK1, IWORK2, INDX, FILMR, 0.0,
     +     WMIN, WMAX, DMIN, D_LMIN, D_LMAX, D_DMIN, 
     +     CELL, PHIS, LATT, CTOF,
     +     MINW, MINH, IERR)
      ELSE
         CALL XDLF_LAUE_SIM_NEW (IVH, NUM_SPOTS, HKL, XF_D, YF_D, 
     +     LAMBDAS, DMIN_THR2, MULTS, FLAGS, NOD_HKL, 
     +     IWORK1, IWORK2, INDX, FILMR, 0.0, WMIN, WMAX, DMIN, 
     +     CELL, PHIS, LATT, CTOF, IERR)
      END IF
      RETURN
      END
