C LAST UPDATE: C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C************************** C** LRL_XDLGNM ** C************************** C CD-Routine: Interface to X-windows Gnomonic Simulation - LRL_XDLGNM C This routine provides an interface the the XDL_VIEW Laue simulation C view-object routine xdlf_laue_sim in its mode to display a gnomonic C projection of the Laue patters. 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_XDLGNM (IVH, IVHPARENT, IX, IY, ICSET, ITYPE, + ISIZE, IREPL, GNOMR, MINW, MINH, IERR) CD-end INCLUDE 'implicit_none.finc' C C Purpose: Interface to xdl_laue_sim routine for a gnomonic projection 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 REAL GNOMR 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 GNOMR r (R) Minimum radius in mm (>0.1) from image centre for C conversion of plot to a gnomonic projection. C (If a value <= 0.1 is given a normal Laue C simulation will be given) 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, GNOMR, + 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, GNOMR, WMIN, WMAX, DMIN, + CELL, PHIS, LATT, CTOF, IERR) END IF RETURN END