C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     Program 'lauegen'   **    ****** L D M ******
C*****************************
C
C Purpose:  Generate Laue patterns and reflections lists; Determine and
C           refine crystal orientations.
C
C Author:   John W. Campbell, May 1990  (Original version)
C                             Sep 1993  (Incorporation of LDM)
C                             Sep 1994  Version 3.0 with soft-limits 
C                                       determinations
C                             Oct 1994  Version 3.1 with 'automatic' 
C                                       refinements including lg_refine command
C                             Nov 1994  Soft limit commands lg_dmin, lg_lmin
C                             Nov 1994  Allow for overwrite of existing files
C                             Nov 1994  Default is to write a log file named
C                                       'lauegen.log'. May be suppressed
C                                       by giving log file name of 'none'
C                                       via command line arg '-l logfile'
C                                       or environment variable LAUEGEN_LOG
C                             Nov 1994  Log writing of new parameters file
C                             Aug 1996  Version 4.1
C                                       Add spot size determining option,
C                                       spot integration, automatic
C                                       refinement option and command line
C                                       processing options.
C                             Feb 1997  Version 4.2 
C                                       Allow deconvolution of spatially
C                                       overlapped spots
C                             Feb 1997  Version 5.0
C                                       Add option for Gnomonic projection
C                                       simulations
C                             Jul 1997  Version 6.0
C                                       Allow for new treatment of overloads.
C                                       Changes for LIRL/LSM related mods.
C                                       Cylindrical detector option. 'mar'
C                                       and 'pfbyte' image formats. Allow
C                                       different width & height limits for
C                                       image display. (Changes to libraries 
C                                       LRL, LFN, LIRL, LDM and MTZ o/p format)
C                                       
C                               
C
C Program uses xdl_view (X-windows) routines.
C 
C This version uses the Laue Data Module (LDM) and related program
C independent functions
C
C Externally Selectable Options
C =============================
C
C    The following environment variables (logical names on Vax) may be set
C
C    LAUEGEN_FONT        Set to a value from 1 to 5 to select font size
C                        for the parameter tables, menu area, io-window etc.
C                        (the default is 2)
C
C    LAUEGEN_LOG         Set to the name of a log file (this will be used
C                        unless a log file name was set via the command
C                        line arguments). If the value is 'NONE' no log file
C                        will be written unless specified in the command
C                        line arguments.
C
C    LAUEGEN_UPD         Parameter updates flags for other packs/plates.
C                        Follow by a number with flags set for parameters
C                        to be updated as follows (value is sum of the
C                        numbers given for the required flags):
C                                                                     default
C                        Update lambda_min, lambda_max           1       y
C                        Update d_min                            2       y
C                        Update phix, phiy, phiz                 4       y
C                        Update c_to_f                           8       y
C                        Update x_cen_f, y_cen_f                16       y
C                        Update x_c, y_c                        32       y
C                        Update w_c                             64       n
C                        Update y_scale                        128       y
C                        Update twist, tilt                    256       y
C                        Update bulge                          512       n
C                        Update roff, toff                    1024       y
C                        Update spd parameters                2048       y
C                        Update spot size parameters          4096       y
C
C                        default is equivalent to 7615 (all=8191)
C
C Command line arguments
C ======================
C
C One of the following may be given -x (or x)  Run in interactive mode on an
C                                              X-windows terminal
C                                   -t (or t)  Run on a text terminal with
C                                              command input
C                                   -b (or b)  Run in backround mode
C
C In addition the code -l (or l) may be given followed by the name of
C an output log file. This will override any one set via the LAUEGEN_LOG
C environment variable and the program will not itself prompt for a log
C file name.
C
C======================================================================
C
      INCLUDE 'implicit_none.finc'
C
C
C====== PARAMETERS:
C
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'spot_box.finc'
      INCLUDE 'gnom_rmin.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'cell_input.finc'
      INCLUDE 'process_omit.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'image.finc'
      INCLUDE 'selrefs.finc'
      INCLUDE 'matches.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'refine_params.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'conics.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'auto_soft.finc'
      INCLUDE 'spot_sizes.finc'
      INCLUDE 'bg_progress.finc'
      INCLUDE 'upd_flags.finc'
      INCLUDE 'autorefn_flags.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'lirl_pars.finc'
      INCLUDE 'save_pkpl.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER INTFP
      INTEGER LENSTR
      INTEGER IARGC
C
C====== LOCALS:
C
C    
C====== xdl_view setup parameters
C
      INTEGER  NUMC
      INTEGER  NCOLORS(2)
      INTEGER  NPLANES(2)

C     INTEGER  NUMC                ! Number of colormaps
C     INTEGER  NCOLORS(2)          ! Array of NUMC 'ncolors' numbers
C     INTEGER  NPLANES(2)          ! Array of NUMC 'nplanes' numbers
C
C====== Miscellaneous parameters
C
      LOGICAL EOF
      LOGICAL QUIT
      LOGICAL PROC_SAV
      INTEGER I
      INTEGER IERR
      INTEGER IVHLIST(10)
      INTEGER IVH
      INTEGER IV
      INTEGER NARG
      INTEGER IOP
      INTEGER IFLAG
      INTEGER IFAIL
      INTEGER IUPD
      INTEGER ND
      INTEGER LL
      INTEGER LISTE(2)
      INTEGER IRET
      REAL FP
      CHARACTER*20 FONTSTR
      CHARACTER*2 ERRSTR
      CHARACTER*150 CMDLIN
      CHARACTER*2 CMD_OPTS(8)
      CHARACTER*(MAXFLEN) LOG_FILE
      CHARACTER*8 DATSTR
      CHARACTER*8 TIMSTR
      CHARACTER*80 HEADER
      CHARACTER*8 UPDSTR
      CHARACTER*20 TMPSTR

C     LOGICAL EOF         !End of file input flag
C     LOGICAL QUIT        !Quit program flag
C     LOGICAL PROC_SAV    !Save value of 'PROCESS' mode flag
C     INTEGER I           !Temp/loop variable
C     INTEGER IERR        !Error return flag
C     INTEGER IVHLIST(10) !View-object handles list for getting events
C     INTEGER IVH         !View-object handle from getting events
C     INTEGER IV          !Integer value from INTFP
C     INTEGER NARG        !No. of command line arguments
C     INTEGER IOP         !Command line option number
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER IFAIL       !File opening flag
C     INTEGER IUPD        !Flag for setting required parameter updates
C     INTEGER ND          !No. of decimal places flag
C     INTEGER LL          !String length (significant)
C     INTEGER LISTE(2)    !Dummy array for SET_PAR1_VALS,SET_PAR2_VALS calls
C     INTEGER IRET        !Return flag form CHECK_INTEGRATED
C     REAL FP             !Real value from INTFP
C     CHARACTER*20 FONTSTR !Character string to receive value of LAUEGEN_FONT
C                          !environment variable
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C     CHARACTER*150 CMDLIN !Command line
C     CHARACTER*2 CMD_OPTS(8) !Command line options
C     CHARACTER*(MAXFLEN) LOG_FILE !Name of log file
C     CHARACTER*8 DATSTR   !Date string
C     CHARACTER*8 TIMSTR   !Time string
C     CHARACTER*80 HEADER  !Log file header
C     CHARACTER*8 UPDSTR   !Parameter updates flag string
C     CHARACTER*20 TMPSTR

      DATA CMD_OPTS/'-X','X','-T','T','-B','B','-L','L'/
C
C-------------------------------------------------------------------------------
C
C====== Set current version
C
      VERSTR = '6.0'
C
C====== Preliminary initialisations
C
      LG_MODE = 1
      CALL TRWSET (5, 6, 0, 0, 0)
      LOG_FILE = ' '
C
C====== Extend LDM parameter set with parameters required by LAUEGEN
C
      CALL EXTEND_LDM
C
C====== Interpret command line arguments
C
      NARG = IARGC()
      IF (NARG.GT.0) THEN
         I = 0
10       I = I + 1
         IF (I.GT.NARG) GO TO 20
         CALL UGTARG (I, CMDLIN)
         CALL CCPUPC (CMDLIN)
         CALL GETOPT (CMD_OPTS, 8, CMDLIN, IOP, IERR)
         IF (IERR.GT.0) GO TO 10
         IF (IOP.EQ.1.OR.IOP.EQ.2) THEN
            LG_MODE = 1
         ELSE IF (IOP.EQ.3.OR.IOP.EQ.4) THEN
            LG_MODE = 2
         ELSE IF (IOP.EQ.5.OR.IOP.EQ.6) THEN
            LG_MODE = 3
         ELSE IF (IOP.EQ.7.OR.IOP.EQ.8) THEN
            IF (I.LT.NARG) THEN
               I = I + 1
               CALL UGTARG (I, LOG_FILE)
            END IF
         END IF
         GO TO 10
      END IF
C
C====== Initialise the xdl_view routines
C
20    IF (LG_MODE.EQ.1) THEN
         NUMC = 1
         NCOLORS(1) = 72
         NPLANES(1) = 0
         CALL XDLF_OPEN_VIEW (NUMC, NCOLORS, NPLANES, IERR)
         IF (IERR.GT.0) THEN
            WRITE (6,2001) IERR
            IF (IERR.NE.1) STOP
         END IF
      END IF
C
C====== Assign the view-object handles
C
      IVH_BASE = 1
      IVH_PAR1 = 2
      IVH_PAR2 = 3
      IVH_PAR3 = 4
      IVH_MENU = 5
      IVH_IOW = 6
      IVH_CMD = 7
      IVH_BAR = 8
      IVH_FILM = 9
      IVH_GRAPH = 10
      IVH_BASE_AUT = 11
      IVH_TABL_AUT = 12
      IVH_MENU_AUT = 13
      IVH_IOW_AUT = 14
      IVH_SIM = 15
      IVH_AUTR_BASE = 16
      IVH_AUTR_TAB = 17
      IVH_AUTR_GRA = 18
      IVH_AUTR_MEN = 19
      IVH_CNCL_BUT = 20
      IVH_PROF_TAB = 21
C
C====== Set logical unit nos.
C
      IUN_LOG = 10
      IUN_GEN = 20
      IUN_MATCH = 21
      IUN_REFLIST = 22
      IUN_GE1 = 23
      IUN_GE2 = 24
      IUN_SPOTS = 25
C
C====== Initialise flags
C
      CALL INIT_FLAGS
C
C====== Initialise symbol types
C
      ISYMBTYP(1) = 2
      ICOLRTYP(1) = 3
      ISYMBTYP(2) = 2
      ICOLRTYP(2) = 5
      ISYMBTYP(3) = 4
      ICOLRTYP(3) = 1
      ISYMBTYP(4) = 24
      ICOLRTYP(4) = 1
      ISYMBTYP(5) = 4
      ICOLRTYP(5) = 4
      ISYMBTYP(6) = 4
      ICOLRTYP(6) = 1
      ISYMBTYP(7) = 4
      ICOLRTYP(7) = 1
      ISYMBTYP(8) = 3
      ICOLRTYP(8) = 5
      ISYMBTYP(9) = 24
      ICOLRTYP(9) = 1
      ISYMBTYP(10) = 13
      ICOLRTYP(10) = 4
      ISYMBTYP(11) = 10
      ICOLRTYP(11) = 1
      
C
C====== Other initialisations
C
      MAX_OBSERVED = MAX_OBS
      CALL SET_OMIT (1)
      KDX_LIRL = -1
      KDX_INTFLAGS = -1
      KEY_LOG = 1
      CALL INIT_LIRL
C
C====== Get required font size (LAUEGEN_FONT)
C
      IFONT = 2
      CALL UGTENV ('LAUEGEN_FONT',FONTSTR)
      IF (FONTSTR.NE.' ') THEN
         IF (INTFP(FONTSTR,FP,IV).EQ.1) THEN
            IF (IV.GE.1.AND.IV.LE.5) IFONT = IV
         END IF
      END IF
C
C====== Open log file if defined (LAUEGEN_LOG)
C
      IF (LOG_FILE.EQ.' ') THEN
         CALL UGTENV ('LAUEGEN_LOG',LOG_FILE)
      END IF
      TMPSTR = LOG_FILE
      CALL CCPUPC (TMPSTR)
      IF (LOG_FILE.EQ.' ') LOG_FILE = 'lauegen.log'
      IF (TMPSTR.NE.'NONE') THEN
         IFAIL = 1
         CALL CCPDPN (-IUN_LOG, LOG_FILE,'UNKNOWN','F',0,IFAIL)
         IF (IFAIL.LT.0) THEN
            WRITE (6,2002) LOG_FILE(1:LENSTR(LOG_FILE))
            STOP
         END IF
      ELSE
         IUN_LOG = 0
      END IF
      IF (IUN_LOG.GT.0) THEN
         CALL CCPDAT(DATSTR)
         CALL UTIME(TIMSTR)
         HEADER = 'LAUEGEN program (version'
         CALL STR_ADDS (HEADER, VERSTR, 1)
         CALL STR_ADDS (HEADER, '):     Run on', 0)
         CALL STR_ADDS (HEADER, DATSTR, 1)
         CALL STR_ADDS (HEADER, 'at',1)
         CALL STR_ADDS (HEADER, TIMSTR, 1)
         LL = LENSTR(HEADER)
         WRITE (IUN_LOG,6000) HEADER(1:LL)
         WRITE (IUN_LOG,6001) ('=',I = 1, LL)
         WRITE (IUN_LOG,6002)
      END IF
C
C====== See if parameter update flags set (LAUEGEN_UPD)
C
      IUPD = -1
      CALL UGTENV ('LAUEGEN_UPD',UPDSTR)
      IF (UPDSTR.NE.' ') THEN
         IF (INTFP(UPDSTR,FP,IV).EQ.1) THEN
            IF (IV.GE.0.AND.IV.LE.8191) IUPD = IV
         END IF
      END IF
      CALL SET_UPD_FLAGS(IUPD)
C
C====== Set default LDM values and cell input values
C
      CALL LDM_RESET (' ', 0, 0, IERR, ERRSTR)
      CALL LDM_CH_RESET(0)
      CALL LDM_GET_A (CELL_INPUT(1), IFLAG, ND)
      CALL LDM_GET_B (CELL_INPUT(2), IFLAG, ND)
      CALL LDM_GET_C (CELL_INPUT(3), IFLAG, ND)
      CALL LDM_GET_ALPHA (CELL_INPUT(4), IFLAG, ND)
      CALL LDM_GET_BETA (CELL_INPUT(5), IFLAG, ND)
      CALL LDM_GET_GAMMA (CELL_INPUT(6), IFLAG, ND)
      CALL RESET_CELL
C
C====== Other initial settings
C
      CALL INIT_SETTINGS
C
C====== Set up initial screen (X-windows mode)
C
      IF (LG_MODE.EQ.1) THEN
         CALL SCREEN_SETUP
C
C====== Setup parameter tables 1&2 with default values (X-windows mode)
C
         CALL SET_PAR12_NAM
         CALL SET_OMIT (2)
         CALL SET_PAR1_VALS (0, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
C
C====== Input from main menu (X-windows mode)
C
         CALL SEL_FUNC
      ELSE
C
C====== Terminal or background/batch modes
C
         PROC_SAV = PROCESS
100      IF (LG_MODE.EQ.2) THEN
            IF (PROCESS) THEN
               CALL TPROMP ('lauegen process > ')
            ELSE
               CALL TPROMP ('lauegen > ')
            END IF
         END IF
         CALL TREAD (CMDLIN,EOF)
         IF (EOF) GO TO 200
         IF (LG_MODE.EQ.3) THEN
            IF (IUN_LOG.GT.0) WRITE (IUN_LOG,1001)
     +         'Command > ',CMDLIN(1:LENSTR(CMDLIN))
         END IF
         CALL CMD_INPUT (CMDLIN, QUIT)
         IF (QUIT) THEN
            CALL CHECK_INTEGRATED (2, 1, IRET)
            IF (IRET.LT.2) GO TO 200
            GO TO 100
         END IF
         IF (.NOT.PROCESS.AND.PROC_SAV) THEN
            CALL CHECK_INTEGRATED (1, 1, IRET)
            IF (IRET.EQ.2) PROCESS = .TRUE.
         END IF
         IF (PROCESS.AND..NOT.PROC_SAV) THEN
            CALL CHECK_INTEGRATED (5, 1, IRET)
            IF (IUN_LOG.GT.0) THEN
               WRITE (IUN_LOG,1000)
               WRITE (IUN_LOG,1010)
               CALL LDM_WRITE (IUN_LOG, 3)
               WRITE (IUN_LOG,1020)
            END IF
            CALL LDM_CH_RESET (0)
         END IF
         PROC_SAV = PROCESS
         GO TO 100
      END IF
C
C====== End of processing
C
200   IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG,1002)
         CALL LDM_WRITE (IUN_LOG, 3)
      END IF
      STOP
C
C====== Format statements
C
1001  FORMAT (/,A,A)
1002  FORMAT (/,'LDM Parameters at Program Quit',/,
     +          '==============================',/)
1000  FORMAT (/,'Process Mode Entered',/,
     +          '====================',/)
1010  FORMAT ('Current LDM parameter values:-',/)
1020  FORMAT (' ')
C
2001  FORMAT (/,'**Error code', I2, ' from xdlf_open_view**')
2002  FORMAT (/,'**Error** Cannot open log file: ',A)
C
6000  FORMAT (/,A)
6001  FORMAT (120A1)
6002  FORMAT (' ')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     A_CALC           **
C**************************
C
C
      SUBROUTINE  A_CALC (ORIENT, PHIS, A_MAT)
C
      INCLUDE 'implicit_none.finc'
C
C
C Purpose: Calculates the master matrix, a_mat, from the crystal system,
C          crystal alignment and cell parameters.
C          This is then premultiplied by the phi matrices.
C Purpose: 
C
C Author:  Based on code from GENLAUE by Clifton et al.
C
C Arguments:
C
      REAL       ORIENT(3,3)
      REAL       PHIS(3)
      REAL       A_MAT(3,3)
C
C ORIENT   (R)   Orientation matrix from crystal setting & cell parameters
C PHIS     (R)   The three missetting angles
C A_MAT    (W)   The master matrix
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      REAL    PC(3,3)
      INTEGER   I, J
C
C------------------------------------------------------------------------------
C
C
C====== Define phi rotation matrix
C
      CALL MTX_ROTATE(PHIS,PC)
C
C====== Apply phi rotations
C
      CALL MTX_MULT(PC,ORIENT,A_MAT,3,3,3)
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C******************************
C**     AUTO_CLEARINT_CTL    **
C******************************
C
C
      SUBROUTINE AUTO_CLEARINT_CTL (OPTSTR, IPKPL_DF, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control deletion of integrated intensities
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      CHARACTER*(*) OPTSTR
      INTEGER IPKPL_DF
      INTEGER IERR
C
C OPTSTR       (R)   Line containing non-default options codes
C IPKPL_DF     (R)   Default flag for plate/pack/all = 1/2/3
C IERR         (W)   Error flag =0 OK, =1 options error (error messages
C                    handled from within this routine)
C
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER IPKPL
      INTEGER INP(3)
      INTEGER NKEYS
      INTEGER IKEY
      INTEGER KERR
      INTEGER LL
      INTEGER M1
      INTEGER M2
      INTEGER I
      INTEGER II
      INTEGER NPACKS
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER IPL
      CHARACTER*8 KEYS(3) 
      CHARACTER*4 SEP
      CHARACTER*80 ERRSTR
      CHARACTER*80 ERRSTR2
      CHARACTER*25 NAME
      CHARACTER*120 STR

C     INTEGER IPKPL              !Process plate/pack/all flag flag
C     INTEGER INP(3)             !Flags for option key already input
C     INTEGER NKEYS              !No. of option keys
C     INTEGER IKEY               !Option key number
C     INTEGER KERR               !Error flag
C     INTEGER LL                 !Index to last character processed in string
C     INTEGER M1                 !Index to first character in token
C     INTEGER M2                 !Index to final character in token
C     INTEGER I                  !Temp/loop variable
C     INTEGER II                 !LDM_INTFP function return value
C     INTEGER NPACKS             !No. of packs
C     INTEGER NPLATES            !No. of plates/pack
C     INTEGER IFLAG              !Parameter status flag
C     INTEGER IPL                !Plates loop counter
C     CHARACTER*8 KEYS(3)        !Option keys
C     CHARACTER*4 SEP            !Token separator characters
C     CHARACTER*80 ERRSTR        !Error string 
C     CHARACTER*80 ERRSTR2       !Subsidiary error string
C     CHARACTER*25 NAME          !Option key name
C     CHARACTER*120 STR          !Message string

      DATA SEP /'  ,='/
      DATA KEYS /'PLATE',
     +           'PACK',
     +           'ALL'/
C
C
C-------------------------------------------------------------------------------
      IERR = 0
      ERRSTR = ' '
      ERRSTR2 = ' '
      IF (IUN_LOG.GT.0) WRITE (IUN_LOG, 1000)
C
C====== Check pack
C
      CALL LDM_GET_NUMP (NPACKS, IFLAG)
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (IPACK.LT.1.OR.IPACK.GT.NPACKS) THEN
         ERRSTR = 'Current pack number is invalid'
         ERRSTR2 = 'Pack ='
         CALL STR_ADDI (ERRSTR2, IPACK, 1)
         CALL STR_ADDS (ERRSTR2, ', plate =', 1)
         CALL STR_ADDI (ERRSTR2, IPLATE, 1)
         CALL AUTO_CLEARINT_ERR (IUN_LOG, ERRSTR, ERRSTR2)
         IERR = 1
         RETURN
      END IF
C
C====== Interpret command string
C
      DO 10 I = 1, 3
         INP(I) = 0
 10   CONTINUE
      IPKPL = 0
      NKEYS = 3
      SEP(2:2) = CHAR(9)
      LL = 0
100   I = NXTTOK (OPTSTR, SEP, LL, M1, M2)
      IF (I.EQ.-1) GO TO 200
      IF (I.EQ.0) GO TO 100
      NAME = OPTSTR(M1:M2)
      CALL CCPUPC (NAME)
      CALL GETOPT (KEYS, NKEYS, NAME, IKEY, KERR)
      IF (KERR.NE.0) THEN
         IF (KERR.EQ.1)  ERRSTR = 'Ambiguous option'
         IF (KERR.EQ.2)  ERRSTR = 'Invalid option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1) 
         CALL AUTO_CLEARINT_ERR (IUN_LOG, ERRSTR, ERRSTR2) 
         IERR = 1
         RETURN
      END IF
      IF (INP(IKEY).EQ.1) THEN
         ERRSTR = 'Duplicate option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1)  
         CALL AUTO_CLEARINT_ERR (IUN_LOG, ERRSTR, ERRSTR2) 
         IERR = 1
         RETURN
      END IF
      IF (IPKPL.NE.0) THEN
         ERRSTR = 'Inconsistent option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1)  
         CALL AUTO_CLEARINT_ERR (IUN_LOG, ERRSTR, ERRSTR2) 
         IERR = 1
         RETURN
      END IF
      INP(IKEY) = 1
      IPKPL = IKEY
      GO TO 100
C
C====== Set pack range 
C
 200  IF (IPKPL.EQ.0) IPKPL = IPKPL_DF
      IF (IPKPL.EQ.1) THEN
         IF (IUN_LOG.GT.0) THEN
            STR = 'Intensities cleared for pack'
            CALL STR_ADDI(STR,IPACK,1)
            CALL STR_ADDS(STR,', plate',0)
            CALL STR_ADDI(STR,IPLATE,1)
            WRITE(IUN_LOG,1010)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
         END IF
         CALL LIRLF_DELETE (KDX_LIRL, IPACK, IPLATE, KERR)
         CALL INTFLAG_SET (IPACK, IPLATE, 0)
      ELSE IF (IPKPL.EQ.2) THEN
         IF (IUN_LOG.GT.0) THEN
            STR = 'Intensities cleared for pack'
            CALL STR_ADDI(STR,IPACK,1)
            WRITE(IUN_LOG,1010)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
         END IF
         CALL LIRLF_DELETE (KDX_LIRL, IPACK, 0, KERR)
         DO 250 IPL = 1, NPLATES
            CALL INTFLAG_SET (IPACK, IPL, 0)
 250     CONTINUE
      ELSE
         IF (IUN_LOG.GT.0) THEN
            STR = 'Intensities cleared for all packs and plates'
            WRITE(IUN_LOG,1010)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
         END IF
         CALL INIT_LIRL
         RETURN
      END IF
      RETURN
C
C====== Format statements
C
1000  FORMAT (/,'==Automatic Clear Intensities==')
1010  FORMAT(' ')
1020  FORMAT(A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     AUTO_CLEARINT_ERR     **
C*******************************
C
C
      SUBROUTINE AUTO_CLEARINT_ERR (KUN_LOG, ERRSTR, ERRSTR2) 
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle command line requested clear intensities errors
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      INTEGER KUN_LOG
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
C
C Parameters:
C
C KUN_LOG     i  (R)  Unit number for log file (0 if none)
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      CHARACTER*120 STR

C     LOGICAL EOF             !End of file flag

C
C-------------------------------------------------------------------------------
C
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
         IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                       ERRSTR2(1:LENSTR(ERRSTR2))
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL LMESSAGE (IVH_CMD, STR)
         IF (ERRSTR2.NE.' ') THEN
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR2, 1)
            CALL LMESSAGE (IVH_CMD, STR)
         END IF
         RETURN

      ELSE IF (LG_MODE.EQ.2) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL TWRITE (STR)
         IF (ERRSTR2.NE.' ') THEN
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR2, 1)
            CALL TWRITE (STR)
         END IF
         RETURN
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     AUTO_CNTL        **
C**************************
C
C
      SUBROUTINE AUTO_CNTL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control auto-indexing (Elder) option
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'image.finc'
      INCLUDE 'symbol_types.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EXISTS
      LOGICAL CENTRE_READ
      INTEGER IERR
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVHLST2(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER M_READ
      INTEGER M_MEAS
      INTEGER M_CURRENT
      INTEGER I
      INTEGER J
      INTEGER IFAIL
      INTEGER M1
      INTEGER M2
      INTEGER NVALS
      INTEGER IYN
      INTEGER NUMP
      INTEGER IFLAG
      REAL    X_CEN_F
      REAL    Y_CEN_F
      REAL    W_F
      REAL    VALUES(20)
      CHARACTER*80 STR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) SPOTS_FILE
      CHARACTER*25 NAMES(3)
      CHARACTER*25 QUITNAM
C
C     LOGICAL EXISTS          !File exists flag
C     LOGICAL CENTRE_READ     !Centre read from file flag
C     INTEGER IERR            !Error return flag
C     INTEGER NVIEW           !No. of view-object for getting events
C     INTEGER IVHLIST(2)      !List of view-object handles for getting events
C     INTEGER IVHLST2(2)      !2'nd list of view-object handles
C     INTEGER IVH             !Returned view-object handle from getting events
C     INTEGER ITEM            !Menu item number
C     INTEGER IQUIT           !Quit box selected flag
C     INTEGER M_READ          !Menu item no. for: 'Read Spots File'
C     INTEGER M_MEAS          !Menu item no. for: 'Measure Spots on Image'
C     INTEGER M_CURRENT       !Menu item no. for: 'Use Current Spots'
C     INTEGER I               !Temp/loop variable
C     INTEGER J               !Temp/loop variable
C     INTEGER IFAIL           !File open failure flag
C     INTEGER M1              !Token start position
C     INTEGER M2              !Token end position
C     INTEGER NVALS           !Number of numerical values in spots file record
C     INTEGER IYN             !Return flag from yes/no notice
C     INTEGER NUMP            !Number of packs
C     INTEGER IFLAG           !Parameter status flag
C     REAL    X_CEN_F         !x centre from fids or input (rasters)
C     REAL    Y_CEN_F         !y centre from fids or input (rasters)
C     REAL    W_F             !omega from fids or 0.0 (degrees)
C     REAL    VALUES(20)      !Numerical values from spots file record
C     CHARACTER*80 STR                 !Temp character string
C     CHARACTER*(MAXFLEN) FILNAM       !File name as input
C     CHARACTER*(MAXFLEN) SPOTS_FILE   !Spots file name
C     CHARACTER*25 NAMES(3)            !Menu item names
C     CHARACTER*25 QUITNAM             !Quit box label

      DATA NAMES /'Read Spots File',
     +            'Measure Spots on Image',
     +            'Use Current Spots'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Reset to key plate if current plate is not key plate
C
      CALL SET_KEYPLATE
C
C====== Find source of spots for auto-indexing
C
      M_READ = 1
      M_MEAS = 2
      M_CURRENT = 3
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 3, XDLSTR(NAMES), 24,
     +                         XDLSTR('Autoindexing Spots Menu'), 23,
     +                         XDLSTR(QUITNAM), 24, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) RETURN
C
C====== Read Spots File
C
         IF (ITEM.EQ.M_READ) THEN
102         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.spots): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') GO TO 100
            CALL FILEXT (FILNAM, 'spots', SPOTS_FILE, I)
            EXISTS = CCPEXS (SPOTS_FILE)
            IF (.NOT.EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**File not found**')
               GO TO 102
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_SPOTS, SPOTS_FILE,'READONLY','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 102
            END IF
            READ (IUN_SPOTS,'(A)',END=104) STR
            J = 0
            IF (NXTTOK (STR, ' ', J, M1, M2).EQ.0) THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''spots:'' keyword**')
               CLOSE (IUN_SPOTS)
               GO TO 102
            END IF
            CALL CCPUPC(STR)
            IF (STR(M1:M2).NE.'SPOTS:') THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''spots:'' keyword**')
               CLOSE (IUN_SPOTS)
               GO TO 102
            END IF
            NUM_INP_SPOTS = 0
            CENTRE_READ = .FALSE.
103         READ (IUN_SPOTS,'(A)',END=104) STR
            IF (STR.EQ.' ') GO TO 103
            CALL STRVAL (STR, ' =', 20, VALUES, NVALS)
            IF (NVALS.NE.2) THEN
               CALL LMESSAGE(IVH_IOW,'**Invalid format in record**')
               GO TO 103
            END IF
            IF (.NOT.CENTRE_READ) THEN
               XCEN_SPOTS = VALUES(1)
               YCEN_SPOTS = VALUES(2)
               IXCEN_SPOTS = NINT(XCEN_SPOTS)
               IYCEN_SPOTS = NINT(YCEN_SPOTS)
               CENTRE_READ = .TRUE.
               GO TO 103
            END IF
            IF (NUM_INP_SPOTS.GE.MAX_MEAS) THEN
               CALL LMESSAGE (IVH_IOW,'**Spots list full**')
               GO TO 104
            END IF
            NUM_INP_SPOTS = NUM_INP_SPOTS + 1
            XINP_SPOTS(NUM_INP_SPOTS) = VALUES(1)
            YINP_SPOTS(NUM_INP_SPOTS) = VALUES(2)
            IXINP_SPOTS(NUM_INP_SPOTS) = NINT(XINP_SPOTS(NUM_INP_SPOTS))
            IYINP_SPOTS(NUM_INP_SPOTS) = NINT(YINP_SPOTS(NUM_INP_SPOTS))
            GO TO 103
104         CLOSE (IUN_SPOTS)
            IF (NUM_INP_SPOTS.EQ.0) THEN
               CALL ERR_NOTICE(1,'**No spots read**')
               GO TO 100
            ENDIF
            STR = 'Number of spots input ='
            CALL STR_ADDI(STR,NUM_INP_SPOTS,1)
            CALL LMESSAGE(IVH_IOW,STR)
C
C====== Measure Image
C
         ELSE IF (ITEM.EQ.M_MEAS) THEN
C
C====== Check that pack input
C
            CALL LDM_GET_NUMP (NUMP, IFLAG)
            IF (NUMP.EQ.0) THEN
               CALL ERR_NOTICE (1, '**Number of packs is zero**')
               GO TO 100
            END IF
C
C====== Open image file if not already done
C
            CALL CHK_OPN(IERR)
            IF (IERR.GT.0) GO TO 100
C
C====== Get (default) centre position
C
            CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
            XCEN_SPOTS = X_CEN_F
            YCEN_SPOTS = Y_CEN_F
            IXCEN_SPOTS = NINT(XCEN_SPOTS)
            IYCEN_SPOTS = NINT(YCEN_SPOTS)
C
C====== Display film/image-plate image
C
            CALL SHOW_IMAGE (1, IERR)
            IF (IERR.EQ.1) GO TO 100
C
C====== Display centre symbol
C
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +                IXCEN_SPOTS, IYCEN_SPOTS,
     +                ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            CALL MEASURE_IMG
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            IF (NUM_INP_SPOTS.EQ.0) THEN
               CALL ERR_NOTICE(0,'**No spots measured**')
               GO TO 50
            END IF
C
C====== Use Current Spots
C
         ELSE IF (ITEM.EQ.M_CURRENT) THEN
            IF (NUM_INP_SPOTS.EQ.0) THEN
               CALL ERR_NOTICE(1,'**No current spots**')
               GO TO 100
            END IF
         END IF
C
C====== Check that some spots given
C
200      IF (NUM_INP_SPOTS.EQ.0) THEN
            CALL ERR_NOTICE(0,
     +           '**No spots yet defined for auto-indexing**')
            GO TO 50
         END IF     
         IF (NUM_INP_SPOTS.LT.3) THEN
            CALL ERR_NOTICE(0,'**Less than 3 spots defined**')
            GO TO 50
         END IF
C
C====== Input index limits and spot positions error
C
         NRAD2_AUT = 10
         STR = 'Limit of h**2+k**2+l**2 (max='
         CALL STR_ADDI(STR,MAX_AUTO_RAD2,0)
         CALL STR_ADDS(STR,')',0)
         CALL IOW_ASKI(IVH_IOW,STR,NRAD2_AUT)
         IF (NRAD2_AUT.GT.MAX_AUTO_RAD2) THEN
            STR = '**Maximum value exceeded, reset to'
            CALL STR_ADDI(STR,MAX_AUTO_RAD2,1)
            CALL STR_ADDS(STR,'**',0)
            CALL LMESSAGE(IVH_IOW,STR)
            NRAD2_AUT = MAX_AUTO_RAD2
         END IF
         SPERR = 0.5
         CALL IOW_ASKF(IVH_IOW,'Error in spot positions (mm)',
     +                 SPERR,2)
C
C====== Call auto-indexing routine
C
         CALL AUTO_IDX
C
C====== See if any solutions
C
         IF (NSTORE_AUT.LE.0) THEN
            CALL YESNO_NOTICE (0, 'Retry with different limits', 
     +                            IYN)
            IF (IYN.EQ.1) GO TO 200
         ELSE
            CALL AUTO_SEL
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     AUTO_IDX         **
C**************************
C
C
      SUBROUTINE AUTO_IDX
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Auto indexing (Method of M.Elder)
C
C Author:  Modified version of M. Elder's INDEXL
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      INTEGER I
      INTEGER J
      INTEGER K
      INTEGER II
      INTEGER L
      INTEGER N
      INTEGER NSOL
      INTEGER MAX_M
      INTEGER NOBS
      INTEGER IDET
      INTEGER NBAD_DET
      INTEGER IHKL(3,MAX_AUTO_SPOTS)
      INTEGER IPSOL(MAX_AUTO_SOLNS,MAX_AUTO_SPOTS)
      INTEGER ISPOT(3,MAX_AUTO_SPOTS)
      INTEGER ITCNT
      INTEGER IDIR
      INTEGER ITIM
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      REAL CTOF
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL XX
      REAL XF
      REAL XQ
      REAL YQ
      REAL ZQ
      REAL YF
      REAL PI
      REAL RMSD
      REAL DEV
      REAL DEVSAV
      REAL SOL(3,3)
      REAL NEWSOL(3,3)
      REAL ADJ
      REAL ANG(3)
      REAL ANGL(MAX_AUTO_SPOTS,MAX_AUTO_SPOTS)
      REAL XSPOT(4,MAX_AUTO_SPOTS)
      REAL XC(5,MAX_AUTO_SPOTS)
      REAL RKEY(MAX_AUTO_SOLNS)
      CHARACTER*80 STR
      CHARACTER*2 ERRSTR

C     INTEGER I            !Temp/loop variable
C     INTEGER J            !Temp/loop variable
C     INTEGER K            !Temp/loop variable
C     INTEGER II           !Temp/loop variable
C     INTEGER L            !Loop counter over found solutions
C     INTEGER N            !No. of spots used in autoindexing
C     INTEGER NSOL         !No. of solutions found for max. no. of matches
C     INTEGER MAX_M        !Maximum number of matches for found solutions
C     INTEGER NOBS         !No. of observations for evaluating orientation
C                           and missetting angles
C     INTEGER IDET         !Error flag from EVANGL
C     INTEGER NBAD_DET     !No. of solutions with bad determinants
C     INTEGER IHKL(3,MAX_AUTO_SPOTS)           !Indices of reflections used
C                                               for evaluating orientation
C     INTEGER IPSOL(MAX_AUTO_SOLNS,MAX_AUTO_SPOTS) !Lists of matching spots
C                                                   for each solution
C     INTEGER ISPOT(3,MAX_AUTO_SPOTS)          !Indices assigned to spots
C     INTEGER ITCNT        !Iteration count for refining angles
C     INTEGER IDIR         !Refinement flag
C     INTEGER ITIM         !Refinement flag
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IERR         !Error flag
C     REAL CTOF            !Crystal to film distance
C     REAL MM_RAST_X       !Conversion mm to x-rasters
C     REAL MM_RAST_Y       !Conversion mm to y-rasters
C     REAL XX              !Temp variable
C     REAL XF              !Film x coordinate
C     REAL YF              !Film y coordinate
C     REAL XQ              !Detector x coordinate wrt 'q' axes (see LDM_DTOQAX)
C     REAL YQ              !Detector y coordinate wrt 'q' axes (see LDM_DTOQAX)
C     REAL ZQ              !Detector z coordinate wrt 'q' axes (see LDM_DTOQAX)
C     REAL PI              !Pi
C     REAL RMSD            !Rms deviation
C     REAL DEV             !Current rms deviation for solution
C     REAL DEVSAV          !Saved value of DEV from previous iteration
C     REAL SOL(3,3)        !Rotation matrix
C     REAL NEWSOL(3,3)     !New rotation matrix
C     REAL ADJ             !Adjustment step for refining angles
C     REAL ANG(3)          !Current values of missetting angles
C     REAL ANGL(MAX_AUTO_SPOTS,MAX_AUTO_SPOTS) !Angles between observed spots
C     REAL XSPOT(4,MAX_AUTO_SPOTS)             !Observed spots parameters
C     REAL XC(5,MAX_AUTO_SPOTS)                !Positions of reflections used
C                                               for evaluating orientation
C                                               (observed and calculated)
C     REAL RKEY(MAX_AUTO_SOLNS) !Array for sorting (indexing) solutions
C     CHARACTER*80 STR     !Temporary string
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
      PI = 3.14159265
      NSTORE_AUT = 0
      CALL LDM_GET_CTOF (IPACK, IPLATE, CTOF, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
C
C====== Get the angles between possible nodal reflections
C
      CALL LMESSAGE(IVH_IOW,
     +     '*Pre-calculating angles between low index reflections*')
      NREF_AUT = 0
      CALL INDANG
C
C====== Get spots for auto-indexing
C
      IF (NUM_INP_SPOTS.GT.MAX_AUTO_SPOTS) THEN
         STR = '**Spot list truncated to maximum of'
         CALL STR_ADDI(STR,MAX_AUTO_SPOTS,1)
         CALL STR_ADDS(STR,'spots**',1)
         CALL ERR_NOTICE(0,STR)
      END IF
      N = MIN (MAX_AUTO_SPOTS,NUM_INP_SPOTS)
      DO 10 I = 1,N
         XF = (XINP_SPOTS(I)-XCEN_SPOTS)/MM_RAST_X
         YF = (YINP_SPOTS(I)-YCEN_SPOTS)/MM_RAST_Y
         CALL LDM_DTOQAX (XF, YF, CTOF, XQ, YQ, ZQ)
         XSPOT(1,I) = XF
         XSPOT(2,I) = YF
         XSPOT(3,I) = PI/2.0 - 0.5*ATAN2(SQRT(XQ**2+YQ**2),ZQ)
         XSPOT(4,I) = ATAN2(YQ,XQ)
10    CONTINUE
C
C====== Calculate the angles between the spots
C
 90   DO 110 I = 2 , N
         DO 100 J = 1 , I - 1
            ANGL(I,J) = COS(XSPOT(4,J))*SIN(XSPOT(3,J))*COS(XSPOT(4,I))
     +                  *SIN(XSPOT(3,I)) + SIN(XSPOT(4,J))
     +                  *SIN(XSPOT(3,J))*SIN(XSPOT(4,I))*SIN(XSPOT(3,I))
     +                  + COS(XSPOT(3,J))*COS(XSPOT(3,I))
            IF (ABS(ANGL(I,J)).GT.1.0) ANGL(I,J) = SIGN(1.0,ANGL(I,J))
            ANGL(I,J) = ACOS(ANGL(I,J))
 100     CONTINUE
 110  CONTINUE
C
C====== Now try to match these angles against the pre-calculated ones
C
      CALL INDMAT(N,ANGL,NSOL,IPSOL,MAX_M)
      IF (NSOL.EQ.0) THEN
         CALL ERR_NOTICE(0,'**No solutions found**')
         RETURN
      END IF
      MAX_MATCH_AUT = MAX_M
C
C====== Loop over all the solutions
C
      NBAD_DET = 0
      L = 0
 200  L = L + 1
      DO 210 I = 1 , N
         K = IPSOL(L,I)
         IF (K.EQ.0) THEN
            ISPOT(1,I) = 0
            ISPOT(2,I) = 0
            ISPOT(3,I) = 0
         ELSE
            ISPOT(1,I) = INDX_AUT(K,1)
            ISPOT(2,I) = INDX_AUT(K,2)
            ISPOT(3,I) = INDX_AUT(K,3)
         END IF
 210  CONTINUE
C
C====== Calculate orientation
C
 220  NOBS = 0

      DO 230 I = 1 , N
         IF (ISPOT(1,I).NE.0 .OR. ISPOT(2,I).NE.0 .OR. ISPOT(3,I).NE.0)
     +       THEN
            NOBS = NOBS + 1
            IHKL(1,NOBS) = ISPOT(1,I)
            IHKL(2,NOBS) = ISPOT(2,I)
            IHKL(3,NOBS) = ISPOT(3,I)
            XC(1,NOBS) = XSPOT(1,I)
            XC(2,NOBS) = XSPOT(2,I)
         END IF
 230  CONTINUE

      CALL EVANGL(NOBS,IHKL,XC,ANG,RMSD,DEV,SOL,IDET)

      IF (IDET.EQ.2) THEN
         NBAD_DET = NBAD_DET + 1
         GO TO 310
      END IF
C
C====== Store data relating to current solution
C 
      IF (NSTORE_AUT.GE.MAX_AUTO_SOLNS) THEN
         CALL ERR_NOTICE(0,'**Too many solutions**')
         GO TO 350
      ENDIF
      NSTORE_AUT = NSTORE_AUT + 1
      STNOBS(NSTORE_AUT) = NOBS
      DO 235 II = 1,NOBS
            STHKL(NSTORE_AUT,1,II) = IHKL(1,II)
            STHKL(NSTORE_AUT,2,II) = IHKL(2,II)
            STHKL(NSTORE_AUT,3,II) = IHKL(3,II)
            STXC(NSTORE_AUT,1,II) = XC(1,II)
            STXC(NSTORE_AUT,2,II) = XC(2,II)
235   CONTINUE
      STDEV0(NSTORE_AUT) = DEV
C
C====== Perform initial refinement of angles
C
      ADJ = DEV/20.
      ITCNT = 0
 270  DO 290 K = 1 , 4
         I = K
         IF (I.GT.3) I = I - 3
         IDIR = 1
         ITIM = 0
 280     DEVSAV = DEV
         ITIM = ITIM + 1
         ANG(I) = ANG(I) - ADJ*(IDIR-2)
         CALL EROTMT(ANG,NEWSOL,SOL,RMSD)
         CALL EVCOOR(NEWSOL,XC,DEV,NOBS,IDET)
         ITCNT = ITCNT + 1
         IF (ITCNT.GE.100) GO TO 300
         IF (DEV.LT.DEVSAV) GO TO 280
         ANG(I) = ANG(I) + ADJ*(IDIR-2)
         DEV = DEVSAV
         IF (ITIM.LE.1) THEN
            IF (IDIR.LE.1) THEN
               IDIR = 3
               ITIM = 0
               GO TO 280
            END IF
         END IF
 290  CONTINUE
      IF (ADJ.LT.0.02) GO TO 300
      ADJ = ADJ/5.
      GO TO 270
 
 300  STDEV(NSTORE_AUT) = DEV
      STANG(NSTORE_AUT,1) = ANG(1)
      STANG(NSTORE_AUT,2) = ANG(2)
      STANG(NSTORE_AUT,3) = ANG(3)
      DO 305 II = 1,NOBS
         STXC(NSTORE_AUT,3,II) = XC(3,II)
         STXC(NSTORE_AUT,4,II) = XC(4,II)
         STXC(NSTORE_AUT,5,II) = XC(5,II)
 305  CONTINUE
 310  IF (L.LT.NSOL) GO TO 200
C
C====== End of solutions reached
C
 350  IF (NSTORE_AUT.EQ.0) THEN
         CALL ERR_NOTICE(0,'**No valid solutions found**')
         RETURN
      END IF

C
C====== Sort solutions
C
      DO 400 I = 1, NSTORE_AUT
         IP_AUT(I) = I
         RKEY(I) = STDEV(I)
 400  CONTINUE
      IF (NSTORE_AUT.GT.1) THEN
         DO 450 J = 2, NSTORE_AUT
            II = IP_AUT(J)
            XX = RKEY(J)
            DO 410 I = J-1,1,-1
               IF (RKEY(I).LE.XX) GO TO 420
               IP_AUT(I+1) = IP_AUT(I)
               RKEY(I+1) = RKEY(I)
 410        CONTINUE
            I=0
 420        IP_AUT(I+1) = II
            RKEY(I+1) = XX
 450     CONTINUE
      END IF
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C******************************
C**     AUTO_INTEGRATE_CTL   **
C******************************
C
C
      SUBROUTINE AUTO_INTEGRATE_CTL (IOP, SKIP_INT, OPTSTR, IPKPL_DF, 
     +                               NPROF_DF, PROMIN_DF, PROF_ROT_DF,
     +                               IPRF_ALL_DF, NOVLD_DF, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control automatic integration 
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      INTEGER IOP
      LOGICAL SKIP_INT
      CHARACTER*(*) OPTSTR
      INTEGER IPKPL_DF
      INTEGER NPROF_DF
      REAL PROMIN_DF
      LOGICAL PROF_ROT_DF
      INTEGER IPRF_ALL_DF
      INTEGER NOVLD_DF
      INTEGER IERR
C
C IOP          (R)   = 1 called from Integration options menu
C                    = 2 called via command line input
C SKIP_INT     (R)   Skip integration for a plate if already done
C OPTSTR       (R)   Line containing non-default options codes & values
C IPKPL_DF     (R)   Default plate/pack/all flag 1/2/3
C NPROF_DF     (R)   Default NPROF value
C PROMIN_DF    (R)   Default PROMIN value
C PROF_ROT_DF  (R)   Default PROF_ROT value
C IPRF_ALL_DF  (R)   Default value for IPRF_ALL flag 0 = use key plate profiles
C                    for all plates in pack, 1 = get profiles for each plate
C NOVLD_DF     (R)   Default value for no. of overload pixels allowed in
C                    an 'OK' spot for integration
C IERR         (W)   Error flag =0 OK, 
C                    =1 error (Note that reporting of errors is done within 
C                       this routine.
C                    =100 Cancelled

C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'image.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
      INTEGER LENSTR
      INTEGER LDM_INTFP
      LOGICAL CMD_CNCL
      EXTERNAL CMD_CNCL
      EXTERNAL INTEGRATE_PROGRESS
C
C====== LOCALS:
C
      LOGICAL NEXT
      LOGICAL PROF_ONLY
      LOGICAL OKNOD
      LOGICAL SPOV
      LOGICAL CLOS
      LOGICAL MEAS
      LOGICAL BAD
      LOGICAL OVLD
      LOGICAL ANY_TO_INT
      LOGICAL PROF_ROT_USE
      INTEGER IMG_PK
      INTEGER IMG_PL
      INTEGER NPACKS
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER NPROF_USE
      INTEGER IPRF_ALL_USE
      INTEGER NOVLD_USE
      INTEGER IPKPL
      INTEGER ISING_PLATE
      INTEGER INP(8)
      INTEGER NKEYS
      INTEGER IKEY
      INTEGER KERR
      INTEGER JERR
      INTEGER LL
      INTEGER M1
      INTEGER M2
      INTEGER I
      INTEGER II
      INTEGER ND
      INTEGER IV
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER IORD
      INTEGER ISWAP
      INTEGER IPK
      INTEGER IPL
      INTEGER LISTE(2)
      INTEGER KEYPLATE
      INTEGER ICONT
      INTEGER IPP
      INTEGER IFLG
      INTEGER IRFL
      INTEGER NUMSPOTS
      INTEGER ISPOT
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER IH_N
      INTEGER IK_N
      INTEGER IL_N
      INTEGER MULT
      INTEGER MINHARM
      INTEGER MAXHARM
      INTEGER INCHARM
      INTEGER ICODE
      INTEGER ICODE_TYPE
      INTEGER ISPAT
      INTEGER ICLOS
      INTEGER IMEAS
      INTEGER IBAD
      INTEGER IOVLD
      INTEGER IPK_MIN
      INTEGER IPK_MAX
      INTEGER NUMREFS
      INTEGER NOV
      REAL FP
      REAL PROMIN_USE
      REAL ALAM
      REAL DMTHR2
      REAL ALNOD
      REAL DTHR2NOD
      REAL AI
      REAL SIGI
      REAL XD
      REAL YD
      REAL XFD
      REAL YFD
      CHARACTER*2 VALSTR
      CHARACTER*12 KEYS(8) 
      CHARACTER*4 SEP
      CHARACTER*80 ERRSTR
      CHARACTER*80 ERRSTR2
      CHARACTER*80 KERRSTR
      CHARACTER*25 NAME
      CHARACTER*120 STR

C     LOGICAL NEXT               !Continue with next pack flag
C     LOGICAL PROF_ONLY          !Calculate profiles only flag
C     LOGICAL OKNOD              !Non-overlapped nodal flag
C     LOGICAL SPOV               !Spatial overlap flag
C     LOGICAL CLOS               !Spot too close to integrated flag
C     LOGICAL MEAS               !Intensity measured flag
C     LOGICAL BAD                !Bad spot flag
C     LOGICAL OVLD               !Overload flag
C     LOGICAL ANY_TO_INT         !Any plates to integrate flag
C     LOGICAL PROF_ROT_USE       !Profiles rotate flag to use
C     INTEGER IMG_PK             !Pack no. of current image read, 0 if none
C     INTEGER IMG_PL             !Plate no. of current image read, 0 if none
C     INTEGER NPACKS             !No. of packs
C     INTEGER NPLATES            !No. of plates
C     INTEGER IFLAG              !Parameter status flag
C     INTEGER NPROF_USE          !No. of profile bins to use
C     INTEGER IPRF_ALL_USE       !Profiles for all plates flag to use
C     INTEGER NOVLD_USE          !No. OK overload pixels to use
C     INTEGER IPKPL              !Process plate/pack/all flag flag
C     INTEGER ISING_PLATE        !Single plate no./flag (0=all plates)
C     INTEGER INP(8)             !Flags for option key already input
C     INTEGER NKEYS              !No. of option keys
C     INTEGER IKEY               !Option key number
C     INTEGER KERR               !Error flag
C     INTEGER JERR               !Error flag
C     INTEGER LL                 !Index to last character processed in string
C     INTEGER M1                 !Index to first character in token
C     INTEGER M2                 !Index to final character in token
C     INTEGER I                  !Temp/loop variable
C     INTEGER II                 !LDM_INTFP function return value
C     INTEGER ND                 !No. of decimal places flag
C     INTEGER IV                 !Integer value
C     INTEGER NXRAST             !No. x-rasters
C     INTEGER NYRAST             !No. y-rasters
C     INTEGER NF_OFF             !Offset between start of slow rasters in image
C     INTEGER IORD               !Axis order flag
C     INTEGER ISWAP              !Byte swap flag
C     INTEGER IPK                !Pack loop variable
C     INTEGER IPL                !Plates loop variable
C     INTEGER LISTE(2)           !List of parameter table entries to be updated
C     INTEGER KEYPLATE           !Key plate
C     INTEGER ICONT              !Continue on error flag
C     INTEGER IPP                !Loop for keyplate then other plates
C     INTEGER IFLG               !Plate integrated flag
C     INTEGER IRFL               !Plate refined flag
C     INTEGER NUMSPOTS           !No. of spots
C     INTEGER ISPOT              !Spot number
C     INTEGER IH                 !'h' index
C     INTEGER IK                 !'k' index
C     INTEGER IL                 !'l' index
C     INTEGER IH_N               !Nodal 'h' index
C     INTEGER IK_N               !Nodal 'k' index
C     INTEGER IL_N               !Nodal 'l' index
C     INTEGER MULT               !Multiplicity
C     INTEGER MINHARM            !Minimum harmonic
C     INTEGER MAXHARM            !Maximum harmonic
C     INTEGER INCHARM            !Harmonic increment
C     INTEGER ICODE              !Integration routine flags code
C     INTEGER ICODE_TYPE         !Code type of integration routines
C     INTEGER ISPAT              !Spatial overlap flag
C     INTEGER ICLOS              !Spots 'too close to integrate' flag
C     INTEGER IMEAS              !Intensity measured flag
C     INTEGER IBAD               !Bad spot flag
C     INTEGER IOVLD              !Overload spot flag
C     INTEGER IPK_MIN            !Minimum pack no. for integration loop
C     INTEGER IPK_MAX            !Maximum pack no. for integration loop
C     INTEGER NUMREFS            !No. of reflns in LIRL
C     INTEGER NOV                !No. of overloaded pixels ia spot
C     REAL FP                    !Real value
C     REAL PROMIN_USE            !PROMIN value to use
C     REAL ALAM                  !Lambda value
C     REAL DMTHR2                !Dmin-threshold**2
C     REAL ALNOD                 !Nodal lambda value
C     REAL DTHR2NOD              !Nodal dmin-threshold**2 value
C     REAL AI                    !Integrated intensity
C     REAL SIGI                  !sig(AI)
C     REAL XD                    !'x' spot position on detector (rasters)
C     REAL YD                    !'y' spot position on detector (rasters)
C     REAL XFD                   !'x' coordinate value for spot (mm)
C     REAL YFD                   !'y' coordinate value for spot (mm)
C     CHARACTER*2 VALSTR         !Parameter value string (dummy)
C     CHARACTER*12 KEYS(8)       !Option keys
C     CHARACTER*4 SEP            !Token separator characters
C     CHARACTER*80 ERRSTR        !Error string 
C     CHARACTER*80 ERRSTR2       !Subsidiary error string
C     CHARACTER*80 KERRSTR       !Error string 
C     CHARACTER*25 NAME          !Option key name
C     CHARACTER*120 STR          !Message string

      DATA SEP /'  ,='/
      DATA KEYS /'PLATE',
     +           'PACK',
     +           'ALL',
     +           'NPROF',
     +           'PROMIN',
     +           'PROF_ALL',
     +           'PROF_ROTATE',
     +           'OVLIM'/
C
C
C-------------------------------------------------------------------------------
      IERR = 0
      ERRSTR = ' '
      ERRSTR2 = ' '
      IF (IUN_LOG.GT.0) WRITE (IUN_LOG, 1000)
C
C====== See if an image already read
C
      IMG_PK = 0
      IMG_PL = 0
      IF (IPACK_OPN.GT.0.AND.IPLATE_OPN.GT.0) THEN
         IF (FILM_OPEN.AND.FILM_READ) THEN
             IMG_PK = IPACK_OPN
             IMG_PL = IPLATE_OPN
         END IF
      END IF
C
C====== Set menu/command-window flag
C
      IF (IOP.LT.2) THEN
         MENU_I_INP = .TRUE.
      ELSE
         MENU_I_INP = .FALSE.
      END IF
C
C====== Check pack
C
      CALL LDM_GET_NUMP (NPACKS, IFLAG)
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (IPACK.LT.1.OR.IPACK.GT.NPACKS) THEN
         ERRSTR = 'Current pack number is invalid'
         ERRSTR2 = 'Pack ='
         CALL STR_ADDI (ERRSTR2, IPACK, 1)
         CALL STR_ADDS (ERRSTR2, ', plate =', 1)
         CALL STR_ADDI (ERRSTR2, IPLATE, 1)
         CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         IERR = 1
         RETURN
      END IF
C
C====== Set control parameters to be used to required defaults
C
      NPROF_USE = NPROF_DF
      PROMIN_USE = PROMIN_DF
      PROF_ROT_USE = PROF_ROT_DF
      IPRF_ALL_USE = IPRF_ALL_DF
      NOVLD_USE = NOVLD_DF
C
C====== Interpret command string
C
      DO 10 I = 1, 8
         INP(I) = 0
 10   CONTINUE
      IPKPL = 0
      NKEYS = 8
      SEP(2:2) = CHAR(9)
      LL = 0
100   I = NXTTOK (OPTSTR, SEP, LL, M1, M2)
      IF (I.EQ.-1) GO TO 200
      IF (I.EQ.0) GO TO 100
      NAME = OPTSTR(M1:M2)
      CALL CCPUPC (NAME)
      CALL GETOPT (KEYS, NKEYS, NAME, IKEY, KERR)
      IF (KERR.NE.0) THEN
         IF (KERR.EQ.1)  ERRSTR = 'Ambiguous option'
         IF (KERR.EQ.2)  ERRSTR = 'Invalid option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1) 
         CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
         IERR = 1
         RETURN
      END IF
      IF (INP(IKEY).EQ.1) THEN
         ERRSTR = 'Duplicate option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1)  
         CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
         IERR = 1
         RETURN
      END IF
      IF (IKEY.LE.3) THEN
         IF (IPKPL.NE.0) THEN
            ERRSTR = 'Inconsistent option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, NAME, 1)  
            CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         ELSE
            INP(IKEY) = 1
            IPKPL = IKEY
         END IF
      ELSE
         INP(IKEY) = 1
         I = NXTTOK (OPTSTR, SEP, LL, M1, M2)
         IF (I.LE.0) THEN
            ERRSTR =  'Option'
            CALL STR_ADDS (ERRSTR, NAME, 1)
            CALL STR_ADDS (ERRSTR, 'not followed by a value', 1)
            CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         END IF
         II = LDM_INTFP (OPTSTR(M1:M2), FP, IV, ND)
         IF (IKEY.EQ.4) THEN
            IF (II.NE.1.OR.IV.LT.1.OR.IV.GT.17) GO TO 150
            NPROF_USE = IV
         ELSE IF (IKEY.EQ.5) THEN
            IF (II.LE.0.OR.FP.LE.0.0) GO TO 150
            PROMIN_USE = FP
         ELSE IF (IKEY.EQ.6) THEN
            STR = OPTSTR(M1:M2)
            CALL CCPUPC(STR)
            IF (STR.NE.'YES'.AND.STR.NE.'NO') GO TO 150
            IF (STR.EQ.'YES') IPRF_ALL_USE = 1
            IF (STR.EQ.'NO') IPRF_ALL_USE = 0
         ELSE IF (IKEY.EQ.7) THEN
            STR = OPTSTR(M1:M2)
            CALL CCPUPC(STR)
            IF (STR.NE.'YES'.AND.STR.NE.'NO') GO TO 150
            IF (STR.EQ.'YES') PROF_ROT_USE = .TRUE.
            IF (STR.EQ.'NO') PROF_ROT_USE = .FALSE.
         ELSE IF (IKEY.EQ.8) THEN
            IF (II.NE.1.OR.IV.LT.0) GO TO 150
            NOVLD_USE = IV
         END IF
      END IF
      GO TO 100
C
C====== Invalid value
C
 150  ERRSTR = OPTSTR(M1:M2)
      CALL STR_ADDS (ERRSTR, 'is not a valid value for option', 1)
      CALL STR_ADDS (ERRSTR, NAME, 1)
      CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
      IERR = 1
      RETURN
C
C====== Set pack range 
C
 200  ISING_PLATE = 0
      IF (IPKPL.EQ.0) IPKPL = IPKPL_DF
      IF (IPKPL.EQ.1) THEN
         IPK_MIN = IPACK
         IPK_MAX = IPACK
         ISING_PLATE = IPLATE
      ELSE IF (IPKPL.EQ.2) THEN
         IPK_MIN = IPACK
         IPK_MAX = IPACK
      ELSE
         IPK_MIN = 1
         CALL LDM_GET_NUMP (IPK_MAX, IFLAG)
         IF (IPK_MAX.LT.1) IPK_MAX = 1
      END IF
C
C====== Check for skip integration if single plate
C
      IF (SKIP_INT.AND.ISING_PLATE.GT.0) THEN
         CALL INTFLAG_GET (IPACK, ISING_PLATE, IFLG)
         IF (IFLG.GT.0) THEN
            STR = 'Integration was already done for pack'
            CALL STR_ADDI(STR,IPACK,1)
            CALL STR_ADDS(STR,', plate',0)
            CALL STR_ADDI(STR,IPLATE,1)
            CALL STR_ADDS(STR,'(skipped)',1)
            WRITE(IUN_LOG,1010)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
            RETURN
         END IF
      END IF       
C
C====== Get some image related details
C
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      IF (LG_MODE.EQ.1) CALL CMD_CNCL_BUT     
      IF (CMD_CNCL(0)) GO TO 900
      JPROG_X = 0
      JPROG_Y = 0            
      IF (LG_MODE.EQ.1) CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_CMD,8,35,
     +                              JPROG_X,JPROG_Y,KERR)
C
C====== Loop through required packs
C====== ===========================
C
      INTEG_LASTPK = 0
      INTEG_LASTPL = 0
      DO 2500 IPK = IPK_MIN, IPK_MAX
         ICONT = 2
         IF (IPK.EQ.IPK_MAX) ICONT = 0
         CALL LDM_GET_KEYP (IPK, KEYPLATE, IFLAG, KERR, ERRSTR)
         IF (KEYPLATE.LT.1.OR.KEYPLATE.GT.NPLATES) THEN
            ERRSTR = 'Keyplate'
            CALL STR_ADDI (ERRSTR, KEYPLATE, 1)
            CALL STR_ADDS (ERRSTR,'out of range for pack',1)
            CALL STR_ADDI (ERRSTR, IPK,1)
            ERRSTR2 = ' '
            CALL AUTO_INTEGRATE_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                               ERRSTR2, NEXT)
            IF (.NOT.NEXT) THEN
               IERR = 1
               GO TO 2600
            END IF
            IF (CMD_CNCL(0)) GO TO 900
            GO TO 2500
         END IF
         IPACK = IPK
         DO 2100 IPP = 1, 2
            DO 2000 IPL = 1, NPLATES
               IF (IPP.EQ.1.AND.IPL.NE.KEYPLATE) GO TO 2000
               IF (IPP.EQ.2.AND.IPL.EQ.KEYPLATE) GO TO 2000
               PROF_ONLY = .FALSE.
               IF (ISING_PLATE.GT.0) THEN
                  IF (IPRF_ALL_USE.EQ.1) THEN
                     IF (IPL.NE.ISING_PLATE) GO TO 2000
                  ELSE
                     IF (IPL.EQ.KEYPLATE) THEN
                        IF (IPL.NE.ISING_PLATE) PROF_ONLY = .TRUE.
                     ELSE
                        IF (IPL.NE.ISING_PLATE) GO TO 2000
                     END IF
                  END IF
               ELSE
                  CALL INTFLAG_GET (IPK, IPL, IFLG)
                  IF (IFLG.GT.0) THEN
                     IF (SKIP_INT) THEN
                        IF (IUN_LOG.GT.0) THEN
                           STR = 'Integration was already done for pack'
                           CALL STR_ADDI(STR,IPACK,1)
                           CALL STR_ADDS(STR,', plate',0)
                           CALL STR_ADDI(STR,IPL,1)
                           CALL STR_ADDS(STR,'(skipped)',1)
                           WRITE(IUN_LOG,1010)
                           WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                           WRITE(IUN_LOG,1010)
                        END IF
                        IF (IPRF_ALL_USE.EQ.1) THEN
                           GO TO 2000
                        ELSE
                           IF (IPL.EQ.KEYPLATE) THEN
                              PROF_ONLY = .TRUE.
                              ANY_TO_INT = .FALSE.
                              DO 220 I = 1, NPLATES
                                 IF (I.EQ.KEYPLATE) GO TO 220
                                 CALL INTFLAG_GET (IPK, I, IFLG)
                                 IF (IFLG.EQ.0) ANY_TO_INT = .TRUE.
 220                          CONTINUE
                              IF (.NOT.ANY_TO_INT) GO TO 2000
                           ELSE
                              GO TO 2000
                           END IF
                        END IF
                     ELSE
                        CALL LIRLF_DELETE (KDX_LIRL, IPK, IPL, KERR)
                        IF (IUN_LOG.GT.0) THEN
                           STR = '*Warning*'
                           CALL STR_ADDS (STR, 
     +                      'Previous intensities deleted for pack', 1)
                           CALL STR_ADDI(STR,IPK,1)
                           CALL STR_ADDS(STR,', plate',0)
                           CALL STR_ADDI(STR,IPL,1)
                           WRITE(IUN_LOG,1010)
                           WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                           WRITE(IUN_LOG,1010)
                        END IF
                        CALL INTFLAG_SET (IPK, IPL, 0)
                     END IF
                  END IF
               END IF
               IPLATE = IPL
               ICONT = 1
               IF (IPLATE.EQ.NPLATES) ICONT = 2
               IF (ISING_PLATE.GT.0) ICONT = 0
               IF (ICONT.EQ.2.AND.IPK.EQ.IPK_MAX) ICONT = 0
               IF (ICONT.EQ.1.AND.IPLATE.EQ.KEYPLATE.AND.
     +             IPRF_ALL_USE.EQ.0) ICONT = 2
C
C====== Update parameter tables
C
               IF (LG_MODE.EQ.1) THEN
                  CALL SET_PAR1_VALS (0, LISTE)
                  CALL SET_PAR2_VALS (0, LISTE)
               END IF
               IF (PROF_ONLY) THEN
                  STR = '==Determining profiles for pack'
               ELSE
                  STR = '==Integration for pack'
               END IF
               CALL STR_ADDI (STR, IPK, 1)
               CALL STR_ADDS (STR, ', plate', 1)
               CALL STR_ADDI (STR, IPLATE, 1)
               CALL STR_ADDS (STR,'==',0)
               IF (LG_MODE.EQ.1) THEN
                  CALL LMESSAGE (IVH_IOW, STR)
               ELSE IF (LG_MODE.EQ.2) THEN
                  CALL TWRITE (STR)
               END IF
C
C====== Check that plate refined
C
               CALL LDM_GET_RFL (IPACK, IPLATE, IRFL, IFLAG, 
     +                           KERR, ERRSTR)
               IF (IRFL.EQ.0) THEN
                  ERRSTR = 'Key plate not refined'
                  ERRSTR2 = 'Cannot determine required profiles'
                  CALL AUTO_INTEGRATE_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                     ERRSTR2, NEXT)
                  IF (.NOT.NEXT) THEN
                     IERR = 1
                     GO TO 2600
                  END IF
                  IF (ICONT.EQ.1) GO TO 2000
                  GO TO 2500
               END IF
C
C====== Read image if not already read
C
               IF (IPACK.NE.IMG_PK.OR.IPLATE.NE.IMG_PL) THEN
                  CALL LAUEGEN_RIMG (IPACK, IPLATE, ITYPE, NF_OFF, IMG, 
     +                          MAX_IMG_WORDS, KERR, KERRSTR)
                  IF (KERR.NE.0) THEN
                     ERRSTR = 'Error reading image for pack'
                     CALL STR_ADDI (ERRSTR, IPACK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate', 0)
                     CALL STR_ADDI (ERRSTR, IPLATE, 1)
                     ERRSTR2 = KERRSTR
                     IMG_PK = 0
                     IMG_PL = 0
                     CALL AUTO_INTEGRATE_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                        ERRSTR2, NEXT)
                     IF (.NOT.NEXT) THEN
                        IERR = 1
                        GO TO 2600
                     END IF
                     IF (ICONT.EQ.1) GO TO 2000
                     GO TO 2500
                  END IF
                  IMG_PK = IPACK
                  IMG_PL = IPLATE
               END IF
               NF_OFF = NFRASTS
               IF (CMD_CNCL(0)) GO TO 900
C
C====== Generate reflection list
C
               CALL LRL_GEN (IPACK, IPLATE, .FALSE., 2, KERR, ERRSTR)
               IF (KERR.NE.0) THEN
                  ERRSTR2 = ' '
                  CALL AUTO_INTEGRATE_ERR (IUN_LOG, ICONT, ERRSTR,  
     +                                     ERRSTR2, NEXT)
                  IF (.NOT.NEXT) THEN
                     IERR = 1
                     GO TO 2600
                  END IF
                  IF (ICONT.EQ.1) GO TO 2000
                  GO TO 2500
               END IF
               IF (IORD.LE.4) THEN
                  CALL LRL_SORT (3)
               ELSE
                  CALL LRL_SORT (4)
               END IF
C
C====== Form profiles if key plate or profiles required for all plates
C
               IF (IPP.EQ.1.OR.IPRF_ALL_USE.EQ.1) THEN
                  JPROG_PASS = 0
                  CALL LFN_SAINT (IPACK, IPLATE, 1, IMG, ITYPE, IORD,
     +                            NFRASTS, NXRAST, NYRAST, PROMIN_USE,
     +                            NPROF_USE, PROF_ROT_USE, NOVLD_USE,
     +                            INTEGRATE_PROGRESS, 
     +                            CMD_CNCL, KERR, ERRSTR)
                  IF (LG_MODE.EQ.1) THEN
                     CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
                  END IF
                  IF (KERR.NE.0) THEN
                     ERRSTR2 = ' '
                     CALL AUTO_INTEGRATE_ERR (IUN_LOG, ICONT, ERRSTR,  
     +                                        ERRSTR2, NEXT)     
                     IF (.NOT.NEXT) THEN
                        IERR = 1
                        GO TO 2600
                     END IF
                     IF (ICONT.EQ.1) GO TO 2000
                     GO TO 2500
                  END IF
                  IF (IUN_LOG.GT.0) THEN
                     WRITE(IUN_LOG,1010)
                     STR = 'Determine integration profiles for pack'
                     CALL STR_ADDI(STR,IPACK,1)
                     CALL STR_ADDS(STR,', plate',0)
                     CALL STR_ADDI(STR,IPLATE,1)
                     WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                     WRITE(IUN_LOG,1010)
                     STR = 'Number of profile bins ='
                     CALL STR_ADDI (STR, NPROF_USE, 1)
                     WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                     WRITE(IUN_LOG,1010)
                     STR = 
     +                'Minimum intensity for inclusion in profiles ='
                     CALL STR_ADDF (STR, PROMIN_USE, 1, 1)
                     WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                     WRITE(IUN_LOG,1010)
                     CALL LFN_LIST_PROFS (IUN_LOG, 0, 0, 0, 80, 
     +                                    2, 2, KERR, ERRSTR)
                  END IF
               END IF
               IPRF_PK = IPACK 
               IPRF_PL = IPLATE
               IF (PROF_ONLY) THEN
                   INTEG_LASTPK = 0
                   INTEG_LASTPL = 0
                   GO TO 2000
               END IF
C
C====== Integrate plate
C
               JPROG_PASS = 0
               CALL LFN_SAINT (IPACK, IPLATE, 2, IMG, ITYPE, IORD,
     +                         NFRASTS, NXRAST, NYRAST, PROMIN_USE,
     +                         NPROF_USE, PROF_ROT_USE, NOVLD_USE, 
     +                         INTEGRATE_PROGRESS, CMD_CNCL,
     +                         KERR, ERRSTR)
               IF (LG_MODE.EQ.1) THEN
                  CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
               END IF
               IF (KERR.NE.0) THEN
                  ERRSTR2 = ' '
                  CALL AUTO_INTEGRATE_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                     ERRSTR2, NEXT)     
                  IF (.NOT.NEXT) THEN
                     IERR = 1
                     GO TO 2600
                  END IF
                  IF (ICONT.EQ.1) GO TO 2000
                  GO TO 2500
               END IF
               IF (IUN_LOG.GT.0) THEN
                  WRITE(IUN_LOG,1010)
                  STR = 'Integrate intensities for pack'
                  CALL STR_ADDI(STR,IPACK,1)
                  CALL STR_ADDS(STR,', plate',0)
                  CALL STR_ADDI(STR,IPLATE,1)
                  WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                  WRITE(IUN_LOG,1010)
                  IF (IPRF_ALL_USE.EQ.1) THEN
                     STR = 
     +                'Profile determination from each plate in pack'
                  ELSE
                     STR = 'Profile determination from key plate only'
                  END IF
                  WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                  WRITE(IUN_LOG,1010)
                  STR = 'Number of overload pixels allowed in a spot =' 
                  CALL STR_ADDI (STR, NOVLD_USE, 1)      
                  WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                  WRITE(IUN_LOG,1010)
                END IF
C
C====== Set last pack/plate integrated flags
C
               INTEG_LASTPK = IPACK
               INTEG_LASTPL = IPLATE
C
C====== Copy spot data to internal LIRL
C
               CALL LRL_NUMSPOTS(NUMSPOTS)
               IF (NUMSPOTS.EQ.0) THEN
                  IF (CMD_CNCL(0)) GO TO 900
                  GO TO 2000
               END IF
               CALL LIRLF_NUMREFS (KDX_LIRL, NUMREFS)
               DO 500 ISPOT = 1, NUMSPOTS
                  CALL LRL_GET (ISPOT, IH, IK, IL, XD, YD, ALAM,
     +                    DMTHR2, MULT, OKNOD, SPOV, KERR)
                  IF (MULT.GT.1) THEN
                     CALL LRL_GET_HARM (ISPOT, IH, IK, IL, 
     +                                  IH_N, IK_N, IL_N,
     +                                  MULT, MINHARM, MAXHARM, 
     +                                  INCHARM,
     +                                  ALNOD, DTHR2NOD, KERR)
                  ELSE
                     MINHARM = 0
                     MAXHARM = 0
                     INCHARM = 0
                  END IF
                  CALL LRL_GET_XFYFD (ISPOT, XFD, YFD, KERR)
                  CALL LRL_GET_OVLP (ISPOT, SPOV, CLOS, KERR)
                  CALL LRL_GET_INT (ISPOT, AI, SIGI, MEAS, BAD, OVLD,
     +                              ICODE, ICODE_TYPE, KERR)
                  ISPAT = 0
                  ICLOS = 0
                  IMEAS = 0
                  IBAD = 0
                  IOVLD = 0
                  IF (SPOV) ISPAT = 1
                  IF (CLOS) ICLOS = 1
                  IF (MEAS) IMEAS = 1
                  IF (BAD) IBAD = 1
                  IF (OVLD) IOVLD = 1
C
C====== Suppress any intensities from spatial overlaps which are too close 
C====== to deconvolute in integration
C
                  IF (CLOS) THEN
                     IMEAS = 0
                     AI = 0.0
                     SIGI = 0.0
                  END IF

                  CALL LIRLF_ADDREF (KDX_LIRL, IH, IK, IL, IPACK,  
     +                               IPLATE, 0, XFD, YFD, ALAM, MULT, 
     +                               MINHARM, MAXHARM, 
     +                               INCHARM, AI, SIGI, 
     +                               ISPAT, ICLOS,
     +                               IMEAS, IBAD, IOVLD, ICODE, KERR)
                  IF (KERR.LT.0) THEN
                     ERRSTR =  'Cannot allocate required memory'
                     ERRSTR2 = 'Integration terminated'
                     CALL AUTO_INTEGRATE_ERR (IUN_LOG, 0, ERRSTR, 
     +                                        ERRSTR2, NEXT)
                     CALL LIRLF_DELETE (KDX_LIRL, IPACK, IPLATE, KERR)
                     GO TO 2600     
                  END IF
                  CALL LRL_GET_OVPIX (ISPOT, NOV, KERR)
                  CALL LIRLF_SET_OVPIX (KDX_LIRL, NUMREFS+ISPOT, NOV, 
     +                                  KERR)
 500           CONTINUE
               CALL INTFLAG_SET (IPACK, IPLATE, 1)
               CALL LOG_INT_TAB1

               IF (CMD_CNCL(0)) GO TO 900

 2000       CONTINUE

 2100    CONTINUE

 2500 CONTINUE

 2600 IF (LG_MODE.EQ.1) THEN
         CALL XDLF_DELETE_VIEW_OBJECT (IVH_CNCL_BUT, KERR)
      END IF
      RETURN
C
C====== Cancel requested
C
 900  CALL AUTO_INTEGRATE_ERR (IUN_LOG, -1, 
     + '==Integration interrupted==', ' ', NEXT)
      IERR = 100
      IF (LG_MODE.EQ.1) THEN
         CALL XDLF_DELETE_VIEW_OBJECT (IVH_CNCL_BUT, KERR)
      END IF 
      RETURN
C
C====== Format statements
C
1000  FORMAT (/,'==Automatic Integration==')
1010  FORMAT(' ')
1020  FORMAT(A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C********************************
C**     AUTO_INTEGRATE_ERR     **
C********************************
C
C
      SUBROUTINE AUTO_INTEGRATE_ERR (KUN_LOG, ICONT, ERRSTR, ERRSTR2, 
     +                               NEXT)
C
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle auto-integrate errors 
C
C Author:  John W. Campbell, December 1995
C
      INTEGER KUN_LOG
      INTEGER ICONT
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
      LOGICAL NEXT
C
C Parameters as for LFN_REFN_ERR
C
C KUN_LOG     i  (R)  Unit number for log file
C ICONT       i  (R)  = 0 treat as error which terminates integration
C                     = 1 may continue with next plate if desired
C                     = 2 may continue with next pack if required
C                     =-1 interrupted
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C NEXT        l  (W)  Set by the routine. If .true. then integration  will
C                     be continued with next pack or plate. If .false. 
C                     then integration will be terminated. Note: the 
C                     routine must set it to .false. ICONT is 0 or -1.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER IBUTTON
      INTEGER IXROOT
      INTEGER IYROOT
      CHARACTER*170 STR
      CHARACTER*60 STR2

C     LOGICAL EOF                 !End of file flag on terminal read
C     INTEGER IBUTTON             !Button selected from error notice
C     INTEGER IXROOT              !Root window x-position for error notice
C     INTEGER IYROOT              !Root window y-position for error notice
C     CHARACTER*170 STR           !String for error message
C     CHARACTER*60 STR2           !TEmp string
C
C-------------------------------------------------------------------------------
C
      NEXT = .FALSE.
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         STR = 'Error during integration of pack'
         CALL STR_ADDI (STR, IPACK, 1)
         CALL STR_ADDS (STR, ',plate', 0)
         CALL STR_ADDI (STR, IPLATE, 1)
         WRITE (IUN_LOG,6010) STR(1:LENSTR(STR))
         IF (ICONT.LT.0) THEN
            WRITE (IUN_LOG,6000) ERRSTR(1:LENSTR(ERRSTR))
         ELSE
            WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
            IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                          ERRSTR2(1:LENSTR(ERRSTR2))
         END IF
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         IF (MENU_I_INP) THEN
            IF (ICONT.LT.0) THEN
               CALL LMESSAGE (IVH_IOW, ERRSTR)
               RETURN
            ELSE
               STR = '**'
               CALL STR_ADDS (STR, ERRSTR, 0)
               IF (ERRSTR2.NE.' ') THEN
                  CALL STR_ADDS (STR, ':', 1)
                  CALL STR_ADDS (STR, ERRSTR2, 1)
               END IF
               CALL STR_ADDS (STR, '**', 0)
               IF (ICONT.EQ.0) THEN
                  CALL ERR_NOTICE (3, STR)
                  RETURN
               ELSE
                  CALL NOTICE_POSN(3, IXROOT, IYROOT)
                  IF (ICONT.EQ.1) THEN
                     STR2 = 'Continue with next plate?'
                  ELSE
                     STR2 = 'Continue with next pack?'
                  END IF
                  CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +                 XDLSTR(STR), LENSTR(STR),
     +                 XDLSTR(STR2), LENSTR(STR2),
     +                 XDLSTR('Yes'), 3,
     +                 XDLSTR('No'), 2,
     +                 IFONT, 1, IBUTTON)
                  NEXT = .TRUE.
                  IF (IBUTTON.EQ.2) NEXT = .FALSE.
                  RETURN
               END IF
            END IF
         ELSE
            IF (ICONT.LT.0) THEN
               CALL LMESSAGE (IVH_CMD, ERRSTR)
               RETURN
            ELSE
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR, 1)
               CALL LMESSAGE (IVH_CMD, STR)
               IF (ERRSTR2.NE.' ') THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR, ERRSTR2, 1)
                  CALL LMESSAGE (IVH_CMD, STR)
               END IF
               IF (ICONT.EQ.0) RETURN
               NEXT = .FALSE.
               IF (ICONT.EQ.1) THEN
                  CALL IOW_ASKQ (IVH_CMD, 'Continue with next plate', 
     +                           NEXT)
               ELSE
                  CALL IOW_ASKQ (IVH_CMD, 'Continue with next pack', 
     +                           NEXT)
               END IF
               RETURN
            END IF
         END IF

      ELSE IF (LG_MODE.EQ.2) THEN
         IF (ICONT.LT.0) THEN
            CALL TWRITE (ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL TWRITE (STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL TWRITE (STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN    
               CALL TASKQ ('Continue with next plate', NEXT, EOF)
            ELSE
               CALL TASKQ ('Continue with next pack', NEXT, EOF)
            END IF
            IF (EOF) NEXT = .FALSE.
            RETURN
         END IF
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     AUTO_REFINE_CTL     **
C*****************************
C
C
      SUBROUTINE AUTO_REFINE_CTL (IOP, OPTSTR, IPKPL_DF, ICLL_DF, 
     +                            NODS_DF, NODF_DF)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control LAUEGEN's auto-refinement requests
C
C Author:  John W. Campbell, October 1994
C
C Arguments:
C
      INTEGER IOP
      CHARACTER*(*) OPTSTR
      INTEGER IPKPL_DF
      INTEGER ICLL_DF
      INTEGER NODS_DF
      INTEGER NODF_DF
C 
C  IOP      (R)   Option = 1  Auto-refine plate called from refinement menu
C                        = 2  Auto-refine pack called from refinement menu
C                        = 3  Auto-refine from command line input
C  OPTSTR   (R)   Auto refinement routine's option string (see LFN_AUTO_REFN)
C  IPKPL_DF (R)  Default value for plate/pack/all (1,2,3)
C  ICLL_DF  (R)  Default refine cell flag 1=yes, 2=no
C  NODS_DF  (R)  Default nodal index for initial refinements (4-12) e.g. 4
C  NODF_DF  (R)  Default nodal index for final refinements (4-12) e.g. 6
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'image.finc'
      INCLUDE 'upd_flags.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'autorefn_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      EXTERNAL REFINE_PROGRESS
      EXTERNAL AUTO_REFINE_ERR
      LOGICAL CMD_CNCL
      EXTERNAL CMD_CNCL
      EXTERNAL LAUEGEN_RIMG
C
C====== LOCALS:
C
      LOGICAL UPD(9)
      LOGICAL ANY
      INTEGER I
      INTEGER J
      INTEGER IMG_PK
      INTEGER IMG_PL
      INTEGER IERR
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER NE
      INTEGER LISTE(20)
      REAL RMS
      CHARACTER*80 ERRSTR
      CHARACTER*80 ERRSTR2
      CHARACTER*8 NAMES(2)
      CHARACTER*60 STR

C     LOGICAL UPD(9)             !Other pack/plate parameter update flags
C     LOGICAL ANY                !Any rms values determined flag
C     INTEGER I                  !Temp/loop variable
C     INTEGER J                  !Temp/loop variable
C     INTEGER IMG_PK             !Pack no. of current image read, 0 if none
C     INTEGER IMG_PL             !Plate no. of current image read, 0 if none
C     INTEGER IERR               !Error flag
C     INTEGER IVHLIST(2)         !View-object handles list for getting events
C     INTEGER IVH                !Returned view-object handle from get events
C     INTEGER NE                 !No of parameters to update
C     INTEGER LISTE(20)          !List of parameters to update
C     REAL RMS                   !Rms error
C     CHARACTER*80 ERRSTR        !Error string
C     CHARACTER*80 ERRSTR2       !Second error string
C     CHARACTER*8 NAMES(2)       !Menu item names
C     CHARACTER*60 STR           !Temp string

      DATA NAMES/'CONTINUE',' '/
C
C-------------------------------------------------------------------------------
C
C====== See if an image already read
C
      IMG_PK = 0
      IMG_PL = 0
      IF (IPACK_OPN.GT.0.AND.IPLATE_OPN.GT.0) THEN
         IF (FILM_OPEN.AND.FILM_READ) THEN
             IMG_PK = IPACK_OPN
             IMG_PL = IPLATE_OPN
         END IF
      END IF
C
C====== Set menu/command-window flag
C
      IF (IOP.LT.3) THEN
         MEN_INP = .TRUE.
      ELSE
         MEN_INP = .FALSE.
      END IF
C
C====== Set other pack/plate parameter update flags
C
      UPD(1) = UPD_PHIS
      UPD(2) = UPD_CTOF
      UPD(3) = UPD_XCYC
      UPD(4) = UPD_WC
      UPD(5) = UPD_YSCAL
      UPD(6) = UPD_TT
      UPD(7) = UPD_BULG
      UPD(8) = UPD_RTOFF
      UPD(9) = UPD_SPD
C
C====== Initialise rms results histogram
C
      DO 10 I = 1, 11
         NRMS(I) = 0
 10   CONTINUE
C
C====== Set up auto-refinement screen 
C
      IF (LG_MODE.EQ.1) THEN
         IF (MEN_INP) THEN 
            CALL AUTOREFN_SCRN
         ELSE
            CALL CMD_CNCL_BUT
         END IF
      END IF

      IERR = 0

      IF (CMD_CNCL(0)) GO TO 500
C
C====== Auto-refine
C
      CALL LFN_AUTO_REFN (IPACK, IPLATE, OPTSTR, IPKPL_DF, ICLL_DF,
     +                    NODS_DF, NODF_DF, IMG_PK, IMG_PL, 
     +                    LAUEGEN_RIMG, IMG, MAX_IMG_WORDS, ITYPE, 
     +                    NFRASTS, IUN_LOG, REFINE_PROGRESS, 
     +                    AUTO_REFINE_ERR, 
     +                    MAX_HALF_BOX, ISPOT_DATA, ISWORK, 
     +                    CMD_CNCL, RMS, UPD, IERR, 
     +                    ERRSTR, ERRSTR2)
C
C====== Procedure completed, output rms summary
C
 500  ANY = .FALSE.
      DO 505 I = 1, 11
         IF (NRMS(I).GT.0) ANY = .TRUE.
 505  CONTINUE
      IF (LG_MODE.EQ.1) THEN
         IF (ANY) THEN
            CALL LMESSAGE (IVH_IOW, 'Refinement rms summary:')
            CALL LMESSAGE (IVH_IOW,
     +      '-----------------------------------------------') 
            CALL LMESSAGE (IVH_IOW, 
     +      '< .01 .02 .03 .04 .05 .06 .07 .08 .09 .10 >=.10')
            STR = ' '
            DO 510 I = 1, 11
               IF (NRMS(I).LE.0) GO TO 510
               J = 4*I - 1
               IF (I.EQ.11) J = J + 2
               WRITE (STR(J:J+2),'(I3)') NRMS(I)
 510        CONTINUE
            CALL LMESSAGE (IVH_IOW, STR)
            CALL LMESSAGE (IVH_IOW,
     +      '-----------------------------------------------')
         END IF
         IF (MEN_INP) THEN 
            CALL XDLF_MENU_AREA_SETMENU (IVH_AUTR_MEN, 1, 
     +                                XDLSTR(NAMES), 8,
     +                                XDLSTR(' '), -1, XDLSTR(' '), -1,
     +                                IFONT, IERR)
            IVHLIST(1) = IVH_AUTR_MEN
            CALL XDLF_GET_EVENTS (1, IVHLIST, IVH)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_AUTR_BASE, IERR)
         ELSE
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_CNCL_BUT, IERR)
         END IF
      ELSE IF (LG_MODE.EQ.2.AND.ANY) THEN
         CALL TWRITE ('Refinement rms summary:')
         CALL TWRITE(
     +   '-----------------------------------------------') 
         CALL TWRITE ( 
     +   '< .01 .02 .03 .04 .05 .06 .07 .08 .09 .10 >=.10')
         STR = ' '
         DO 520 I = 1, 11
            IF (NRMS(I).LE.0) GO TO 520
            J = 4*I - 1
            IF (I.EQ.11) J = J + 2
            WRITE (STR(J:J+2),'(I3)') NRMS(I)
 520     CONTINUE
         CALL TWRITE (STR)
         CALL TWRITE (
     +   '-----------------------------------------------') 

      END IF
C
C====== Update parameter tables
C
      CALL RESET_CELL
      IF (LG_MODE.EQ.1) THEN
         NE = 0
         NE = NE + 1
         LISTE(NE) = IP_PACK
         NE = NE + 1
         LISTE(NE) = IP_PLATE
         NE = NE + 1
         LISTE(NE) = IP_PHIX
         NE = NE + 1
         LISTE(NE) = IP_PHIY
         NE = NE + 1
         LISTE(NE) = IP_PHIZ
         NE = NE + 1
         LISTE(NE) = IP_A
         NE = NE + 1
         LISTE(NE) = IP_B
         NE = NE + 1
         LISTE(NE) = IP_C
         NE = NE + 1
         LISTE(NE) = IP_ALPH
         NE = NE + 1
         LISTE(NE) = IP_BETA
         NE = NE + 1
         LISTE(NE) = IP_GAMM
         CALL SET_PAR1_VALS (NE, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     AUTO_REFINE_ERR     **
C*****************************
C
C
      SUBROUTINE AUTO_REFINE_ERR (KUN_LOG, ICONT, ERRSTR, ERRSTR2, 
     +                            NEXT)
C
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle auto-refinement errors 
C
C    NOTE: PARAMETERS MUST MATCH THOSE REQUIRED BY LFN_AUTO_REFN ROUTINE
C
C
C Author:  John W. Campbell, October 1994
C
      INTEGER KUN_LOG
      INTEGER ICONT
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
      LOGICAL NEXT
C
C Parameters as for LFN_REFN_ERR
C
C KUN_LOG     i  (R)  Unit number for log file as passed to LFN_AUTO_REFN
C ICONT       i  (R)  = 0 treat as error which terminates refinent
C                     = 1 may continue with next plate if desired
C                     = 2 may continue with next pack if required
C                     =-1 interrupted
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C NEXT        l  (W)  Set by the routine. If .true. then refinement will
C                     be continued with next pack or plate. If .false. 
C                     then refinement will be terminated. Note: the 
C                     routine must set it to .false. ICONT is 0 or -1.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
      INCLUDE 'autorefn_flags.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER IBUTTON
      INTEGER IXROOT
      INTEGER IYROOT
      CHARACTER*170 STR
      CHARACTER*60 STR2

C     LOGICAL EOF                 !End of file flag on terminal read
C     INTEGER IBUTTON             !Button selected from error notice
C     INTEGER IXROOT              !Root window x-position for error notice
C     INTEGER IYROOT              !Root window y-position for error notice
C     CHARACTER*170 STR           !String for error message
C     CHARACTER*60 STR2           !TEmp string
C
C-------------------------------------------------------------------------------
C
      NEXT = .FALSE.
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         IF (ICONT.LT.0) THEN
            WRITE (IUN_LOG,6000) ERRSTR(1:LENSTR(ERRSTR))
         ELSE
            WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
            IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                          ERRSTR2(1:LENSTR(ERRSTR2))
         END IF
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         IF (MEN_INP) THEN
            IF (ICONT.LT.0) THEN
               CALL LMESSAGE (IVH_IOW, ERRSTR)
               RETURN
            ELSE
               STR = '**'
               CALL STR_ADDS (STR, ERRSTR, 0)
               IF (ERRSTR2.NE.' ') THEN
                  CALL STR_ADDS (STR, ':', 1)
                  CALL STR_ADDS (STR, ERRSTR2, 1)
               END IF
               CALL STR_ADDS (STR, '**', 0)
               IF (ICONT.EQ.0) THEN
                  CALL ERR_NOTICE (3, STR)
                  RETURN
               ELSE
                  CALL NOTICE_POSN(3, IXROOT, IYROOT)
                  IF (ICONT.EQ.1) THEN
                     STR2 = 'Continue with next plate?'
                  ELSE
                     STR2 = 'Continue with next pack?'
                  END IF
                  CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +                 XDLSTR(STR), LENSTR(STR),
     +                 XDLSTR(STR2), LENSTR(STR2),
     +                 XDLSTR('Yes'), 3,
     +                 XDLSTR('No'), 2,
     +                 IFONT, 1, IBUTTON)
                  NEXT = .TRUE.
                  IF (IBUTTON.EQ.2) NEXT = .FALSE.
                  RETURN
               END IF
            END IF
         ELSE
            IF (ICONT.LT.0) THEN
               CALL LMESSAGE (IVH_CMD, ERRSTR)
               RETURN
            ELSE
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR, 1)
               CALL LMESSAGE (IVH_CMD, STR)
               IF (ERRSTR2.NE.' ') THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR, ERRSTR2, 1)
                  CALL LMESSAGE (IVH_CMD, STR)
               END IF
               IF (ICONT.EQ.0) RETURN
               NEXT = .FALSE.
               IF (ICONT.EQ.1) THEN
                  CALL IOW_ASKQ (IVH_CMD, 'Continue with next plate', 
     +                           NEXT)
               ELSE
                  CALL IOW_ASKQ (IVH_CMD, 'Continue with next pack', 
     +                           NEXT)
               END IF
               RETURN
            END IF
         END IF

      ELSE IF (LG_MODE.EQ.2) THEN
         IF (ICONT.LT.0) THEN
            CALL TWRITE (ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL TWRITE (STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL TWRITE (STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN    
               CALL TASKQ ('Continue with next plate', NEXT, EOF)
            ELSE
               CALL TASKQ ('Continue with next pack', NEXT, EOF)
            END IF
            IF (EOF) NEXT = .FALSE.
            RETURN
         END IF
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     AUTO_SCREEN      **
C**************************
C
C
      SUBROUTINE AUTO_SCREEN
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up screen for handling auto-indexing
C
C Author:  John W. Campbell, March 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
C====== Layout parameters
C
      INTEGER  IWIDTH_FRAME
      INTEGER  IHEIGHT_FRAME
      INTEGER  IX_TABLE
      INTEGER  IY_TABLE
      INTEGER  ITABW
      INTEGER  ITABH
      INTEGER  IX_MENU
      INTEGER  IY_MENU
      INTEGER  MENW
      INTEGER  MENH
      INTEGER  MENUW
      INTEGER  MENUH
      INTEGER  IX_IOW
      INTEGER  IY_IOW
      INTEGER  IOW_W
      INTEGER  IOW_H
      INTEGER  ICOL2_W
      INTEGER  IROW2_H
      INTEGER  MITEMS
      INTEGER  MCHARS
      INTEGER  NCOLS_T
      INTEGER  NCOLS_IOW
      INTEGER  NROWS_T
      INTEGER  NROWS_IOW

C     INTEGER  IWIDTH_FRAME        ! Width of the base frame
C     INTEGER  IHEIGHT_FRAME       ! Height of the base frame
C     INTEGER  IX_TABLE            ! X position of the text table
C     INTEGER  IY_TABLE            ! Y position of the text table
C     INTEGER  ITABW               ! Text table width required
C     INTEGER  ITABH               ! Text table height required
C     INTEGER  IX_MENU             ! X position of the menu area
C     INTEGER  IY_MENU             ! Y position of the menu area
C     INTEGER  MENW                ! Menu width required
C     INTEGER  MENH                ! Menu height required
C     INTEGER  MENUW               ! Menu width to be used
C     INTEGER  MENUH               ! Menu height to be used
C     INTEGER  IX_IOW              ! X position of the io_window
C     INTEGER  IY_IOW              ! Y position of the io_window
C     INTEGER  IOW_W               ! io_window text area width needed
C     INTEGER  IOW_H               ! io_window text area height needed
C     INTEGER  IOW_USEW            ! io_window width to use
C     INTEGER  IROW2_H             ! height of second row of layout
C     INTEGER  MITEMS              ! No. of items in menu area (max)
C     INTEGER  MCHARS              ! No. of chars (max) in menu item name/title
C     INTEGER  NCOLS_T             ! No. columns needed in text table
C     INTEGER  NCOLS_IOW           ! No. columns needed in io-window
C     INTEGER  NROWS_T             ! No. rows needed in text table
C     INTEGER  NROWS_IOW           ! No. rows needed in io-window
C
C====== Miscellaneous parameters
C
      INTEGER IERR
      INTEGER IXROOT
      INTEGER IYROOT
C
C     INTEGER IERR   !Error return flag
C     INTEGER IXROOT !Root window x position for autoindexing screen layout
C     INTEGER IYROOT !Root window y position for autoindexing screen layout
C
C-------------------------------------------------------------------------------
C
C
C====== Calculate size requirements and layout parameters
C
      MITEMS = 15
      MCHARS = 25
      NCOLS_T = 60
      NCOLS_IOW = 60
      NROWS_T = 18
      NROWS_IOW = 16
      CALL XDLF_MENU_AREA_GETSIZE (MITEMS, MCHARS,
     +     IFONT, 1, MCHARS, MENW, MENH)
      CALL XDLF_TEXT_TABLE_GETSIZE (NCOLS_T, NROWS_T, IFONT,
     +     ITABW, ITABH)
      CALL XDLF_IO_WINDOW_GETSIZE (NCOLS_IOW, NROWS_IOW, IFONT, 1,
     +     IOW_W, IOW_H)
C
C====== X coordinates and widths 
C
      MENUW = MENW
      IX_MENU = IBORDER
      IX_TABLE = IBORDER + MENUW + ISEP
      IX_IOW = IBORDER + MENUW + ISEP
      ICOL2_W = ITABW
      IF (IOW_W.GT.ICOL2_W) ICOL2_W = IOW_W
      IWIDTH_FRAME = 2*IBORDER + ISEP + MENUW + ICOL2_W + 2
C
C====== Y coordinates and heights
C
      IY_MENU = IBORDER
      IY_TABLE = IBORDER
      IY_IOW = IBORDER + ITABH + ISEP
      IROW2_H = IOW_H
      IF (MENH.GT.ITABH+ISEP+IOW_H) IROW2_H = MENH - ISEP - ITABH
      MENUH = ITABH + ISEP + IROW2_H
      IHEIGHT_FRAME = 2*IBORDER + ITABH + ISEP + IROW2_H + 2
C
C====== Create main frame
C
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_BASE,0,0,IXROOT,IYROOT,IERR)
      CALL XDLF_BASE_FRAME (IVH_BASE_AUT, IWIDTH_FRAME, IHEIGHT_FRAME,
     +     XDLSTR('Autoindex'), 9, XDLSTR('auto'), 4, IXROOT, IYROOT)
C
C====== Set up text table
C
      CALL XDLF_TEXT_TABLE (IVH_TABL_AUT, IVH_BASE_AUT,
     +      IX_TABLE, IY_TABLE,
     +      0, 0, 0, 
     +      ICOL2_W, ITABH, IFONT, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2002) IERR
         STOP
      ENDIF
C
C====== Set up menu area
C
      CALL XDLF_MENU_AREA (IVH_MENU_AUT, IVH_BASE_AUT,
     +     IX_MENU, IY_MENU, 0,
     +     MITEMS, MCHARS, IFONT, 1, MCHARS,
     +     MENUW, MENUH, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2003) IERR
         STOP
      ENDIF
C
C====== Set up io-window area
C
      CALL XDLF_IO_WINDOW (IVH_IOW_AUT, IVH_BASE_AUT,
     +     IX_IOW, IY_IOW, 
     +     0, 0, 0,
     +     ICOL2_W, IROW2_H, IFONT, 100, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2004) IERR
         STOP
      ENDIF
C
C====== Return
C
      RETURN
C
C====== Format statements
C
2002  FORMAT (/,'**Error code', I2, ' from xdlf_text_table**')        
2003  FORMAT (/,'**Error code', I2, ' from xdlf_menu_area**')
2004  FORMAT (/,'**Error code', I2, ' from xdlf_io_window**')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     AUTO_SEL         **
C**************************
C
C
      SUBROUTINE AUTO_SEL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Select/show/re-refine etc. autoindexing solutions
C
C Author:  John W. Campbell, March 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL SEL
      LOGICAL CONT
      LOGICAL EXISTS
      INTEGER IFAIL
      INTEGER M_SEL
      INTEGER M_SHOW
      INTEGER M_REFINE
      INTEGER M_LIST
      INTEGER M_SAVE
      INTEGER I
      INTEGER N
      INTEGER LC
      INTEGER IYN
      INTEGER NSHOW
      INTEGER IERR
      INTEGER LIN_MSG
      INTEGER M_ITEM
      INTEGER ISOLN
      INTEGER NSEL
      INTEGER NITEMS
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER IQUIT
      INTEGER NE
      INTEGER LISTE(4)
      INTEGER IFLAG
      INTEGER ND
      REAL XD
      REAL YD
      REAL SAV_PHIS(3)
      REAL SAV_SPINDLE
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) PAR_FILE
      CHARACTER*25 M2ITEMS(11)
      CHARACTER*80 STR
      CHARACTER*2 ERRSTR

C     LOGICAL SEL          !Solution selected flag
C     LOGICAL CONT         !Continue with writing file flag
C     LOGICAL EXISTS       !File already exists flag
C     INTEGER IFAIL        !File open failure flag
C     INTEGER M_SEL        !Menu item number for: Select Solution
C     INTEGER M_SHOW       !Menu item number for: Show Solution
C     INTEGER M_REFINE     !Menu item number for: Refine Solution
C     INTEGER M_LIST       !Menu item number for: List Solution
C     INTEGER M_SAVE       !Menu item number for: Save Solution
C     INTEGER I            !Temp/loop variable
C     INTEGER N            !Points to current solution in sorted list
C     INTEGER LC           !Line count for listing solution data in sections
C     INTEGER IYN          !Return flag from YESNO_NOTICE
C     INTEGER NSHOW        !No. of solutions to be shown in text table
C     INTEGER IERR         !Error flag
C     INTEGER LIN_MSG      !Line number in text table for no. of solns. message
C     INTEGER M_ITEM       !Menu item number from Autoindexing menu
C     INTEGER ISOLN        !Solution number to be used for current option
C     INTEGER NSEL         !Number of solutions with entries on selection menu
C     INTEGER NITEMS       !Number of items in solution number selection menu
C     INTEGER NVIEW        !Number of view_objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view object handle from getting events
C     INTEGER IQUIT        !Quit flag from menus
C     INTEGER NE           !Number of parameter table entries to update
C     INTEGER LISTE(4)     !List of parameter table 1 entries to be updated
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     REAL XD              !Difference in x between obs and calc spot position
C     REAL YD              !Difference in y between obs and calc spot position
C     REAL SAV_PHIS(3)     !Save current PhiX, PhiY, PhiZ values
C     REAL SAV_SPINDLE     !Save current spindle value
C     CHARACTER*(MAXFLEN) FILNAM   !Temp file name
C     CHARACTER*(MAXFLEN) PAR_FILE !.gen file name
C     CHARACTER*25 M2ITEMS(11)     !Solution numbers selection menu items
C     CHARACTER*80 STR             !Temp output string
C     CHARACTER*2 ERRSTR           !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
C
C====== Set up screen for handling the solutions
C
      CALL AUTO_SCREEN
C
C====== Set up menu item numbers for handling the solutions
C
      M_SEL = 1
      M_SHOW = 2
      M_REFINE = 3
      M_LIST = 4
      M_SAVE = 5
      SEL = .FALSE.
C
C====== Show best results in text table
C
      CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, 
     +     XDLSTR('Autoindexing Results'), 20, 1, 18, 1, IERR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT,
     +     XDLSTR('No.     PhiX     PhiY     PhiZ'), 30, 3, 1, 0, IERR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT,
     +     XDLSTR('Unrefined-rms  Refined-rms'), 26, 3, 34, 0, IERR)
      NSHOW = NSTORE_AUT
      IF (NSHOW.GT.10) NSHOW = 10
      DO 100 I = 1, NSHOW
         N = IP_AUT(I)
         WRITE (STR,'(I2,1X,3F9.2)') I, STANG(N,1), STANG(N,2), 
     +          STANG(N,3)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR), 30,
     +        4+I, 1, 0, IERR)
         WRITE(STR,'(F13.3)') STDEV0(N)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR), 13,
     +        4+I, 34, 0, IERR)
         WRITE (STR,'(F11.3)') STDEV(N)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR), 11,
     +        4+I, 49, 0, IERR)
100   CONTINUE
      IF (NSTORE_AUT.GT.NSHOW) THEN
         STR = '(+'
         CALL STR_ADDI(STR,NSTORE_AUT-NSHOW,1)
         CALL STR_ADDS(STR,'other poorer solutions)',1)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR),
     +        LENSTR(STR), 16, 1, 0, IERR)
      ENDIF
         
      LIN_MSG = 16
      IF (NSTORE_AUT.GT.NSHOW) LIN_MSG = 18
      STR = 'Best results have'
      CALL STR_ADDI(STR,NSTORE_AUT,1)
      CALL STR_ADDS(STR,'solutions with',1)
      CALL STR_ADDI(STR,MAX_MATCH_AUT,1)
      CALL STR_ADDS(STR,'matches',1)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR),
     +     LENSTR(STR), LIN_MSG, 1, 0, IERR)
C
C====== Process Menu
C
200   CALL SET_MENU6
      NVIEW = 1
      IVHLIST(1) = IVH_MENU_AUT
C
C====== Start event loop
C
      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU_AUT) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU_AUT, M_ITEM, IQUIT)
C
C====== Quit box selected
C
         IF (IQUIT.EQ.1) THEN
            IF (.NOT.SEL) THEN
               CALL YESNO_NOTICE (2,
     +                           'No solution selected - still quit?',
     +                            IYN)
               IF (IYN.EQ.2) GO TO 200
            END IF
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_IOW_AUT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_TABL_AUT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_MENU_AUT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_BASE_AUT, IERR)
            RETURN
         END IF
C
C====== Get required solution number
C
         NSEL = NSTORE_AUT
         IF (NSEL.GT.10) NSEL = 10
         DO 220 I = 1, NSEL
            M2ITEMS(I) = 'Solution'
            CALL STR_ADDI(M2ITEMS(I),I,1)
220      CONTINUE
         M2ITEMS(NSEL+1) = 'Enter Solution Number'
         NITEMS = NSEL + 1
         NVIEW = 1
         IVHLIST(1) = IVH_MENU_AUT
         CALL XDLF_MENU_AREA_SETMENU (IVH_MENU_AUT, NITEMS,
     +        XDLSTR(M2ITEMS), 25,
     +        XDLSTR('Solution Number Menu'), 20, 
     +        XDLSTR('Quit Selection'), 14, 0, IERR)
         CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU_AUT, ISOLN, IQUIT)
         IF (IQUIT.EQ.1) GO TO 200
         IF (ISOLN.EQ.NSEL+1) THEN
240         ISOLN = 1
            CALL IOW_ASKI (IVH_IOW_AUT, 'Solution number', ISOLN)
            IF (ISOLN.LT.1.OR.ISOLN.GT.NSTORE_AUT) THEN
               CALL LMESSAGE (IVH_IOW_AUT,'**Solution not stored**')
               GO TO 240
            END IF
         END IF
C
C====== Select the solution
C
         IF (M_ITEM.EQ.M_SEL) THEN
            IF (SEL) THEN
               CALL YESNO_NOTICE(2,
     +              'Another solution already accepted - override?',
     +               IYN)
               IF (IYN.EQ.2) GO TO 200
            END IF
            N = IP_AUT(ISOLN)
            CALL LDM_SET_PHIX (IPACK, STANG(N,1), IERR, ERRSTR)
            CALL LDM_SET_PHIY (IPACK, STANG(N,2), IERR, ERRSTR)
            CALL LDM_SET_PHIZ (IPACK, STANG(N,3), IERR, ERRSTR)
            CALL LDM_SET_SPIN (IPACK, 0.0, IERR, ERRSTR)
            SEL = .TRUE.
            NE = 0
            NE = NE + 1
            LISTE(NE) = IP_PHIX
            NE = NE + 1
            LISTE(NE) = IP_PHIY
            NE = NE + 1
            LISTE(NE) = IP_PHIZ
            NE = NE + 1
            LISTE(NE) = IP_SPINDL
            CALL SET_PAR1_VALS (NE, LISTE)
C
C====== Show the solution (predicted pattern on displayed image)
C
         ELSE IF (M_ITEM.EQ.M_SHOW) THEN
            N = IP_AUT(ISOLN)
            CALL SHOW_IMAGE(2, IERR)
            IF (IERR.EQ.1) GO TO 200
            CALL LDM_GET_PHIX (IPACK, SAV_PHIS(1), IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_GET_PHIY (IPACK, SAV_PHIS(2), IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_GET_PHIZ (IPACK, SAV_PHIS(3), IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_GET_SPIN (IPACK, SAV_SPINDLE, IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_SET_PHIX (IPACK, STANG(N,1), IERR, ERRSTR)
            CALL LDM_SET_PHIY (IPACK, STANG(N,2), IERR, ERRSTR)
            CALL LDM_SET_PHIZ (IPACK, STANG(N,3), IERR, ERRSTR)
            CALL LDM_SET_SPIN (IPACK, 0.0, IERR, ERRSTR)
            CALL SHOW_PREDICT(2)
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT(IVH_FILM,IERR)
            CALL LDM_SET_PHIX (IPACK, SAV_PHIS(1), IERR, ERRSTR)
            CALL LDM_SET_PHIY (IPACK, SAV_PHIS(2), IERR, ERRSTR)
            CALL LDM_SET_PHIZ (IPACK, SAV_PHIS(3), IERR, ERRSTR)
            CALL LDM_SET_SPIN (IPACK, SAV_SPINDLE, IERR, ERRSTR)
            GO TO 200
C
C====== Refine solution further
C
         ELSE IF (M_ITEM.EQ.M_REFINE) THEN
            N = IP_AUT(ISOLN)
            CALL REFIN_AUT(N)
            IF (ISOLN.LE.NSHOW) THEN
               WRITE (STR,'(3F9.2)') STANG(N,1), STANG(N,2), STANG(N,3)
               CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR), 30,
     +              4+ISOLN, 4, 0, IERR)
               WRITE (STR,'(F11.3)') STDEV(N)
               CALL XDLF_TEXT_TABLE_TEXT (IVH_TABL_AUT, XDLSTR(STR), 11,
     +              4+ISOLN, 49, 0, IERR)
            END IF
            GO TO 200
C
C====== List solution (showing individual observations)
C
         ELSE IF (M_ITEM.EQ.M_LIST) THEN
            N = IP_AUT(ISOLN)
            LC = 0
            I = 0
            CALL LMESSAGE(IVH_IOW_AUT,
     +           '  h  k  l    xobs    yobs   xcalc'//
     +           '   ycalc   xdiff   ydiff')
 300        I = I + 1
            LC = LC + 1
            XD = ABS(STXC(N,1,I)-STXC(N,3,I))
            YD = ABS(STXC(N,2,I)-STXC(N,4,I))
            WRITE (STR,'(3I3,6F8.2)')
     +            STHKL(N,1,I), STHKL(N,2,I), STHKL(N,3,I),
     +            STXC(N,1,I), STXC(N,2,I), STXC(N,3,I), STXC(N,4,I),
     +            XD, YD
            CALL LMESSAGE(IVH_IOW_AUT,STR)
            IF (LC.EQ.10.AND.I.LT.STNOBS(N)) THEN
               LC = 0
               CALL XDLF_IO_WINDOW_PRINT (IVH_IOW_AUT,
     +              XDLSTR('Enter <CR> to continue...'), 25, 0, IERR)
               NVIEW = 1
               IVHLIST(1) = IVH_IOW_AUT
               CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
            END IF
            IF (I.LT.STNOBS(N)) GO TO 300
            STR = 'PhiX ='
            CALL STR_ADDF(STR,STANG(N,1),2,1)
            CALL STR_ADDS(STR,', PhiY =',0)
            CALL STR_ADDF(STR,STANG(N,2),2,1)
            CALL STR_ADDS(STR,', PhiZ =',0)
            CALL STR_ADDF(STR,STANG(N,3),2,1)
            CALL LMESSAGE(IVH_IOW_AUT,STR)
            STR = 'rms ='
            CALL STR_ADDF(STR,STDEV(N),3,1)
            CALL STR_ADDS(STR,'from',1)
            CALL STR_ADDF(STR,STDEV0(N),3,1)            
            CALL LMESSAGE(IVH_IOW_AUT,STR)
            GO TO 200  
C
C====== Save solution (in a parameter file
C
         ELSE IF (M_ITEM.EQ.M_SAVE) THEN
            N = IP_AUT(ISOLN)
610         CALL LPROMPT 
     +        (IVH_IOW_AUT, 'File name (default ext=.ldm): ')
            NVIEW = 1
            IVHLIST(1) = IVH_IOW_AUT
            CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW_AUT, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') GO TO 200
            CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
            CONT = .TRUE.
            EXISTS = CCPEXS (PAR_FILE)
            IF (EXISTS) THEN
               CALL LMESSAGE(IVH_IOW_AUT,'**File already exists**')
               CONT = .FALSE.
               CALL IOW_ASKQ (IVH_IOW_AUT, 'Overwrite file', CONT)
            END IF
            IF (.NOT.CONT) GO TO 610
            IFAIL = 1
            CALL CCPDPN (-IUN_GEN, PAR_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW_AUT,
     +                       '**Error in opening the file**')
               GO TO 610
            END IF
            CALL LDM_GET_PHIX (IPACK, SAV_PHIS(1), IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_GET_PHIY (IPACK, SAV_PHIS(2), IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_GET_PHIZ (IPACK, SAV_PHIS(3), IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_GET_SPIN (IPACK, SAV_SPINDLE, IFLAG, ND, IERR,
     +                         ERRSTR)
            CALL LDM_SET_PHIX (IPACK, STANG(N,1), IERR, ERRSTR)
            CALL LDM_SET_PHIY (IPACK, STANG(N,2), IERR, ERRSTR)
            CALL LDM_SET_PHIZ (IPACK, STANG(N,3), IERR, ERRSTR)
            CALL LDM_SET_SPIN (IPACK, 0.0, IERR, ERRSTR)
            CALL WRITE_PARFIL (PAR_FILE)
            CLOSE (UNIT=IUN_GEN)
            CALL LDM_SET_PHIX (IPACK, SAV_PHIS(1), IERR, ERRSTR)
            CALL LDM_SET_PHIY (IPACK, SAV_PHIS(2), IERR, ERRSTR)
            CALL LDM_SET_PHIZ (IPACK, SAV_PHIS(3), IERR, ERRSTR)
            CALL LDM_SET_SPIN (IPACK, SAV_SPINDLE, IERR, ERRSTR)
            GO TO 200
         END IF
            
      END IF
      GO TO 200
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     AUTO_SOFT_CTL    **
C**************************
C
C
      SUBROUTINE AUTO_SOFT_CTL (IOPT, LINE, IPKALL_DF, NPROF_DF, 
     +                          PRF_ROT_DF,PROMIN_DF, FRAC_DF, 
     +                          SIGTEST_DF, FRTEST_DF, 
     +                          NBINS_DF, BINW_DF, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control soft limits calculation from command line requests
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER IOPT 
      CHARACTER*(*) LINE
      INTEGER IPKALL_DF
      INTEGER NPROF_DF
      LOGICAL PRF_ROT_DF
      REAL PROMIN_DF
      REAL FRAC_DF
      REAL SIGTEST_DF
      REAL FRTEST_DF
      INTEGER NBINS_DF
      REAL BINW_DF
      INTEGER IERR
C
C IOPT       (R)   Soft limit type, 1=dmin, 2=lmin
C LINE       (R)   Line containing non-default options codes & values
C IPKALL_DF  (R)   Default pac/all flag 1/2
C NPROF_DF   (R)   Default no. of profile bins
C PRF_ROT_DF (R)   Default rotate profiles flag
C PROMIN_DF  (R)   Default PROMIN value
C FRAC_DF    (R)   Default FRAC value
C SIGTEST_DF (R)   Default SIGTEST value
C FRTEST_DF  (R)   Default FRTEST value
C NBINS_DF   (R)   DEfault NBINS value
C BINW_DF    (R)   Default BINW value
C IERR       (W)   Error flag =0 OK, =1 error (Note that reporting of errors
C                  is done within this (or called) routines.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'image.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      EXTERNAL SOFT_INTEG_PROGRESS
      LOGICAL CMD_CNCL
      EXTERNAL CMD_CNCL
      EXTERNAL LAUEGEN_RIMG
      EXTERNAL SOFT_LIST
      EXTERNAL AUTO_SOFT_ERR
      EXTERNAL SOFT_PROGRESS
C
C====== LOCALS:
C
      INTEGER IMG_PK
      INTEGER IMG_PL
      INTEGER NF_OFF
      INTEGER NMEAS(MAX_SOFT_BINS)
      INTEGER NGTSIG(MAX_SOFT_BINS)
      REAL RBIN(MAX_SOFT_BINS)
      CHARACTER*80 ERRSTR
      CHARACTER*80 ERRSTR2

C     INTEGER IMG_PK             !Pack of currently read image, 0 if none
C     INTEGER IMG_PL             !Plate of currently read image, 0 if none
C     INTEGER NF_OFF             !Offset between start of successive image 
C                                 rasters
C     INTEGER NMEAS(MAX_SOFT_BINS)  !Nos. of measured spots in bins
C     INTEGER NGTSIG(MAX_SOFT_BINS) !Nos. of significant spots in bins
C     REAL RBIN(MAX_SOFT_BINS)   !Significant/measured ratios for bins
C     CHARACTER*80 ERRSTR        !Error string (dummy)
C     CHARACTER*80 ERRSTR2       !Second error string (dummy)
C
C-------------------------------------------------------------------------------
C
      IERR = 0
C
C====== See if an image already read
C
      IMG_PK = 0
      IMG_PL = 0
      IF (IPACK_OPN.GT.0.AND.IPLATE_OPN.GT.0) THEN
         IF (FILM_OPEN.AND.FILM_READ) THEN
             IMG_PK = IPACK_OPN
             IMG_PL = IPLATE_OPN
         END IF
      END IF

      CALL LFN_AUTO_SOFT (IPACK, IPLATE, IOPT, LINE,
     +                    IPKALL_DF, NPROF_DF, PRF_ROT_DF, PROMIN_DF,  
     +                    FRAC_DF, SIGTEST_DF, FRTEST_DF,     
     +                    NBINS_DF, BINW_DF,
     +                    IMG_PK, IMG_PL, LAUEGEN_RIMG, 
     +                    IMG, MAX_IMG_WORDS, ITYPE, NFRASTS,
     +                    IUN_LOG, SOFT_PROGRESS, SOFT_INTEG_PROGRESS,
     +                    SOFT_LIST, AUTO_SOFT_ERR, CMD_CNCL,
     +                    MAX_SOFT_BINS, NMEAS, NGTSIG, RBIN,
     +                    2, IERR, ERRSTR, ERRSTR2)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     AUTO_SOFT_ERR      **
C****************************
C
C
      SUBROUTINE AUTO_SOFT_ERR (KUN_LOG, ICONT, ERRSTR, ERRSTR2, NEXT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle automatic soft limit determination errors
C
C    NOTE: PARAMETERS MUST MATCH THOSE REQUIRED BY LFN_AUTO_SOFT ROUTINE
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER KUN_LOG
      INTEGER ICONT
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
      LOGICAL NEXT
C
C Parameters as for LFN_SOFT_ERR
C
C KUN_LOG     i  (R)  Unit number for log file (0 if none)
C ICONT       i  (R)  = 0 treat as error which terminates procedure
C                     = 1 may continue with next pack if desired
C                     =-1 interrupted
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C NEXT        l  (W)  Set by the routine. If .true. then procedure will
C                     be continued with next pack. If .false. 
C                     then procedure will be terminated. Note: the 
C                     routine must set it to .false. ICONT is 0 or -1.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      CHARACTER*120 STR

C     LOGICA EOF              !End of file flag
C     CHARACTER*120 STR       !Temp. string

C
C-------------------------------------------------------------------------------
C
      NEXT = .FALSE.
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         IF (ICONT.LT.0) THEN
            WRITE (IUN_LOG,6000) ERRSTR(1:LENSTR(ERRSTR))
         ELSE
            WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
            IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                          ERRSTR2(1:LENSTR(ERRSTR2))
         END IF
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         IF (ICONT.LT.0) THEN
            CALL LMESSAGE (IVH_CMD, ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL LMESSAGE (IVH_CMD, STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL LMESSAGE (IVH_CMD, STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN
               CALL IOW_ASKQ (IVH_CMD, 'Continue with next pack', 
     +                        NEXT)
            END IF
            RETURN
         END IF

      ELSE IF (LG_MODE.EQ.2) THEN
         IF (ICONT.LT.0) THEN
            CALL TWRITE (ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL TWRITE (STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL TWRITE (STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN    
               CALL TASKQ ('Continue with next pack', NEXT, EOF)
            END IF
            IF (EOF) NEXT = .FALSE.
            RETURN
         END IF
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     AUTO_SPOTSIZE_CTL     **
C*******************************
C
C
      SUBROUTINE AUTO_SPOTSIZE_CTL (OPTSTR, IPKALL_DF, NBINS_DF,
     +                              SDCUT_DF, THRFAC_DF, EXPAND_DF,
     +                              IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control spot size determination from command line input
C
C Author:  John W. Campbell, Setpember 1995
C
C Arguments:
C
      CHARACTER*(*) OPTSTR
      INTEGER IPKALL_DF
      INTEGER NBINS_DF
      REAL SDCUT_DF
      REAL THRFAC_DF
      REAL EXPAND_DF
      INTEGER IERR
C
C OPTSTR       (R)  Line containing non-default options codes & values
C IPKALL_DF    (R)  Default is for pack/all 1/2
C NBINS_DF     (R)  Default no. bins for theta analysis for LFN_SPOTS_ANALYSE
C SDCUT_DF     (R)  Default 'standard deviation cutoff' for LFN_FINDSPOTS
C THRFAC_DF    (R)  Default threshold factor for LFN_FINDSPOTS
C EXPAND_DF    (R)  Default spot size expand factor for LFN_SPOTS_ANA_LIS etc.
C IERR         (W)  Error flag =0 OK, 
C                   =1 error (Note that reporting of errors is done within 
C                      this routine.
C                   =100 Cancelled
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'image.finc'
      INCLUDE 'spot_sizes.finc'
      INCLUDE 'upd_flags.finc'
      INCLUDE 'bg_progress.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
      INTEGER LDM_INTFP
      EXTERNAL SPOT_PROGRESS
      LOGICAL CMD_CNCL
      EXTERNAL CMD_CNCL
      EXTERNAL BG_PROGRESS
      EXTERNAL BG_CNCL
C
C====== LOCALS:
C
      LOGICAL NEXT
      INTEGER IMG_PK
      INTEGER IMG_PL
      INTEGER NBINS
      INTEGER NPACKS
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER IPKALL
      INTEGER INP(6)
      INTEGER I
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER NKEYS
      INTEGER IKEY
      INTEGER KERR
      INTEGER JERR
      INTEGER ND
      INTEGER IV
      INTEGER IPK_MIN
      INTEGER IPK_MAX
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER IORDER
      INTEGER ISWAP
      INTEGER IPK
      INTEGER LISTE(2)
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER KEYPLATE
      INTEGER ICONT
      INTEGER NPBOX
      INTEGER IPCNT
      INTEGER MINDX_SPOT
      INTEGER NUMB_L(64)
      INTEGER NREJ_L(64)
      INTEGER NGOOD_L(64)
      INTEGER NUMB_W(64)
      INTEGER NREJ_W(64)
      INTEGER NGOOD_W(64)
      INTEGER NSPOT
      REAL FP
      REAL SDCUT
      REAL THRFAC
      REAL EXPAND
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL RMIN
      REAL RMAX
      REAL XLOW
      REAL XHIGH
      REAL YLOW
      REAL YHIGH
      REAL REXCLUDE
      REAL SEL_LEN
      REAL SEL_WID
      REAL SPT_LEN
      REAL SPT_WID
      REAL BIN_S_L(64)
      REAL BIN_E_L(64)
      REAL SUM_L (64)
      REAL VAR_L(64)
      REAL SDEV_L(64)
      REAL AVE_L(64)
      REAL SGOOD_L(64)
      REAL BIN_S_W(64)
      REAL BIN_E_W(64)
      REAL SUM_W (64)
      REAL VAR_W(64)
      REAL SDEV_W(64)
      REAL AVE_W(64)
      REAL SGOOD_W(64)
      REAL X_CEN_F 
      REAL Y_CEN_F
      REAL W_F
      REAL X_C
      REAL Y_C
      REAL XCEN
      REAL YCEN
      CHARACTER*2 VALSTR
      CHARACTER*12 KEYS(6) 
      CHARACTER*80 ERRSTR
      CHARACTER*80 KERRSTR
      CHARACTER*80 ERRSTR2
      CHARACTER*25 NAME
      CHARACTER*120 STR
      CHARACTER*4 SEP

C     LOGICAL NEXT               !Continue with next pack flag
C     INTEGER IMG_PK             !Pack no. of current image read, 0 if none
C     INTEGER IMG_PL             !Plate no. of current image read, 0 if none
C     INTEGER NBINS              !No. of angular bins for spot size analysis
C     INTEGER NPACKS             !No. of packs
C     INTEGER NPLATES            !No. of plates
C     INTEGER IFLAG              !Parameter status flag
C     INTEGER IPKALL             !Process all/pack flag
C     INTEGER INP(6)             !Flags for option key already input
C     INTEGER I                  !Temp/loop variable
C     INTEGER II                 !LDM_INTFP function return value
C     INTEGER IL                 !Index to last character processed in string
C     INTEGER M1                 !Index to first character in token
C     INTEGER M2                 !Index to final character in token
C     INTEGER NKEYS              !No. of option keys
C     INTEGER IKEY               !Option key number
C     INTEGER KERR               !Error flag
C     INTEGER JERR               !Error flag
C     INTEGER ND                 !No. of decimal places flag
C     INTEGER IV                 !Integer value
C     INTEGER IPK_MIN            !Minimum pack number for processing
C     INTEGER IPK_MAX            !Maximum pack number for processing
C     INTEGER NXRAST             !No. x-rasters
C     INTEGER NYRAST             !No. y-rasters
C     INTEGER NF_OFF             !Offset between start of slow rasters in image
C     INTEGER IORDER             !Axis order flag
C     INTEGER ISWAP              !Byte swap flag
C     INTEGER IPK                !Pack loop variable
C     INTEGER LISTE(2)           !List of parameter table entries to be updated
C     INTEGER KPACK              !Pack number, 0 = all packs
C     INTEGER KPLATE             !Plate number, 0 = all plates
C     INTEGER KEYPLATE           !Key plate
C     INTEGER ICONT              !Continue on error flag
C     INTEGER NPBOX              !Box size for background searches
C     INTEGER IPCNT              !Percent threshold for background points
C     INTEGER MINDX_SPOT         !Index for spots list in memory records
C     INTEGER NUMB_L(64)         !Spot length analysis parameters
C     INTEGER NREJ_L(64)         !"
C     INTEGER NGOOD_L(64)        !"
C     INTEGER NUMB_W(64)         !Spot width analysis parameters
C     INTEGER NREJ_W(64)         !"
c     INTEGER NGOOD_W(64)        !"
C     INTEGER NSPOT              !No. of spots found
C     REAL FP                    !Real value
C     REAL SDCUT                 !Standard deviation cutoff
C     REAL THRFAC                !Threshold factor (*background) for spots
C     REAL EXPAND                !Expansion factor: ave obs. -> proposed
C     REAL MM_RAST_X             !Conversion mm to x-rasters
C     REAL MM_RAST_Y             !Conversion mm to y-rasters
C     REAL RMIN                  !RMIN parameter converted to rasters
C     REAL RMAX                  !RMAX parameter converted to rasters
C     REAL XLOW                  !Low x limit in rasters
C     REAL XHIGH                 !High x limit in rasters
C     REAL YLOW                  !Low y limit in raster
C     REAL YHIGH                 !High y limit in rasters
C     REAL REXCLUDE              !Exclusion adjustment to RMIN, RMAX (rasters)
C     REAL SEL_LEN               !Determined spot length (rasters)
C     REAL SEL_WID               !Determined spot width (rasters)
C     REAL SPT_LEN               !Spot length (proposed) in mm
C     REAL SPT_WID               !Spot width (proposed) in mm
C     REAL BIN_S_L(64)           !Spot length analysis parameters
C     REAL BIN_E_L(64)           !"
C     REAL SUM_L (64)            !"
C     REAL VAR_L(64)             !"
C     REAL SDEV_L(64)            !"
C     REAL AVE_L(64)             !"
C     REAL SGOOD_L(64)           !"
C     REAL BIN_S_W(64)           !Spot width analysis parameters
C     REAL BIN_E_W(64)           !"
C     REAL SUM_W (64)            !"
C     REAL VAR_W(64)             !"
C     REAL SDEV_W(64)            !"
C     REAL AVE_W(64)             !"
C     REAL SGOOD_W(64)           !"
C     REAL X_CEN_F               !X centre
C     REAL Y_CEN_F               !Y centre
C     REAL W_F                   !Omega
C     REAL X_C                   !x_c in mm
C     REAL Y_C                   !y_c in mm
C     REAL XCEN                  !X centre (corrected) in rasters
C     REAL YCEN                  !Y centre (corrected) in rasters
C     CHARACTER*2 VALSTR         !Parameter value string (dummy)
C     CHARACTER*12 KEYS(6)       !Option keys
C     CHARACTER*80 ERRSTR        !Error string 
C     CHARACTER*80 KERRSTR       !Error string 
C     CHARACTER*80 ERRSTR2       !Subsidiary error string
C     CHARACTER*25 NAME          !Option key name
C     CHARACTER*120 STR          !Message string
C     CHARACTER*4 SEP            !Token separator characters

      DATA SEP /'  ,='/
      DATA KEYS /'PACK',
     +           'ALL',
     +           'THRESH',
     +           'NBINS',
     +           'SDCUT',
     +           'EXPAND'/
C
C
C-------------------------------------------------------------------------------
      IERR = 0
      ERRSTR = ' '
      ERRSTR2 = ' '
C
C====== See if an image already read
C
      IMG_PK = 0
      IMG_PL = 0
      IF (IPACK_OPN.GT.0.AND.IPLATE_OPN.GT.0) THEN
         IF (FILM_OPEN.AND.FILM_READ) THEN
             IMG_PK = IPACK_OPN
             IMG_PL = IPLATE_OPN
         END IF
      END IF
C
C====== Check pack/plate
C
      CALL LDM_GET_NUMP (NPACKS, IFLAG)
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (IPACK.LT.1.OR.IPACK.GT.NPACKS) THEN
         ERRSTR = 'Current pack number is invalid'
         ERRSTR2 = 'Pack ='
         CALL STR_ADDI (ERRSTR2, IPACK, 1)
         CALL STR_ADDS (ERRSTR2, ', plate =', 0)
         CALL STR_ADDI (ERRSTR2, IPLATE, 1)
         CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         IERR = 1
         RETURN
      END IF
      IF (IPLATE.LT.1.OR.IPLATE.GT.NPLATES) THEN
         ERRSTR = 'Current plate number is invalid'
         ERRSTR2 = 'Pack ='
         CALL STR_ADDI (ERRSTR2, IPACK, 1)
         CALL STR_ADDS (ERRSTR2, ', plate =', 0)
         CALL STR_ADDI (ERRSTR2, IPLATE, 1)
         CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         IERR = 1
         RETURN
      END IF
C
C====== Get control parameter defaults
C
      NBINS = NBINS_DF
      SDCUT = SDCUT_DF
      THRFAC = THRFAC_DF
      EXPAND = EXPAND_DF
C
C====== Interpret command string
C
      DO 10 I = 1, 6
         INP(I) = 0
 10   CONTINUE
      IPKALL = 0
      NKEYS = 6
      SEP(2:2) = CHAR(9)
      IL = 0
100   I = NXTTOK (OPTSTR, SEP, IL, M1, M2)
      IF (I.EQ.-1) GO TO 200
      IF (I.EQ.0) GO TO 100
      NAME = OPTSTR(M1:M2)
      CALL CCPUPC (NAME)
      CALL GETOPT (KEYS, NKEYS, NAME, IKEY, KERR)
      IF (KERR.NE.0) THEN
         IF (KERR.EQ.1)  ERRSTR = 'Ambiguous option'
         IF (KERR.EQ.2)  ERRSTR = 'Invalid option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1) 
         CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
         IERR = 1
         RETURN
      END IF
      IF (INP(IKEY).EQ.1) THEN
         ERRSTR = 'Duplicate option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1)  
         CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
         IERR = 1
         RETURN
      END IF
      IF (IKEY.LE.2) THEN
         IF (IPKALL.NE.0) THEN
            ERRSTR = 'Inconsistent option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, NAME, 1)  
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         ELSE
            INP(IKEY) = 1
            IPKALL = IKEY
         END IF
      ELSE
         INP(IKEY) = 1
         I = NXTTOK (OPTSTR, SEP, IL, M1, M2)
         IF (I.LE.0) THEN
            ERRSTR =  'Option'
            CALL STR_ADDS (ERRSTR, NAME, 1)
            CALL STR_ADDS (ERRSTR, 'not followed by a value', 1)
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         END IF
         II = LDM_INTFP (OPTSTR(M1:M2), FP, IV, ND)
         IF (II.LE.0) THEN 
            ERRSTR =  'Option'
            CALL STR_ADDS (ERRSTR, NAME, 1)
            CALL STR_ADDS (ERRSTR, 'not followed by a valid value', 1)
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         END IF
         IF (IKEY.EQ.3) THEN
            IF (FP.LE.1.0) GO TO 150
            THRFAC = FP
         ELSE IF (IKEY.EQ.4) THEN            
            IF (II.NE.1.OR.IV.LT.1.OR.IV.GT.64) GO TO 150
            NBINS = IV
         ELSE IF (IKEY.EQ.5) THEN
            IF (FP.LE.0.0) GO TO 150
            SDCUT = FP
         ELSE IF (IKEY.EQ.6) THEN
            IF (FP.LE.1.0) GO TO 150
            EXPAND = FP
         END IF
      END IF
      GO TO 100
C
C====== Invalid value
C
 150  ERRSTR = OPTSTR(M1:M2)
      CALL STR_ADDS (ERRSTR, 'is not a valid value for option', 1)
      CALL STR_ADDS (ERRSTR, NAME, 1)
      CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
      IERR = 1
      RETURN
C
C====== Set pack  range 
C
 200  IF (IPKALL.EQ.0) IPKALL = IPKALL_DF 
      IF (IPKALL.EQ.1) THEN
         IPK_MIN = IPACK
         IPK_MAX = IPACK
      ELSE
         IPK_MIN = 1
         CALL LDM_GET_NUMP (IPK_MAX, IFLAG)
         IF (IPK_MAX.LT.1) IPK_MAX = 1
      END IF
C
C====== Get some image related details
C
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORDER, ISWAP, IFLAG)
      CALL LDM_GET_XLOW (XLOW, IFLAG, ND)
      CALL LDM_GET_XHIGH (XHIGH, IFLAG, ND)
      CALL LDM_GET_YLOW (YLOW, IFLAG, ND)
      CALL LDM_GET_YHIGH (YHIGH, IFLAG, ND)
      IF (LG_MODE.EQ.1) CALL CMD_CNCL_BUT     
      IF (CMD_CNCL(0)) GO TO 900
      ISP_PROGX = 0
      ISP_PROGY = 0            
      IF (LG_MODE.EQ.1) CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_CMD,8,35,
     +                              ISP_PROGX,ISP_PROGY,KERR)
      IBG_PROGX = ISP_PROGX
      IBG_PROGY = ISP_PROGY
C
C====== Loop through required packs
C====== ===========================
C
      DO 2000 IPK = IPK_MIN, IPK_MAX
         ICONT = 1
         IF (IPK.EQ.IPK_MAX) ICONT = 0
         CALL LDM_GET_KEYP (IPK, KEYPLATE, IFLAG, KERR, ERRSTR)
         IF (KEYPLATE.LT.1.OR.KEYPLATE.GT.NPLATES) THEN
            ERRSTR = 'Keyplate'
            CALL STR_ADDI (ERRSTR, KEYPLATE, 1)
            CALL STR_ADDS (ERRSTR,'out of range for pack',1)
            CALL STR_ADDI (ERRSTR, IPK,1)
            ERRSTR2 = ' '
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                               ERRSTR2, NEXT)
            IF (.NOT.NEXT) THEN
               IERR = 1
               GO TO 2010
            END IF
            IF (CMD_CNCL(0)) GO TO 900
            GO TO 2000
         END IF
         IPACK = IPK
         IPLATE = KEYPLATE
C
C====== Update parameter tables
C
         IF (LG_MODE.EQ.1) THEN
            CALL SET_PAR1_VALS (0, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
         END IF
         STR = '==Determining spot size for pack'
         CALL STR_ADDI (STR, IPACK, 1)
         CALL STR_ADDS (STR, 'using plate', 1)
         CALL STR_ADDI (STR, IPLATE, 1)
         CALL STR_ADDS (STR, '==', 0)
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE (IVH_IOW, STR)
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (STR)
         END IF
C
C====== Read image if not already read
C
         IF (IPACK.NE.IMG_PK.OR.IPLATE.NE.IMG_PL) THEN
            CALL LAUEGEN_RIMG (IPACK, IPLATE, ITYPE, NF_OFF, IMG, 
     +                    MAX_IMG_WORDS, KERR, KERRSTR)
            IF (KERR.NE.0) THEN
               ERRSTR = 'Error reading image for pack'
               CALL STR_ADDI (ERRSTR, IPACK, 1)
               CALL STR_ADDS (ERRSTR, ', plate', 0)
               CALL STR_ADDI (ERRSTR, IPLATE, 1)
               ERRSTR2 = KERRSTR
               ICONT = 1
               IF (IPACK.EQ.IPK_MAX) ICONT = 0
               IMG_PK = 0
               IMG_PL = 0
               CALL AUTO_SPOTSIZE_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                 ERRSTR2, NEXT)
               IF (.NOT.NEXT) THEN
                  IERR = 1
                  GO TO 2010
               END IF
               GO TO 2000
            END IF
            IMG_PK = IPACK
            IMG_PL = IPLATE
         END IF
         NF_OFF = NFRASTS
         IF (CMD_CNCL(0)) GO TO 900
C
C====== 2-D background calculations
C
         NPBOX = 2 * ((NFRASTS/NCMP)/50) + 1
         IPCNT = 50
         PROG_BG_ON = .FALSE.
         CALL XDLF_BG_CALC_PROG (IMG, ITYPE, NSRASTS, NFRASTS, NFRASTS,
     +                      NCMP, NPBOX, -IPCNT, IMG_BG, NF_BGOFF,
     +                      BG_PROGRESS, BG_CNCL, KERR)
         IF (LG_MODE.EQ.1) THEN
            IF (PROG_BG_ON) CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
         END IF
         IF (KERR.EQ.-1) GO TO 900
         IF (KERR.EQ.2) THEN
            ERRSTR = 'Search box too big for image'
            ERRSTR2 = ' '
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            IERR = 1
            GO TO 2010
         END IF
         CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
         CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, KERR, ERRSTR)
         CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, KERR, ERRSTR)
         CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
         CALL LDM_GET_RMIN (RMIN, IFLAG, ND)
         RMIN = RMIN*MM_RAST_X
         CALL LDM_GET_RMAX (RMAX, IFLAG, ND)
         RMAX = RMAX*MM_RAST_X
         XCEN = X_CEN_F + X_C*MM_RAST_X
         YCEN = Y_CEN_F + Y_C*MM_RAST_Y
         IF (NXRAST.GT.MAX_RASTS.OR.NYRAST.GT.MAX_RASTS) THEN
            ERRSTR = 'Too many rasters in image for spot search'
            ERRSTR2 = ' '
            IERR = 1
            GO TO 2010
         END IF
         REXCLUDE = FLOAT(NPBOX*NCMP)/SQRT(2.0)
C 
C====== Determine spot size
C
         CALL LFN_FINDSPOTS (IMG, ITYPE, IORDER, NF_OFF, 
     +                       NXRAST, NYRAST, IMG_BG, NF_BGOFF,
     +                       NCMP, ISP_DATA, ISP_WORK, XCEN, YCEN,
     +                       RMIN, RMAX, 
     +                       XLOW, XHIGH, YLOW, YHIGH, REXCLUDE, 
     +                       THRFAC, 
     +                       SPOT_PROGRESS, CMD_CNCL,
     +                       MINDX_SPOT, NSPOT, KERR, ERRSTR)
         IF (LG_MODE.EQ.1) THEN
            IF (PROG_BAR) CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
         END IF
         IF (KERR.NE.0) THEN
            CALL DMLF_FREE (MINDX_SPOT, JERR)
            IF (KERR.EQ.100) GO TO 900
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            IERR = 1
            GO TO 2010
         END IF
         IF (NSPOT.EQ.0) THEN
            CALL DMLF_FREE (MINDX_SPOT, KERR)
            ERRSTR = 'No spots found'
            ERRSTR2 = ' '
            CALL AUTO_SPOTSIZE_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            IERR = 1
            GO TO 2010
         END IF
         CALL LFN_SPOTS_ANALYSE (MINDX_SPOT, 1, SDCUT, NBINS,
     +                          BIN_S_L, BIN_E_L, SUM_L, NUMB_L,
     +                          VAR_L, SDEV_L, AVE_L, NREJ_L, SGOOD_L,
     +                          NGOOD_L, SEL_LEN, KERR, ERRSTR)
         CALL LFN_SPOTS_ANALYSE (MINDX_SPOT, 2, SDCUT, NBINS,
     +                          BIN_S_W, BIN_E_W, SUM_W, NUMB_W,
     +                          VAR_W, SDEV_W, AVE_W, NREJ_W, SGOOD_W,
     +                          NGOOD_W, SEL_WID, KERR, ERRSTR)
         CALL DMLF_FREE (MINDX_SPOT, KERR)
         SPT_LEN = EXPAND*SEL_LEN/MM_RAST_X
         SPT_WID = EXPAND*SEL_WID/MM_RAST_X
         CALL LDM_SET_SPOTL (IPACK, IPLATE, SPT_LEN, KERR, ERRSTR)
         CALL LDM_SET_SPOTW (IPACK, IPLATE, SPT_WID, KERR, ERRSTR)
         IF (LG_MODE.EQ.1) THEN
            LISTE(1) = IP_STRK_L
            LISTE(2) = IP_STRK_W
            CALL SET_PAR2_VALS (2, LISTE)
         END IF
         STR = 'New spot length ='
         CALL STR_ADDF (STR, SPT_LEN, 2, 1)
         CALL STR_ADDS (STR, 'mm', 1)
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE(IVH_IOW, STR)
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (STR)
         END IF
         STR = 'New spot width ='
         CALL STR_ADDF (STR, SPT_WID, 2, 1)
         CALL STR_ADDS (STR, 'mm', 1)
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE(IVH_IOW, STR)
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (STR)
         END IF
         CALL OTHERS_UPD (1, UPD_SPOT, KPACK, KPLATE)
         CALL LDM_SET_SPOTL (KPACK, KPLATE, SPT_LEN, KERR, ERRSTR)
         CALL LDM_SET_SPOTW (KPACK, KPLATE, SPT_WID, KERR, ERRSTR)
         IF (IUN_LOG.GT.0) WRITE(IUN_LOG,'('' '')')
         IF (IUN_LOG.GT.0) CALL LFN_SPOTS_ANA_LIS (IUN_LOG, 0, 1,
     +                     ISPOT_NBIN, BIN_S_L, BIN_E_L, SGOOD_L,
     +                     NGOOD_L, NREJ_L, SEL_LEN, 1.0/MM_RAST_X,
     +                     THRFAC, SDCUT, EXPAND, IPACK, IPLATE) 
         IF (IUN_LOG.GT.0) CALL LFN_SPOTS_ANA_LIS (IUN_LOG, 0,  2,
     +                     ISPOT_NBIN, BIN_S_W, BIN_E_W, SGOOD_W,
     +                     NGOOD_W, NREJ_W, SEL_WID, 1.0/MM_RAST_X,
     +                     THRFAC, SDCUT, EXPAND, IPACK, IPLATE) 
         IF (CMD_CNCL(0)) GO TO 900

 2000 CONTINUE

 2010 IF (LG_MODE.EQ.1) THEN
         CALL XDLF_DELETE_VIEW_OBJECT (IVH_CNCL_BUT, KERR)
      END IF
      RETURN
C
C====== Cancel requested
C
 900  CALL AUTO_SPOTSIZE_ERR (IUN_LOG, -1, 
     + '==Spot size determination interrupted==', ' ', NEXT)
      IERR = 100
      IF (LG_MODE.EQ.1) THEN
         CALL XDLF_DELETE_VIEW_OBJECT (IVH_CNCL_BUT, KERR)
      END IF 
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     AUTO_SPOTSIZE_ERR     **
C*******************************
C
C
      SUBROUTINE AUTO_SPOTSIZE_ERR (KUN_LOG, ICONT, ERRSTR, ERRSTR2, 
     +                              NEXT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle command line requested spotsize determination errors
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
      INTEGER KUN_LOG
      INTEGER ICONT
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
      LOGICAL NEXT
C
C Parameters:
C
C KUN_LOG     i  (R)  Unit number for log file (0 if none)
C ICONT       i  (R)  = 0 treat as error which terminates procedure
C                     = 1 may continue with next pack if desired
C                     =-1 interrupted
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C NEXT        l  (W)  Set by the routine. If .true. then procedure will
C                     be continued with next pack. If .false. 
C                     then procedure will be terminated. Note: the 
C                     routine must set it to .false. ICONT is 0 or -1.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      CHARACTER*120 STR

C     LOGICA EOF              !End of file flag
C     CHARACTER*120 STR       !Temp. string

C
C-------------------------------------------------------------------------------
C
      NEXT = .FALSE.
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         IF (ICONT.LT.0) THEN
            WRITE (IUN_LOG,6000) ERRSTR(1:LENSTR(ERRSTR))
         ELSE
            WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
            IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                          ERRSTR2(1:LENSTR(ERRSTR2))
         END IF
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         IF (ICONT.LT.0) THEN
            CALL LMESSAGE (IVH_CMD, ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL LMESSAGE (IVH_CMD, STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL LMESSAGE (IVH_CMD, STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN
               CALL IOW_ASKQ (IVH_CMD, 'Continue with next pack', 
     +                        NEXT)
            END IF
            RETURN
         END IF

      ELSE IF (LG_MODE.EQ.2) THEN
         IF (ICONT.LT.0) THEN
            CALL TWRITE (ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL TWRITE (STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL TWRITE (STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN    
               CALL TASKQ ('Continue with next pack', NEXT, EOF)
            END IF
            IF (EOF) NEXT = .FALSE.
            RETURN
         END IF
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     AUTO_WRITEINT_CTL     **
C*******************************
C
C
      SUBROUTINE AUTO_WRITEINT_CTL (OPTSTR, IPKALL_DF, INT_FTYP_DF,
     +                              INT_TEMPL_DF, SCAL_INT_DF, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control writing of integrated intensities files from 
C          command line input
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      CHARACTER*(*) OPTSTR
      INTEGER IPKALL_DF
      CHARACTER*(*) INT_FTYP_DF
      CHARACTER*(*) INT_TEMPL_DF
      REAL SCAL_INT_DF
      INTEGER IERR
C
C OPTSTR       (R)  Line containing non-default options codes & values
C IPKALL_DF    (R)  Default is for pack/all 1/2
C INT_FTYP_DF  (R)  Default file type string 'mtz' or 'ge'
C INT_TEMPL_DF (R)  Default template for intensities file names
C SCAL_INT_DF  (R)  Default o/p intensities scaling factor
C IERR         (W)  Error flag =0 OK, 
C                   =1 error (Note that reporting of errors is done within 
C                      this routine.
C                   =100 Cancelled
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
      INTEGER LDM_INTFP
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL NEXT
      LOGICAL ANY_INT
      LOGICAL ANY_PRES
      LOGICAL EXISTS
      INTEGER IPKALL
      INTEGER INP(5)
      INTEGER I
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER NKEYS
      INTEGER IKEY
      INTEGER KERR
      INTEGER ND
      INTEGER IV
      INTEGER IPK_MIN
      INTEGER IPK_MAX
      INTEGER IPK
      INTEGER IPL
      INTEGER IFLG
      INTEGER ICONT
      INTEGER NPACKS
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER IRET
      INTEGER JLEN
      INTEGER ILEN
      INTEGER IFAIL
      INTEGER INT_TYPE
      INTEGER LISTE(2)
      REAL FP
      REAL SCALE_INT
      CHARACTER*12 KEYS(5) 
      CHARACTER*80 ERRSTR
      CHARACTER*80 ERRSTR2
      CHARACTER*25 NAME
      CHARACTER*120 STR
      CHARACTER*4 SEP
      CHARACTER*6 INT_FTYP
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) MTZ_FILE
      CHARACTER*(MAXFLEN) GE1_FILE
      CHARACTER*(MAXFLEN) GE2_FILE

      CHARACTER*(MAXFLEN) INT_TEMPL 

C     LOGICAL NEXT               !Continue with next pack flag
C     LOGICAL ANY_INT            !Any intensities present flag
C     LOGICAL ANY_PRES           !.ge1 and/or .ge2 file already present flag
C     LOGICAL EXISTS             !File exists flag
C     INTEGER IPKALL             !Process all/pack flag
C     INTEGER INP(5)             !Flags for option key already input
C     INTEGER I                  !Temp/loop variable
C     INTEGER II                 !LDM_INTFP function return value
C     INTEGER IL                 !Index to last character processed in string
C     INTEGER M1                 !Index to first character in token
C     INTEGER M2                 !Index to final character in token
C     INTEGER NKEYS              !No. of option keys
C     INTEGER IKEY               !Option key number
C     INTEGER KERR               !Error flag
C     INTEGER ND                 !No. of decimal places flag
C     INTEGER IV                 !Integer value
C     INTEGER IPK_MIN            !Minimum pack number for processing
C     INTEGER IPK_MAX            !Maximum pack number for processing
C     INTEGER IPK                !Pack loop variable
C     INTEGER IPL                !Plate loop variable
C     INTEGER IFLG               !Integration status flag
C     INTEGER ICONT              !Continue on error flag
C     INTEGER NPACKS             !No. of packs
C     INTEGER NPLATES            !No. of plates
C     INTEGER IFLAG              !Parameter status flag
C     INTEGER IRET               !Return flag from MTZ file check routines
C     INTEGER JLEN               !Length of filename up to extension
C     INTEGER ILEN               !Length of filename up to extension
C     INTEGER IFAIL              !File open failure flag
C     INTEGER INT_TYPE           !Intensities file type flag =1 mtz,=2 ge1/.ge2
C     INTEGER LISTE(2)           !List of parameter table entries to be updated
C     REAL FP                    !Floating point value
C     REAL SCALE_INT             !Scale factor for output intensities
C     CHARACTER*12 KEYS(5)       !Option keys
C     CHARACTER*80 ERRSTR        !Error string 
C     CHARACTER*80 ERRSTR2       !Subsidiary error string
C     CHARACTER*25 NAME          !Option key name
C     CHARACTER*120 STR          !Message string
C     CHARACTER*4 SEP            !Token separator characters
C     CHARACTER*6 INT_FTYP       !Output file type code
C     CHARACTER*(MAXFLEN) FILNAM    !File name 
C     CHARACTER*(MAXFLEN) MTZ_FILE  !MTZ file name
C     CHARACTER*(MAXFLEN) GE1_FILE  !.ge1 file name
C     CHARACTER*(MAXFLEN) GE2_FILE  !.ge2 file name
C     CHARACTER*(MAXFLEN) INT_TEMPL !File name template

      DATA SEP /'  ,='/
      DATA KEYS /'PACK',
     +           'ALL',
     +           'INT_FTYPE',
     +           'INT_TEMPLATE',
     +           'SCALE_INT'/
C
C
C-------------------------------------------------------------------------------
      IERR = 0
      ERRSTR = ' '
      ERRSTR2 = ' '
      IF (IUN_LOG.GT.0) WRITE (IUN_LOG, 1000)
C
C====== Check pack/plate
C
      CALL LDM_GET_NUMP (NPACKS, IFLAG)
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (IPACK.LT.1.OR.IPACK.GT.NPACKS) THEN
         ERRSTR = 'Current pack number is invalid'
         ERRSTR2 = 'Pack ='
         CALL STR_ADDI (ERRSTR2, IPACK, 1)
         CALL STR_ADDS (ERRSTR2, ', plate =', 0)
         CALL STR_ADDI (ERRSTR2, IPLATE, 1)
         CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         IERR = 1
         RETURN
      END IF
      IF (IPLATE.LT.1.OR.IPLATE.GT.NPLATES) THEN
         ERRSTR = 'Current plate number is invalid'
         ERRSTR2 = 'Pack ='
         CALL STR_ADDI (ERRSTR2, IPACK, 1)
         CALL STR_ADDS (ERRSTR2, ', plate =', 0)
         CALL STR_ADDI (ERRSTR2, IPLATE, 1)
         CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         IERR = 1
         RETURN
      END IF
C
C====== Get control parameter defaults
C
      INT_TEMPL = INT_TEMPL_DF
      INT_FTYP = INT_FTYP_DF
      SCALE_INT = SCAL_INT_DF
C
C====== Interpret command string
C
      DO 10 I = 1, 5
         INP(I) = 0
 10   CONTINUE
      IPKALL = 0
      NKEYS = 5
      SEP(2:2) = CHAR(9)
      IL = 0
100   I = NXTTOK (OPTSTR, SEP, IL, M1, M2)
      IF (I.EQ.-1) GO TO 200
      IF (I.EQ.0) GO TO 100
      NAME = OPTSTR(M1:M2)
      CALL CCPUPC (NAME)
      CALL GETOPT (KEYS, NKEYS, NAME, IKEY, KERR)
      IF (KERR.NE.0) THEN
         IF (KERR.EQ.1)  ERRSTR = 'Ambiguous option'
         IF (KERR.EQ.2)  ERRSTR = 'Invalid option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1) 
         CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
         IERR = 1
         RETURN
      END IF
      IF (INP(IKEY).EQ.1) THEN
         ERRSTR = 'Duplicate option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, NAME, 1)  
         CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
         IERR = 1
         RETURN
      END IF
      IF (IKEY.LE.2) THEN
         IF (IPKALL.NE.0) THEN
            ERRSTR = 'Inconsistent option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, NAME, 1)  
            CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         ELSE
            INP(IKEY) = 1
            IPKALL = IKEY
         END IF
      ELSE
         INP(IKEY) = 1
         I = NXTTOK (OPTSTR, SEP, IL, M1, M2)
         IF (I.LE.0) THEN
            ERRSTR =  'Option'
            CALL STR_ADDS (ERRSTR, NAME, 1)
            CALL STR_ADDS (ERRSTR, 'not followed by a value', 1)
            CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
            IERR = 1
            RETURN
         END IF
         II = LDM_INTFP (OPTSTR(M1:M2), FP, IV, ND)
         IF (IKEY.EQ.3) THEN
            STR = OPTSTR(M1:M2)
            CALL CCPUPC(STR)
            IF (STR.NE.'MTZ'.AND.STR.NE.'GE') GO TO 150
            INT_FTYP = STR
            INT_TYPE = 1
            CALL CCPUPC (INT_FTYP)
            IF (INT_FTYP.EQ.'GE') INT_TYPE = 2
         ELSE IF (IKEY.EQ.4) THEN            
            IF (INDEX(OPTSTR(M1:M2),'#').EQ.0) GO TO 150
            INT_TEMPL = OPTSTR(M1:M2)
         ELSE IF (IKEY.EQ.5) THEN
            IF (II.LE.0.OR.FP.LE.0.0) GO TO 150
            SCALE_INT = FP
         END IF
      END IF
      GO TO 100
C
C====== Invalid value
C
 150  ERRSTR = OPTSTR(M1:M2)
      CALL STR_ADDS (ERRSTR, 'is not a valid value for option', 1)
      CALL STR_ADDS (ERRSTR, NAME, 1)
      CALL AUTO_WRITEINT_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT) 
      IERR = 1
      RETURN
C
C====== Set pack  range 
C
 200  IF (IPKALL.EQ.0) IPKALL = IPKALL_DF 
      IF (IPKALL.EQ.1) THEN
         IPK_MIN = IPACK
         IPK_MAX = IPACK
      ELSE
         IPK_MIN = 1
         CALL LDM_GET_NUMP (IPK_MAX, IFLAG)
         IF (IPK_MAX.LT.1) IPK_MAX = 1
      END IF
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
C
C====== Loop through required packs
C====== ===========================
C
      DO 2000 IPK = IPK_MIN, IPK_MAX
         ICONT = 1
         IF (IPK.EQ.IPK_MAX) ICONT = 0
         ANY_INT = .FALSE.
         DO 250 IPL = 1, NPLATES
            CALL INTFLAG_GET (IPK, IPL, IFLG)
            IF (IFLG.GT.0) ANY_INT = .TRUE.
 250     CONTINUE
         IF (.NOT.ANY_INT) THEN
            IERR = 1
            ERRSTR = 'No integrated intensities for pack'
            CALL STR_ADDI (ERRSTR, IPK, 1)
            ERRSTR2 = ' '
            CALL AUTO_WRITEINT_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                              ERRSTR2, NEXT)
            IF (.NOT.NEXT) RETURN
            GO TO 2000
         END IF
         STR = '==Writing intensities file for pack'
         CALL STR_ADDI (STR, IPK, 1)
         CALL STR_ADDS (STR, '==', 0)
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE (IVH_IOW, STR)
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (STR)
         END IF
         IPACK = IPK
         IF (LG_MODE.EQ.1) THEN
            CALL SET_PAR1_VALS (0, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
         END IF
         CALL INT_FILNAM (INT_TEMPL, MTZ_FILE)
         IF (INT_TYPE.EQ.1) THEN
            CALL MTZ_CHK1 (MTZ_FILE, IRET)
            IF (IRET.EQ.1) THEN
               IERR = 1
               ERRSTR = 'MTZ file exists and cannot be overwritten'
               ERRSTR2 = MTZ_FILE
               CALL AUTO_WRITEINT_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                 ERRSTR2, NEXT)
               IF (.NOT.NEXT) RETURN
               GO TO 2000
            END IF
            IF (IRET.EQ.2.) THEN
               CALL LOG_MSG (IVH_IOW, 
     +         '*Warning* Existing mtz file overwritten', 1)
            END IF        
            CALL MTZ_CHK2 (MTZ_FILE, IRET)
            IF (IRET.EQ.1) THEN
               IERR = 1
               ERRSTR = 'Cannot open MTZ file'
               ERRSTR2 = MTZ_FILE
               CALL AUTO_WRITEINT_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                 ERRSTR2, NEXT)
               IF (.NOT.NEXT) RETURN
               GO TO 2000
            END IF
         ELSE
            CALL INT_FILNAM (INT_TEMPL, FILNAM)
            CALL FILEXT (FILNAM, 'xxx', GE1_FILE, ILEN)
            CALL FILEXT (FILNAM(1:ILEN), 'ge1', GE1_FILE, JLEN)
            CALL FILEXT (FILNAM(1:ILEN), 'ge2', GE2_FILE, JLEN)
            ANY_PRES = .FALSE.
            EXISTS = CCPEXS (GE1_FILE)
            IF (EXISTS) ANY_PRES = .TRUE.
            EXISTS = CCPEXS (GE2_FILE)
            IF (EXISTS) ANY_PRES = .TRUE.
            IF (ANY_PRES) THEN
               CALL LOG_MSG (IVH_IOW, 
     +         '*Warning* Existing .ge1/.ge2 files overwritten', 1)
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GE1, GE1_FILE,'UNKNOWN','DU',19,IFAIL)
            IF (IFAIL.LT.0) THEN
               IERR = 1
               ERRSTR = 'Cannot open the .ge1 file'
               ERRSTR2 = GE1_FILE
               CALL AUTO_WRITEINT_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                 ERRSTR2, NEXT)
               IF (.NOT.NEXT) RETURN
               GO TO 2000
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GE2, GE2_FILE,'UNKNOWN','DU',2,IFAIL)
            IF (IFAIL.LT.0) THEN
               IERR = 1
               ERRSTR = 'Cannot open the .ge2 file'
               ERRSTR2 = GE2_FILE
               CALL AUTO_WRITEINT_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                                 ERRSTR2, NEXT)
               IF (.NOT.NEXT) RETURN
               GO TO 2000
            END IF
         END IF
         CALL WRITE_INTFILE (IPK, INT_TYPE, SCALE_INT,
     +                       MTZ_FILE, GE1_FILE, GE2_FILE, KERR)
         IF (KERR.EQ.1) THEN
            IERR = 1
            ERRSTR = 'Memory allocation error'
            ERRSTR2 = 'Could not write files'
            CALL AUTO_WRITEINT_ERR (IUN_LOG, ICONT, ERRSTR, 
     +                              ERRSTR2, NEXT)
            IF (.NOT.NEXT) RETURN
         END IF
 2000 CONTINUE

      RETURN
C
C====== Format statements
C
1000  FORMAT (/,'==Automatic Intensities File Writing==')
1010  FORMAT(' ')
1020  FORMAT(A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     AUTO_WRITEINT_ERR     **
C*******************************
C
C
      SUBROUTINE AUTO_WRITEINT_ERR (KUN_LOG, ICONT, ERRSTR, ERRSTR2, 
     +                              NEXT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle command line requested write intensities files  errors
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      INTEGER KUN_LOG
      INTEGER ICONT
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
      LOGICAL NEXT
C
C Parameters:
C
C KUN_LOG     i  (R)  Unit number for log file (0 if none)
C ICONT       i  (R)  = 0 treat as error which terminates procedure
C                     = 1 may continue with next pack if desired
C                     =-1 interrupted
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C NEXT        l  (W)  Set by the routine. If .true. then procedure will
C                     be continued with next pack. If .false. 
C                     then procedure will be terminated. Note: the 
C                     routine must set it to .false. ICONT is 0 or -1.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      CHARACTER*120 STR

C     LOGICAL EOF             !End of file flag
C     CHARACTER*120 STR       !Temp. string

C
C-------------------------------------------------------------------------------
C
      NEXT = .FALSE.
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         IF (ICONT.LT.0) THEN
            WRITE (IUN_LOG,6000) ERRSTR(1:LENSTR(ERRSTR))
         ELSE
            WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
            IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                          ERRSTR2(1:LENSTR(ERRSTR2))
         END IF
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         IF (ICONT.LT.0) THEN
            CALL LMESSAGE (IVH_CMD, ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL LMESSAGE (IVH_CMD, STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL LMESSAGE (IVH_CMD, STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN
               CALL IOW_ASKQ (IVH_CMD, 'Continue with next pack', 
     +                        NEXT)
            END IF
            RETURN
         END IF

      ELSE IF (LG_MODE.EQ.2) THEN
         IF (ICONT.LT.0) THEN
            CALL TWRITE (ERRSTR)
            RETURN
         ELSE
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR, 1)
            CALL TWRITE (STR)
            IF (ERRSTR2.NE.' ') THEN
               STR = '**Error**'
               CALL STR_ADDS (STR, ERRSTR2, 1)
               CALL TWRITE (STR)
            END IF
            IF (ICONT.EQ.0) RETURN
            NEXT = .FALSE.
            IF (ICONT.EQ.1) THEN    
               CALL TASKQ ('Continue with next pack', NEXT, EOF)
            END IF
            IF (EOF) NEXT = .FALSE.
            RETURN
         END IF
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     AUTOREFN_SCRN    **
C**************************
C
C
      SUBROUTINE AUTOREFN_SCRN
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up screen for displaying progress of auto-refinement
C
C Author:  John W. Campbell, October 1994
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
C====== Layout parameters
C
      INTEGER IWIDTH_FRAME
      INTEGER IHEIGHT_FRAME
      INTEGER NCOLS_T
      INTEGER NROWS_T
      INTEGER NWID_G
      INTEGER NHGT_G
      INTEGER IX
      INTEGER IY
      INTEGER IX1
      INTEGER IY1
      INTEGER IX2
      INTEGER IY2
      INTEGER IX3
      INTEGER IY3
      INTEGER IX4
      INTEGER IY4
      INTEGER IW
      INTEGER IH
      INTEGER IW1
      INTEGER IH1
      INTEGER IW2
      INTEGER IH2
      INTEGER IW3
      INTEGER IH3
      INTEGER IW4
      INTEGER IH4
      INTEGER IERR
      INTEGER KXROOT
      INTEGER KYROOT
      INTEGER KERR
      REAL TH_XO
      REAL TH_YO
      CHARACTER*8 NAMES(2)

C     INTEGER IWIDTH_FRAME        ! Width of the base frame
C     INTEGER IHEIGHT_FRAME       ! Height of the base frame
C     INTEGER NCOLS_T             ! No. columns needed in text table
C     INTEGER NROWS_T             ! No. rows needed in text table
C     INTEGER NWID_G              ! Width of graphics window
C     INTEGER NHGT_G              ! Height of graphics window
C     INTEGER IX                  ! X position for view-object
C     INTEGER IY                  ! Y position for view-object
C     INTEGER IX1                 ! X position for view-object
C     INTEGER IY1                 ! Y position for view-object
C     INTEGER IX2                 ! X position for view-object
C     INTEGER IY2                 ! Y position for view-object
C     INTEGER IX3                 ! X position for view-object
C     INTEGER IY3                 ! Y position for view-object
C     INTEGER IX4                 ! X position for view-object
C     INTEGER IY4                 ! Y position for view-object
C     INTEGER IW                  ! Width for view-object
C     INTEGER IH                  ! Height for view-object
C     INTEGER IW1                 ! Width for object
C     INTEGER IH1                 ! Height for object
C     INTEGER IW2                 ! Width for object
C     INTEGER IH2                 ! Height for object
C     INTEGER IW3                 ! Width for object
C     INTEGER IH3                 ! Height for object
C     INTEGER IW4                 ! Width for object
C     INTEGER IH4                 ! Height for object
C     INTEGER IERR                ! Error return flag
C     INTEGER KXROOT              ! Root window 'x' position
C     INTEGER KYROOT              ! Root window 'y' position
C     INTEGER KERR                ! Error flag
C     REAL TH_XO                  ! X origin for 'thermometer'
C     REAL TH_YO                  ! Y origin for 'thermometer'
C     CHARACTER*8 NAMES(2)        ! Dummy names for menu item
C
      DATA NAMES/' ',' '/
C
C-------------------------------------------------------------------------------
C
C
C====== Calculate size requirements for the view objects
C
      NCOLS_T = 50
      NROWS_T = 25
      NWID_G = 100
      NHGT_G = 220
C
C====== Get sizes of individual objects
C
      CALL XDLF_TEXT_TABLE_GETSIZE (NCOLS_T, NROWS_T, IFONT, IW1, IH1)
      CALL XDLF_CONTROL_BUTTON_GETSIZE (0, IFONT, 2, 8, IW2, IH2)
      CALL XDLF_GRAPH_WIN_GETSIZE (NWID_G, NHGT_G, IW3, IH3)
      CALL XDLF_MENU_AREA_GETSIZE (1, 10, 2, 0, 0, IW4, IH4)
C
C====== Get layout parameters
C
      CALL XDLF_LAYOUT_INIT (IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('tab'), 3, IW1, IH1,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('but'), 3, IW2, IH2,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('gra'), 3, IW3, IH3,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('men'), 3, IW4, IH4,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (1, 1, XDLSTR('butgra'), 6,
     +                           XDLSTR('but'), 3, XDLSTR('gra'), 3,
     +                           0, 0, ISEP, 10, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (1, 1, XDLSTR('butgramen'), 9,
     +                           XDLSTR('butgra'), 6, XDLSTR('men'), 3,
     +                           0, 0, ISEP, 80, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (0, 1, XDLSTR('all'), 3,
     +                           XDLSTR('tab'), 3, 
     +                           XDLSTR('butgramen'), 9,
     +                           0, 0, ISEP, 75, IERR)
      CALL XDLF_LAYOUT (XDLSTR('all'), 3, IBORDER, IBORDER, 
     +                  IW, IH, IERR)
C
C====== Get positions
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('tab'), 3, IX1, IY1, 
     +                               IW1, IH1, IERR)
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('but'), 3, IX2, IY2, 
     +                               IW2, IH2, IERR)
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('gra'), 3, IX3, IY3, 
     +                               IW3, IH3, IERR)
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('men'), 3, IX4, IY4, 
     +                               IW4, IH4, IERR)
C
C====== Create base frame  
C
      IWIDTH_FRAME = IW + 2*IBORDER
      IHEIGHT_FRAME = IH + 2*IBORDER
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,0,0,KXROOT,KYROOT,KERR)
      KYROOT = KYROOT - 30
      IF (KYROOT.LT.0) KYROOT = 0
      CALL XDLF_BASE_FRAME (IVH_AUTR_BASE, IWIDTH_FRAME, IHEIGHT_FRAME,
     +     XDLSTR('Auto-refine'), 11, XDLSTR('autoref'), 7, 
     +     KXROOT, KYROOT)

C
C====== Create text table
C
      CALL XDLF_TEXT_TABLE (IVH_AUTR_TAB, IVH_AUTR_BASE, IX1, IY1,
     +                      0, 0, 0, IW1, IH1, IFONT, IERR)
      IF (IERR.NE.0) THEN
         WRITE (6,2001)
         STOP
      END IF
C
C====== Create 'cancel' button
C
      CALL XDLF_CONTROL_BUTTON (IVH_CNCL_BUT, IVH_AUTR_BASE, IX2, IY2,
     +                          0, 1, 1, IFONT, 2,
     +                          XDLSTR('CANCEL'), 6, 8, 
     +                          XDLSTR(' '), 1, 1, 1, IW2, IH2, IERR)
      IF (IERR.NE.0) THEN
         WRITE (6,2002)
         STOP
      END IF
C
C====== Create graph window
C
      CALL XDLF_GRAPH_WIN (IVH_AUTR_GRA, IVH_AUTR_BASE, IX3, IY3,
     +                      0, 0, NWID_G, NHGT_G, IW3, IH3, 0, 0, IERR)
      IF (IERR.NE.0) THEN
         WRITE (6,2003)
         STOP
      END IF
C
C====== Create menu area
C
      CALL XDLF_MENU_AREA (IVH_AUTR_MEN, IVH_AUTR_BASE, IX4, IY4,
     +                      0, 1, 8, IFONT, 0, 0, IW4, IH4, IERR)
      IF (IERR.NE.0) THEN
         WRITE (6,2004)
         STOP
      END IF
C
C====== Draw 'thermomter' on graph window
C
      CALL XDLF_GRAPH_WIN_MAP (IVH_AUTR_GRA, 0.0, FLOAT(NWID_G),
     +                         0.0, FLOAT(NHGT_G), 0.0, 1.0, 0.0, 1.0,
     +                         0, IERR)
      TH_XO = 50.0
      TH_YO = 50.0
      CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, -1, 2, -1, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-3.5, TH_YO-10.0,
     +                                         TH_XO-3.5, TH_YO+155.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO+4.0, TH_YO-10.0,
     +                                         TH_XO+4.0, TH_YO+155.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_ARC (IVH_AUTR_GRA, TH_XO, TH_YO+155.0, 
     +                         3.5, 3.5, 0.0, 180.0, 0, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO+25.0,
     +                                         TH_XO+20.0, TH_YO+25.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 0, 1, 2, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO,
     +                                         TH_XO+20.0, TH_YO,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO-5.0,
     +                           XDLSTR('0.00'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO+50.0,
     +                                         TH_XO+20.0, TH_YO+50.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO+20.0,
     +                           XDLSTR('0.05'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO+45.0,
     +                           XDLSTR('0.10'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO+75.0,
     +                                         TH_XO+20.0, TH_YO+75.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO+70.0,
     +                           XDLSTR('0.15'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO+100.0,
     +                                         TH_XO+20.0, TH_YO+100.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO+95.0,
     +                           XDLSTR('0.20'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO+125.0,
     +                                         TH_XO+20.0, TH_YO+125.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO+120.0,
     +                           XDLSTR('0.25'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_LINE  (IVH_AUTR_GRA, TH_XO-20.0, TH_YO+150.0,
     +                                         TH_XO+20.0, TH_YO+150.0,
     +                                         IERR)
      CALL XDLF_GRAPH_WIN_XTEXT (IVH_AUTR_GRA, TH_XO+25.0, TH_YO+145.0,
     +                           XDLSTR('0.30'), 4, 0, IERR)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 2, 1, -1, IERR)
      CALL XDLF_GRAPH_WIN_ARC (IVH_AUTR_GRA, TH_XO, TH_YO-25.0, 
     +                         14.0, 14.0, 0.0, 360.0, 1, IERR)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 0, 2, -1, IERR)
      CALL XDLF_GRAPH_WIN_ARC (IVH_AUTR_GRA, TH_XO, TH_YO-25.0, 
     +                         15.0, 15.0, 95.0, 350.0, 0, IERR)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 2, 1, -1, IERR)
      CALL XDLF_GRAPH_WIN_RECTANGLE (IVH_AUTR_GRA, TH_XO-2.5,
     +                               TH_YO-15.0, TH_XO+2.5, TH_YO,
     +                               1, IERR)
      CALL XDLF_GRAPH_WIN_SETID (IVH_AUTR_GRA, 2, IERR)
C
C====== Return
C
      CALL XDLF_FLUSH_EVENTS (0)

      RETURN
C
C====== Format statements
C
 2001 FORMAT (/,'**Error code', I2, ' from xdlf_text_table**')        
 2002 FORMAT (/,'**Error code', I2, ' from xdlf_control_button**')        
 2003 FORMAT (/,'**Error code', I2, ' from xdlf_graph_win**')
 2004 FORMAT (/,'**Error code', I2, ' from xdlf_menu_area**')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     BG_CALC          **
C**************************
C
C
      SUBROUTINE BG_CALC
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control background image calculations
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'image.finc'
      INCLUDE 'file_units.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
      INTEGER NPBOX
      INTEGER IPCNT
      INTEGER IOPT
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER M_2D
      INTEGER M_RADX
      INTEGER M_RADY
      INTEGER IORD
      INTEGER ISWAP
      INTEGER IFLAG
      CHARACTER*2 VALSTR
      CHARACTER*25 NAMES(3)
      CHARACTER*25 QUITNAM
C
C     INTEGER IERR            !Error return flag
C     INTEGER NPBOX           !Box size for background searches
C     INTEGER NVIEW           !No. of view-object for getting events
C     INTEGER IVHLIST(2)      !List of view-object handles for getting events
C     INTEGER IVH             !Returned view-object handle from getting events
C     INTEGER ITEM            !Menu item number
C     INTEGER IQUIT           !Quit box selected flag
C     INTEGER IPCNT           !Percent threshold for background points
C     INTEGER IOPT            !Strip direction 1=x, 2=y
C     INTEGER M_2D            !Menu item no. for: '2-D Search'
C     INTEGER M_RADX          !Menu item no. for: 'Radial x strip'
C     INTEGER M_RADY          !Menu item no. for: 'radial y strip'
C     INTEGER IORD            !Axis order flag 1-8
C     INTEGER ISWAP           !Byte swap flag
C     INTEGER IFLAG           !Parameter status flag
C     CHARACTER*2 VALSTR      !Parameter value string (dummy)
C     CHARACTER*25 NAMES(3)   !Menu item names
C     CHARACTER*25 QUITNAM    !Quit box label

      DATA NAMES /'2-D Search',
     *            'Radial X Strip',
     *            'Radial Y Strip'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Get axis order flag
C
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
C
C====== Find type of background calculation required
C
      M_2D = 1
      M_RADX = 2
      M_RADY = 3
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 3, XDLSTR(NAMES), 24,
     *                             XDLSTR('Background Menu'), 15,
     *                             XDLSTR(QUITNAM), 24, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) RETURN
C
C====== 2-D Background Search
C
         IF (ITEM.EQ.M_2D) THEN
            NPBOX = 11
            CALL IOW_ASKI (IVH_IOW, 
     *           'Box size (compressed pixels - odd)', NPBOX)
            IPCNT = 50
            CALL IOW_ASKI (IVH_IOW, 'Percentage of background pixels', 
     *           IPCNT)
            CALL LMESSAGE (IVH_IOW, 
     +                     '==Starting background calculation==')    
            CALL XDLF_BG_CALC (IMG, ITYPE, NSRASTS, NFRASTS, NFRASTS,
     +                         NCMP, NPBOX, IPCNT, IMG_BG, NF_BGOFF,
     +                         IERR)
            IF (IERR.EQ.2) THEN
               CALL LMESSAGE (IVH_IOW, 
     +              '**Search box too big for image**')
               GO TO 100
            END IF
            CALL XDLF_IMAGE_BACKGROUND (IVH_FILM, IMG_BG, NCMP,
     +                                  NF_BGOFF, IERR)
            CALL LMESSAGE (IVH_IOW, 
     +                     '==Background calculation complete==')
C
C====== Radial Strip
C
         ELSE IF (ITEM.EQ.M_RADX.OR.ITEM.EQ.M_RADY) THEN
            NPBOX = 21
            CALL IOW_ASKI (IVH_IOW, 
     *           'Strip width (compressed pixels - odd)', NPBOX)
            IPCNT = 50
            CALL IOW_ASKI (IVH_IOW, 'Percentage of background pixels', 
     *           IPCNT)
            IF (IORD.LT.5) THEN
               IOPT = 2
               IF (ITEM.EQ.M_RADY) IOPT = 1
            ELSE
               IOPT = 1
               IF (ITEM.EQ.M_RADY) IOPT = 2
            END IF
            CALL LMESSAGE (IVH_IOW, 
     +                     '==Starting background calculation==')
            CALL XDLF_BG_STRIP(IMG,ITYPE,NSRASTS,NFRASTS,NFRASTS,NCMP,
     +                         NPBOX,50,IOPT,IBGAVE,NBG,IERR)
            IF (IERR.EQ.1) THEN
               CALL LMESSAGE (IVH_IOW, '**Insufficient memory**')
               GO TO 100
            END IF
            IF (IERR.EQ.2) THEN
               CALL LMESSAGE (IVH_IOW, 
     *                       '**Search box too big for image**')
               GO TO 100
            END IF
            CALL XDLF_BG_RADIMG(ITYPE,NSRASTS/NCMP,NFRASTS/NCMP,
     +                          NF_BGOFF,IBGAVE,NBG,IMG_BG,IERR)
            CALL XDLF_IMAGE_BACKGROUND (IVH_FILM, IMG_BG, NCMP,
     +                                  NF_BGOFF, IERR)
            CALL LMESSAGE (IVH_IOW, 
     +                    '==Background calculation complete==')
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*********************
C**     BG_CNCL     **
C*********************
C
C
      SUBROUTINE BG_CNCL(ICANCL) 
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Detect cancelling of command window processing command during
C          2-D background calculation
C
C Author:  John W. Campbell, November 1994
C
C
C Arguments:
C
      INTEGER ICANCL
C
C ICANCL   (W)  Return 0 to continue, 1 to cancel
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IVHLIST(2)
      INTEGER IVH

C     INTEGER IVHLIST(2)      !List of view-object handles for getting events
C     INTEGER IVH             !Returned view-object handle from getting events
C
C-------------------------------------------------------------------------------
C
      ICANCL = 0
      IF (LG_MODE.NE.1) RETURN
      IVHLIST(1) = IVH_CNCL_BUT
      CALL XDLF_GET_EVENTS (-1, IVHLIST, IVH)
      IF (IVH.EQ.IVH_CNCL_BUT) ICANCL = 1
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     BG_DUMMY_CNCL    **
C**************************
C
C
      SUBROUTINE BG_DUMMY_CNCL (ICANCL)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Dummy cancel routine for 2-D background calculation
C
C Author:  John W. Campbell, October 1995
C
C Arguments:
C
      INTEGER ICANCL

C  ICANCL   (W)   Return 0 to continue, 1 to cancel
C
C====== Parameter statements
C 
 
C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C

C
C-------------------------------------------------------------------------------
C
      ICANCL = 0
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C************************
C**     BG_PROGRESS    **
C************************
C
C
      SUBROUTINE BG_PROGRESS (IFLAG, NSTRIP, ISTRIP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Monitor progess of 2-D background calculation routine
C
C Author:  John W. Campbell, October 1995
C
C Arguments:
C
      INTEGER IFLAG
      INTEGER NSTRIP
      INTEGER ISTRIP
C  
C  IFLAG    (R)   = 0 start, =1 in progress, =2 done
C  NSTRIP   (R)   Total no. of strips of image to process
C  ISTRIP   (R)   Current strip (1 to NSTRIP)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'bg_progress.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
C
C    INTEGER IERR          !Error flag
C
C-------------------------------------------------------------------------------
C
      IF (IFLAG.EQ.0) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL XDLF_PROGRESS_BAR (IVH_BAR, IBG_PROGX, IBG_PROGY,
     +           XDLSTR('Calculating 2-D background:'), 27, 150, NSTRIP,       
     +           2, 6)
            PROG_BG_ON = .TRUE.
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE ('==Calculating 2-D background==')
         END IF
      ELSE IF (IFLAG.EQ.1) THEN
         IF (LG_MODE.NE.1) RETURN
         IF (MOD(ISTRIP,5).NE.0) RETURN
         CALL XDLF_PROGRESS_BAR_VALUE (IVH_BAR, ISTRIP, IERR)
      ELSE IF (IFLAG.EQ.2) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, IERR)
            PROG_BG_ON = .FALSE.
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE ('==Background calculation complete==')
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CALC_CONIC       **
C**************************
C
C
      SUBROUTINE CALC_CONIC (NCSPOTS, X, Y, COEFF, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Calculate conic from spot positions
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
      INTEGER  NCSPOTS
      DOUBLE PRECISION  X(NCSPOTS)
      DOUBLE PRECISION  Y(NCSPOTS)
      DOUBLE PRECISION  COEFF(5)
      INTEGER  IERR
C
C NCSPOTS   (R)  No. of measured spot positions on conic
C X()       (R)  Spot x positions
C Y()       (R)  Spot y positions
C COEFF()   (W)  Conic coefficients
C IERR      (W)  Error flag =0 OK, =1 Singular matrix
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'conics.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER I
      INTEGER J
      INTEGER K
      INTEGER NC
      DOUBLE PRECISION A(MAX_CONIC_SPOTS,5)
      DOUBLE PRECISION AT(5,MAX_CONIC_SPOTS)
      DOUBLE PRECISION AN(5,5)
      DOUBLE PRECISION AI(5,5)
      DOUBLE PRECISION RHS(5)
      DOUBLE PRECISION DET

C     INTEGER I        !Loop variable
C     INTEGER J        !Loop variable
C     INTEGER K        !Loop variable
C     INTEGER NC       !No. of conic spots
C     DOUBLE PRECISION A(MAX_CONIC_SPOTS,5)    !Left hand side 'A' matrix
C     DOUBLE PRECISION AT(5,MAX_CONIC_SPOTS)   !Transpose of matrix 'A'
C     DOUBLE PRECISION AN(5,5)                 !Normal matrix
C     DOUBLE PRECISION AI(5,5)                 !Inverse of normal matrix
C     DOUBLE PRECISION RHS(5)                  !Right hand side elements
C     DOUBLE PRECISION DET                     !Determinant of normal matrix
C
C-------------------------------------------------------------------------------
C
C
C====== Set up matrix 'A'
C
      NC = NCSPOTS
      IF (NC.GT.MAX_CONIC_SPOTS) NC = MAX_CONIC_SPOTS
      DO 10 I = 1, NC
         A(I,1) = (X(I)*X(I))/(CONIC_SCAL*CONIC_SCAL)
         A(I,2) = (X(I)*Y(I))/(CONIC_SCAL*CONIC_SCAL)
         A(I,3) = (Y(I)*Y(I))/(CONIC_SCAL*CONIC_SCAL)
         A(I,4) = X(I)/CONIC_SCAL
         A(I,5) = Y(I)/CONIC_SCAL
10    CONTINUE
C
C====== Get transpose of 'A' in 'AT'
C
      DO 40 I = 1, 5
         DO 30 J = 1, NC
            AT(I,J) = A(J,I)
30       CONTINUE
40    CONTINUE
C
C====== Set Normal Matrix 'AN'
C
      DO 60 I = 1, 5
         DO 55 J = 1, 5
            AN(I,J) = 0.0
            DO 50 K = 1, NC
               AN(I,J) = AN(I,J) + AT(I,K)*A(K,J)
50          CONTINUE
55       CONTINUE
60    CONTINUE
C
C====== Get Right Hand Side elements 'AT.g' (g=unit vector)
C
      DO 80 I = 1,5
         RHS(I) = 0.0
         DO 70 K = 1, NC
            RHS(I) = RHS(I) + AT(I,K)
70       CONTINUE
80    CONTINUE
C
C====== Inverts Normal Matrix
C
      CALL INVMAT(AN, AI, 5, 5, 0, DET, IERR)
      IF (IERR.EQ.1) RETURN
C
C====== Calculate the coefficients
C
      DO 100 I = 1, 5
         COEFF(I) = 0.0
         DO 90 K = 1, 5
            COEFF(I) = COEFF(I) + AI(I,K)*RHS(K)
90       CONTINUE
100   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CALC_LAUE        **
C**************************
C
C
      SUBROUTINE CALC_LAUE (DISTOR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Calculate Laue Pattern (Generate reflections, find overlaps and
C          find nodals as needed)
C
C Author:  John W. Campbell, July 1991
C
C Arguments:
C
      LOGICAL DISTOR
C
C DISTOR   (R)   Distortion correct coordinates .TRUE .yes, .FALSE. no
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'      
C
C====== GLOBALS:
C
      INCLUDE 'film_pack.finc'
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER IERR
      INTEGER NUMSPOTS
      INTEGER NUMREFL
      INTEGER NUMSING
      INTEGER NUMMULT
      INTEGER NUMSPAT
      INTEGER NUMCLOS
      CHARACTER*80 ERRSTR
      CHARACTER*80 STR

C     INTEGER IERR              !Error flag
C     INTEGER NUMSPOTS          !No. of spots generated
C     INTEGER NUMREFL           !No. of reflections generated
C     INTEGER NUMSING           !No. of singles
C     INTEGER NUMMULT           !No. of multiples
C     INTEGER NUMSPAT           !No. of spatially overlapped spots
C     INTEGER NUMCLOS           !No. too close to measure
C     CHARACTER*80 ERRSTR       !Error message string
C     CHARACTER*80 STR          !Output messages string

C
C-------------------------------------------------------------------------------
C
C
C====== Generate reflections and find overlaps 
C
      CALL LMESSAGE (IVH_IOW,
     +               '==Generating reflections and finding overlaps==')
      CALL LRL_GEN (IPACK, IPLATE, DISTOR, 2, IERR, ERRSTR)
      CALL LRL_COUNTS (NUMSPOTS, NUMREFL, NUMSING, NUMMULT, NUMSPAT,
     +                 NUMCLOS)
      STR = 'Number of spots ='
      CALL STR_ADDI (STR, NUMSPOTS, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      STR = 'Number of reflections ='
      CALL STR_ADDI (STR, NUMREFL, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      STR = 'Number of singles ='
      CALL STR_ADDI (STR, NUMSING, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      STR = 'Number of multiples ='
      CALL STR_ADDI (STR, NUMMULT, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      STR = 'Number spatially overlapped ='
      CALL STR_ADDI (STR, NUMSPAT, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      STR = 'Number too close to integrate ='
      CALL STR_ADDI (STR, NUMCLOS, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CELL_CHK         **
C**************************
C
C
      SUBROUTINE CELL_CHK(IOPT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle saving of cell parameters during command input
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
      INTEGER IOPT
C 
C IOPT   (R)   Flag = 0, clear cell updated flags
C                   = 1, save any input values then reset cell to be
C                        consistent with crystal system
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C
      INCLUDE 'cell_input.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      LOGICAL CLL
      INTEGER I
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      CHARACTER*2 ERRSTR

C     LOGICAL CLL         !Cell changed flag
C     INTEGER I           !Temp/loop variable
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER ND          !No. of decimal places flag
C     INTEGER IERR        !Error flag
C     CHARACTER*2 ERRSTR  !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
      IF (IOPT.EQ.0) THEN
         DO 10 I = 1, 6
            CELL_CH(I) = .FALSE.
10       CONTINUE
         SYST_CH = .FALSE.
      ELSE
         IF (SYST_CH) THEN
            CALL LDM_SET_A (CELL_INPUT(1), IERR, ERRSTR)
            CALL LDM_SET_B (CELL_INPUT(2), IERR, ERRSTR)
            CALL LDM_SET_C (CELL_INPUT(3), IERR, ERRSTR)
            CALL LDM_SET_ALPHA (CELL_INPUT(4), IERR, ERRSTR)
            CALL LDM_SET_BETA (CELL_INPUT(5), IERR, ERRSTR)
            CALL LDM_SET_GAMMA (CELL_INPUT(6), IERR, ERRSTR)
         END IF
         CLL = .FALSE.
         IF (CELL_CH(1)) THEN
            CALL LDM_GET_A (CELL_INPUT(1), IFLAG, ND)
            CLL = .TRUE.
         ELSE IF (CELL_CH(2)) THEN
            CALL LDM_GET_B (CELL_INPUT(2), IFLAG, ND)
            CLL = .TRUE.
         ELSE IF (CELL_CH(3)) THEN
            CALL LDM_GET_C (CELL_INPUT(3), IFLAG, ND)
            CLL = .TRUE.
         ELSE IF (CELL_CH(4)) THEN
            CALL LDM_GET_ALPHA (CELL_INPUT(4), IFLAG, ND)
            CLL = .TRUE.
         ELSE IF (CELL_CH(5)) THEN
            CALL LDM_GET_BETA (CELL_INPUT(5), IFLAG, ND)
            CLL = .TRUE.
         ELSE IF (CELL_CH(6)) THEN
            CALL LDM_GET_GAMMA (CELL_INPUT(6), IFLAG, ND)
            CLL = .TRUE.
         END IF
         IF (SYST_CH.OR.CLL) CALL RESET_CELL
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     CHECK_INTEGRATED   **
C****************************
C
C
      SUBROUTINE CHECK_INTEGRATED (ICNTXT, ICMD, IRET)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check whether data integrated and whether written to file
C          and give appropriate warnings etc. Allow option to continue  
C          or not (unless in batch mode)
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      INTEGER ICNTXT
      INTEGER ICMD
      INTEGER IRET

C ICNTXT   (R)  Context of call flag =1 end process request
C                                    =2 quit program request
C                                    =3 reset program defaults request
C                                    =4 read parameters file request
C                                    =5 enter process
C ICMD     (R)  Input is from command window flag =1 yes, =0 no
C IRET     (W)  Return flag =0 no integrated data present
C                           =1 integrated data present but continue anyway
C                           =2 integrated data present or not all written
C                              - do not coninue with current option
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL ANY_UNW
      LOGICAL ANY_INT
      LOGICAL OK_CONT
      LOGICAL EOF
      INTEGER NUMP
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER IPK
      INTEGER IPL
      INTEGER IFLG
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IBUTTON
      CHARACTER*80 STR

C     LOGICAL ANY_UNW       !Any unwritten intensities flag
C     LOGICAL ANY_INT       !Any integrated intensities present flag
C     LOGICAL OK_CONT       !OK to continue with requested option
C     LOGICAL EOF           !End of file on terminal input
C     INTEGER NUMP          !No. of packs
C     INTEGER NPLATES       !No. of plates/pack
C     INTEGER IFLAG         !Parameter status flag
C     INTEGER IPK           !Loop counter for packs
C     INTEGER IPL           !Loop counter for plates
C     INTEGER IFLG          !Intensities status flag
C     INTEGER IXROOT        !Root window 'x' position for popup notice
C     INTEGER IYROOT        !Root window 'y' position for popup notice
C     INTEGER IBUTTON       !Button from popup notice
C     CHARACTER*80 STR      !Message string
C
C-------------------------------------------------------------------------------
C
      IRET = 0
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) RETURN
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      ANY_UNW = .FALSE.
      ANY_INT = .FALSE.
      DO 20 IPK = 1, NUMP
         DO 10 IPL = 1, NPLATES
            CALL INTFLAG_GET (IPK, IPL, IFLG)
            IF (IFLG.GT.0) ANY_INT = .TRUE.
            IF (IFLG.EQ.1) ANY_UNW = .TRUE.
 10      CONTINUE
 20   CONTINUE
      IF (.NOT.ANY_INT) RETURN
      IRET = 1
      IF (ANY_UNW.AND.ICNTXT.LT.5) THEN
         IF (ICNTXT.EQ.1) THEN
            STR = 'Exit from process mode anyway'
         ELSE IF (ICNTXT.EQ.2) THEN
            STR = 'Quit program anyway'
         ELSE IF (ICNTXT.EQ.3) THEN
            STR = 'Reset program defaults anyway'
         ELSE IF (ICNTXT.EQ.4) THEN
            STR = 'Read new parameters file anyway'
         END IF
         IF (LG_MODE.EQ.1) THEN
            IF (ICMD.EQ.1) THEN
               CALL NOTICE_POSN(3, IXROOT, IYROOT)
            ELSE
            CALL NOTICE_POSN(0, IXROOT, IYROOT)
            END IF
            CALL STR_ADDS (STR,'?',0)
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +      XDLSTR('*Not all integrated intensities written to file*'), 
     +             48,
     +             XDLSTR(STR), LENSTR(STR),
     +             XDLSTR('Yes'), 3,
     +             XDLSTR('No'), 2,
     +             IFONT, 1, IBUTTON)
            IF (IBUTTON.EQ.1) THEN
               IRET = 1
            ELSE IF (IBUTTON.EQ.2) THEN
               IRET = 2
            END IF
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (
     +             '*Warning* Not all intensities written to file')
            OK_CONT = .FALSE.
            CALL TASKQ(STR,OK_CONT,EOF)
            IF (OK_CONT.OR.EOF) THEN
               IRET = 1
            ELSE
               IRET = 2
            END IF
         END IF
      END IF
      IF (IRET.EQ.2) RETURN
      IF (ICNTXT.EQ.1) THEN
         IF (ANY_UNW.AND.IUN_LOG.GT.0) WRITE (IUN_LOG,6000)
         RETURN
      ELSE IF (ICNTXT.EQ.2) THEN
         IF (ANY_UNW.AND.IUN_LOG.GT.0) WRITE (IUN_LOG,6010)
         RETURN
      ELSE IF (ICNTXT.EQ.3.OR.ICNTXT.EQ.4) THEN
         IF (LG_MODE.EQ.1) THEN
            IF (ICMD.EQ.1) THEN
               CALL NOTICE_POSN(3, IXROOT, IYROOT)
            ELSE
            CALL NOTICE_POSN(0, IXROOT, IYROOT)
            END IF
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +      XDLSTR('**All current intensities will be cleared**'), 
     +             43,
     +             XDLSTR('Continue with request?'), 22,
     +             XDLSTR('Yes'), 3,
     +             XDLSTR('No'), 2,
     +             IFONT, 1, IBUTTON)
            IF (IBUTTON.EQ.1) THEN
               IRET = 1
            ELSE IF (IBUTTON.EQ.2) THEN
               IRET = 2
            END IF
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (
     +             '**All current intensities will be cleared**')
            OK_CONT = .FALSE.
            CALL TASKQ('Continue with request',OK_CONT,EOF)
            IF (OK_CONT.OR.EOF) THEN
               IRET = 1
            ELSE
               IRET = 2
            END IF
         END IF
         IF (IRET.EQ.2) RETURN
         IF (ANY_UNW.AND.IUN_LOG.GT.0) WRITE (IUN_LOG,6020)
         IF (IUN_LOG.GT.0) WRITE (IUN_LOG,6030)
      ELSE IF (ICNTXT.EQ.5) THEN
         IF (LG_MODE.EQ.1) THEN
            IF (ICMD.EQ.1) THEN
               CALL NOTICE_POSN(3, IXROOT, IYROOT)
            ELSE
            CALL NOTICE_POSN(0, IXROOT, IYROOT)
            END IF
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +      XDLSTR('*Intensities present*'), 21,
     +             XDLSTR('Keep intensities?'), 17,
     +             XDLSTR('Yes'), 3,
     +             XDLSTR('No'), 2,
     +             IFONT, 1, IBUTTON)
            IF (IBUTTON.EQ.2) THEN
               CALL INIT_LIRL
               IF (IUN_LOG.GT.0) WRITE(IUN_LOG, 6030)
            END IF
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (
     +             '*Intensities present*')
            OK_CONT = .TRUE.
            CALL TASKQ('Keep intensities',OK_CONT,EOF)
            IF (.NOT.OK_CONT.AND..NOT.EOF) THEN
               CALL INIT_LIRL
               IF (IUN_LOG.GT.0) WRITE(IUN_LOG, 6030)
            END IF
            RETURN
         END IF         
       END IF
       RETURN
C
C====== Format statements
C
 6000 FORMAT(/,
     + '*Warning* Exiting process mode with unwritten intensities')
 6010 FORMAT(/,
     + '*Warning* Quitting program with unwritten intensities')
 6020 FORMAT(/,
     + '*Warning* Unwritten intensities deleted')
 6030 FORMAT(/,
     + '*Warning* Current intensities cleared')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CHK_OPN          **
C**************************
C
C
      SUBROUTINE CHK_OPN (IQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check that current plate file is open (open if not) and allow
C          for correction of file name if needed (in an interactive mode)
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
      INTEGER IQUIT
C
C  IQUIT (W)   Return flag =0 OK, >0 file cannot be opened
C                                 =1 missing file declared
C                                 =2 file name input abandoned
C                                 =3 cannot handle requested file type
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EXISTS
      LOGICAL TRY_AGAIN
      LOGICAL EOF
      INTEGER IPOSL
      INTEGER IFLAG
      INTEGER IERR
      INTEGER KFLAG
      INTEGER IFTYPE
      INTEGER LISTE(2)
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*26 UC
      CHARACTER*120 STR
      CHARACTER*(MAXFLEN) FILNAM

C     LOGICAL EXISTS              !File exists flag
C     LOGICAL TRY_AGAIN           !Try again for filename input flag
C     LOGICAL EOF                 !End of file input
C     INTEGER IPOSL               !Position of film letter in file name
C     INTEGER IFLAG               !Flag return from GET_FILNAM
C     INTEGER IERR                !Error flag
C     INTEGER KFLAG               !Parameter status flag
C     INTEGER IFTYPE              !Image file type flag
C     INTEGER LISTE(2)            !Parameter value changed flags
C     CHARACTER*2 ERRSTR          !Error string (dummy)
C     CHARACTER*2 VALSTR          !Parameter value string (dummy)
C     CHARACTER*26 UC             !Upper case letters
C     CHARACTER*80 STR            !Message & temp string
C     CHARACTER*(MAXFLEN) FILNAM  !File name string     
C
      DATA UC/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
C
C-------------------------------------------------------------------------------
C
      IQUIT = 0
      IF (IPACK.EQ.IPACK_OPN.AND.IPLATE.EQ.IPLATE_OPN
     +    .AND.FILM_OPEN) RETURN
      CALL LDM_GET_IMDAT (VALSTR, IFTYPE, KFLAG)
      IF (IFTYPE.LT.1.OR.IFTYPE.GT.4) THEN
         CALL LOG_MSG(IVH_IOW,
     +   '**Error** Cannot handle requested image data type',1)
         IF (LG_MODE.EQ.3) STOP
         IQUIT = 3
         RETURN
      END IF
      IF (FILM_OPEN) THEN
         IF (IFTYPE.EQ.1) THEN
            CALL XDLF_CLOSE_FILM_FILE (IFD, IERR)
         ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
            CALL XDLF_CLOSE_I2 (IFD, IERR)
         END IF
         FILM_OPEN = .FALSE.
         FILM_READ = .FALSE.
         IPACK_OPN = 0
         IPLATE_OPN = 0
      END IF
      CALL LDM_FILENAME (IPACK, IPLATE, FILNAM)
      IF (FILNAM.EQ.' ') GO TO 120
      STR = FILNAM
      CALL CCPUPC (STR)
      IF (STR.EQ.'MISSING') THEN
         IQUIT = 1
         RETURN
      END IF
      IF (IFTYPE.EQ.1) THEN
         CALL XDLF_OPEN_FILM_FILE (XDLSTR(FILNAM),LENSTR(FILNAM),
     +             IFD, IERR)
      ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
         CALL XDLF_OPEN_I2(XDLSTR(FILNAM),LENSTR(FILNAM),
     +             IFD, IERR)
      END IF
      IF (IERR.EQ.0) THEN
         FILM_OPEN = .TRUE.
         IPACK_OPN = IPACK
         IPLATE_OPN = IPLATE
         RETURN
      END IF
      STR = '**Error** Cannot open file:'
      CALL STR_ADDS(STR,FILNAM,1)
      CALL LOG_MSG(IVH_IOW,STR,1)
      IF (LG_MODE.EQ.3) STOP
100   TRY_AGAIN = .TRUE.
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKQ(IVH_IOW,'Input a new file name',TRY_AGAIN)
      ELSE IF (LG_MODE.EQ.2) THEN
         CALL TASKQ('Input a new file name',TRY_AGAIN,EOF)
         IF (EOF) THEN
            IQUIT = 2
            RETURN
         END IF
      END IF
      IF (.NOT.TRY_AGAIN) THEN
         IQUIT = 2
         RETURN
      END IF
120   STR = 'File name for plate'
      CALL STR_ADDI(STR,IPLATE,1)
      IF (IPLATE.LE.26) THEN
         CALL STR_ADDS(STR,'(',1)
         CALL STR_ADDS(STR,UC(IPLATE:IPLATE),0)
         CALL STR_ADDS(STR,')',0)
      END IF
      CALL STR_ADDS(STR,': ',0)
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT(IVH_IOW, STR)
      ELSE IF (LG_MODE.EQ.2) THEN
         CALL TPROMP (STR)
      END IF
      CALL GET_FILNAM(IPLATE, FILNAM, IPOSL, IFLAG)
      IF (IFLAG.EQ.-2) THEN
         CALL LDM_SET_FNAME (IPACK, IPLATE, 'missing', IERR, ERRSTR)
         IF (LG_MODE.EQ.1) THEN
            LISTE(1) = IP_FNAM
            CALL SET_PAR2_VALS (1, LISTE)
         END IF
         IQUIT = 1
         RETURN
      END IF
      IF (IFLAG.LT.0) GO TO 100
      EXISTS = CCPEXS (FILNAM)
      IF (.NOT.EXISTS) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE (IVH_IOW, '**Error** File not found')
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE ('**Error** File not found')
         END IF
         GO TO 100
      END IF
      IF (IFTYPE.EQ.1) THEN
         CALL XDLF_OPEN_FILM_FILE (XDLSTR(FILNAM),LENSTR(FILNAM),
     +             IFD, IERR)
         IF (IERR.EQ.1) THEN
            IF (LG_MODE.EQ.1) THEN
               CALL LMESSAGE (IVH_IOW, 
     +              '**Error** Error in opening file')       
            ELSE IF (LG_MODE.EQ.2) THEN
               CALL TWRITE ('**Error** Error in opening file')
            END IF
            GO TO 100
         END IF
      ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
         CALL XDLF_OPEN_I2(XDLSTR(FILNAM),LENSTR(FILNAM),
     +             IFD, IERR)
         IF (IERR.EQ.1) THEN
            IF (LG_MODE.EQ.1) THEN
               CALL LMESSAGE (IVH_IOW, 
     +              '**Error** Error in opening file')
            ELSE IF (LG_MODE.EQ.2) THEN
               CALL TWRITE ('**Error** Error in opening file')
            END IF
            GO TO 100
         END IF
      END IF
      CALL LDM_SET_FNAME (IPACK, IPLATE, FILNAM, IERR, ERRSTR)
      IF (LG_MODE.EQ.1) THEN
         LISTE(1) = IP_FNAM
         CALL SET_PAR2_VALS (1,LISTE)
      END IF
      FILM_OPEN = .TRUE.
      IPACK_OPN = IPACK
      IPLATE_OPN = IPLATE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CHK_REFINE       **
C**************************
C
C
      SUBROUTINE CHK_REFINE (IQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check that current plate is appropriate for refinement
C
C Author:  John W. Campbell, May 1993
C
C Arguments:
C
      INTEGER IQUIT
C 
C IQUIT      (W)   Flag =0 OK, continue with refinement
C                       =1 do not continue with this refinement
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL OTHER_REFINED
      INTEGER I
      INTEGER KEYPLATE
      INTEGER IERR
      INTEGER IFLAG
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IRFL
      INTEGER IBUTTON
      INTEGER NPLATES
      CHARACTER*2 ERRSTR

C     LOGICAL OTHER_REFINED     !Plates other than the key plate refined flag
C     INTEGER I                 !Temp/loop variable
C     INTEGER KEYPLATE          !Key plate
C     INTEGER IERR              !Error flag
C     INTEGER IFLAG             !Parameter status flag
C     INTEGER IXROOT            !Root window x position for warning notice
C     INTEGER IYROOT            !Root window y position for warning notice
C     INTEGER IRFL              !Plate refined 0 = no, >0 = yes
C     INTEGER IBUTTON           !Notice returned button no.
C     INTEGER NPLATES           !No. plates in a pack
C     CHARACTER*2 ERRSTR        !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
      IQUIT = 0
C
C====== Get key plate for current pack
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
C
C====== Check refinement status of other plates
C
      IF (IPLATE.NE.KEYPLATE) THEN
         CALL LDM_GET_RFL(IPACK, KEYPLATE, IRFL, IFLAG, IERR, ERRSTR)
         IF (IRFL.EQ.0) THEN
            CALL NOTICE_POSN(1, IXROOT, IYROOT)
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +           XDLSTR('**Key plate not yet refined**'), 29,
     +           XDLSTR('Continue in spite of this?'), 26,
     +           XDLSTR('Yes'), 3,
     +           XDLSTR('No'), 2,
     +           IFONT, 1, IBUTTON)
            IF (IBUTTON.EQ.2) THEN
               IQUIT = 1
               RETURN
            END IF
         END IF
      ELSE
         OTHER_REFINED = .FALSE.
         CALL LDM_GET_NPLAT (NPLATES, IFLAG)
         IF (NPLATES.LT.2) RETURN
         DO 100 I = 1, NPLATES
            IF (I.EQ.KEYPLATE) GO TO 100
            CALL LDM_GET_RFL(IPACK, I, IRFL, IFLAG, IERR, ERRSTR)
            IF (IRFL.GT.0) OTHER_REFINED = .TRUE.
100      CONTINUE
         IF (OTHER_REFINED) THEN
            CALL NOTICE_POSN(1, IXROOT, IYROOT)
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +           XDLSTR(
     +           '**Other plates will need to be re-refined**'),
     +           43,
     +           XDLSTR('Continue to refine key plate?'), 29,
     +           XDLSTR('Yes'), 3,
     +           XDLSTR('No'), 2,
     +           IFONT, 1, IBUTTON)
            IF (IBUTTON.EQ.2) THEN
               IQUIT = 1
               RETURN
            END IF
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*********************
C**     CMD_CNCL    **
C*********************
C
C
      LOGICAL FUNCTION CMD_CNCL(IDUM) 
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Detect cancelling of command window processing command
C
C Author:  John W. Campbell, November 1994
C
C Return:  Return .false. continue processing
C                 .true.  cancel processing
C
C Arguments:
C
      INTEGER IDUM
C
C IDUM   (R)  Dummy parameter
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IVHLIST(2)
      INTEGER IVH

C     INTEGER IVHLIST(2)      !List of view-object handles for getting events
C     INTEGER IVH             !Returned view-object handle from getting events
C
C-------------------------------------------------------------------------------
C
      CMD_CNCL = .FALSE.
      IF (LG_MODE.NE.1) RETURN
      IVHLIST(1) = IVH_CNCL_BUT
      CALL XDLF_GET_EVENTS (-1, IVHLIST, IVH)
      IF (IVH.EQ.IVH_CNCL_BUT) CMD_CNCL = .TRUE.
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CMD_CNCL_BUT     **
C**************************
C
C
      SUBROUTINE CMD_CNCL_BUT
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Create command window cancel button
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
C
C     INTEGER IERR  !Error flag
C
C-------------------------------------------------------------------------------
C
      CALL XDLF_CONTROL_BUTTON (IVH_CNCL_BUT, IVH_CMD, 
     +                          360, 35,
     +                          0, 1, 1, IFONT, 2,
     +                          XDLSTR('CANCEL'), 6, 8, 
     +                          XDLSTR(' '), 1, 1, 1, 0, 0, IERR)
      CALL XDLF_DELAY(50)
      CALL XDLF_FLUSH_EVENTS(0)
      CALL XDLF_DELAY(50)
      CALL XDLF_FLUSH_EVENTS(0)
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CMD_INPUT        **
C**************************
C
C
      SUBROUTINE CMD_INPUT (STR, QUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Process command window (/command line) input
C
C Author:  John W. Campbell, September 1993
C
C Arguments:
C
      CHARACTER*(*) STR
      LOGICAL QUIT
C
C STR      (R)   String read from command window (/command line)
C QUIT     (W)   Quit program flag =.true. quit, =.false. do not
C
C====== Parameter statements
C 
      INCLUDE 'screen_params.finc'
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'cell_input.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'auto_soft.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      EXTERNAL PAR_CHK
      INTEGER XDLSTR
      INTEGER NXTTOK
      INTEGER INTFP
C
C====== LOCALS:
C
      LOGICAL EOF
      LOGICAL CONT
      LOGICAL EXISTS
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER INDIRECT
      INTEGER IFLAG
      INTEGER KFLAG
      INTEGER LFLAG
      INTEGER IERR
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER IVAL
      INTEGER ND
      INTEGER ITYP
      INTEGER LISTE(2)
      INTEGER I
      INTEGER NSPG
      INTEGER NSYMP
      INTEGER NSYM
      INTEGER IOP
      INTEGER NOPTS
      INTEGER NPACKS
      INTEGER NPLATES
      INTEGER NBINS
      INTEGER IRET
      INTEGER IFAIL
      REAL VALUE
      REAL SDCUT
      REAL THRFAC
      REAL EXPAND
      CHARACTER*1000 LINE
      CHARACTER*150 TMPSTR
      CHARACTER*20 KEYWORD
      CHARACTER*120 VALSTR
      CHARACTER*80 BADTOK
      CHARACTER*80 ERRSTR
      CHARACTER*80 ERRSTR2
      CHARACTER*10 SPGNAM
      CHARACTER*20 CMD
      CHARACTER*20 CMD_OPTS(15)
      CHARACTER*6 INT_FTYP
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) PAR_FILE
      CHARACTER*(MAXFLEN) INT_TEMPL

C     LOGICAL EOF                !End of file on input flag
C     LOGICAL CONT               !Continue flag
C     LOGICAL EXISTS             !File exists flag
C     INTEGER II                 !Return flag from NXTTOK
C     INTEGER IL                 !Character count for NXTTOK
C     INTEGER M1                 !Start character position of token
C     INTEGER M2                 !End character position of token
C     INTEGER INDIRECT           !Indirection pointer for LDM_READSTR
C     INTEGER IFLAG              !Flag from LDM_READSTR routine
C     INTEGER KFLAG              !Flag from LDM_PARSEITEM routine
C     INTEGER LFLAG              !Parameter status flag
C     INTEGER IERR               !Error flag
C     INTEGER KPACK              !Pack number/flag
C     INTEGER KPLATE             !Plate number/flag
C     INTEGER IVAL               !Integer parameter value
C     INTEGER ND                 !No. of decimal places flag
C     INTEGER ITYP               !Parameter type flag
C     INTEGER LISTE(2)           !Parameter table update flags 
C     INTEGER I                  !Temp/loop variable
C     INTEGER NSPG               !Space group number/flag
C     INTEGER NSYMP              !No. of primitive symmetry operators
C     INTEGER NSYM               !No. of symmetry operators
C     INTEGER IOP                !Option number
C     INTEGER NOPTS              !No. of options
C     INTEGER NPACKS             !No. of packs
C     INTEGER NPLATES            !No. of plates
C     INTEGER NBINS              !No. of angular bins for spot size analysis
C     INTEGER IRET               !Return code form CHECK_INTEGRATED
C     INTEGER IFAIL              !File open error flag
C     REAL VALUE                 !Real parameter value
C     REAL SDCUT                 !Standard deviation cutoff
C     REAL THRFAC                !Threshold factor (*background) for spots
C     REAL EXPAND                !Expansion factor: ave obs. -> proposed
C     CHARACTER*1000 LINE        !Logical line buffer
C     CHARACTER*150 TMPSTR       !Temporary string
C     CHARACTER*20 KEYWORD       !LDM parameter name string
C     CHARACTER*120 VALSTR       !Parameter value string
C     CHARACTER*80 BADTOK        !Bad token string
C     CHARACTER*80 ERRSTR        !Error message string
C     CHARACTER*80 ERRSTR2       !Error message string
C     CHARACTER*10 SPGNAM        !Space group name
C     CHARACTER*20 CMD           !Command
C     CHARACTER*20 CMD_OPTS(15)  !Command options
C     CHARACTER*6 INT_FTYP       !Intensities o/p file type code
C     CHARACTER*(MAXFLEN) FILNAM   !Temp file name
C     CHARACTER*(MAXFLEN) PAR_FILE !Parameter (.ldm) file name
C     CHARACTER*(MAXFLEN) INT_TEMPL !Intensities file name template flag

      DATA CMD_OPTS /'QUIT',
     +               'PROCESS',
     +               'END',
     +               'DEFAULTS',
     +               'PACK',
     +               'PLATE',
     +               'LG_SPOTSIZE',
     +               'LG_REFINE',
     +               'LG_DMIN',
     +               'LG_LMIN',
     +               'LG_INTEGRATE',
     +               'LG_WRITEINT',
     +               'LG_CLEARINT',
     +               'LG_READLDM',
     +               'LG_WRITELDM'/
C
C-------------------------------------------------------------------------------
C
      QUIT = .FALSE.
      IF (STR.EQ.' ') RETURN
      NOPTS = 15
      LINE = STR
      INDIRECT = 0
C
C====== Get next logical line
C
100   CALL LDM_READSTR (LINE, 10, INDIRECT, IFLAG, IERR)
      IF (IERR.GT.0) THEN
         IF (IERR.EQ.2)  THEN
            CALL CMD_MSG (IVH_CMD,
     +                    '**Error** Error opening an indirect file')
         ELSE IF (IERR.EQ.3) THEN
            CALL CMD_MSG (IVH_CMD, 
     +                    '**Error** Too many indirect files')
         ELSE
            TMPSTR = '**Error** LDM_READSTR error ='
            CALL STR_ADDI (TMPSTR, IERR, 1)
            CALL CMD_MSG (IVH_CMD, TMPSTR)
         END IF
         RETURN
      END IF
      IF (IFLAG.EQ.-1) RETURN
      CALL CELL_CHK(0)
      CALL LDM_CHK_PARSE (LINE, PAR_CHK, KFLAG, BADTOK, ERRSTR)
      CALL CELL_CHK(1)
      IF (KFLAG.EQ.0) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL SET_PAR1_VALS (0, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
         END IF
         GO TO 600
      END IF
      IF (KFLAG.LT.0) THEN
         CALL CMD_MSG (IVH_CMD, '**Error** LDM parsing error')
         TMPSTR = 'Bad token:'
         CALL STR_ADDS (TMPSTR, BADTOK,1)
         CALL CMD_MSG (IVH_CMD, TMPSTR)
         TMPSTR = 'Error message:'
         CALL STR_ADDS (TMPSTR, ERRSTR,1)
         CALL CMD_MSG (IVH_CMD, TMPSTR)
         GO TO 600
      END IF
C
C====== Program command
C
      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.LE.0) GO TO 600
      IF (LINE(M1:M1).EQ.'?') THEN
C
C====== LDM parameter value requested
C
         IL = M1
         II = NXTTOK (LINE, ' ,', IL, M1, M2)
         IF (II.LE.0) GO TO 600
         CALL LDM_PARSEITEM (LINE(M1:M2), KEYWORD, KPACK, KPLATE,
     +                       ITYP, IERR)
         IF (IERR.NE.0) THEN
            IF (IERR.EQ.1) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Invalid LDM parameter name')        
            ELSE IF (IERR.EQ.-1) THEN
               CALL CMD_MSG (IVH_CMD, 
     +                  '**Error** Not a pack specific parameter')
            ELSE IF (IERR.EQ.-2) THEN
               CALL CMD_MSG (IVH_CMD,
     +                   '**Error** Not a plate specific parameter')
            ELSE IF (IERR.EQ.-3) THEN
               CALL CMD_MSG (IVH_CMD, 
     +                   '**Error** Invalid pack/plate syntax')
            END IF
            GO TO 600
         END IF
         IF (KEYWORD.EQ.'SYMMETRY')  THEN
            CALL LDM_GET_SPGRP (NSPG, SPGNAM, NSYMP, NSYM)
            IF (NSYM.EQ.0) THEN
               CALL CMD_MSG (IVH_CMD, 'undefined')
            ELSE
               IF (NSPG.GT.0.OR.SPGNAM.NE.' ') THEN
                  TMPSTR = 'space group number:'
                  CALL STR_ADDI (TMPSTR, NSPG, 1)
                  CALL CMD_MSG (IVH_CMD, TMPSTR)
                  TMPSTR = 'space group name:'
                  CALL STR_ADDS (TMPSTR, SPGNAM, 1)
                  CALL CMD_MSG (IVH_CMD, TMPSTR)
               ELSE
                  TMPSTR = 'Number of symmetry operators:'
                  CALL STR_ADDI(TMPSTR, NSYM, 1)
                  CALL CMD_MSG (IVH_CMD, TMPSTR)
                  DO 150 I = 1, NSYM
                     CALL LDM_SYMM_STR (I, TMPSTR)
                     CALL CMD_MSG (IVH_CMD, TMPSTR)
150               CONTINUE
               END IF
            END IF
         ELSE
            IF (KPACK.EQ.0) KPACK = IPACK
            IF (KPLATE.EQ.0) KPLATE = IPLATE
            CALL LDM_GET (KEYWORD, KPACK, KPLATE, VALSTR, VALUE, ND,
     +                   IVAL, LFLAG, ITYP, IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               IF (IERR.EQ.-1) THEN
                  CALL CMD_MSG (IVH_CMD, 
     +                 '**Error** Invalid pack number')
               ELSE IF (IERR.EQ.-2) THEN
                  CALL CMD_MSG (IVH_CMD, 
     +                 '**Error** Invalid pack number')
               END IF
               GO TO 600
            ELSE
               TMPSTR = 'Parameter value:'
               CALL STR_ADDS (TMPSTR, VALSTR, 1)
               CALL CMD_MSG (IVH_CMD, TMPSTR)
            END IF
         END IF
         GO TO 600
      ELSE
C
C====== Look for program command
C
         IF (LINE(M2:M2).EQ.'>') THEN
            M2 = M2 - 1
         END IF
         CMD = LINE(M1:M2)
         CALL CCPUPC (CMD)
         IOP = 0
         DO 200 I = 1, NOPTS
            IF (CMD.EQ.CMD_OPTS(I)) THEN
               IOP = I
               GO TO 210
            END IF
 200     CONTINUE
 210     IF (IOP.EQ.0) THEN
            CALL CMD_MSG (IVH_CMD, 
     +           '**Error** Unknown parameter/command')
            GO TO 600
         END IF
C
C====== Quit
C
         IF (IOP.EQ.1) THEN
            IF (PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Invalid in Process Mode')
               GO TO 600
            ENDIF
            QUIT = .TRUE.
            RETURN
C
C====== Enter Process mode
C
         ELSE IF (IOP.EQ.2) THEN
            PROCESS = .TRUE.
            IF (LINE(M2+1:).NE.' ') GO TO 590
C
C====== Exit from Process mode
C
         ELSE IF (IOP.EQ.3) THEN
            PROCESS = .FALSE.
            IF (LINE(M2+1:).NE.' ') GO TO 590
C
C====== Reset program defaults
C
         ELSE IF (IOP.EQ.4) THEN
            IF (PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Invalid in Process Mode')
               GO TO 600
            ENDIF
            CALL CHECK_INTEGRATED (3, 1, IRET)
            IF (IRET.EQ.2) GO TO 600
            CALL LOG_HEAD ('RESET PROGRAM DEFAULTS (defaults command)'
     +                     ,3)
            CALL LDM_RESET (' ', 0, 0, IERR, ERRSTR)
            CALL LDM_GET_A (CELL_INPUT(1), LFLAG, ND)
            CALL LDM_GET_B (CELL_INPUT(2), LFLAG, ND)
            CALL LDM_GET_C (CELL_INPUT(3), LFLAG, ND)
            CALL LDM_GET_ALPHA (CELL_INPUT(4), LFLAG, ND)
            CALL LDM_GET_BETA (CELL_INPUT(5), LFLAG, ND)
            CALL LDM_GET_GAMMA (CELL_INPUT(6), LFLAG, ND)
            CALL INIT_FLAGS
            CALL INIT_SETTINGS
            CALL INIT_LIRL
            CALL RESET_CELL
            IF (LG_MODE.EQ.1) THEN
               CALL SET_PAR1_VALS (0, LISTE)
               CALL SET_PAR2_VALS (0, LISTE)
            END IF
            IF (LINE(M2+1:).NE.' ') GO TO 590
C
C====== Reset pack number
C
         ELSE IF (IOP.EQ.5) THEN
            II = NXTTOK (LINE, ' ,', IL, M1, M2)
            IF (II.LE.0) THEN
               CALL CMD_MSG (IVH_CMD,
     +             '**Error** Pack number must be given')
               GO TO 600
            END IF
            IF (INTFP (LINE(M1:M2),VALUE,IVAL).NE.1) THEN
               CALL CMD_MSG (IVH_CMD,
     +             '**Error** Invalid syntax for pack number')
               GO TO 600
            END IF
            CALL LDM_GET_NUMP (NPACKS, LFLAG)
            IF (IVAL.LT.1.OR.(IVAL.GT.1.AND.IVAL.GT.NPACKS)) THEN
               CALL CMD_MSG (IVH_CMD,
     +             '**Error** Pack number out of range')
               GO TO 600
            END IF
            IF (IVAL.NE.IPACK) THEN
               IPACK = IVAL
               IF (LG_MODE.EQ.1) THEN
                  CALL SET_PAR1_VALS (0, LISTE)
                  CALL SET_PAR2_VALS (0, LISTE)
               END IF
            END IF
            IF (LINE(M2+1:).NE.' ') GO TO 590
C
C====== Reset plate number
C
         ELSE IF (IOP.EQ.6) THEN
            II = NXTTOK (LINE, ' ,', IL, M1, M2)
            IF (II.LE.0) THEN
               CALL CMD_MSG (IVH_CMD,
     +             '**Error** Plate number must be given')
               GO TO 600
            END IF
            IF (INTFP (LINE(M1:M2),VALUE,IVAL).NE.1) THEN
               CALL CMD_MSG (IVH_CMD,
     +             '**Error** Invalid syntax for plate number')
               GO TO 600
            END IF
            CALL LDM_GET_NPLAT (NPLATES, LFLAG)
            IF (IVAL.LT.1.OR.(IVAL.GT.1.AND.IVAL.GT.NPLATES)) THEN
               CALL CMD_MSG (IVH_CMD,
     +             '**Error** Plate number out of range')
               GO TO 600
            END IF
            IF (IVAL.NE.IPLATE) THEN
               IPLATE = IVAL
               IF (LG_MODE.EQ.1) THEN
                  CALL SET_PAR1_VALS (0, LISTE)
                  CALL SET_PAR2_VALS (0, LISTE)
               END IF
            END IF
            IF (LINE(M2+1:).NE.' ') GO TO 590

C
C====== PROCESS OPTION - Determine spot sizes
C
         ELSE IF (IOP.EQ.7) THEN
            IF (.NOT.PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Only valid in Process Mode')
               GO TO 600
            ENDIF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Determine spot sizes (lg_spotsize command)'
     +                     ,3)
            CALL LG_SPOTSIZE_PROMPT (LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL SPOTSIZE_DFLTS (NBINS, SDCUT, THRFAC, EXPAND)
            CALL SAVE_PKPL
            CALL AUTO_SPOTSIZE_CTL (LINE(M2+1:), 1, NBINS, SDCUT,
     +                              THRFAC, EXPAND, IERR)
            CALL RESTORE_PKPL
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Auto-refinement
C
         ELSE IF (IOP.EQ.8) THEN
            IF (.NOT.PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Only valid in Process Mode')
               GO TO 600
            ENDIF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD (
     +           'Auto-Refine Orientation (lg_refine command)',3)
            CALL LG_REFINE_PROMPT (LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL SAVE_PKPL
            CALL AUTO_REFINE_CTL (3, LINE(M2+1:), 2, 1, 4, 6)
            CALL RESTORE_PKPL
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Improve 'dmin'
C
         ELSE IF (IOP.EQ.9) THEN
            IF (.NOT.PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Only valid in Process Mode')
               GO TO 600
            ENDIF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Improve Soft Limits (lg_dmin command)',3)
            CALL SET_PROMIN
            CALL LG_SOFT_PROMPT (1, LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL SAVE_PKPL
            CALL AUTO_SOFT_CTL (1, LINE(M2+1:), 1, NPROF, 
     +                          PRF_ROT, PROMIN,
     +                          FRAC_AUT, SIGTEST_AUT, FRTEST_AUT,
     +                          NUMBINS_AUT, BINW_AUT, IERR)       
            CALL RESTORE_PKPL
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Improve 'lambda-min'
C
         ELSE IF (IOP.EQ.10) THEN
            IF (.NOT.PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Only valid in Process Mode')
               GO TO 600
            ENDIF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Improve Soft Limits (lg_lmin command)',3)
            CALL SET_PROMIN
            CALL LG_SOFT_PROMPT (2, LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL SAVE_PKPL
            CALL AUTO_SOFT_CTL (2, LINE(M2+1:), 1, NPROF, 
     +                          PRF_ROT, PROMIN,
     +                          FRAC_AUT, SIGTEST_AUT, FRTEST_AUT, 
     +                          NUMBINS_AUT, BINW_AUT, IERR)
            CALL RESTORE_PKPL
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Integrate Spots
C
         ELSE IF (IOP.EQ.11) THEN
            IF (.NOT.PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Only valid in Process Mode')
               GO TO 600
            ENDIF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Integrate Spots (lg_integrate command)',3)
            CALL SET_PROMIN
            CALL LG_INTEGRATE_PROMPT (LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL SAVE_PKPL
            CALL AUTO_INTEGRATE_CTL (2, .FALSE., LINE(M2+1:), 2,
     +                               NPROF, PROMIN, PRF_ROT,
     +                               IPRF_ALL, NOVLD, IERR)
            CALL RESTORE_PKPL
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Write integrated intensities files
C
         ELSE IF (IOP.EQ.12) THEN
            IF (.NOT.PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Only valid in Process Mode')
               GO TO 600
            ENDIF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD (
     +                'Write Intensities Files (lg_writeint command)',3)
            CALL SET_SCALINT
            CALL LG_WRITEINT_PROMPT (LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL SAVE_PKPL
            CALL AUTO_WRITEINT_CTL (LINE(M2+1:), 2, ERRSTR,
     +                             INT_TEMPLATE, SCAL_INT, IERR)
            CALL RESTORE_PKPL
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Clear intensities from LIRL
C
         ELSE IF (IOP.EQ.13) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD (
     +                'Clear Intensities (lg_clearint command)',3)
            CALL LG_CLEARINT_PROMPT (LINE(M2+1:), IERR)
            IF (IERR.NE.0) GO TO 600
            CALL AUTO_CLEARINT_CTL (LINE(M2+1:), 2, IERR)
            CALL LDM_CH_RESET (1)

C
C====== PROCESS OPTION - Read LDM parameters file
C
         ELSE IF (IOP.EQ.14) THEN
            IF (PROCESS) THEN
               CALL CMD_MSG (IVH_CMD, 
     +              '**Error** Not valid in Process Mode')
               GO TO 600
            ENDIF
            CALL CHECK_INTEGRATED (4, 1, IRET)
            IF (IRET.EQ.2) GO TO 600 
            CALL LOG_HEAD (
     +                'Read LDM Parameter File (lg_readldm command)',3)
            II = NXTTOK (LINE, ' ,', IL, M1, M2)
            IF (II.LE.0) THEN
               ERRSTR = 'No file name given'
               ERRSTR2 = ' '
               CALL PARFIL_ERR (ERRSTR, ERRSTR2)
               GO TO 600
            END IF
            IF (LINE(M1:M1).EQ.'>') THEN
               IF (LG_MODE.EQ.3) THEN
                  CALL CMD_MSG (IVH_CMD, 
     +     '**Error** Prompt request invalid in batch/background mode')
                  GO TO 600
               END IF
               IF (LG_MODE.EQ.1) THEN
                  CALL LPROMPT (IVH_CMD, 'File name: ')
                  CALL LREAD (IVH_CMD, FILNAM)
               ELSE
                  CALL TPROMP ('File name: ')
                  CALL TREAD (FILNAM, EOF)
                  IF (EOF) GO TO 600
                  IF (FILNAM.EQ.' ') GO TO 600
               END IF
            ELSE
               FILNAM = LINE(M1:M2)
            END IF
            CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
            EXISTS = CCPEXS (PAR_FILE)
            IF (.NOT.EXISTS) THEN
               ERRSTR = 'File not found'
               ERRSTR2 = PAR_FILE
               CALL PARFIL_ERR (ERRSTR, ERRSTR2)
               GO TO 600
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GEN, PAR_FILE,'READONLY','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               ERRSTR = 'Cannot open the input .ldm file'
               ERRSTR2 = PAR_FILE
               CALL PARFIL_ERR (ERRSTR, ERRSTR2)
               GO TO 600
            END IF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL READ_PAR_FILE (.TRUE., PAR_FILE)
            CALL LDM_CH_RESET (1)
C
C====== PROCESS OPTION - Write LDM parameters file
C
         ELSE IF (IOP.EQ.15) THEN
            CALL LOG_HEAD (
     +           'Write LDM Parameter File (lg_writeldm command)',3)
            II = NXTTOK (LINE, ' ,', IL, M1, M2)
            IF (II.LE.0) THEN
               ERRSTR = 'No file name given'
               ERRSTR2 = ' '
               CALL PARFIL_ERR (ERRSTR, ERRSTR2)
               GO TO 600
            END IF
            IF (LINE(M1:M1).EQ.'>') THEN
               IF (LG_MODE.EQ.3) THEN
                  CALL CMD_MSG (IVH_CMD, 
     +     '**Error** Prompt request invalid in batch/background mode')
                  GO TO 600
               END IF
               IF (LG_MODE.EQ.1) THEN
                  CALL LPROMPT (IVH_CMD, 'File name: ')
                  CALL LREAD (IVH_CMD, FILNAM)
               ELSE
                  CALL TPROMP ('File name: ')
                  CALL TREAD (FILNAM, EOF)
                  IF (EOF) GO TO 600
                  IF (FILNAM.EQ.' ') GO TO 600
               END IF
            ELSE
               FILNAM = LINE(M1:M2)
            END IF
            CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
            EXISTS = CCPEXS (PAR_FILE)
            IF (EXISTS) THEN
               IF (LG_MODE.EQ.1) THEN
                  CALL LMESSAGE(IVH_CMD,'**File already exists**')
                  CONT = .FALSE.
                  CALL IOW_ASKQ (IVH_CMD, 'Overwrite file', CONT)
               ELSE IF (LG_MODE.EQ.2) THEN
                  CALL TWRITE ('**File already exists**')
                  CONT = .FALSE.
                  CALL TASKQ ('Overwrite file', CONT, EOF)
                  IF (EOF) GO TO 600
               ELSE 
                  CONT = .TRUE.
               END IF
               IF (.NOT.CONT) GO TO 600
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GEN, PAR_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               ERRSTR = 'Cannot open the output .ldm file'
               ERRSTR2 = PAR_FILE
               CALL PARFIL_ERR (ERRSTR, ERRSTR2)
               GO TO 600
            END IF
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL WRITE_PARFIL (PAR_FILE)
            CALL LDM_CH_RESET (1)
            CLOSE (UNIT=IUN_GEN)

         END IF

      END IF
      GO TO 600
C
C====== Extraneous info. found on line
C
 590  CALL CMD_MSG (IVH_CMD, '*Warning* Extraneous information ignored')
      CALL CMD_MSG (IVH_CMD, LINE(M2+1:))
C
C====== Get next logical line 
C
600   IF (IFLAG.EQ.0) RETURN
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CMD_MSG          **
C**************************
C
      SUBROUTINE CMD_MSG (IVH_W, CHSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Output a message string in response to command input
C             to the command window, terminal or log file
C
C Author:     John W. Campbell, October 1993
C
C Arguments:
C
      INTEGER IVH_W
      CHARACTER*(*) CHSTR
C
C    IVH_W    (R)   View-object handle for the io-window
C    CHSTR    (R)   The message string
C
C Declarations
C ============
C
C GLOBALS:
C
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C LOCALS:
C
      INTEGER LENS
      INTEGER I
      INTEGER IERR
      INTEGER NCH

C     INTEGER LENS   !Length of the character string
C     INTEGER I      !Loop counter
C     INTEGER IERR   !Error return
C     INTEGER NCH    !No. characters up to last non-blank character
C
C-------------------------------------------------------------------------------
C
C====== Find length of message string up to last non-blank
C
      LENS = LEN (CHSTR)
      NCH = 1
      DO 100 I = LENS, 1, -1
      IF (CHSTR(I:I).NE.' ') THEN
         NCH = I
         GO TO 200
      ENDIF
100   CONTINUE
C
C====== Output the message to io/window, terminal or log file
C
200   IF (LG_MODE.EQ.1) THEN
         CALL XDLF_IO_WINDOW_PRINT (IVH_W, XDLSTR(CHSTR), NCH, 2, IERR)
      ELSE IF (LG_MODE.EQ.2) THEN
         CALL TWRITE (CHSTR)
      ELSE IF (LG_MODE.EQ.3) THEN
         IF (IUN_LOG.GT.0) WRITE (IUN_LOG,1001) CHSTR(1:NCH)
      END IF
      RETURN
C
C====== Format statements
C
1001  FORMAT (' ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CONIC_CENTRE     **
C**************************
C
C
      SUBROUTINE CONIC_CENTRE
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Input conic spots & calculate centre
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'image.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'conics.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'spot_box.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
      INTEGER LENSTR
      EXTERNAL CONIC_FN
C
C====== LOCALS:
C
      LOGICAL CONICS_COMPLETE
      LOGICAL CEN_OK
      INTEGER I
      INTEGER J
      INTEGER M_CALC
      INTEGER M_CENT
      INTEGER M_REDO
      INTEGER NVIEW
      INTEGER IVHLIST(3)
      INTEGER IVH
      INTEGER IQUIT
      INTEGER ITEM
      INTEGER IERR
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER NOVER
      INTEGER ITHRESH
      INTEGER IBG
      INTEGER ISTYP
      INTEGER IOP
      INTEGER ITYP
      INTEGER IV
      INTEGER ITM
      INTEGER IP_STYP
      INTEGER IP_SBOX
      INTEGER IP_THRESH
      INTEGER ICONIC
      INTEGER IFLAG
      INTEGER IYN
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER IORD
      INTEGER ISWAP
      INTEGER ND
      INTEGER LISTE(2)
      REAL CGX
      REAL CGY
      REAL FP
      REAL XTEMP
      REAL YTEMP
      REAL MM_RAST_X
      REAL MM_RAST_Y
      DOUBLE PRECISION CEN(2)
      DOUBLE PRECISION ACC
      DOUBLE PRECISION FMIN
      DOUBLE PRECISION FVECC(MAX_CONICS)
      DOUBLE PRECISION W(12)
      CHARACTER*80 STR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL
      CHARACTER*25 NAMES(3)
      CHARACTER*25 QUITNAM
      CHARACTER*6 SMETHOD(2)
      CHARACTER*6 SMETHOD_UC(2)    
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     LOGICAL CONICS_COMPLETE   !All allowed conics input flag
C     LOGICAL CEN_OK            !Found centre OK flag
C     INTEGER I           !Temp/loop variable
C     INTEGER J           !Temp/loop variable
C     INTEGER M_CALC      !Menu item number for 'Calculate Conic'
C     INTEGER M_CENT      !Menu item number for 'Calculate Centre'
C     INTEGER M_REDO      !Menu item number for 'Redo Current Conic'
C     INTEGER NVIEW       !No. of view-objects for getting events
C     INTEGER IVHLIST(3)  !List of view-objects for getting events
C     INTEGER IVH         !Returned view-object handle from events input
C     INTEGER IQUIT       !Quit box selected flag =1 yes, =0 no
C     INTEGER ITEM        !Item no. selected from the menu
C     INTEGER IERR        !Error return flag
C     INTEGER IXPIX       !x pixel value from film image view-object
C     INTEGER IYPIX       !y pixel value from film image view-object
C     INTEGER IXSIZ       !Spot box half size x
C     INTEGER IYSIZ       !Spot box half size y
C     INTEGER NOVER       !no. of pixels over the threshold value
C     INTEGER ITHRESH     !Threshold value
C     INTEGER IBG         !Background value at spot position
C     INTEGER ISTYP       !Spot method 1=c_of_g, 2=input (cursor)
C     INTEGER IOP         !Option from GETOPT
C     INTEGER ITYP        !Type of number input flag (from INTFP)
C     INTEGER IV          !Integer value returned from INTFP
C     INTEGER ITM         !Parameter table selected item number
C     INTEGER IP_STYP     !Parameter table 3 item: Spot method
C     INTEGER IP_SBOX     !Parameter table 3 item: Spot box size
C     INTEGER IP_THRESH   !Parameter table 3 item: Spot threshold
C     INTEGER ICONIC      !Count of current conic being input
C     INTEGER IFLAG       !Flag from refinement routine / parameter status flag
C     INTEGER IYN         !Return flag fro yes-no notice
C     INTEGER NXRAST      !No. x-rasters
C     INTEGER NYRAST      !No. y-rasters
C     INTEGER ISPIX       !Pixel position along slow axis
C     INTEGER IFPIX       !Pixel position along fast axis
C     INTEGER IORD        !Axis order flag 1-8
C     INTEGER ISWAP       !Byte swap flag
C     INTEGER ND          !No. of decimal places flag
C     INTEGER LISTE(2)    !Parameter updates list
C     INTEGER ND          !No. of decimal places flag
C     INTEGER LISTE(2)    !Parameter updates list
C     REAL MM_RAST_X      !mm to x-rasters conversion factor
C     REAL MM_RAST_Y      !mm to y-rastrs conversion factor
C     REAL CGX            !x centre of gravity
C     REAL CGY            !y centre of gravity
C     REAL FP             !Floating point value returned from INTFP
C     REAL XTEMP          !Temp. refined x centre position
C     REAL YTEMP          !Temp. refined y centre position
C     DOUBLE PRECISION CEN(2)     !Position of estimated/refined centre
C     DOUBLE PRECISION ACC        !Accuracy parameter for Powell refinement
C     DOUBLE PRECISION FMIN       !Refined minimum value sum of squares
C     DOUBLE PRECISION FVECC(MAX_CONICS) !Calculated function values
C     DOUBLE PRECISION W(12)      !Work array for Powell refinement
C     CHARACTER*80 STR    !Temporary string
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !Return string from parameter table 3
C     CHARACTER*25 NAMES(3)      !Names for the menu items
C     CHARACTER*25 QUITNAM       !Quit box label
C     CHARACTER*6 SMETHOD(2)     !Spot method option strings
C     CHARACTER*6 SMETHOD_UC(2)  !Spot method option strings (upper case)
C     CHARACTER*2 VALSTR         !paramter value string (dummy)
C     CHARACTER*2 ERRSTR         !Error string (dummy)

      DATA NAMES /'Calculate Conic',
     +            'Calculate Centre',
     +            'Redo Current Conic'/
      DATA QUITNAM /'Abort Centre Calculation'/
      DATA SMETHOD /'c_of_g','input'/
      DATA SMETHOD_UC /'C_OF_G','INPUT'/

C-------------------------------------------------------------------------------
C
C
C====== Clear symbols from image
C
      CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
C
C====== Initialisations
C
      CONICS_COMPLETE = .FALSE.
      NUM_CONICS = 0
      DO 10 I=1,MAX_CONICS
         NUM_CONIC_SPOTS(I) = 0
10    CONTINUE
      ICONIC = 1
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CONIC_SCAL = MAX(NXRAST,NYRAST)
      CALL LDM_GET_STHR (SPOT_INPUT_THRESH, IFLAG, ND)
C
C====== Set up parameter table 3
C
      IP_STYP = 1
      IP_SBOX = 3
      IP_THRESH = 4

      ISTYP = 1

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_STYP,
     +     XDLSTR('Spot method:'), 12,
     +     XDLSTR(SMETHOD(1)),6, 0, 0, IERR)
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR3, IP_STYP,
     +     2, XDLSTR(SMETHOD), 6, IERR)
      WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_SBOX,
     +     XDLSTR('Spot box (mm):'), 14,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_THRESH,
     +     XDLSTR('Spot threshold:'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
C
C====== Set up menu
C
      M_CALC = 1
      M_CENT = 2
      M_REDO = 3
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 3, XDLSTR(NAMES), 24,
     +                             XDLSTR('Conic Centre Menu'), 17,
     +                             XDLSTR(QUITNAM), 24, 0, IERR)
C
C====== Set up event loop for first menu input
C
50    STR = 'Input Conic'
      CALL STR_ADDI(STR,ICONIC,1)
      CALL STR_ADDS(STR,' Spot Positions',1)
      CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +     XDLSTR(STR), 40, IERR)
      NVIEW = 3
      IF (CONICS_COMPLETE) NVIEW = 2
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR3
      IVHLIST(3) = IVH_FILM
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
C
C====== Menu item selected
C
      IF (IVH.EQ.IVH_MENU) THEN
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C====== Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            RETURN
         END IF
C
C====== Calculate Conic
C
         IF (ITEM.EQ.M_CALC) THEN
            IF (CONICS_COMPLETE) THEN
               CALL ERR_NOTICE(1,'**All Allowed Conics Completed**')
               GO TO 100
            END IF
            IF (NUM_CONIC_SPOTS(ICONIC).LT.5) THEN
               CALL ERR_NOTICE(1,'**Minimum of 5 spots needed**')
               GO TO 100
            END IF
            CALL CALC_CONIC (NUM_CONIC_SPOTS(ICONIC),
     +                      XCONIC(1,ICONIC),YCONIC(1,ICONIC),
     +                      COEFFS(1,ICONIC),IERR)
            IF (IERR.EQ.1) THEN
               CALL YESNO_NOTICE (1,
     +           '**Singular Matrix** Retry with more spots?',IYN)
               IF (IYN.EQ.1) GO TO 100
               CALL XDLF_IMAGE_CLEAR_SYMBOLS(IVH_FILM, IERR)
               NUM_CONIC_SPOTS(ICONIC) = 0
               IF (NUM_CONICS.EQ.0) GO TO 100
               DO 120 I=1,NUM_CONICS
                  DO 110 J=1,NUM_CONIC_SPOTS(I)
                     CALL XDLF_IMAGE_SYMBOL(IVH_FILM,
     +                    NINT(XCONIC(J,I)), NINT(YCONIC(J,I)),
     +                    ISYMBTYP(7),ICOLRTYP(7), 1, IERR)
110                  CONTINUE
120            CONTINUE
               GO TO 100
            END IF
            NUM_CONICS = NUM_CONICS + 1
            IF (NUM_CONICS.EQ.MAX_CONICS) THEN
               CALL ERR_NOTICE (1,'*All Allowed Conics now Input*')
               CONICS_COMPLETE = .TRUE.
               GO TO 100
            ELSE
               ICONIC = ICONIC + 1
            END IF
            GO TO 50
C
C====== Calculate Centre
C
         ELSE IF (ITEM.EQ.M_CENT) THEN
            IF (.NOT.CONICS_COMPLETE
     +          .AND.NUM_CONIC_SPOTS(ICONIC).GT.0) THEN
                  CALL ERR_NOTICE(1,'**Last conic not yet calculated**')
                  GO TO 100
            END IF
            IF (NUM_CONICS.LT.3) THEN
               CALL ERR_NOTICE(1,'**Minimum of three conics needed**')
               GO TO 100
            END IF
            CEN(1) = (NXRAST/2.0)/CONIC_SCAL
            CEN(2) = (NYRAST/2.0)/CONIC_SCAL
            ACC = 1.0D-8
            CALL SSQMIN(NUM_CONICS,2,CEN,ACC,100,CONIC_FN,FMIN,
     +                  FVECC,IFLAG,W)
            IF (IFLAG.EQ.-1) THEN
               CALL ERR_NOTICE(1,'**Failure(s) finding line minima**')
               GO TO 100
            END IF
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
               IF (IFLAG.EQ.-1) THEN
                  CALL LMESSAGE(IVH_IOW,
     +            '*Refinement terminated after 100 iterations*')
               ELSE
                  STR = 'Refinement completed after'
                  CALL STR_ADDI(STR,IFLAG,1)
                  CALL STR_ADDS(STR,'iterations',1)
                  CALL LMESSAGE(IVH_IOW,STR)
               ENDIF
               STR = 'Refined centre: x ='
               XTEMP = CEN(1)*CONIC_SCAL
               YTEMP = CEN(2)*CONIC_SCAL
               CALL STR_ADDF(STR,XTEMP,2,1)
               CALL STR_ADDS(STR,', y =',0)
               CALL STR_ADDF(STR,YTEMP,2,1)
               CALL LMESSAGE(IVH_IOW,STR)
               CEN_OK = .TRUE.
               CALL IOW_ASKQ(IVH_IOW,'Accept value for the centre',
     +                       CEN_OK)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
               IF (CEN_OK) THEN
                  XCEN_SPOTS = XTEMP
                  YCEN_SPOTS = YTEMP
                  IXCEN_SPOTS = NINT(XCEN_SPOTS)
                  IYCEN_SPOTS = NINT(YCEN_SPOTS)
                  CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
                  RETURN
               END IF
            GO TO 50
C
C====== Redo Current Conic
C
         ELSE IF (ITEM.EQ.M_REDO) THEN
            IF (CONICS_COMPLETE) GO TO 100
            IF (NUM_CONIC_SPOTS(ICONIC).EQ.0) GO TO 100
            NUM_CONIC_SPOTS(ICONIC) = 0
            CALL XDLF_IMAGE_CLEAR_SYMBOLS(IVH_FILM, IERR)
            IF (NUM_CONICS.EQ.0) GO TO 100
            DO 220 I=1,NUM_CONICS
               DO 210 J=1,NUM_CONIC_SPOTS(I)
                  CALL XDLF_IMAGE_SYMBOL(IVH_FILM,
     +                 NINT(XCONIC(J,I)), NINT(YCONIC(J,I)),
     +                 ISYMBTYP(7),ICOLRTYP(7), 1, IERR)
210               CONTINUE
220         CONTINUE
            GO TO 100
         END IF
         GO TO 100
C
C====== Spot position input
C
      ELSE IF (IVH.EQ.IVH_FILM) THEN
         CALL XDLF_IMAGE_GETPIX (IVH_FILM, IXPIX, IYPIX, IERR)
         IF (ISTYP.EQ.1) THEN
            IXSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_X)
            IXSIZ = IXSIZ/2
            IF (IXSIZ.LT.1) IXSIZ = 1
            IF (IXSIZ.GT.MAX_HALF_BOX) THEN
               CALL ERR_NOTICE (0,'**Spot box size too large**')
               GO TO 100
            END IF
            IYSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_Y)
            IYSIZ = IYSIZ/2
            IF (IYSIZ.LT.1) IYSIZ = 1
            IF (IYSIZ.GT.MAX_HALF_BOX) THEN
               CALL ERR_NOTICE (0,'**Spot box size too large**')
               GO TO 100
            END IF
            CALL SFPIX (IXPIX,IYPIX,ISPIX,IFPIX)
            CALL XDLF_BG_VALIMG(ISPIX,IFPIX,IMG_BG,ITYPE,NF_BGOFF,
     +                          NCMP,IBG, IERR)
            ITHRESH = IBG + NINT(SPOT_INPUT_THRESH)
            CALL SPOT_C_OF_G (IXPIX, IYPIX, IXSIZ, IYSIZ, ISPOT_DATA,
     +           ISWORK, ITHRESH, IMG, ITYPE, IORD, NFRASTS,
     +           NXRAST, NYRAST, NOVER,
     +           CGX, CGY, IERR)
            IF (IERR.LT.0) THEN
               CALL ERR_NOTICE (0,'**Error in spot_c_of_g call**')
               GO TO 100
            ELSE IF (IERR.EQ.2) THEN
               CALL ERR_NOTICE (0,
     +              '**Spot box outside range of image**')
               GO TO 100
            ELSE IF (NOVER.EQ.0) THEN
               CALL ERR_NOTICE (0,'**No pixels above threshold**')
               GO TO 100
            END IF
            IXPIX = NINT (CGX)
            IF (IXPIX.LT.1) IXPIX = 1
            IF (IXPIX.GT.NXRAST) IXPIX = NXRAST
            IYPIX = NINT (CGY)
            IF (IYPIX.LT.1) IYPIX = 1
            IF (IYPIX.GT.NYRAST) IYPIX = NYRAST
         END IF
         IF (NUM_CONIC_SPOTS(ICONIC).GE.MAX_CONIC_SPOTS) THEN
            CALL ERR_NOTICE (0,
     +           '**Spot list full for current conic**')
            GO TO 100
         END IF
         NUM_CONIC_SPOTS(ICONIC) = NUM_CONIC_SPOTS(ICONIC) + 1
         J = NUM_CONIC_SPOTS(ICONIC)
         IF (ISTYP.EQ.1) THEN
            XCONIC(J,ICONIC) = CGX
            YCONIC(J,ICONIC) = CGY
         ELSE
            XCONIC(J,ICONIC) = IXPIX
            YCONIC(J,ICONIC) = IYPIX
         END IF
C
C====== Display symbol
C
         CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +        NINT(XCONIC(J,ICONIC)), NINT(YCONIC(J,ICONIC)),
     +        ISYMBTYP(7), ICOLRTYP(7), 1, IERR)
         GO TO 100
C
C====== Parameter table input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITM.EQ.IP_STYP) THEN
            CALL LJUST (PVAL)
            CALL CCPUPC (PVAL)
            CALL GETOPT (SMETHOD_UC, 2, PVAL, IOP, IERR)
            IF (IERR.EQ.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Ambiguous selection**'), 23, IERR)
               GO TO 100
            END IF
            IF (IERR.EQ.2) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Invalid Method**'), 18, IERR)
               RETURN
            END IF
            ISTYP = IOP
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(SMETHOD(ISTYP)), 6, 0, IERR)
         ELSE IF (ITM.EQ.IP_SBOX) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_INPUT_BOX = FP
            WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
         ELSE IF (ITM.EQ.IP_THRESH) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_INPUT_THRESH = FP
            WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            CALL LDM_SET_STHR (SPOT_INPUT_THRESH, IERR, ERRSTR)
            LISTE(1) = IP_STHR
            CALL SET_PAR1_VALS (1, LISTE)
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     CONIC_FN         **
C**************************
C
C
      SUBROUTINE CONIC_FN (M,N,FVECC,X)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: 
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
      INTEGER M
      INTEGER N
      DOUBLE PRECISION FVECC(M)
      DOUBLE PRECISION X(N)
C
C M          (R)  No. of observations
C N          (R)  No. of parameters
C FVECC      (W)  The M calculated function values
C X          (R)  The current parameter values
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'conics.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER I

C     INTEGER I    !Loop variable
C
C-------------------------------------------------------------------------------
C
      DO 10 I = 1, M
         FVECC(I) = COEFFS(1,I)*X(1)*X(1) + COEFFS(2,I)*X(1)*X(2) +
     +              COEFFS(3,I)*X(2)*X(2) + COEFFS(4,I)*X(1) +
     +              COEFFS(5,I)*X(2) - 1.0
10    CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     DISPLAY_OPT      **
C**************************
C
C
      SUBROUTINE DISPLAY_OPT
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle Display/Measure program option
C
C Author:  John W. Campbell, February 1992
C
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL NORMAL_IMAGE
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER NUMP
      INTEGER IFLAG
      INTEGER M_MEASURE
      INTEGER M_PREDICT
      INTEGER M_DISTOR_X
      INTEGER M_DISTOR_Y
      INTEGER M_NORMAL
      INTEGER IPACK_SAV
      INTEGER IPLATE_SAV
      INTEGER IMGSET(11)
      REAL    X_CEN_F
      REAL    Y_CEN_F
      REAL    W_F
      CHARACTER*25 NAMES(5)
      CHARACTER*25 QUITNAM

C     LOGICAL NORMAL_IMAGE !Normal image displayed flag
C     INTEGER NVIEW       !Number of view-objects from which data is to be input
C     INTEGER IVHLIST(2)  !View-object handles list for getting data
C     INTEGER IVH         !View-object handle of view-object returning data
C     INTEGER ITEM        !Item number selected from menu
C     INTEGER IQUIT       !Quit flag
C     INTEGER IERR        !Error flag
C     INTEGER NUMP        !Number of packs
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER M_MEASURE   !Menu item number for: Measure Image
C     INTEGER M_PREDICT   !Menu item number for: Show Predicted Pattern
C     INTEGER M_DISTOR_X  !Menu item number for: X-distortion image
C     INTEGER M_DISTOR_Y  !Menu item number for: Y-distortion image
C     INTEGER M_NORMAL    !Menu item number for: Re-display Normal Image
C     INTEGER IPACK_SAV   !Saves current pack number
C     INTEGER IPLATE_SAV  !Saves current plate number
C     INTEGER IMGSET(11)  !Array in which to save current image display settings
C     REAL    X_CEN_F     !x centre from fids or input (rasters)
C     REAL    Y_CEN_F     !y centre from fids or input (rasters)
C     REAL    W_F         !omega from fids or 0.0 (degrees)
C     CHARACTER*25 NAMES(5)  !Menu item names
C     CHARACTER*25 QUITNAM   !Quit box label

      DATA NAMES /'Measure Image',
     +            'Show Predicted Pattern',
     +            'X-distortion Image',
     +            'Y-distortion Image',
     +            'Re-display Normal Image'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C
C====== Check that pack input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) THEN
         CALL ERR_NOTICE (1, '**Number of packs is zero**')
         RETURN
      END IF
C
C====== Get (default) centre position
C
10    CALL CHK_OPN (IQUIT)
      IF (IQUIT.GT.0) RETURN
      CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
      XCEN_SPOTS = X_CEN_F
      YCEN_SPOTS = Y_CEN_F
      IXCEN_SPOTS = NINT(XCEN_SPOTS)
      IYCEN_SPOTS = NINT(YCEN_SPOTS)
C
C====== Display film/image-plate image
C
      NORMAL_IMAGE = .TRUE.
      CALL SHOW_IMAGE (1, IERR)
      IF (IERR.EQ.1) RETURN
C
C====== Display centre symbol
C
      CALL XDLF_IMAGE_SYMBOL (IVH_FILM, IXCEN_SPOTS, IYCEN_SPOTS,
     +          ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
C
C====== Set up menu
C
      M_MEASURE = 1
      M_PREDICT = 2
      M_DISTOR_X = 3
      M_DISTOR_Y = 4
      M_NORMAL = 5
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 5, XDLSTR(NAMES), 25,
     +                             XDLSTR('Display/Measure Menu'), 20,
     +                             XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 2
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C====== Quit box selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            RETURN
         END IF
C
C====== Measure Image
C
         IF (ITEM.EQ.M_MEASURE) THEN
            IF (.NOT.NORMAL_IMAGE) THEN
               CALL ERR_NOTICE(1,'**Cannot measure distortion image**')
            END IF
            CALL MEASURE_IMG
            GO TO 50
C
C====== Show Predicted pattern
C
         ELSE IF (ITEM.EQ.M_PREDICT) THEN
            IF (.NOT.NORMAL_IMAGE) THEN
               CALL ERR_NOTICE(1,
     +              '**Cannot predict on distortion image**')
            END IF
            CALL SHOW_PREDICT (1)
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +                IXCEN_SPOTS, IYCEN_SPOTS,
     +                ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            GO TO 50
C
C====== X-distortion Image
C
         ELSE IF (ITEM.EQ.M_DISTOR_X) THEN
            IF (NORMAL_IMAGE) THEN
               CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +              MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +              MAG_OPT, ISHOW_INT, IERR)
            END IF
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            CALL DISTOR_IMAGE (1)
            NORMAL_IMAGE = .FALSE.
            GO TO 50
C
C====== Y-distortion Image
C
         ELSE IF (ITEM.EQ.M_DISTOR_Y) THEN
            IF (NORMAL_IMAGE) THEN
               CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +              MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +              MAG_OPT, ISHOW_INT, IERR)
            END IF
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            CALL DISTOR_IMAGE (2)
            NORMAL_IMAGE = .FALSE.
            GO TO 50
C
C====== Re-display Normal Image
C
         ELSE IF (ITEM.EQ.M_NORMAL) THEN     
            IF (NORMAL_IMAGE) GO TO 50
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            CALL SHOW_IMAGE (1, IERR)
            NORMAL_IMAGE = .TRUE.
            GO TO 50
         END IF
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         IPACK_SAV = IPACK
         IPLATE_SAV = IPLATE
         CALL PAR1_INPUT
         IF (IPACK.NE.IPACK_SAV.OR.IPLATE.NE.IPLATE_SAV) THEN
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            GO TO 10
         END IF
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     DISTOR_IMAGE       **
C****************************
C
C
      SUBROUTINE DISTOR_IMAGE (IXY)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Create and display an image showing the distortion corrections
C          image if needed)
C
C Author:  John W. Campbell, December 1993
C
C Arguments:
C
      INTEGER IXY
C
C IXY     (R)   =1 show x-distortion, =2 show y-distortion
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL WITHIN
      INTEGER KERR
      INTEGER IDUMMY(2)
      INTEGER KXROOT
      INTEGER KYROOT
      INTEGER IFLAG
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER MSRASTS
      INTEGER MFRASTS
      INTEGER ND
      INTEGER NXP
      INTEGER NYP
      INTEGER MCMP
      INTEGER IXR
      INTEGER IYR
      INTEGER IP
      INTEGER IFAST
      INTEGER ISLOW
      INTEGER IX
      INTEGER IY
      INTEGER IRED(64)
      INTEGER IGREEN(64)
      INTEGER IBLUE(64)
      INTEGER MINV
      INTEGER MAXV
      INTEGER MINTH
      INTEGER MAXTH
      REAL    MM_RAST_X
      REAL    MM_RAST_Y
      REAL    XCEN
      REAL    YCEN
      REAL    COS_WC
      REAL    SIN_WC
      REAL    XF
      REAL    YF
      REAL    X_CEN_F
      REAL    Y_CEN_F
      REAL    X_C
      REAL    Y_C
      REAL    W_C
      REAL    CTOF
      REAL    XLOW
      REAL    XHIGH
      REAL    YLOW
      REAL    YHIGH
      REAL    XMIN
      REAL    XMAX
      REAL    YMIN
      REAL    YMAX
      REAL    XFD
      REAL    YFD
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR

C     LOGICAL WITHIN      !Pixel within limits flag
C     INTEGER KERR        !Error flag
C     INTEGER IDUMMY(2)   !Dummy array for film display routine
C     INTEGER KXROOT      !Root window x position for image display
C     INTEGER KYROOT      !Root window y position for image display
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER NXRAST      !No. of x-rasters
C     INTEGER NYRAST      !No. of y-rasters
C     INTEGER MSRASTS     !No. of slow rasters
C     INTEGER MFRASTS     !No. of fast rasters
C     INTEGER ND          !No. of decimaol places flag for parameter value
C     INTEGER NXP         !Minimum compression factor required for x
C     INTEGER NYP         !Minimum compression factor required for y
C     INTEGER MCMP        !Compression factor for distortion image
C     INTEGER IXR         !X root window position for progress bar
C     INTEGER IYR         !Y root window position for progress bar
C     INTEGER IP          !Index into image array
C     INTEGER IFAST       !Fast loop index
C     INTEGER ISLOW       !Slow loop index
C     INTEGER IX          !x raster position for current pixel
C     INTEGER IY          !Y raster position for current pixel
C     INTEGER IRED(64)    !Red colormap components
C     INTEGER IGREEN(64)  !Green colormap components
C     INTEGER IBLUE(64)   !Blue colormap components
C     INTEGER MINV        !Minimum value in distortion image
C     INTEGER MAXV        !Maximum value in distortion image
C     INTEGER MINTH       !Minimum threshold
C     INTEGER MAXTH       !Maximum threshold
C     REAL    MM_RAST_X   !Conversion factor mm to x-rasters
C     REAL    MM_RAST_Y   !Conversion factor mm to y-rasters
C     REAL    XCEN        !X centre (corrected) in rasters
C     REAL    YCEN        !Y centre (corrected) in rasters
C     REAL    COS_WC      !cos(w-c)
C     REAL    SIN_WC      !sin(w_c)
C     REAL    XF          !x raster coordinate converted to mm from centre
C     REAL    YF          !y raster coordinate converted to mm from centre
C     REAL    X_CEN_F     !Uncorrected x-centre in rasters
C     REAL    Y_CEN_F     !Uncorrected y-centre in rasters
C     REAL    X_C         !x_c in mm
C     REAL    Y_C         !y_c in mm
C     REAL    W_C         !w_c in degrees
C     REAL    CTOF        !Crystal to film distance
C     REAL    XLOW        !Low x limit in rasters
C     REAL    XHIGH       !High x limit in rasters
C     REAL    YLOW        !Low y limit in raster
C     REAL    YHIGH       !High y limit in rasters
C     REAL    XMIN        !Min allowed x (mm from centre)
C     REAL    XMAX        !Max allowed x (mm from centre)
C     REAL    YMIN        !Min allowed y (mm from centre)
C     REAL    YMAX        !Max allowed y (mm from centre)
C     REAL    XFD         !Distortion corrected x coordinate (mm from centre)
C     REAL    YFD         !Distortion corrected y coordinate (mm from centre)
C     CHARACTER*2 VALSTR  !Value string (dummy)
C     CHARACTER*2 ERRSTR  !Error string (dummy)
C     CHARACTER*80 STR    !Message string
C
C-------------------------------------------------------------------------------
C
C
C====== Get LDM parameters
C
      DOUBLE PRECISION COSD, SIND
      EXTERNAL COSD, SIND
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_CTOF (IPACK, IPLATE, CTOF, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_XCENF (IPACK, IPLATE, X_CEN_F, IFLAG, 
     +                    ND, KERR, ERRSTR)
      CALL LDM_GET_YCENF (IPACK, IPLATE, Y_CEN_F, IFLAG, 
     +                    ND, KERR, ERRSTR)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_WC (IPACK, IPLATE, W_C, IFLAG, ND, KERR, ERRSTR)
      COS_WC = COSD(W_C)
      SIN_WC = SIND(W_C)
      IF (X_CEN_F.GT.0.0.AND.Y_CEN_F.GT.0.0) THEN 
         XCEN = X_CEN_F + X_C*MM_RAST_X
         YCEN = Y_CEN_F + Y_C*MM_RAST_Y
      ELSE
         XCEN = NXRAST/2
         YCEN = NYRAST/2
      END IF
      CALL LDM_GET_XLOW (XLOW, IFLAG, ND)
      CALL LDM_GET_XHIGH (XHIGH, IFLAG, ND)
      CALL LDM_GET_YLOW (YLOW, IFLAG, ND)
      CALL LDM_GET_YHIGH (YHIGH, IFLAG, ND)
C
C====== Calculate allowed x, y limits in mm from predicted centre based on
C       xlow, xhigh, ylow, yhigh
C
      XMIN = (1.0 - XCEN)/MM_RAST_X
      XMAX = (NXRAST - XCEN)/MM_RAST_X
      YMIN = (1.0 - YCEN)/MM_RAST_Y
      YMAX = (NYRAST - YCEN)/MM_RAST_Y
      IF (XLOW.GT.0.0) XMIN = (XLOW - XCEN)/MM_RAST_X
      IF (XHIGH.GT.0.0) XMAX = (XHIGH - XCEN)/MM_RAST_X
      IF (YLOW.GT.0.0) YMIN = (YLOW - YCEN)/MM_RAST_Y
      IF (YHIGH.GT.0.0) YMAX = (YHIGH - YCEN)/MM_RAST_Y
 

      NXP = (NXRAST + MAX_IMG_SIZE - 1)/MAX_IMG_SIZE
      NYP = (NYRAST + MAX_IMG_SIZE - 1)/MAX_IMG_SIZE
      MCMP = MAX(NXP,NYP)
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,IXR,IYR,KERR)
      IF (MCMP.GT.1) THEN
         STR = '*Distortion Image compressed by'
         CALL STR_ADDI(STR,MCMP,1)
         CALL STR_ADDS(STR,'to 1 from full image*',1)
         CALL LMESSAGE(IVH_IOW,STR)
      END IF
      MSRASTS = NXRAST/MCMP
      MFRASTS = NYRAST/MCMP
C
C====== Create Distortion image
C
      MINV = 10000000
      MAXV = -10000000
      CALL XDLF_PROGRESS_BAR (IVH_BAR, IXR, IYR, 
     +     XDLSTR('Forming distortion image:'),  25, 100, MSRASTS,
     +     IFONT, 5)

      IP = 0
      DO 200 ISLOW = 1, MSRASTS
         IX = (ISLOW-1)*MCMP + MCMP/2 + 1
         XF = (FLOAT(IX)-XCEN)/MM_RAST_X
         DO 150 IFAST = 1, MFRASTS
            IY = (IFAST-1)*MCMP + MCMP/2 + 1
            YF = (FLOAT(IY)-YCEN)/MM_RAST_Y
            WITHIN = .TRUE.
            IF (XF.LT.XMIN.OR.XF.GT.XMAX) WITHIN = .FALSE.
            IF (YF.LT.YMIN.OR.YF.GT.YMAX) WITHIN = .FALSE.
            IP = IP + 1
            IF (WITHIN) THEN
               CALL LDM_CORR (IPACK, IPLATE, COS_WC, SIN_WC, CTOF, 
     +                        XF, YF, XFD, YFD)
               IF (IXY.EQ.1) THEN
                  DISTOR_IMG(IP) = NINT(100.0*(XFD-XF)*MM_RAST_X)
               ELSE
                  DISTOR_IMG(IP) = NINT(100.0*(YFD-YF)*MM_RAST_Y)
               END IF
            ELSE
               DISTOR_IMG(IP) = 0
            END IF
            IF (DISTOR_IMG(IP).GT.MAXV) MAXV = DISTOR_IMG(IP)
            IF (DISTOR_IMG(IP).LT.MINV) MINV = DISTOR_IMG(IP)
150      CONTINUE
         CALL XDLF_PROGRESS_BAR_VALUE (IVH_BAR, ISLOW, KERR)
200   CONTINUE
      CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, KERR)
C
C====== Display distortion image
C
      KXROOT = 0
      KYROOT = 0
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,0,0,KXROOT,KYROOT,KERR)
      KYROOT = KYROOT - 30
      IF (KYROOT.LT.0) KYROOT = 0
      MINTH = MINV
      MAXTH = MAXV
      CALL XDLF_IMAGE (IVH_FILM,0,KXROOT,KYROOT,1,DISTOR_IMG,3,
     +                 MSRASTS,MFRASTS,MFRASTS,
     +                 1,1,NXRAST/MCMP,NYRAST/MCMP,1,1,2,
     +                 MINV,MAXV,MINTH,MAXTH,0,0,
     +                 1,1,1024,1,KERR)
      CALL XDLF_IMAGE_AXNAMES (IVH_FILM,XDLSTR('x'),1,XDLSTR('y'),1,
     +                         KERR)
      CALL IMAGE_COLOURS (IRED, IGREEN, IBLUE)
      CALL XDLF_IMAGE_SET_COLORMAP (IVH_FILM, IRED, IGREEN, IBLUE, 
     +                              KERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     DRAW_CIRC        **
C**************************
C
C
      SUBROUTINE DRAW_CIRC (IVH_IMG, IXC, IYC, RAD, N, IV, ICOLR, LAST)       
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Draw circle on image
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
      INTEGER IVH_IMG
      INTEGER IXC
      INTEGER IYC
      REAL RAD
      INTEGER N
      INTEGER IERR
      INTEGER IV
      INTEGER ICOLR
      LOGICAL LAST
C     
C IVH_IMG    (R) View-object handle for the image
C IXC        (R) X centre of circle (pixel number)
C IYC        (R) Y centre of circle (pixel number)
C RAD        (R) Radius of circle in raster units (real)
C N          (R) No. of segments for circle draw
C IV         (R) Vector id
C ICOLR      (R) Color no.
C LAST       (R) = .TRUE. update magnifying window when circle drawn,
C                = .FALSE. do not
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      INTEGER I
      INTEGER IMAG
      INTEGER IX1, IY1
      INTEGER IX2, IY2
      REAL TH
      REAL DTH
C
C-------------------------------------------------------------------------------
C
      TH = 0.0
      DTH = 6.28319/N
      IMAG = 0
      DO 100 I = 1, N
         IX1 = NINT(IXC + RAD*COS(TH))
         IY1 = NINT(IYC + RAD*SIN(TH))
         TH = TH + DTH
         IX2 = NINT(IXC + RAD*COS(TH))
         IY2 = NINT(IYC + RAD*SIN(TH))
         IF (LAST.AND.I.EQ.N) IMAG = 1
         CALL XDLF_IMAGE_VECT (IVH_IMG, IV, IX1, IY1, IX2, IY2,
     +                         ICOLR, 1, IMAG, IERR)
100   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     EDIT_FIDS        **
C**************************
C
C
      SUBROUTINE EDIT_FIDS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Allow editing of fid values via popup parameter table and menu
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
C None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      INTEGER INTFP
C
C====== LOCALS:
C
      INTEGER IVH_POPFR
      INTEGER IVH_POPPT
      INTEGER IVH_POPMN
      INTEGER NP_NAME_CHARS
      INTEGER NP_VAL_CHARS
      INTEGER JP_FIDX1
      INTEGER JP_FIDY1
      INTEGER JP_FIDX2
      INTEGER JP_FIDY2
      INTEGER JP_FIDX3
      INTEGER JP_FIDY3
      INTEGER P_WIDTH
      INTEGER P_HEIGHT
      INTEGER M_WIDTH
      INTEGER M_HEIGHT
      INTEGER IWIDTH_FRAME
      INTEGER IHEIGHT_FRAME
      INTEGER IX_PARM
      INTEGER IY_PARM
      INTEGER IX_MENU
      INTEGER IY_MENU
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER ITYP
      INTEGER IFLAG
      INTEGER ND
      INTEGER IV
      REAL XHALF
      REAL YHALF
      REAL VALUE
      REAL MM_RAST_X
      REAL MM_RAST_Y
      CHARACTER*15 MENU_STRS(2)
      CHARACTER*15 PVAL
      CHARACTER*80 ERRSTR
C
C     INTEGER IVH_POPFR    !View-object handle for pop-up frame
C     INTEGER IVH_POPPT    !View-object handle for parameter table
C     INTEGER IVH_POPMN    !View-object handle for menu
C     INTEGER NP_NAME_CHARS !Max no. chars in parameter table name
C     INTEGER NP_VAL_CHARS  !Max no. chars in pareter table value
C     INTEGER JP_FIDX1     !Item numbers in param. table for fidx1
C     INTEGER JP_FIDY1     !Item numbers in param. table for fidy1
C     INTEGER JP_FIDX2     !Item numbers in param. table for fidx2
C     INTEGER JP_FIDY2     !Item numbers in param. table for fidy2
C     INTEGER JP_FIDX3     !Item numbers in param. table for fidx3
C     INTEGER JP_FIDY3     !Item numbers in param. table for fidy3
C     INTEGER P_WIDTH      !Parameter table width
C     INTEGER P_HEIGHT     !Parameter table height
C     INTEGER M_WIDTH      !Menu area width
C     INTEGER M_HEIGHT     !Menu area height
C     INTEGER IWIDTH_FRAME !Width of pop-up frame
C     INTEGER IHEIGHT_FRAME !Height of pop-up frame
C     INTEGER IX_PARM      !X position of parameter table within frame
C     INTEGER IY_PARM      !Y position of parameter table within frame
C     INTEGER IX_MENU      !X position of menu area within frame
C     INTEGER IY_MENU      !Y position of menu area within frame
C     INTEGER IXROOT       !Root X position of pop-up frame
C     INTEGER IYROOT       !Root Y position of pop_up frame
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. modified in parameter table
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER ITYP         !Return flag from INTFP
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IV           !Integer value
C     REAL XHALF           !Half of image along x
C     REAL YHALF           !Half of image aling y
C     REAL VALUE           !Real parameter value
C     REAL MM_RAST_X       !Convert mm to x-rasters
C     REAL MM_RAST_Y       !Convert mm to y-rasters
C     CHARACTER*15 MENU_STRS(2)  !Menu strings
C     CHARACTER*15 PVAL          !String for parameter table input value
C     CHARACTER*80 ERRSTR        !Error message string
C
C====== Data statements
C
      DATA MENU_STRS/'Arndt-Wonacott','Huber'/
C
C-------------------------------------------------------------------------------
C
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (IV, IFLAG)
      XHALF = IV/2.0
      CALL LDM_GET_NYRAS (IV, IFLAG)
      YHALF = IV/2.0
      IVH_POPFR = 100
      IVH_POPPT = 101
      IVH_POPMN = 102
      NP_NAME_CHARS = 18
      NP_VAL_CHARS = 10
      JP_FIDX1 = 1
      JP_FIDY1 = 2
      JP_FIDX2 = 3
      JP_FIDY2 = 4
      JP_FIDX3 = 5
      JP_FIDY3 = 6
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,100,0,IXROOT,IYROOT,IERR)        
C
C====== Get required parameter table size and menu size
C
      CALL XDLF_PARAM_TABLE_GETSIZE (1, 6, NP_NAME_CHARS, NP_VAL_CHARS,
     +                 1, IFONT, 1, P_WIDTH, P_HEIGHT)        
      CALL XDLF_MENU_AREA_GETSIZE (2, 20, IFONT, 1, 0, 
     +                 M_WIDTH, M_HEIGHT)
C
C====== Get required size for pop-up frame and positions of windows
C
      IWIDTH_FRAME = 2*IBORDER + P_WIDTH + 8
      IHEIGHT_FRAME = 2*IBORDER + P_HEIGHT + ISEP + M_HEIGHT + 8
      IX_PARM = IBORDER + 4
      IY_PARM = IBORDER + 4
      IX_MENU = IBORDER + 4
      IY_MENU = IBORDER + 4 + P_HEIGHT + ISEP
C
C====== Create pop-up base frame
C
      CALL XDLF_POPUP_FRAME (IVH_POPFR, IXROOT, IYROOT, IWIDTH_FRAME,
     +                       IHEIGHT_FRAME, 5)
C
C====== Create parameter_table & menu (Note: Use param width for menu)
C
      CALL XDLF_PARAM_TABLE (IVH_POPPT, IVH_POPFR, IX_PARM, IY_PARM, 
     +               0, 1, 6, NP_NAME_CHARS, 
     +               NP_VAL_CHARS, NP_VAL_CHARS,
     +               XDLSTR('Fiducials'), 9, IFONT,
     +               1, IERR)
      CALL XDLF_MENU_AREA (IVH_POPMN, IVH_POPFR, IX_MENU, IY_MENU, 0, 
     +               2, 20, IFONT, 1, 0, P_WIDTH, M_HEIGHT, IERR)
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_POPMN, 2,
     +     XDLSTR(MENU_STRS), 15, XDLSTR(' '), -1,
     +     XDLSTR('Continue'), 8, IFONT, IERR)
C
C====== Set up parameter table entries
C
      CALL LDM_GET_FIDX1 (VALUE, IFLAG, ND)
      VALUE = XHALF + VALUE*MM_RAST_X/100.0
      WRITE (PVAL,'(F8.1)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_FIDX1,
     +     XDLSTR('fidx1 (rasters):'), 16, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_FIDY1 (VALUE, IFLAG, ND)
      VALUE = YHALF + VALUE*MM_RAST_Y/100.0
      WRITE (PVAL,'(F8.1)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_FIDY1,
     +     XDLSTR('fidy1 (rasters):'), 16, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_FIDX2 (VALUE, IFLAG, ND)
      VALUE = XHALF + VALUE*MM_RAST_X/100.0
      WRITE (PVAL,'(F8.1)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_FIDX2,
     +     XDLSTR('fidx2 (rasters):'), 16, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_FIDY2 (VALUE, IFLAG, ND)
      VALUE = YHALF + VALUE*MM_RAST_Y/100.0
      WRITE (PVAL,'(F8.1)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_FIDY2,
     +     XDLSTR('fidy2 (rasters):'), 16, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_FIDX3 (VALUE, IFLAG, ND)
      VALUE = XHALF + VALUE*MM_RAST_X/100.0
      WRITE (PVAL,'(F8.1)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_FIDX3,
     +     XDLSTR('fidx3 (rasters):'), 16, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_FIDY3 (VALUE, IFLAG, ND)
      VALUE = YHALF + VALUE*MM_RAST_Y/100.0
      WRITE (PVAL,'(F8.1)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_FIDY3,
     +     XDLSTR('fidy3 (rasters):'), 16, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)
C
C====== Get input from the menu and/or parameter table
C
      NVIEW = 2
      IVHLIST(1) = IVH_POPMN
      IVHLIST(2) = IVH_POPPT
200   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
C
C====== Parameter table input
C
      IF (IVH.EQ.IVH_POPPT) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_POPPT, ITEM,
     +        XDLSTR(PVAL), 15, IERR)
         ITYP = INTFP (PVAL, VALUE, IV)
         IF (ITYP.EQ.0) THEN
            CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +      XDLSTR('**Invalid syntax**'), 18, IERR)
            GO TO 200
         END IF
         IF (VALUE.LE.0) THEN
            CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +      XDLSTR('**Value must be greater than zero**'), 35, IERR)
            GO TO 200
         END IF
         IF (ITEM.EQ.JP_FIDX1) THEN
            VALUE = 100.0*(VALUE-XHALF)/MM_RAST_X
            CALL LDM_SET_FIDX1 (VALUE, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            GO TO 200

         ELSE IF (ITEM.EQ.JP_FIDY1) THEN
            VALUE = 100.0*(VALUE-YHALF)/MM_RAST_Y
            CALL LDM_SET_FIDY1 (VALUE, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            GO TO 200

         ELSE IF (ITEM.EQ.JP_FIDX2) THEN
            VALUE = 100.0*(VALUE-XHALF)/MM_RAST_X
            CALL LDM_SET_FIDX2 (VALUE, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            GO TO 200

         ELSE IF (ITEM.EQ.JP_FIDY2) THEN
            VALUE = 100.0*(VALUE-YHALF)/MM_RAST_Y
            CALL LDM_SET_FIDY2 (VALUE, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            GO TO 200

         ELSE IF (ITEM.EQ.JP_FIDX3) THEN
            VALUE = 100.0*(VALUE-XHALF)/MM_RAST_X
            CALL LDM_SET_FIDX3 (VALUE, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            GO TO 200

         ELSE IF (ITEM.EQ.JP_FIDY3) THEN
            VALUE = 100.0*(VALUE-YHALF)/MM_RAST_Y
            CALL LDM_SET_FIDY3 (VALUE, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            GO TO 200
         END IF
C
C====== Menu input
C
      ELSE IF (IVH.EQ.IVH_POPMN) THEN
         CALL XDLF_MENU_AREA_GETITEM (IVH_POPMN, ITEM, IQUIT)
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPMN, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPPT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPFR, IERR)
            RETURN
         ELSE
            IF (ITEM.EQ.1) THEN
               CALL LDM_SET_FIDX1 (-5000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDY1 (-4000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDX2 (-5000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDY2 (4000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDX3 (5000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDY3 (4000.0, IERR, ERRSTR)
            ELSE IF (ITEM.EQ.2) THEN
               CALL LDM_SET_FIDX1 (-4000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDY1 (5000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDX2 (-4000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDY2 (-5000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDX3 (4000.0, IERR, ERRSTR)
               CALL LDM_SET_FIDY3 (-5000.0, IERR, ERRSTR)
            ENDIF
         END IF

         CALL LDM_GET_FIDX1 (VALUE, IFLAG, ND)
         VALUE = XHALF + VALUE*MM_RAST_X/100.0
         WRITE (PVAL,'(F8.1)') VALUE
         CALL LJUST(PVAL)       
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_FIDX1,
     +     XDLSTR(PVAL), 15, 0, IERR)

         CALL LDM_GET_FIDY1 (VALUE, IFLAG, ND)
         VALUE = YHALF + VALUE*MM_RAST_Y/100.0
         WRITE (PVAL,'(F8.1)') VALUE
         CALL LJUST(PVAL)       
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_FIDY1,
     +     XDLSTR(PVAL), 15, 0, IERR)

         CALL LDM_GET_FIDX2 (VALUE, IFLAG, ND)
         VALUE = XHALF + VALUE*MM_RAST_X/100.0
         WRITE (PVAL,'(F8.1)') VALUE
         CALL LJUST(PVAL)       
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_FIDX2,
     +     XDLSTR(PVAL), 15, 0, IERR)

         CALL LDM_GET_FIDY2 (VALUE, IFLAG, ND)
         VALUE = YHALF + VALUE*MM_RAST_Y/100.0
         WRITE (PVAL,'(F8.1)') VALUE
         CALL LJUST(PVAL)       
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_FIDY2,
     +     XDLSTR(PVAL), 15, 0, IERR)

         CALL LDM_GET_FIDX3 (VALUE, IFLAG, ND)
         VALUE = XHALF + VALUE*MM_RAST_X/100.0
         WRITE (PVAL,'(F8.1)') VALUE
         CALL LJUST(PVAL)       
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_FIDX3,
     +     XDLSTR(PVAL), 15, 0, IERR)

         CALL LDM_GET_FIDY3 (VALUE, IFLAG, ND)
         VALUE = YHALF + VALUE*MM_RAST_Y/100.0
         WRITE (PVAL,'(F8.1)') VALUE
         CALL LJUST(PVAL)       
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_FIDY3,
     +     XDLSTR(PVAL), 15, 0, IERR)

      END IF
      GO TO 200
C
C====== Parameter value error
C
800   CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +     XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR)
      GO TO 200
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     EDIT_SPD         **
C**************************
C
C
      SUBROUTINE EDIT_SPD
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Allow editing of spd values via popup parameter table and menu
C
C Author:  John W. Campbell, September 1993
C
C Arguments:
C
C None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      INTEGER INTFP
      INTEGER LDM_SPDMAX
C
C====== LOCALS:
C
      INTEGER IVH_POPFR
      INTEGER IVH_POPPT
      INTEGER IVH_POPMN
      INTEGER NP_NAME_CHARS
      INTEGER NP_VAL_CHARS
      INTEGER JP_SPDXN
      INTEGER JP_SPDXMIN
      INTEGER JP_SPDXMAX
      INTEGER JP_SPDX1
      INTEGER JP_SPDYN
      INTEGER JP_SPDYMIN
      INTEGER JP_SPDYMAX
      INTEGER JP_SPDY1
      INTEGER P_WIDTH
      INTEGER P_HEIGHT
      INTEGER M_WIDTH
      INTEGER M_HEIGHT
      INTEGER IWIDTH_FRAME
      INTEGER IHEIGHT_FRAME
      INTEGER IX_PARM
      INTEGER IY_PARM
      INTEGER IX_MENU
      INTEGER IY_MENU
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER ITYP
      INTEGER IFLAG
      INTEGER ND
      INTEGER IV
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER LISTE(2)
      INTEGER IVAL
      INTEGER MAX_SPD
      INTEGER I
      INTEGER LL
      REAL VALUE
      REAL VAL(2)
      CHARACTER*22 MENU_STRS(3)
      CHARACTER*15 PVAL
      CHARACTER*80 ERRSTR
      CHARACTER*20 SPDNAM
C
C     INTEGER IVH_POPFR    !View-object handle for pop-up frame
C     INTEGER IVH_POPPT    !View-object handle for parameter table
C     INTEGER IVH_POPMN    !View-object handle for menu
C     INTEGER NP_NAME_CHARS !Max no. chars in parameter table name
C     INTEGER NP_VAL_CHARS  !Max no. chars in pareter table value
C     INTEGER JP_SPDXN      !Param table item no. for spdx_n
C     INTEGER JP_SPDXMIN    !Param table item no. for spdx_min
C     INTEGER JP_SPDXMAX    !Param table item no. for spdx_max
C     INTEGER JP_SPDX1      !Param table item no. for spdx1
C     INTEGER JP_SPDYN      !Param table item no. for spdy_n
C     INTEGER JP_SPDYMIN    !Param table item no. for spdy_min
C     INTEGER JP_SPDYMAX    !Param table item no. for spdy_max
C     INTEGER JP_SPDY1      !Param table item no. for spdy1
C     INTEGER P_WIDTH      !Parameter table width
C     INTEGER P_HEIGHT     !Parameter table height
C     INTEGER M_WIDTH      !Menu area width
C     INTEGER M_HEIGHT     !Menu area height
C     INTEGER IWIDTH_FRAME !Width of pop-up frame
C     INTEGER IHEIGHT_FRAME !Height of pop-up frame
C     INTEGER IX_PARM      !X position of parameter table within frame
C     INTEGER IY_PARM      !Y position of parameter table within frame
C     INTEGER IX_MENU      !X position of menu area within frame
C     INTEGER IY_MENU      !Y position of menu area within frame
C     INTEGER IXROOT       !Root X position of pop-up frame
C     INTEGER IYROOT       !Root Y position of pop_up frame
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. modified in parameter table
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER ITYP         !Return flag from INTFP
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IV           !Integer value
C     INTEGER KPACK        !Pack no. or 0 for all packs update
C     INTEGER KPLATE       !Plate no. or 0 for all plates update
C     INTEGER LISTE(2)     !Parameter items for parameter table updates
C     INTEGER IVAL         !Integer parameter value
C     INTEGER MAX_SPD      !Maximum spd coefficient no.
C     INTEGER I            !Temp/loop variable
C     INTEGER LL           !String length
C     REAL VALUE           !Real parameter value
C     REAL VAL(2)          !Real parameter values array
C     CHARACTER*22 MENU_STRS(3)  !Menu strings
C     CHARACTER*15 PVAL          !String for parameter table input value
C     CHARACTER*80 ERRSTR        !Error message string
C     CHARACTER*20 SPDNAM        !Name of SPD.. parameter
C
C====== Data statements
C
      DATA MENU_STRS/'Zero spdx coefficients',
     +               'Zero spdy coefficients',
     +               'Zero all coefficients'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      IVH_POPFR = 100
      IVH_POPPT = 101
      IVH_POPMN = 102
      MAX_SPD = LDM_SPDMAX(0)
      NP_NAME_CHARS = 14
      NP_VAL_CHARS = 12
      JP_SPDXN = 1
      JP_SPDXMIN = 2
      JP_SPDXMAX = 3
      JP_SPDX1 = 4
      JP_SPDYN = MAX_SPD + 4
      JP_SPDYMIN = MAX_SPD + 5
      JP_SPDYMAX = MAX_SPD + 6
      JP_SPDY1 = MAX_SPD + 7
C
C====== Get position for popup frame
C
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,100,0,IXROOT,IYROOT,IERR)        
C
C====== Get required parameter table size and menu size
C
      CALL XDLF_PARAM_TABLE_GETSIZE (2, MAX_SPD+3, 
     +                 NP_NAME_CHARS, NP_VAL_CHARS,
     +                 1, IFONT, 1, P_WIDTH, P_HEIGHT)        
      CALL XDLF_MENU_AREA_GETSIZE (3, 25, IFONT, 1, 0, 
     +                 M_WIDTH, M_HEIGHT)
C
C====== Get required size for pop-up frame and positions of windows
C
      IWIDTH_FRAME = 2*IBORDER + P_WIDTH + 8
      IHEIGHT_FRAME = 2*IBORDER + P_HEIGHT + ISEP + M_HEIGHT + 8
      IX_PARM = IBORDER + 4
      IY_PARM = IBORDER + 4
      IX_MENU = IBORDER + 4
      IY_MENU = IBORDER + 4 + P_HEIGHT + ISEP
C
C====== Create pop-up base frame
C
      CALL XDLF_POPUP_FRAME (IVH_POPFR, IXROOT, IYROOT, IWIDTH_FRAME,
     +                       IHEIGHT_FRAME, 5)
C
C====== Create parameter_table & menu (Note: Use param width for menu)
C
      CALL XDLF_PARAM_TABLE (IVH_POPPT, IVH_POPFR, IX_PARM, IY_PARM, 
     +               0, 2, MAX_SPD+3, NP_NAME_CHARS, 
     +               NP_VAL_CHARS, NP_VAL_CHARS,
     +               XDLSTR('Spatial Distortion'), 18, 
     +               IFONT, 1, IERR)
      CALL XDLF_MENU_AREA (IVH_POPMN, IVH_POPFR, IX_MENU, IY_MENU, 0, 
     +               3, 25, IFONT, 1, 0, P_WIDTH, M_HEIGHT, IERR)
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_POPMN, 3,
     +     XDLSTR(MENU_STRS), 22, XDLSTR(' '), -1,
     +     XDLSTR('Continue'), 8, IFONT, IERR)
C
C====== Set up parameter table entries
C
      CALL LDM_GET_SPDXN (IPACK, IPLATE, IVAL, IFLAG, IERR, ERRSTR)
      WRITE (PVAL,'(I8)') IVAL
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDXN,
     +     XDLSTR('spdx_n:'), 7, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_SXMIN (IPACK, IPLATE, VALUE, IFLAG, ND, 
     +     IERR, ERRSTR)
      WRITE (PVAL,'(F8.2)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDXMIN,
     +     XDLSTR('spdx_min (mm):'), 14, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_SXMAX (IPACK, IPLATE, VALUE, IFLAG, ND, 
     +     IERR, ERRSTR)
      WRITE (PVAL,'(F8.2)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDXMAX,
     +     XDLSTR('spdx_max (mm):'), 14, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      DO 100 I = 1, MAX_SPD
         CALL LDM_GET_SPDX (I, IPACK, IPLATE, VAL, IFLAG, ND, 
     +        IERR, ERRSTR)
         WRITE (PVAL,'(E12.4)') VAL(1)
         CALL LJUST(PVAL)
         SPDNAM = 'spdx'
         CALL STR_ADDI(SPDNAM,I,0)
         LL = LENSTR(SPDNAM)       
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDX1+I-1,
     +        XDLSTR(SPDNAM), LL, XDLSTR(PVAL), 15, 
     +        0, 0, IERR)
100   CONTINUE

      CALL LDM_GET_SPDYN (IPACK, IPLATE, IVAL, IFLAG, IERR, ERRSTR)
      WRITE (PVAL,'(I8)') IVAL
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDYN,
     +     XDLSTR('spdy_n:'), 7, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_SYMIN (IPACK, IPLATE, VALUE, IFLAG, ND, 
     +     IERR, ERRSTR)
      WRITE (PVAL,'(F8.2)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDYMIN,
     +     XDLSTR('spdy_min (mm):'), 14, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      CALL LDM_GET_SYMAX (IPACK, IPLATE, VALUE, IFLAG, ND, 
     +     IERR, ERRSTR)
      WRITE (PVAL,'(F8.2)') VALUE
      CALL LJUST(PVAL)       
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDYMAX,
     +     XDLSTR('spdy_max (mm):'), 14, XDLSTR(PVAL), 15, 
     +     0, 0, IERR)

      DO 110 I = 1, MAX_SPD
         CALL LDM_GET_SPDY (I, IPACK, IPLATE, VAL, IFLAG, ND, 
     +        IERR, ERRSTR)
         WRITE (PVAL,'(E12.4)') VAL(1)
         CALL LJUST(PVAL)
         SPDNAM = 'spdy'
         CALL STR_ADDI(SPDNAM,I,0)
         LL = LENSTR(SPDNAM)       
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDY1+I-1,
     +        XDLSTR(SPDNAM), LL, XDLSTR(PVAL), 15, 
     +        0, 0, IERR)
110   CONTINUE

C
C====== Get input from the menu and/or parameter table
C
      NVIEW = 2
      IVHLIST(1) = IVH_POPMN
      IVHLIST(2) = IVH_POPPT
200   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
C
C====== Parameter table input
C
      IF (IVH.EQ.IVH_POPPT) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_POPPT, ITEM,
     +        XDLSTR(PVAL), 15, IERR)
         IF (ITEM.EQ.JP_SPDXN) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDX_N', KPACK, KPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            LISTE(1) = IP_SPDX
            CALL SET_PAR2_VALS (1, LISTE)

         ELSE IF (ITEM.EQ.JP_SPDXMIN) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDX_MIN', KPACK, KPLATE, PVAL, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800

         ELSE IF (ITEM.EQ.JP_SPDXMAX) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDX_MAX', KPACK, KPLATE, PVAL, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800

         ELSE IF (ITEM.GE.JP_SPDX1.AND.ITEM.LE.JP_SPDX1+MAX_SPD-1) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            SPDNAM = 'SPDX'
            CALL STR_ADDI(SPDNAM,ITEM-JP_SPDX1+1,0)
            CALL LDM_SET (SPDNAM, KPACK, KPLATE, PVAL, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800

         ELSE IF (ITEM.EQ.JP_SPDYN) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDY_N', KPACK, KPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            LISTE(1) = IP_SPDY
            CALL SET_PAR2_VALS (1, LISTE)

         ELSE IF (ITEM.EQ.JP_SPDYMIN) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDY_MIN', KPACK, KPLATE, PVAL, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800

         ELSE IF (ITEM.EQ.JP_SPDYMAX) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDY_MAX', KPACK, KPLATE, PVAL, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800

         ELSE IF (ITEM.GE.JP_SPDY1.AND.ITEM.LE.JP_SPDY1+MAX_SPD-1) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            SPDNAM = 'SPDY'
            CALL STR_ADDI(SPDNAM,ITEM-JP_SPDY1+1,0)
            CALL LDM_SET (SPDNAM, KPACK, KPLATE, PVAL, IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800

         END IF
C
C====== Menu input
C
      ELSE IF (IVH.EQ.IVH_POPMN) THEN
         CALL XDLF_MENU_AREA_GETITEM (IVH_POPMN, ITEM, IQUIT)
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPMN, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPPT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPFR, IERR)
            RETURN
         ELSE
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            WRITE (PVAL,'(E12.4)') 0.0
            CALL LJUST(PVAL)       
            IF (ITEM.EQ.1) THEN
               DO 120 I = 1, MAX_SPD
                  VAL(1) = 0.0
                  CALL LDM_SET_SPDX (I, KPACK, KPLATE, VAL, 
     +                 IERR, ERRSTR)
                  CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, 
     +                               JP_SPDX1+I-1,
     +                               XDLSTR(PVAL), 15, 0, IERR)
120            CONTINUE
            ELSE IF (ITEM.EQ.2) THEN
               DO 130 I = 1, MAX_SPD
                  VAL(1) = 0.0
                  CALL LDM_SET_SPDY (I, KPACK, KPLATE, VAL, 
     +                 IERR, ERRSTR)
                  CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, 
     +                               JP_SPDY1+I-1,
     +                               XDLSTR(PVAL), 15, 0, IERR)
130            CONTINUE
            ELSE IF (ITEM.EQ.3) THEN
               DO 140 I = 1, MAX_SPD
                  VAL(1) = 0.0
                  CALL LDM_SET_SPDX (I, KPACK, KPLATE, VAL, 
     +                 IERR, ERRSTR)
                  CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, 
     +                               JP_SPDX1+I-1,
     +                               XDLSTR(PVAL), 15, 0, IERR)
140            CONTINUE
               DO 150 I = 1, MAX_SPD
                  VAL(1) = 0.0
                  CALL LDM_SET_SPDY (I, KPACK, KPLATE, VAL, 
     +                 IERR, ERRSTR)
                  CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, 
     +                               JP_SPDY1+I-1,
     +                               XDLSTR(PVAL), 15, 0, IERR)
150            CONTINUE
            ENDIF
         END IF

      END IF
      GO TO 200
C
C====== Parameter value error
C
800   CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +     XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR)
      GO TO 200
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     EROTMT           **
C**************************
C
C
      SUBROUTINE EROTMT(ANG,B,A,RMSD)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Use the formulae of the preceding routine to calculate the new
C          matrix (B), from the rotation angles in degrees (ANG). RMSD returns
C          the root mean square deviation of new matrix elements from old (A).
C
C Author:  Modified version of M. Elder's routine
C
C Arguments:
C
      REAL ANG(3)
      REAL B(3,3)
      REAL A(3,3)
      REAL RMSD
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      REAL CX,CY,CZ,RAD,SX,SY,SZ
      INTEGER I,J
C
C-------------------------------------------------------------------------------
C
      RAD = 180./3.14159265
      CX = COS(ANG(1)/RAD)
      CY = COS(ANG(2)/RAD)
      CZ = COS(ANG(3)/RAD)
      SX = SIN(ANG(1)/RAD)
      SY = SIN(ANG(2)/RAD)
      SZ = SIN(ANG(3)/RAD)
      B(1,1) = CY*CZ
      B(1,2) = SX*SY*CZ - CX*SZ
      B(1,3) = CX*SY*CZ + SX*SZ
      B(2,1) = CY*SZ
      B(2,2) = SX*SY*SZ + CX*CZ
      B(2,3) = CX*SY*SZ - SX*CZ
      B(3,1) = -SY
      B(3,2) = SX*CY
      B(3,3) = CX*CY
      RMSD = 0.
      DO 30 I = 1 , 3
         DO 20 J = 1 , 3
            RMSD = (A(I,J)-B(I,J))**2 + RMSD
 20      CONTINUE
 30   CONTINUE
      RMSD = SQRT(RMSD/9.)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     ERR_NOTICE       **
C**************************
C
C
      SUBROUTINE ERR_NOTICE (ITYP, MESSAGE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Output a popup notice error/warning message for 'lauegen' with a
C          'Continue' box
C
C Author:  John W. Campbell, August 1991
C
C Arguments:
C
      INTEGER ITYP
      CHARACTER*(*) MESSAGE
C
C ITYP    (R)  = 0, Position notice at default position (no arrow on notice)
C              = 1, Position notice at last selected menu item position (arrow
C                   on notice in this case)
C              = 2, Position notice at last selected menu item position on
C                   autoindexing solutions menu
C              = 3. position on command window
C MESSAGE (R)  The error/warning message
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IARROW
      INTEGER IBUTTON

C     INTEGER IXROOT      !X root position for popup notice
C     INTEGER IYROOT      !Y root position for popup notice
C     INTEGER IARROW      !Arrow required flag 0=no, 1=yes
C     INTEGER IBUTTON     !Returns selected button
C
C-------------------------------------------------------------------------------
C
C====== Get the required position
C
      CALL NOTICE_POSN (ITYP, IXROOT, IYROOT)
C
C====== Output the popup notice
C
      IARROW = 0
      IF (ITYP.EQ.1) IARROW = 1
      CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +          XDLSTR(MESSAGE), LENSTR(MESSAGE),
     +          XDLSTR(' '), -1,
     +          XDLSTR('Continue'), 8,
     +          XDLSTR(' '), -1,
     +          IFONT, IARROW, IBUTTON)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     EVANGL           **
C**************************
C
C
      SUBROUTINE EVANGL(NOBS,IHKL,XC,ANG,RMSD,DEV,SOL,IDET)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: On entry have nobs reflections with indices in ihkl.
C          Observed film coords (mm) are in xc
C
C          Firstly, calculate the standard reciprocal lattice coords
C          (x) from the indices.
C
C Author:  Modified version of M. Elder's routine
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C Arguments:
C
      INTEGER NOBS
      INTEGER IHKL(3,MAX_AUTO_SPOTS)
      REAL XC(5,MAX_AUTO_SPOTS)
      REAL ANG(3)
      REAL RMSD
      REAL DEV
      REAL SOL(3,3)
      INTEGER IDET
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      REAL RF,TH
      INTEGER I,ICOD,J,K
      REAL A(3,3),AA(3,3),AAA(3,20),AC1(3,3),AC2(3,3),AC3(3,3),AC4(3,3)
      REAL AC5(3,3),AC6(3,3),AI(3,3),NEWSOL(3,3),XTMP(3),XX(3)
      REAL RCELL(6),CCELL(6)
      REAL CTOF, CELL(6)
      INTEGER ISYST, IFLAG, ND, IERR
      CHARACTER*2 VALSTR, ERRSTR
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_CTOF (IPACK, IPLATE, CTOF, IFLAG, ND, IERR, 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 RECCEL(RCELL,CELL,1.0)
      CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
      CALL CELLCX(ISYST,CCELL,RCELL,2,2)
      DO 10 I = 1,3
         DO 5 J=1,3
            AA(I,J) = 0.0
  5      CONTINUE
 10   CONTINUE
      CALL MATS(AA,AC1,AC2,AC3,AC4,AC5,AC6,CCELL)
      DO 30 I = 1 , NOBS
         DO 20 J = 1 , 3
            X_AUT(J,I) = AA(J,1)*IHKL(1,I) + AA(J,2)*IHKL(2,I) 
     +                   + AA(J,3)*IHKL(3,I)
 20      CONTINUE
         DS2_AUT(I) = X_AUT(1,I)**2 + X_AUT(2,I)**2 + X_AUT(3,I)**2
 30   CONTINUE
C
C====== Now calculate the observed reciprocal lattice points (b)
C
      DO 40 I = 1 , NOBS
         CALL LDM_DTOR (XC(1,I), XC(2,I), DS2_AUT(I), CTOF,
     +                   B_AUT(1,I), B_AUT(2,I), B_AUT(3,I))
 40   CONTINUE
C
C====== Now calculate the x-transpose.x matrix (a) and invert it (ai).
C
      DO 70 I = 1 , 3
         DO 60 J = 1 , 3
            A(I,J) = 0.
            DO 50 K = 1 , NOBS
               A(I,J) = A(I,J) + X_AUT(I,K)*X_AUT(J,K)
 50         CONTINUE
 60      CONTINUE
 70   CONTINUE
      CALL MINV_AUT(A,AI,ICOD)
C
C====== If the matrix was not inverted (determinant near zero)
C====== return immediately
C
      IF (ICOD.EQ.1) THEN
         IDET = 2
         RETURN
 
      END IF
C
C====== Now store in aaa the (a-transpose.a)inverted.a-transpose matrix
C
      DO 100 I = 1 , 3
         DO 90 J = 1 , NOBS
            AAA(I,J) = 0.
            DO 80 K = 1 , 3
               AAA(I,J) = AAA(I,J) + AI(I,K)*X_AUT(K,J)
 80         CONTINUE
 90      CONTINUE
 100  CONTINUE
C
C====== Now loop through the 3 sets of simultaneous equations, calculating
C====== the 3 vector solutions - stored in sol.
C
      DO 130 I = 1 , 3
         DO 120 J = 1 , 3
            SOL(I,J) = 0.
            DO 110 K = 1 , NOBS
               SOL(I,J) = SOL(I,J) + AAA(J,K)*B_AUT(I,K)
 110        CONTINUE
 120     CONTINUE
 130  CONTINUE
C
C====== Now unravel the actual rotation angles from the matrix sol.
C
      CALL FNDANG(SOL,ANG,NEWSOL,IDET,RMSD)
      IF (IDET.EQ.2) RETURN
C
C====== The rotation matrix derived from these angles is now in newsol.
C====== Apply it to get calculated film coordinates to compare with
C====== the observed ones.
C
      CALL EVCOOR(NEWSOL,XC,DEV,NOBS,IDET)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     EVCOOR           **
C**************************
C
C
      SUBROUTINE EVCOOR(NEWSOL,XC,DEV,NOBS,IDET)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Evaluate the film coords (xc(3-5,i)) from the standard r.l. coords
C          (x_aut) using the matrix (newsol), and returning rmsdev in dev.
C
C
C Author:  Modified version of M. Elder's routine
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C Arguments:
C
      REAL NEWSOL(3,3)
      REAL XC(5,MAX_AUTO_SPOTS)
      REAL DEV
      INTEGER NOBS
      INTEGER IDET
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL LDM_RTOD
C
C====== LOCALS:
C
      LOGICAL RECORDED
      REAL XF, YF, XX(3), CT, DSTAR2
      REAL RF
      INTEGER I,J
      REAL XTMP(3)
      INTEGER IFLAG, ND, IERR
      CHARACTER*2 ERRSTR
C
C-------------------------------------------------------------------------------
C
      DEV = 0.
      DO 30 I = 1 , NOBS
C
C====== Change the sign of the 3rd standard r.l. coordinate if det=-1
C
         IF (IDET.NE.0) THEN
            XTMP(3) = -X_AUT(3,I)
            XTMP(2) = -X_AUT(2,I)
            XTMP(1) = -X_AUT(1,I)
 
         ELSE
            XTMP(3) = X_AUT(3,I)
            XTMP(2) = X_AUT(2,I)
            XTMP(1) = X_AUT(1,I)
         END IF
 
         DO 20 J = 1 , 3
            XX(J) = NEWSOL(J,1)*XTMP(1) + NEWSOL(J,2)*XTMP(2)
     +              + NEWSOL(J,3)*XTMP(3)
 20      CONTINUE
         RF = DS2_AUT(I)/(2.0*XX(1))
         DSTAR2 = DS2_AUT(I)
         CALL LDM_GET_CTOF (IPACK, IPLATE, CT, IFLAG, ND, 
     +                      IERR, ERRSTR)
         RECORDED = LDM_RTOD (XX(1), XX(2), XX(3), DSTAR2, CT,
     +              XF, YF)
         XC(3,I) = XF
         XC(4,I) = YF
         XC(5,I) = -RF + XX(1)
         DEV = (XC(3,I)-XC(1,I))**2 + (XC(4,I)-XC(2,I))**2 + DEV
 30   CONTINUE
      DEV = SQRT(DEV/NOBS)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     EXAMINE_SPOTS    **
C**************************
C
C
      SUBROUTINE EXAMINE_SPOTS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Examine individual spots after integration
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'lirl_pars.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL IMG_DISP
      LOGICAL RESET_PLATE
      LOGICAL NODF
      LOGICAL SPAT
      LOGICAL BAD
      LOGICAL OVL
      INTEGER M_SHOW
      INTEGER M_SELI
      INTEGER M_INDX
      INTEGER M_DISMISS
      INTEGER IPACK_SAV
      INTEGER IPLATE_SAV
      INTEGER LISTE(2)
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER NUMSPOTS
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER MULT
      INTEGER I
      INTEGER ISPOT
      INTEGER IXSPOT
      INTEGER IYSPOT
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER NVALS
      INTEGER IVHLST2(2)
      REAL XFD
      REAL YFD
      REAL BLAM
      REAL DTHR
      REAL DSQMIN
      REAL DSQ
      REAL VALUES(20)
      CHARACTER*25 NAMES(4)
      CHARACTER*25 QUITNAM
      CHARACTER*80 ERRSTR
      CHARACTER*25 STR

C     LOGICAL IMG_DISP      !Image is currently displayed flag
C     LOGICAL RESET_PLATE   !Plate reset flag
C     LOGICAL NODF          !OK nodal flag
C     LOGICAL SPAT          !Spatially overlapped flag
C     LOGICAL BAD           !Bad spot flag
C     LOGICAL OVL           !Overload flag
C     INTEGER M_SHOW        !Menu item no.: Show Image
C     INTEGER M_SELI        !Menu item no.: Select From Image
C     INTEGER M_INDX        !Menu item no.: Select By Index
C     INTEGER M_DISMISS     !Menu item no.: Dismiss Image
C     INTEGER IPACK_SAV     !Save current pack
C     INTEGER IPLATE_SAV    !Save current plate
C     INTEGER LISTE(2)      !List of parameter table entries to be updated
C     INTEGER NVIEW         !No. of view-objects for getting events
C     INTEGER IVHLIST(2)    !List of view-object handles for getting events
C     INTEGER IVH           !Returned view-object handle from getting events
C     INTEGER ITEM          !Item no. from menu selection
C     INTEGER IQUIT         !Quit button flage from menu
C     INTEGER IERR          !Error flag
C     INTEGER NUMSPOTS      !No. of spots in LRL
C     INTEGER IXPIX         !'x' pixel position of selected spot
C     INTEGER IYPIX         !'y' pixel position of selected spot
C     INTEGER IH            !'h' index
C     INTEGER IK            !'k' index
C     INTEGER IL            !'l' index
C     INTEGER MULT          !Multiplicity
C     INTEGER I             !Temp/loop variable
C     INTEGER ISPOT         !Spot number
C     INTEGER IXSPOT        !Spot 'x' pixel position on image (predicted)
C     INTEGER IYSPOT        !Spot 'y' pixel position on image (predicted)
C     INTEGER JH            !Requested reflection 'h' index
C     INTEGER JK            !Requested reflection 'k' index
C     INTEGER JL            !Requested reflection 'l' index
C     INTEGER NVALS         !No. of input values
C     INTEGER IVHLST2(2)    !2'nd list of view-object handles
C     REAL YFD              !yf position of spot
C     REAL BLAM             !Lambda value of spot
C     REAL DTHR             !Dminthresholds2 value of spot
C     REAL DSQMIN           !Distance squared check
C     REAL DSQ              !Distance squared from sel. posn to predicted spot
C     REAL VALUES(20)       !Numerical values from input string
C     CHARACTER*25 NAMES(4) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string
C     CHARACTER*80 ERRSTR   !Error string
C     CHARACTER*25 STR      !Input string

      DATA NAMES /'Show Image',
     +            'Select From Image',
     +            'Select By Index',
     +            'Dismiss Image'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C
C====== Set up & process menu
C
      M_SHOW = 1
      M_SELI = 2
      M_INDX = 3
      M_DISMISS = 4
      IMG_DISP = .FALSE.
      RESET_PLATE = .FALSE.
      IF (INTEG_LASTPK.NE.IPACK.OR.INTEG_LASTPL.NE.IPLATE) THEN
         IPACK_SAV = IPACK
         IPLATE_SAV = IPLATE
         IPACK = INTEG_LASTPK
         IPLATE = INTEG_LASTPL
         CALL SET_PAR1_VALS (0, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
      END IF
      CALL LRL_GEN (IPACK, IPLATE, .FALSE., 2, IERR, ERRSTR)
      CALL LRL_NUMSPOTS (NUMSPOTS)
      IF (NUMSPOTS.EQ.0) THEN
         CALL ERR_NOTICE (1, '**No predicted spots**')
         IF (RESET_PLATE) THEN
            IPACK = IPACK_SAV
            IPLATE = IPLATE_SAV
            CALL SET_PAR1_VALS (0, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
         END IF
         RETURN 
      END IF  
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_FILM

50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 4, XDLSTR(NAMES), 25,
     +                         XDLSTR('Examine Spots Menu'), 18,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            IF (RESET_PLATE) THEN
               IPACK = IPACK_SAV
               IPLATE = IPLATE_SAV
               CALL SET_PAR1_VALS (0, LISTE)
               CALL SET_PAR2_VALS (0, LISTE)
            END IF   
            IF (IMG_DISP) CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            RETURN
         END IF 
C
C====== Show Image
C
         IF (ITEM.EQ.M_SHOW) THEN
            NVIEW = 1
            IF (IMG_DISP) THEN
               CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
               GO TO 100
            END IF
            CALL SHOW_IMAGE (1, IERR)
            IF (IERR.NE.0) GO TO 50
            IMG_DISP = .TRUE.
            GO TO 100
C
C====== Select From Image
C
         ELSE IF (ITEM.EQ.M_SELI) THEN
            IF (.NOT.IMG_DISP) THEN
               CALL SHOW_IMAGE (1, IERR)
               IF (IERR.NE.0) GO TO 50
               IMG_DISP = .TRUE.
            END IF
               CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     *              XDLSTR('Input Spot Position'), 19, IERR)
            NVIEW = 2
            GO TO 100
C
C====== Select By Index
C
         ELSE IF (ITEM.EQ.M_INDX) THEN
            IF (IMG_DISP) THEN
               CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            END IF
            NVIEW = 1
 150        CALL LPROMPT (IVH_IOW, 'Reflection Indices: ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, I)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(STR),
     +           25, IERR)
            CALL STRVAL (STR, ' ,', 20, VALUES, NVALS)
            IF (NVALS.EQ.0) THEN
               IF (IMG_DISP) THEN
                  CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
               END IF
               GO TO 100
            END IF
            IF (NVALS.NE.3) THEN
               CALL LMESSAGE(IVH_IOW,'**Invalid indices**')
               GO TO 150
            END IF
            JH = NINT(VALUES(1))
            JK = NINT(VALUES(2))
            JL = NINT(VALUES(3))
            ISPOT = 0
            DO 160 I = 1, NUMSPOTS
               CALL LRL_GET (I, IH, IK, IL, XFD, YFD, BLAM, DTHR, 
     +                    MULT, NODF, SPAT, IERR)
               IF (IH.EQ.JH.AND.IK.EQ.JK.AND.IL.EQ.JL) THEN
                  ISPOT = I
                  IXSPOT = NINT(XFD)
                  IYSPOT = NINT(YFD)
                  GO TO 170
               END IF
 160        CONTINUE
            CALL ERR_NOTICE (1,
     +           '**Reflection not found in predicted spots list**')
            IF (IMG_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
            END IF
            GO TO 100
 170        IF (IMG_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
               CALL XDLF_IMAGE_SYMBOL (IVH_FILM, IXSPOT, IYSPOT, 
     +                         ISYMBTYP(11), ICOLRTYP(11), 1, IERR)
            END IF
            CALL INTEG_SINGSPOT (ISPOT, IMG_DISP)
            GO TO 50
C
C====== Dismiss Image
C
         ELSE IF (ITEM.EQ.M_DISMISS) THEN
            IF (.NOT.IMG_DISP) GO TO 100
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            IMG_DISP = .FALSE.
            NVIEW = 1
            GO TO 100
         END IF
         GO TO 100
C
C====== Input from image
C
      ELSE IF (IVH.EQ.IVH_FILM) THEN
         CALL XDLF_IMAGE_GETPIX (IVH_FILM, IXPIX, IYPIX, IERR)
         CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
         ISPOT = 0
         DSQMIN = 18.0*NCMP*NCMP
         DO 200 I = 1, NUMSPOTS
            CALL LRL_GET (I, IH, IK, IL, XFD, YFD, BLAM, DTHR, 
     +                    MULT, NODF, SPAT, IERR)
            DSQ = (IXPIX-XFD)*(IXPIX-XFD) + (IYPIX-YFD)*(IYPIX-YFD)
            IF (DSQ.LT.DSQMIN) THEN
               ISPOT = I
               IXSPOT = NINT(XFD)
               IYSPOT = NINT(YFD)
               DSQMIN = DSQ
            END IF
 200     CONTINUE
         IF (ISPOT.EQ.0) THEN
            CALL ERR_NOTICE (0,
     +      '**No predicted spot close to selected position**')
            GO TO 100
         END IF
         CALL XDLF_IMAGE_SYMBOL (IVH_FILM, IXSPOT, IYSPOT, 
     +                           ISYMBTYP(11), ICOLRTYP(11), 1, IERR)
         CALL INTEG_SINGSPOT (ISPOT, IMG_DISP)
         GO TO 50
      END IF
      GO TO 100
      END
C LAST UPDATE:
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**       FACTOR_INDEX        **
C*******************************
C
C
      SUBROUTINE FACTOR_INDEX (H, K, L)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: To factor out the HCF of 3 indices.
C
C Author:  Based on code from GENLAUE by Clifton et al.
C
C Arguments:
C
      INTEGER   H
      INTEGER   K
      INTEGER   L
C
C H   (M)    h index
C K   (M)    k index
C L   (M)    l index
C
C====== FUNCTION TYPES:
C
      INTEGER HCF
C
C====== LOCALS:
C
      INTEGER HCF1, HCF2
C
C------------------------------------------------------------------------------
C
      HCF1 = HCF(H,K)
      HCF2 = HCF(HCF1,L)
      H = H/HCF2
      K = K/HCF2
      L = L/HCF2
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     FILM_CENTRE      **
C**************************
C
C
      SUBROUTINE FILM_CENTRE (X_CEN_F,Y_CEN_F,OMEGA)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check/get film centre from fids or input values
C
C Author:  John W. Campbell, January 1992
C
C **** Assumes that CHK_OPN has been called previously ****
C
C Arguments:
C
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL OMEGA
C     
C X_CEN_F  (W)   X centre position (raster units)
C Y_CEN_F  (W)   Y centre position (raster units)
C OMEGA    (W)   Omega offset (degrees) (Now all contained in W_C)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IRETN
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      INTEGER IFID
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER LISTE(2)
      REAL F_THRESH
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR
C
C     INTEGER IXROOT      !Root X position for pop-up notice
C     INTEGER IYROOT      !Root Y position for pop-up notice
C     INTEGER IRETN       !Return flag from pop-up notice
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER ND          !Number of decimal places flag
C     INTEGER IERR        !Error flag
C     INTEGER IFID        !Fiducials present flag
C     INTEGER NXRAST      !No. of x-rasters
C     INTEGER NYRAST      !No. of y-rasters
C     INTEGER LISTE(2)    !Parameters reset flags
C     REAL F_THRESH       !Fiducials threshold
C     CHARACTER*2 VALSTR  !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR  !Error string (dummy)
C     CHARACTER*80 STR    !Message string
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_XCENF (IPACK, IPLATE, X_CEN_F, IFLAG, ND,
     +                    IERR, ERRSTR)
      CALL LDM_GET_YCENF (IPACK, IPLATE, Y_CEN_F, IFLAG, ND,
     +                    IERR, ERRSTR)
      IF (X_CEN_F.GT.0.0.AND.Y_CEN_F.GT.0.0) THEN
         CALL LDM_GET_WC (IPACK, IPLATE, OMEGA, IFLAG, ND,
     +                    IERR, ERRSTR)
         RETURN
      END IF
      CALL LDM_GET_FIDT (VALSTR, IFID, IFLAG)
      IF (IFID.EQ.1) THEN
         CALL LDM_GET_FTHR (F_THRESH, IFLAG, ND)
         CALL GET_FIDS (F_THRESH, IERR)
         CALL LDM_GET_XCENF (IPACK, IPLATE, X_CEN_F, IFLAG, ND,
     +                    IERR, ERRSTR)
         CALL LDM_GET_YCENF (IPACK, IPLATE, Y_CEN_F, IFLAG, ND,
     +                    IERR, ERRSTR)
      ELSE
         STR = '*Warning* Using image mid-point as centre for pack'
         CALL STR_ADDI (STR, IPACK, 1)
         CALL STR_ADDS (STR, ', plate',0)
         CALL STR_ADDI (STR, IPLATE, 1)
         CALL LOG_MSG (IVH_IOW, STR, 1)
         CALL LDM_GET_NXRAS (NXRAST, IFLAG)
         CALL LDM_GET_NYRAS (NYRAST, IFLAG)
         X_CEN_F = NXRAST/2.0
         Y_CEN_F = NYRAST/2.0
         CALL LDM_SET_XCENF (IPACK, IPLATE, X_CEN_F, IERR, ERRSTR)
         CALL LDM_SET_YCENF (IPACK, IPLATE, Y_CEN_F, IERR, ERRSTR)
         IF (LG_MODE.EQ.1) THEN
            LISTE(1) = IP_XCENF
            LISTE(2) = IP_YCENF
            CALL SET_PAR2_VALS(2, LISTE)
         END IF
      END IF
      CALL LDM_GET_WC (IPACK, IPLATE, OMEGA, IFLAG, ND,
     +                 IERR, ERRSTR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     FIND_SEL_NODS    **
C**************************
C
C
      SUBROUTINE FIND_SEL_NODS (ITYP, IRAISE, IOPT, IHIST, IHM, 
     +           IKM, ILM)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Find nodal reflections and select index for nodal
C          selection for refinement etc.
C
C Author:  Based on code from FIND_NODALS from GENLAUE by Clifton et al.
C
C Arguments:
C
      INTEGER ITYP
      INTEGER IRAISE
      INTEGER IOPT
      INTEGER IHIST
      INTEGER IHM, IKM, ILM
C
C ITYP    (R)  Flag =1 using main base frame / io-window
C                   =2 using auto-indexing solutions base frame / io-window
C IRAISE  (R)  Flag =0 no raising of windows required
C                   =1 raise I/O window at start and film-image at end
C IOPT    (R)  Option flag = 0 Use h,k,l limits given
C                          = 1 Request input of nodal index limit
C                          = 2 Request input of nodal h, k, l limits
C IHIST   (R)  Histogram flag = 0 Do not display nodals histogram
C                             = 1 Display nodals histogram
C IHM, IKM, ILM (R) Nodal index maxima for h, k, l (only used if IOPT=0)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'selrefs.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NBITST
      INTEGER NODAL_INDEX
      INTEGER HCF
C
C====== LOCALS:
C
      LOGICAL    SPAT, NODFLG
      INTEGER    JH, JK, JL
      INTEGER    OFFSET
      INTEGER    IVH_IOW_USE
      INTEGER    IVH_BASE_USE
      INTEGER    NODALS(2*MAX_HKL_LIMIT+1, 2*MAX_HKL_LIMIT+1, 
     +                  2*MAX_HKL_LIMIT+1)
      INTEGER    I, J, SEL_NODAL_HKL
      INTEGER    SEL_NODAL_H, SEL_NODAL_K, SEL_NODAL_L
      INTEGER    H, K, L, HCF1, HCF2
      INTEGER    NODAL_HIST(20)
      INTEGER    NOD_IDX
      INTEGER    NUMSPOTS
      INTEGER    IERR
      INTEGER    NL, NLIN
      INTEGER    MULT
      REAL       XFD, YFD, ALAM, DTHR2
      CHARACTER*80 STR
C
C------------------------------------------------------------------------------
C
C====== Initialisations
C
      CALL LRL_NUMSPOTS (NUMSPOTS)
      IVH_IOW_USE = IVH_IOW
      IF (ITYP.EQ.2) IVH_IOW_USE = IVH_IOW_AUT
      IVH_BASE_USE = IVH_BASE
      IF (ITYP.EQ.2) IVH_BASE_USE = IVH_BASE_AUT
      SEL_NODAL_H = IABS(IHM)
      SEL_NODAL_K = IABS(IKM)
      SEL_NODAL_L = IABS(ILM)
      IF (SEL_NODAL_H.GT.MAX_HKL_LIMIT) SEL_NODAL_H = MAX_HKL_LIMIT
      IF (SEL_NODAL_K.GT.MAX_HKL_LIMIT) SEL_NODAL_K = MAX_HKL_LIMIT
      IF (SEL_NODAL_L.GT.MAX_HKL_LIMIT) SEL_NODAL_K = MAX_HKL_LIMIT
      OFFSET=MAX_HKL_LIMIT+1
      DO 20 I = 1 , MAX_HKL_LIMIT
         NODAL_HIST(I) = 0
 20   CONTINUE
C
C====== Clear array of pointers
C
      DO 50 K = 1 , 2*MAX_HKL_LIMIT+1
         DO 40 J = 1 , 2*MAX_HKL_LIMIT+1
            DO 30 I = 1 , 2*MAX_HKL_LIMIT+1
               NODALS(I,J,K) = 0
 30         CONTINUE
 40      CONTINUE
 50   CONTINUE
C
C====== Find the nodals
C
      IF (NUMSPOTS.GT.0) THEN
         DO 60 I = 1 , NUMSPOTS
            CALL LRL_GET (I, JH, JK, JL, XFD, YFD, ALAM, 
     +                    DTHR2, MULT, NODFLG, SPAT, IERR)
            H = JH
            K = JK
            L = JL
 
            NOD_IDX = NODAL_INDEX(H,K,L)
            IF (NOD_IDX.LE.MAX_HKL_LIMIT) THEN
C
C====== Check if it was a spatial
C
               IF (.NOT.SPAT) THEN
C
C====== Found a nodal!
C
                  CALL FACTOR_INDEX(H,K,L)
                  IF (NODALS(H+OFFSET,K+OFFSET,L+OFFSET).EQ.0) THEN
C
C====== Inc the histogram (but count distinct nodals)
C======                              --------
C
                     NODAL_HIST(NOD_IDX) = NODAL_HIST(NOD_IDX) + 1
                  END IF
                  NODALS(H+OFFSET,K+OFFSET,L+OFFSET) = I
               END IF
            END IF
 60      CONTINUE
      END IF
      IF (IRAISE.EQ.1) CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE_USE,
     +                           IERR)
C
C====== Calc cumulative totals
C
      DO 70 I = 1 , MAX_HKL_LIMIT - 1
         NODAL_HIST(I+1) = NODAL_HIST(I+1) + NODAL_HIST(I)
 70   CONTINUE
C
C====== Output histogram if required
C
      IF (IHIST.EQ.1) THEN 
         CALL LMESSAGE(IVH_IOW_USE,'Histogram of nodal spots')
         CALL LMESSAGE(IVH_IOW_USE,'========================')
         NLIN = (MAX_HKL_LIMIT+3)/4
         I = 0
         DO 80 NL = 1, NLIN
            K = 1
            STR = ' '
            DO 75 J = 1, 4
               I = I + 1
               IF (I.LE.MAX_HKL_LIMIT) THEN
                  CALL STR_ADDI(STR(K:),I,0)
                  IF (I.LT.10) THEN
                     CALL STR_ADDI(STR(K:),NODAL_HIST(I),3)
                  ELSE
                     CALL STR_ADDI(STR(K:),NODAL_HIST(I),2)
                  END IF
               END IF
               K = K + 15
75          CONTINUE
            CALL LMESSAGE(IVH_IOW_USE,STR)
80       CONTINUE
      END IF
C
C====== Input selection criteria if required
C
      IF (IOPT.EQ.1) THEN
 90      SEL_NODAL_HKL = 4
         CALL IOW_ASKI(IVH_IOW_USE,'Nodal spot selection index',
     +                 SEL_NODAL_HKL)
         IF (SEL_NODAL_HKL.LT.1) THEN
            CALL LMESSAGE(IVH_IOW_USE,'**Must be greater than 0**')
            GO TO 90
         END IF
         IF (SEL_NODAL_HKL.GT.MAX_HKL_LIMIT) THEN
            STR = '**Must be less than or equal to'
            CALL STR_ADDI(STR,MAX_HKL_LIMIT,1)
            CALL STR_ADDS(STR,'**',0)
            CALL LMESSAGE(IVH_IOW_USE,STR)
            GO TO 90
         END IF
         SEL_NODAL_H = SEL_NODAL_HKL
         SEL_NODAL_K = SEL_NODAL_HKL
         SEL_NODAL_L = SEL_NODAL_HKL
      ELSE IF (IOPT.EQ.2) THEN
 92      SEL_NODAL_H = 4
         CALL IOW_ASKI(IVH_IOW_USE,'Nodal spot selection h index',
     +                 SEL_NODAL_H)
         IF (SEL_NODAL_H.LT.1) THEN
            CALL LMESSAGE(IVH_IOW_USE,'**Must be greater than 0**')
            GO TO 92
         END IF
         IF (SEL_NODAL_H.GT.MAX_HKL_LIMIT) THEN
            STR = '**Must be less than or equal to'
            CALL STR_ADDI(STR,MAX_HKL_LIMIT,1)
            CALL STR_ADDS(STR,'**',0)
            CALL LMESSAGE(IVH_IOW_USE,STR)
            GO TO 92
         END IF
 94      SEL_NODAL_K = 4
         CALL IOW_ASKI(IVH_IOW_USE,'Nodal spot selection k index',
     +                 SEL_NODAL_K)
         IF (SEL_NODAL_K.LT.1) THEN
            CALL LMESSAGE(IVH_IOW_USE,'**Must be greater than 0**')
            GO TO 94
         END IF
         IF (SEL_NODAL_K.GT.MAX_HKL_LIMIT) THEN
            STR = '**Must be less than or equal to'
            CALL STR_ADDI(STR,MAX_HKL_LIMIT,1)
            CALL STR_ADDS(STR,'**',0)
            CALL LMESSAGE(IVH_IOW_USE,STR)
            GO TO 94
         END IF
 96      SEL_NODAL_L = 4
         CALL IOW_ASKI(IVH_IOW_USE,'Nodal spot selection l index',
     +                 SEL_NODAL_L)
         IF (SEL_NODAL_L.LT.1) THEN
            CALL LMESSAGE(IVH_IOW_USE,'**Must be greater than 0**')
            GO TO 96
         END IF
         IF (SEL_NODAL_L.GT.MAX_HKL_LIMIT) THEN
            STR = '**Must be less than or equal to'
            CALL STR_ADDI(STR,MAX_HKL_LIMIT,1)
            CALL STR_ADDS(STR,'**',0)
            CALL LMESSAGE(IVH_IOW_USE,STR)
            GO TO 96
         END IF
      END IF
C
C====== Now assign found nodal spots to the sel_nodals vector
C
      NUM_SELECT = 0
      DO 120 K = OFFSET - SEL_NODAL_H , OFFSET + SEL_NODAL_H
         DO 110 J = OFFSET - SEL_NODAL_K , OFFSET + SEL_NODAL_K
            DO 100 I = OFFSET - SEL_NODAL_L , OFFSET + SEL_NODAL_L
               IF (NODALS(I,J,K).NE.0) THEN
                  NUM_SELECT = NUM_SELECT + 1
                  IF (NUM_SELECT.LE.MAX_OBS) THEN
                     SEL_REFS(NUM_SELECT) = NODALS(I,J,K)
                  END IF
                  IF (NUM_SELECT.EQ.MAX_OBS+1) THEN
                     STR = '**Number of refinement'//
     +                     ' reflections truncated to'
                     CALL STR_ADDI(STR,MAX_OBS,1)
                     CALL STR_ADDS(STR,'**',0)
                     CALL ERR_NOTICE(0,STR)
                  END IF
               END IF
 100        CONTINUE
 110     CONTINUE
 120  CONTINUE
 
      NUM_SELECT = MIN(NUM_SELECT,MAX_OBS)
 
      WRITE (STR,'(I8)') NUM_SELECT
      CALL LJUST(STR)
      CALL STR_ADDS(STR,'nodal spots',1)
      CALL LMESSAGE(IVH_IOW_USE,STR)
      IF (IRAISE.EQ.1) CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     FNDANG           **
C**************************
C
C
      SUBROUTINE FNDANG(A,ANG,B,IDET,RMSD)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Find missetting angles
C
C====== A contains a matrix with the following form
C
C====== cy.cz       sx.sy.cz - cx.sz    cx.sy.cz + sx.sz
C
C====== cy.sz       sx.sy.sz + cx.cz    cx.sy.sz - sx.cz
C
C====== -sy              sx.cy               cx.cy
C
C====== and on return ang should contain the corresponding angles - x,y,z
C====== cy stands for cos(y), etc.
C
C Author:  Modified version of M. Elder's routine
C
C Arguments:
C
      REAL A(3,3)
      REAL ANG(3)
      REAL B(3,3)
      INTEGER IDET
      REAL RMSD
C
C IDET      = 0 OK
C           = 1 Determinant was -1 so matrix signs were reversed 
C           = 2 Transformation matrix not a true rotation matrix
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      LOGICAL ADJUST
      REAL ADET,CON,CY,DET,PI,SY,X,XMZ,XPZ,Y,Z
      INTEGER I,J
C
C-------------------------------------------------------------------------------
C
      PI = 3.14159265
C
C====== First check for det=1 for true rotation matrix
C
      IDET = 0
      DET = A(1,1)*A(2,2)*A(3,3) + A(1,2)*A(2,3)*A(3,1) + A(1,3)*A(2,1)
     +      *A(3,2) - A(1,2)*A(2,1)*A(3,3) - A(1,1)*A(2,3)*A(3,2)
     +      - A(1,3)*A(2,2)*A(3,1)
      ADET = ABS(DET)
      IF (ABS(1.0-ADET).GT.0.1) THEN
         IDET = 2
         RETURN
      END IF
      IF (DET.LT.0.0) THEN
         DO 30 I = 1 , 3
            DO 20 J = 1 , 3
               A(I,J) = -A(I,J)
 20         CONTINUE
 30      CONTINUE
         IDET = 1
      END IF
C
C====== Evaluate y from a(3,1): range -pi/2 to +pi/2
C====== There is an ambiguity since pi-y gives same sin, but this is
C====== taken care of by x and z each +pi
C
      ANG(2) = ASIN(-A(3,1))
C
C====== Guard against cy very close to zero
C
      IF ((1.-ABS(A(3,1))).GT.0.001) THEN
         ANG(1) = ATAN2(A(3,2),A(3,3))
         ANG(3) = ATAN2(A(2,1),A(1,1))
         XPZ = ATAN2(-(A(1,2)+A(2,3)),-(A(1,3)-A(2,2)))
         XMZ = ATAN2((A(1,2)-A(2,3)),(A(1,3)+A(2,2)))
         X = 0.5*(XPZ+XMZ)
         Z = 0.5*(XPZ-XMZ)
         IF (ABS(ANG(1)-X).GT.0.1) THEN
            IF (ANG(1).GT.X) CON = PI
            IF (ANG(1).LT.X) CON = -PI
            X = X + CON
         END IF
 
         IF (ABS(ANG(3)-Z).GT.0.1) THEN
            IF (ANG(3).GT.Z) CON = PI
            IF (ANG(3).LT.Z) CON = -PI
            Z = Z + CON
         END IF
 
         ANG(1) = 0.5*(ANG(1)+X)
         ANG(3) = 0.5*(ANG(3)+Z)
C
C====== Adjust angle 2 unless special cases of ANG(1) & ANG(3) with
C====== zero sines or cosines (Extra check put in by jwc 31/1/96)
C
         ADJUST = .TRUE.
         IF (ABS(SIN(ANG(1))).LT.0.00001) ADJUST = .FALSE.
         IF (ABS(COS(ANG(1))).LT.0.00001) ADJUST = .FALSE.
         IF (ABS(SIN(ANG(3))).LT.0.00001) ADJUST = .FALSE.
         IF (ABS(COS(ANG(3))).LT.0.00001) ADJUST = .FALSE.
         IF (ABS(SIN(ANG(1)+ANG(3))).LT.0.00001) ADJUST = .FALSE.
         IF (ABS(COS(ANG(1)+ANG(3))).LT.0.00001) ADJUST = .FALSE.
         IF (ADJUST) THEN
            CY = 0.25*(A(3,3)/COS(ANG(1))+A(3,2)/SIN(ANG(1))+A(1,1)
     +           /COS(ANG(3))+A(2,1)/SIN(ANG(3)))
            SY = 0.5*((A(1,2)+A(2,3))/SIN(ANG(1)+ANG(3))
     +           +1+(A(1,3)-A(2,2))/COS(ANG(1)+ANG(3))+1)
            Y = ATAN2(SY,CY)
            ANG(2) = (ANG(2)+2.*Y)/3.
         END IF
      ELSE IF (A(3,1).LT.0.0) THEN
C
C====== This is the case when y=pi/2, sy=1, cy=0. The top right 2*2 of the
C====== a matrix has terms s(x-z),c(x-z)/c(x-z),-s(x-z). Assume z=0.
C====== ( lt above changed from gt by Pella Aug 86)
C
         ANG(1) = ATAN2((A(1,2)-A(2,3)),(A(1,3)+A(2,2)))
         ANG(3) = 0.
 
      ELSE
C
C====== This is the case when y=-pi/2, sy=-1, cy=0. The top right 2*2 of
C====== the a matrix has terms -s(x+z),-c(x+z)/c(x+z),-s(x+z). Assume z=0.
C
         ANG(1) = ATAN2((-A(1,2)-A(2,3)),(-A(1,3)+A(2,2)))
         ANG(3) = 0.
      END IF
C
C====== Evaluate the true rotation matrix, angles in degrees.
C
      DO 40 I = 1 , 3
         ANG(I) = ANG(I)*180./PI
 40   CONTINUE
      CALL EROTMT(ANG,B,A,RMSD)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GDIST_FN         **
C**************************
C
C
      SUBROUTINE GDIST_FN (M,N,FVECC,X)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Calculate distances of points from lines for gnomonic centre
C          determination
C
C Author:  John W. Campbell, February 1993
C
C Arguments:
C
      INTEGER M
      INTEGER N
      DOUBLE PRECISION FVECC(M)
      DOUBLE PRECISION X(N)
C
C M          (R)  No. of observations
C N          (R)  No. of parameters
C FVECC      (W)  The M calculated function values
C X          (R)  The current parameter values
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'conics.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER I
      INTEGER J
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL CTOF
      DOUBLE PRECISION R
      DOUBLE PRECISION RR
      DOUBLE PRECISION TWOTH
      DOUBLE PRECISION THG
      DOUBLE PRECISION XG(3)
      DOUBLE PRECISION YG(3)
      DOUBLE PRECISION Q
      DOUBLE PRECISION CRHO
      DOUBLE PRECISION SRHO
      DOUBLE PRECISION PIOV2
      CHARACTER*2 ERRSTR

C     INTEGER I               !Loop variable (over observations)
C     INTEGER J               !Loop variable (over set of 3 points)
C     INTEGER IFLAG           !Parameter status flag
C     INTEGER ND              !No. of decimal places flag
C     INTEGER IERR            !Error flag
C     REAL MM_RAST_X          !Conversion factor mm to x-rasters
C     REAL MM_RAST_Y          !Conversion factor mm to y-rasters
C     REAL CTOF               !Crystal-film distance
C     DOUBLE PRECISION R      !Distance of centre of unconverted spot
C     DOUBLE PRECISION RR     !Distance from centre of converted spot
C     DOUBLE PRECISION TWOTH  !2*theta value of spot
C     DOUBLE PRECISION THG    !90-theta value for gnomonic coords.
C     DOUBLE PRECISION XG(3)  !Gnomonic 'x' coords of line and point
C     DOUBLE PRECISION YG(3)  !Gnomonic 'y' coords of line and point
C     DOUBLE PRECISION Q      !Distance between end points of line
C     DOUBLE PRECISION CRHO   !cos(rho) (rho = rotation angle of line wrt x)
C     DOUBLE PRECISION SRHO   !sin(rho)
C     DOUBLE PRECISION PIOV2  !Pi/2.0
C     CHARACTER*2 ERRSTR      !Error string (dummy)
C
      DATA PIOV2/1.5707963/
C
C-------------------------------------------------------------------------------
C
C
C====== Three points are associated with each line; points 1 and 3 are the
C====== end points; point 2 is the point whose distance from the line is
C====== determined for the minimisation to get the best centre position.
C
      CALL LDM_GET_CTOF (IPACK, IPLATE, CTOF, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      DO 20 I = 1, M
         DO 10 J = 1,3
            R = SQRT((XCONIC(J,I)-X(1))**2 + (YCONIC(J,I)-X(2))**2)
            TWOTH = ATAN (R/(CTOF*MM_RAST_X))
            THG = PIOV2 - TWOTH/2.0
            RR = CTOF*MM_RAST_X*TAN(THG)
            XG(J) = X(1) + (XCONIC(J,I)-X(1))*RR/R
            YG(J) = X(2) + (YCONIC(J,I)-X(2))*RR/R
10       CONTINUE
         Q = SQRT((XG(3)-XG(1))**2+(YG(3)-YG(1))**2)
         CRHO = (XG(3)-XG(1))/Q
         SRHO = (YG(3)-YG(1))/Q
         FVECC(I) = (YG(2)-YG(1))*CRHO - (XG(2)-XG(1))*SRHO
20    CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GET_FIDS         **
C**************************
C
C
      SUBROUTINE GET_FIDS (F_THRESH, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get fids (if required and not already found) for current film/plate
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
      REAL F_THRESH
      INTEGER IERR
C
C F_THRESH  (R)   Starting threshold for fids search
C     IERR  (W)   Error flag =0 OK,
C                            =1 Found on retry
C                            =2 Found on 2'nd retry
C                            =3 Not found or other error (centre set to
C                               image mid point)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER KERR
      INTEGER I
      INTEGER NF_FID
      INTEGER ITHRESH
      INTEGER NOVER
      INTEGER IXC
      INTEGER IYC
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ND
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER JERR
      INTEGER LISTE(3)
      INTEGER IORD
      INTEGER ISWAP
      INTEGER NTRIES
      REAL FIDBOX
      REAL RASTER
      REAL FIDX(3)
      REAL FIDY(3)
      REAL FIDX1
      REAL FIDY1
      REAL FIDX2
      REAL FIDY2
      REAL FIDX3
      REAL FIDY3
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL W_F
      REAL CGX
      REAL CGY
      REAL BOX
      REAL F_THR
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL XHALF
      REAL YHALF
      CHARACTER*80 STR
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     INTEGER KERR             !Error flag
C     INTEGER I                !Temp/loop variable
C     INTEGER NF_FID           !No. of fids found
C     INTEGER ITHRESH          !Threshold for fids search
C     INTEGER NOVER            !No. pixel values over theshold
C     INTEGER IXC              !Pixel x centre of search box
C     INTEGER IYC              !Pixel y centre of search box
C     INTEGER IXSIZ            !Half size x of search box
C     INTEGER IYSIZ            !Half size y of search box
C     INTEGER IVAL             !Integer parameter value
C     INTEGER IFLAG            !Parameter status flag
C     INTEGER ND               !Number of decimal places flag
C     INTEGER NXRAST           !No. x-rasters
C     INTEGER NYRAST           !No. y-rasters
C     INTEGER NF_OFF           !Offset between start of slow rasters in image
C     INTEGER JERR             !Error flag
C     INTEGER LISTE(3)         !Parameter reset flags
C     INTEGER IORD             !Axis order flag 1-8
C     INTEGER ISWAP            !Byte swap flag
C     INTEGER NTRIES           !No. of tries at finding fiducials
C     REAL FIDBOX              !Fids box size in mm.
C     REAL RASTER              !Raster size (microns)
C     REAL FIDX(3)             !Found fid x positions
C     REAL FIDY(3)             !Found fid y positions
C     REAL FIDX1               !Fiducial search positions
C     REAL FIDY1               ! "
C     REAL FIDX2               ! "
C     REAL FIDY2               ! "
C     REAL FIDX3               ! "
C     REAL FIDY3               ! "
C     REAL X_CEN_F             !Plate x-centre (rasters)
C     REAL Y_CEN_F             !Plate y-centre (rasters)
C     REAL W_F                 !Omega-f
C     REAL CGX                 !Centre of gravity x of found fid
C     REAL CGY                 !Centre of gravity y of found fid
C     REAL BOX                 !Current size of seach box (mm)
C     REAL F_THR               !Current threshold value
C     REAL MM_RAST_X           !mm to x-rasters conversion
C     REAL MM_RAST_Y           !mm to y-rasters conversion
C     REAL XHALF               !x mid-point of image
C     REAL YHALF               !y mid-point of image
C     CHARACTER*80 STR         !Message string
C     CHARACTER*2 VALSTR       !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR       !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      CALL LDM_GET_FIDT (VALSTR, IVAL, IFLAG)
      IF (IVAL.EQ.0) RETURN
      CALL LDM_GET_FBOX (FIDBOX, IFLAG, ND)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CALL LDM_GET_XCENF (IPACK, IPLATE, X_CEN_F, IFLAG, ND,
     +                    JERR, ERRSTR)
      CALL LDM_GET_YCENF (IPACK, IPLATE, Y_CEN_F, IFLAG, ND,
     +                    JERR, ERRSTR)
      IF (X_CEN_F.GT.0.0.OR.Y_CEN_F.GT.0.0) RETURN
      CALL LDM_GET_RAST (RASTER, IFLAG, ND)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      XHALF = NXRAST/2.0
      YHALF = NYRAST/2.0
      STR = 'Finding fiducials for pack'
      CALL STR_ADDI (STR, IPACK, 1)
      CALL STR_ADDS (STR, ', plate',0)
      CALL STR_ADDI (STR, IPLATE,1)
      CALL LOG_HEAD (STR, 1)
      IF (.NOT.FILM_READ) THEN
         CALL READ_IMAGE (0, IMG, MAX_IMG_WORDS, ITYPE, NF_OFF, 
     +                    JERR, ERRSTR)
         IF (.NOT.FILM_READ) THEN
            CALL LOG_MSG (IVH_IOW, 
     +           '**Error** Unable to read image file',1)
            GO TO 800
         END IF
      END IF
      NTRIES = 1
      NF_FID = 0
      BOX = FIDBOX
      F_THR = F_THRESH
      GO TO 150
C
C====== Modify threshold for retry
C
100   IF (NTRIES.EQ.3) GO TO 800
      NTRIES = NTRIES + 1
      F_THR = 0.5*F_THR
      STR = 'Retrying with lowered threshold of'
      CALL STR_ADDF (STR,F_THR,1,1)
      CALL LOG_MSG (IVH_IOW,STR,1)
      IERR = NTRIES - 1
      NF_FID = 0
C
C====== Search for fids
C
150   IXSIZ = NINT (1000.0*BOX)/RASTER
      IXSIZ = IXSIZ/2
      IF (IXSIZ.GT.MAX_HALF_BOX) THEN
         CALL LOG_MSG(IVH_IOW,
     +        '**Error** Fid box size too large for program',1)        
         GO TO 800
      END IF
      IYSIZ = NINT (1000.0*BOX)/RASTER
      IYSIZ = IYSIZ/2
      IF (IYSIZ.GT.MAX_HALF_BOX) THEN
         CALL LOG_MSG(IVH_IOW,
     +        '**Error** Fid box size too large for program',1)
         GO TO 800
      END IF
      ITHRESH = NINT(F_THR)
      CALL CHK_OPN (KERR)
      IF (KERR.GT.0) THEN
         CALL LOG_MSG(IVH_IOW,'**Error** cannot open image file',1)
         GO TO 800
      END IF
      DO 200 I=1,3
         IF (I.EQ.1) THEN
            CALL LDM_GET_FIDX1 (FIDX1, IFLAG, ND)
            CALL LDM_GET_FIDY1 (FIDY1, IFLAG, ND)
            IXC = NINT(XHALF + FIDX1*MM_RAST_X/100.0)
            IYC = NINT(YHALF + FIDY1*MM_RAST_Y/100.0)
         ELSE IF (I.EQ.2) THEN
            CALL LDM_GET_FIDX2 (FIDX2, IFLAG, ND)
            CALL LDM_GET_FIDY2 (FIDY2, IFLAG, ND)
            IXC = NINT(XHALF + FIDX2*MM_RAST_X/100.0)
            IYC = NINT(YHALF + FIDY2*MM_RAST_Y/100.0)
         ELSE IF (I.EQ.3) THEN
            CALL LDM_GET_FIDX3 (FIDX3, IFLAG, ND)
            CALL LDM_GET_FIDY3 (FIDY3, IFLAG, ND)
            IXC = NINT(XHALF + FIDX3*MM_RAST_X/100.0)
            IYC = NINT(YHALF + FIDY3*MM_RAST_Y/100.0)
         ENDIF
         STR = 'Searching for fiducial number'
         CALL STR_ADDI (STR, I, 1)
         CALL LOG_MSG (IVH_IOW,STR,1)
         CALL SPOT_C_OF_G (IXC, IYC, IXSIZ, IYSIZ, ISPOT_DATA, 
     +                     ISWORK, ITHRESH, IMG, ITYPE, IORD, 
     +                     NFRASTS, NXRAST, NYRAST, NOVER, 
     +                     CGX,CGY,KERR)
         IF (KERR.LT.0) THEN
            CALL LOG_MSG (IVH_IOW,
     +      '**Error** Invalid spot_c_of_g call',1)
            GO TO 800
         ELSE IF (KERR.EQ.2) THEN
            CALL LOG_MSG (IVH_IOW,
     +           '**Error** Fid box outside range of image',1)
            GO TO 800
         ELSE IF (NOVER.EQ.0) THEN
            CALL LOG_MSG (IVH_IOW,
     +           '**Error** No pixels above threshold',0)
            GO TO 200
         ELSE
            FIDX (I) = CGX
            FIDY (I) = CGY
            NF_FID = NF_FID + 1
         STR = 'Fiducial found at x ='
         CALL STR_ADDF (STR, CGX, 1, 1)
         CALL STR_ADDS (STR,', y =',0)
         CALL STR_ADDF (STR, CGY, 1,1)
         CALL LOG_MSG (IVH_IOW, STR,0)
         ENDIF
200   CONTINUE
      IF (NF_FID.EQ.3) THEN
         X_CEN_F = (FIDX(1)+FIDX(3))/2.0
         Y_CEN_F = (FIDY(1)+FIDY(3))/2.0
         W_F = (FIDY(3)-FIDY(2)) / (FIDX(3)-FIDX(2))
         W_F = 57.29578*ATAN(W_F)
         CALL LDM_SET_XCENF (IPACK, IPLATE, X_CEN_F, IERR, ERRSTR)
         CALL LDM_SET_YCENF (IPACK, IPLATE, Y_CEN_F, IERR, ERRSTR)
         CALL LDM_SET_WC (IPACK, IPLATE, W_F, IERR, ERRSTR)
         IF (LG_MODE.EQ.1) THEN
            LISTE(1) = IP_XCENF
            LISTE(2) = IP_YCENF
            LISTE(3) = IP_WC
            CALL SET_PAR2_VALS(3, LISTE)
         END IF
      ELSE
         STR = '**Error** Only'
         CALL STR_ADDI(STR, NF_FID, 1)
         CALL STR_ADDS(STR,'fiducials found',1)
         CALL LOG_MSG (IVH_IOW,STR,1)
         GO TO 100
      END IF
      RETURN
C
C====== Error conditions, reset centre to mid point of image
C
800   IERR = 3
      CALL LOG_MSG (IVH_IOW, 
     +     '*Warning* Using image mid-point as centre',1)
      X_CEN_F = NXRAST/2.0
      Y_CEN_F = NYRAST/2.0
      CALL LDM_SET_XCENF (IPACK, IPLATE, X_CEN_F, IERR, ERRSTR)
      CALL LDM_SET_YCENF (IPACK, IPLATE, Y_CEN_F, IERR, ERRSTR)
      IF (LG_MODE.EQ.1) THEN
         LISTE(1) = IP_XCENF
         LISTE(2) = IP_YCENF
         CALL SET_PAR2_VALS(2, LISTE)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GET_FILNAM       **
C**************************
C
C
      SUBROUTINE GET_FILNAM (KFILM,FILNAM,IPOSL,IFLAG)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Read in (/expand file name)   A reply of ! indicates a missing file
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
      INTEGER KFILM
      CHARACTER*(*) FILNAM
      INTEGER IPOSL
      INTEGER IFLAG
C
C   KFILM  (R)  Film/plate number
C  FILNAM  (W)  Returns file name
C   IPOSL  (W)  Position in file name of last character before the extension
C   IFLAG  (W)  = 0 OK 
C               = -1 blank
C               = -2 missing file indicated
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER IERR
      INTEGER L
      CHARACTER*(MAXFLEN) FILTEMP
      CHARACTER*(MAXFLEN) PATH
      CHARACTER*(MAXFLEN) NAME
      CHARACTER*(MAXFLEN) LOGNAM
      CHARACTER*20 TYPE
      CHARACTER*20 VERS
      CHARACTER*10 STR

C     LOGICAL EOF                 !End of file input flag
C     INTEGER NVIEW               !No. of view-objects for getting events
C     INTEGER IVHLIST(2)          !List of view-objects for getting events
C     INTEGER IVH                 !Returned view-object handle
C     INTEGER IERR                !Error flag
C     INTEGER L                   !String length
C     CHARACTER*(MAXFLEN) FILTEMP !Temporary input file name
C     CHARACTER*(MAXFLEN) PATH    !Path parsed from file name
C     CHARACTER*(MAXFLEN) NAME    !Name parsed from file name
C     CHARACTER*(MAXFLEN) LOGNAM  !Path from 'film' environment variable
C     CHARACTER*20 TYPE           !Type parsed from file name
C     CHARACTER*20 VERS           !Version parsed from file name
C     CHARACTER*10 STR            !Temp. string
C
C
C-------------------------------------------------------------------------------
C
      FILNAM = ' '
      IFLAG = -1
      IPOSL = 0
      IF (LG_MODE.EQ.1) THEN
         NVIEW = 1
         IVHLIST(1) = IVH_IOW
         CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
         CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILTEMP),
     +        MAXFLEN, IERR)
         IF (FILTEMP.EQ.' ') RETURN
      ELSE IF (LG_MODE.EQ.2) THEN
         CALL TREAD (FILTEMP, EOF)
         IF (EOF.OR.FILTEMP.EQ.' ') RETURN
      END IF
      CALL LJUST(FILTEMP)
      STR = FILTEMP
      CALL CCPUPC (STR)
      IF (STR.EQ.'MISSING') THEN
         IFLAG = -2
         RETURN
      END IF
      CALL FILEXT (FILTEMP, 'dat', FILNAM, IPOSL)
C
C====== Find default directory from environment variable FILM if set 
C====== and if no path was specified
C
      CALL CCPPSF(FILNAM,PATH,NAME,TYPE,VERS)
      IF (PATH.EQ.' ') THEN
         CALL UGTENV('FILM',LOGNAM)
         IF (LOGNAM.NE.' ') THEN
            FILTEMP = FILNAM
            FILNAM = LOGNAM
            L = LENSTR(FILNAM)
            FILNAM(L+1:) = FILTEMP
            IPOSL = IPOSL + L
         END IF
      END IF
      IFLAG = 0
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GET_REFPARS      **
C**************************
C
C
      SUBROUTINE GET_REFPARS (IFLAG, JFLAG, KFLAG, IFCELL, KQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get list of parameters to be refined & select refinement option
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
      INTEGER IFLAG(7)
      INTEGER JFLAG(6)
      INTEGER KFLAG(6)
      INTEGER IFCELL
      INTEGER KQUIT
C
C IFLAG(7)   (W)    Set flags for general setting parameters to be refined 
C                   (0=no, 1=yes)
C JFLAG(6)   (W)    Set flags for cell parameters to be refined (0=no, 1=yes)
C KFLAG(6)   (W)    Set flags for distortion parameters to be refined 
C                   (0=no, 1=yes)
C IFCELL     (W)    Refine cell flag 0=no, 1=yes
C KQUIT      (W)    Quit flag =1 quit refinement, =0 continue with refinement
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'refine_params.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
C
C====== LOCALS:
C
      LOGICAL ALL
      LOGICAL CLR_DISTOR
      LOGICAL CLR_SPD
      LOGICAL CLR_CTOF
      LOGICAL CLR_XCYC
      INTEGER NP
      INTEGER NCP(7)
      INTEGER IVH_POPFR
      INTEGER IVH_POPPT
      INTEGER IVH_POPMN
      INTEGER NP_NAME_CHARS
      INTEGER NP_VAL_CHARS
      INTEGER JP_PHI(3)
      INTEGER JP_CTOF
      INTEGER JP_XC
      INTEGER JP_YC
      INTEGER JP_WC
      INTEGER JP_RFC
      INTEGER JP_CELL(6)
      INTEGER JP_DISTOR
      INTEGER JP_SPD
      INTEGER JP_TWIST
      INTEGER JP_TILT
      INTEGER JP_BULGE
      INTEGER JP_YSCAL
      INTEGER JP_ROFF
      INTEGER JP_TOFF
      INTEGER JP_SPDXY
      INTEGER JP_SPDX
      INTEGER JP_SPDY
      INTEGER JP_RFTYP
      INTEGER JP_TUNE(3)
      INTEGER NL
      INTEGER I
      INTEGER IFDISTOR
      INTEGER P_WIDTH
      INTEGER P_HEIGHT
      INTEGER M_WIDTH
      INTEGER M_HEIGHT
      INTEGER IWIDTH_FRAME
      INTEGER IHEIGHT_FRAME
      INTEGER IX_PARM
      INTEGER IY_PARM
      INTEGER IX_MENU
      INTEGER IY_MENU
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER J
      INTEGER IOP
      INTEGER ITYP
      INTEGER IV
      INTEGER ISYST
      INTEGER DISTOR_TYPE
      INTEGER LFLAG
      INTEGER KEYPLATE
      REAL X
      CHARACTER*15 CELL_STR(6,7)
      CHARACTER*6  RFSTR(2)
      CHARACTER*6  MENU_STRS(2)
      CHARACTER*10 TMPSTR
      CHARACTER*15 PVAL
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
C
C     LOGICAL ALL          !Checks for all cell parameters refine request
C     LOGICAL CLR_DISTOR   !Clear main distortion parameters flag
C     LOGICAL CLR_SPD      !Clear polynomial spd parameters flag
C     LOGICAL CLR_CTOF     !Clear refine ctof flag
C     LOGICAL CLR_XCYC     !Clear refine x_c, y_c flags
C     INTEGER NP           !No. of refineable parameters (apart from cell)
C     INTEGER NCP(7)       !No. of unique cell params foreach crystal system
C     INTEGER IVH_POPFR    !View-object handle for pop-up frame
C     INTEGER IVH_POPPT    !View-object handle for parameter table
C     INTEGER IVH_POPMN    !View-object handle for menu
C     INTEGER NP_NAME_CHARS !Max no. chars in parameter table name
C     INTEGER NP_VAL_CHARS  !Max no. chars in pareter table value
C     INTEGER JP_PHI(3)    !Item numbers in param. table for Phi's
C     INTEGER JP_CTOF      !Item number in param. table for c-to-f
C     INTEGER JP_XC        !Item number in param. table for x_c
C     INTEGER JP_YC        !Item number in param. table for y_c
C     INTEGER JP_WC        !Item number in param. table for w_c
C     INTEGER JP_RFC       !Item number in param. table for Refine cell
C     INTEGER JP_CELL(6)   !Item numbers in param. table for cell params.
C     INTEGER JP_DISTOR    !Item number in param table for Refine distortion.
C     INTEGER JP_SPD       !Item number in param table for SPD polynominal
C     INTEGER JP_TWIST     !Item number in param table for twist
C     INTEGER JP_TILT      !Item number in param table for tilt
C     INTEGER JP_BULGE     !Item number in param table for bulge
C     INTEGER JP_YSCAL     !Item number in param table for y_scale
C     INTEGER JP_ROFF      !Item number in table for roff
C     INTEGER JP_TOFF      !Item number in table for toff
C     INTEGER JP_SPDXY     !Item number in table for spdxy
C     INTEGER JP_SPDX      !Item number in table for spd_x
C     INTEGER JP_SPDY      !Item number in table for spd_y
C     INTEGER JP_RFTYP     !Item number in param. table for Refinement type
C     INTEGER JP_TUNE(3)   !Item numbers in param. table for tuning params
C     INTEGER NL           !Parameter table line no. count
C     INTEGER I            !Temp/loop variable
C     INTEGER IFDISTOR     !Refine main distortion parameters flag
C     INTEGER P_WIDTH      !Parameter table width
C     INTEGER P_HEIGHT     !Parameter table height
C     INTEGER M_WIDTH      !Menu area width
C     INTEGER M_HEIGHT     !Menu area height
C     INTEGER IWIDTH_FRAME !Width of pop-up frame
C     INTEGER IHEIGHT_FRAME !Height of pop-up frame
C     INTEGER IX_PARM      !X position of parameter table within frame
C     INTEGER IY_PARM      !Y position of parameter table within frame
C     INTEGER IX_MENU      !X position of menu area within frame
C     INTEGER IY_MENU      !Y position of menu area within frame
C     INTEGER IXROOT       !Root X position of pop-up frame
C     INTEGER IYROOT       !Root Y position of pop_up frame
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. modified in parameter table
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER J            !Temp/loop variable
C     INTEGER IOP          !Option no. from an options list
C     INTEGER ITYP         !Number type from INTFP
C     INTEGER IV           !Integer value
C     INTEGER ISYST        !Crystal system
C     INTEGER DISTOR_TYPE  !Distortion type flag
C     INTEGER LFLAG        !Parameter status flag
C     INTEGER KEYPLATE     !Key plate
C     REAL X               !Temp real value
C     CHARACTER*15 CELL_STR(6,7) !Cell parameter strings
C     CHARACTER*6  RFSTR(2)      !Refinement type strings
C     CHARACTER*6 MENU_STRS(2)   !Menu strings
C     CHARACTER*10 TMPSTR        !Temporary string for parameter o/p value
C     CHARACTER*15 PVAL          !String for parameter table input value
C     CHARACTER*2 VALSTR         !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR         !Error string (dummy)
C
C====== Data statements
C
      DATA NCP/6,4,3,2,2,2,1/
      DATA CELL_STR/
     + 'Refine a:','Refine b:','Refine c:',
     + 'Refine alpha:','Refine beta:','Refine gamma:',
     + 'Refine a:','Refine b:','Refine c:',
     + 'Refine beta:',' ',' ',
     + 'Refine a:','Refine b:','Refine c:',
     + ' ',' ',' ',
     + 'Refine a:','Refine c:',' ',
     + ' ',' ',' ',
     + 'Refine a:','Refine c:',' ',
     + ' ',' ',' ',
     + 'Refine a:','Refine alpha:',' ',
     + ' ',' ',' ',
     + 'Refine a:',' ',' ',
     + ' ',' ',' '/
      DATA RFSTR/'LSR','Powell'/
      DATA MENU_STRS/'REFINE',' '/
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, LFLAG, IERR, ERRSTR)
      CALL LDM_GET_SYST (VALSTR, ISYST, LFLAG)
      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, LFLAG)
      IVH_POPFR = 100
      IVH_POPPT = 101
      IVH_POPMN = 102
      NP_NAME_CHARS = 15
      NP_VAL_CHARS = 10
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,100,0,IXROOT,IYROOT,IERR)        
      DO 5 I = 1,7
         IFLAG(I) = 0
5     CONTINUE
      DO 6 I = 1,6
         JFLAG(I) = 0
6     CONTINUE
      DO 7 I = 1,6 
         KFLAG(I) = 0
7     CONTINUE
      IFCELL = 0
      IFDISTOR = 0
      DO 10 I=1,3
         JP_PHI(I) = 0
10    CONTINUE
      JP_CTOF = 0
      JP_XC = 0
      JP_YC = 0
      JP_WC = 0
      JP_RFC = 0
      DO 20 I=1,6
         JP_CELL(I) = 0
20    CONTINUE
      JP_RFTYP = 0
      DO 30 I= 1,3
         JP_TUNE(I) = 0
30    CONTINUE
      IF (IPLATE.EQ.KEYPLATE) THEN
         JP_PHI(1) = 1
         JP_PHI(2) = 2
         JP_PHI(3) = 3
         JP_CTOF = 4
         JP_XC = 5
         JP_YC = 6
         NL = 6
      ELSE
         JP_CTOF = 1
         JP_XC = 2
         JP_YC = 3
         JP_WC = 4
         NL = 4
      END IF
      IF (IPLATE.EQ.KEYPLATE) THEN
         NL = NL + 2
         JP_RFC = NL
         DO 40 I = 1, NCP(ISYST)
            NL = NL + 1
            JP_CELL(I) = NL
40       CONTINUE
      END IF
      NL = NL + 2
      JP_DISTOR = NL
      NL = NL + 1
      JP_YSCAL = NL
      NL = NL + 1
      JP_TWIST = NL
      NL = NL + 1
      JP_TILT = NL
      IF (DISTOR_TYPE.EQ.1) THEN
         JP_ROFF = 0
         JP_TOFF = 0
         NL = NL + 1
         JP_BULGE = NL
      ELSE IF (DISTOR_TYPE.EQ.2) THEN
         JP_BULGE = 0
         NL = NL + 1
         JP_ROFF = NL
         NL = NL + 1
         JP_TOFF = NL
      ELSE
         JP_BULGE = 0
         JP_ROFF = 0
         JP_TOFF = 0
      END IF
      IF (DISTOR_TYPE.EQ.3) THEN
         NL = NL + 2
         JP_SPD = NL
         NL = NL + 1
         JP_SPDXY = NL
         NL = NL + 1
         JP_SPDX = NL
         NL = NL + 1
         JP_SPDY = NL
      ELSE
         JP_SPD = 0
         JP_SPDX = 0
         JP_SPDX = 0
      END IF
      NL = NL + 2
      JP_RFTYP = NL
      DO 50 I= 1,3
         NL = NL + 1
         JP_TUNE(I) = NL
50    CONTINUE
C
C====== Get required parameter table size and menu size
C
      CALL XDLF_PARAM_TABLE_GETSIZE (1, NL, NP_NAME_CHARS, NP_VAL_CHARS,
     +                 1, IFONT, 1, P_WIDTH, P_HEIGHT)        
      CALL XDLF_MENU_AREA_GETSIZE (1, 20, IFONT, 1, 0, 
     +                 M_WIDTH, M_HEIGHT)
C
C====== Get required size for pop-up frame and positions of windows
C
      IWIDTH_FRAME = 2*IBORDER + P_WIDTH + 8
      IHEIGHT_FRAME = 2*IBORDER + P_HEIGHT + ISEP + M_HEIGHT + 8
      IX_PARM = IBORDER + 4
      IY_PARM = IBORDER + 4
      IX_MENU = IBORDER + 4
      IY_MENU = IBORDER + 4 + P_HEIGHT + ISEP
C
C====== Create pop-up base frame
C
c      CALL XDLF_POPUP_FRAME (IVH_POPFR, IXROOT, IYROOT, IWIDTH_FRAME,
c     +                       IHEIGHT_FRAME, 5)
      CALL XDLF_BASE_FRAME (IVH_POPFR, IWIDTH_FRAME, IHEIGHT_FRAME, 
     +                      XDLSTR('Refine'), 6,
     +                      XDLSTR('Refine'), 6, IXROOT, IYROOT)
C
C====== Create parameter_table & menu (Note: Use param width for menu)
C
      CALL XDLF_PARAM_TABLE (IVH_POPPT, IVH_POPFR, IX_PARM, IY_PARM, 
     +               0, 1, NL, NP_NAME_CHARS, 
     +               NP_VAL_CHARS, NP_VAL_CHARS,
     +               XDLSTR('Refinement Parameters'), 21, IFONT,
     +               1, IERR)
      CALL XDLF_MENU_AREA (IVH_POPMN, IVH_POPFR, IX_MENU, IY_MENU, 0, 
     +               1, 20, IFONT, 1, 0, P_WIDTH, M_HEIGHT, IERR)
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_POPMN, 1,
     +     XDLSTR(MENU_STRS), 6, XDLSTR(' '), -1,
     +     XDLSTR('Quit Refinement'), 15, IFONT, IERR)
C
C====== Set up parameter table entries
C
      IF (JP_PHI(1).GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_PHI(1),
     +        XDLSTR('Refine PhiX:'), 12, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(1) = 1
      END IF
      IF (JP_PHI(2).GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_PHI(2),
     +        XDLSTR('Refine PhiY:'), 12, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(2) = 1
      END IF
      IF (JP_PHI(3).GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_PHI(3),
     +        XDLSTR('Refine PhiZ:'), 12, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(3) = 1
      END IF
      IF (JP_CTOF.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_CTOF,
     +        XDLSTR('Refine c_to_f:'), 14, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(4) = 1
      END IF
      IF (JP_XC.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_XC,
     +        XDLSTR('Refine x_c:'), 10, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(5) = 1
      END IF
      IF (JP_YC.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_YC,
     +        XDLSTR('Refine y_c:'), 10, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(6) = 1
      END IF
      IF (JP_WC.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_WC,
     +        XDLSTR('Refine w_c:'), 10, XDLSTR(' '), 1, 
     +        3, 0, IERR)
         IFLAG(7) = 1
      END IF
      IF (JP_RFC.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_RFC,
     +        XDLSTR('Refine cell:'), 12, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      DO 100 I=1,6
         IF (JP_CELL(I).GT.0) THEN
            CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_CELL(I),
     +           XDLSTR(CELL_STR(I,ISYST)), 15, XDLSTR(' '), 1, 
     +           4, 0, IERR)
         END IF
100   CONTINUE
      IF (JP_DISTOR.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_DISTOR,
     +        XDLSTR('Distortion:'), 11, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_YSCAL.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_YSCAL,
     +        XDLSTR('Refine y_scale:'), 15, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_TWIST.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TWIST,
     +        XDLSTR('Refine twist:'), 13, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_TILT.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TILT,
     +        XDLSTR('Refine tilt:'), 12, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_BULGE.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_BULGE,
     +        XDLSTR('Refine bulge:'), 13, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_ROFF.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_ROFF,
     +        XDLSTR('Refine roff:'), 12, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_TOFF.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TOFF,
     +        XDLSTR('Refine toff:'), 12, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_SPD.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPD,
     +        XDLSTR('Polynomial fit:'), 15, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_SPDXY.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDXY,
     +        XDLSTR('Refine spdxy:'), 13, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_SPDX.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDX,
     +        XDLSTR('Refine spd_x:'), 13, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_SPDY.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_SPDY,
     +        XDLSTR('Refine spd_y:'), 13, XDLSTR(' '), 1, 
     +        4, 0, IERR)
      END IF
      IF (JP_RFTYP.GT.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_RFTYP,
     +        XDLSTR('Method:'), 7, XDLSTR(RFSTR(IRFN_TYP)), 6,
     +        0, 0, IERR)
         CALL XDLF_PARAM_TABLE_SETMENU (IVH_POPPT, JP_RFTYP, 2,
     +        XDLSTR(RFSTR), 6, IERR)
         IF (IRFN_TYP.EQ.1) THEN
            X = LSR_SHFLM
            WRITE (TMPSTR,'(F10.4)') X
            CALL LJUST(TMPSTR)
            CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(1),
     +        XDLSTR('Shift limit:'), 12, XDLSTR(TMPSTR), 10,
     +        0, 0, IERR)
            X = LSR_DSTEP
            WRITE (TMPSTR,'(E10.3)') X
            CALL LJUST(TMPSTR)
            CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(2),
     +        XDLSTR('Deriv. step:'), 12, XDLSTR(TMPSTR), 10,
     +        0, 0, IERR)
            X = LSR_DAMP
            WRITE (TMPSTR,'(F10.2)') X
            CALL LJUST(TMPSTR)
            CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(3),
     +        XDLSTR('Damp factor:'), 12, XDLSTR(TMPSTR), 10,
     +        0, 0, IERR)
         ELSE
            X = POWELL_ACC
            WRITE (TMPSTR,'(E10.3)') X
            CALL LJUST(TMPSTR)
            CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(1),
     +        XDLSTR('Accuracy:'), 9, XDLSTR(TMPSTR), 10,
     +        0, 0, IERR)
         END IF            
      END IF
C
C====== Get input from the menu and/or parameter table
C
      NVIEW = 2
      IVHLIST(1) = IVH_POPMN
      IVHLIST(2) = IVH_POPPT
200   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
C
C====== Parameter table input
C
      IF (IVH.EQ.IVH_POPPT) THEN
         CLR_DISTOR = .FALSE.
         CLR_SPD = .FALSE.
         CLR_CTOF = .FALSE.
         CLR_XCYC = .FALSE.
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_POPPT, ITEM,
     +        XDLSTR(PVAL), 15, IERR)
         IF (ITEM.EQ.JP_PHI(1)) THEN
            IFLAG(1) = 0
            IF (PVAL.EQ.'Yes') IFLAG(1) = 1
         ELSE IF (ITEM.EQ.JP_PHI(2)) THEN
            IFLAG(2) = 0
            IF (PVAL.EQ.'Yes') IFLAG(2) = 1
         ELSE IF (ITEM.EQ.JP_PHI(3)) THEN
            IFLAG(3) = 0
            IF (PVAL.EQ.'Yes') IFLAG(3) = 1
         ELSE IF (ITEM.EQ.JP_CTOF) THEN
            IFLAG(4) = 0
            IF (PVAL.EQ.'Yes') IFLAG(4) = 1
            IF (DISTOR_TYPE.EQ.3) CLR_SPD = .TRUE.
         ELSE IF (ITEM.EQ.JP_XC) THEN
            IFLAG(5) = 0
            IF (PVAL.EQ.'Yes') IFLAG(5) = 1
            IF (DISTOR_TYPE.EQ.3) CLR_SPD = .TRUE.
         ELSE IF (ITEM.EQ.JP_YC) THEN
            IFLAG(6) = 0
            IF (PVAL.EQ.'Yes') IFLAG(6) = 1
            IF (DISTOR_TYPE.EQ.3) CLR_SPD = .TRUE.
         ELSE IF (ITEM.EQ.JP_WC) THEN
            IFLAG(7) = 0
            IF (PVAL.EQ.'Yes') IFLAG(7) = 1
         ELSE IF (ITEM.EQ.JP_DISTOR) THEN
            IFDISTOR = 0
            IF (PVAL.EQ.'Yes') IFDISTOR = 1
            J = 4
            IF (IFDISTOR.EQ.1) J=3
            KFLAG(1) = IFDISTOR
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_YSCAL, XDLSTR(' '),1,J,IERR)
            KFLAG(2) = IFDISTOR
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_TWIST, XDLSTR(' '),1,J,IERR)
            KFLAG(3) = IFDISTOR
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_TILT, XDLSTR(' '),1,J,IERR)
            IF (DISTOR_TYPE.EQ.1) THEN
               KFLAG(4) = IFDISTOR
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_BULGE, XDLSTR(' '),1,J,IERR)
            ELSE IF (DISTOR_TYPE.EQ.2) THEN
               KFLAG(4) = IFDISTOR
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_ROFF, XDLSTR(' '),1,J,IERR)
               KFLAG(5) = IFDISTOR
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_TOFF, XDLSTR(' '),1,J,IERR)
            ELSE IF (DISTOR_TYPE.EQ.3) THEN
               IF (IFDISTOR.EQ.1) CLR_SPD = .TRUE.
            END IF
         ELSE IF (ITEM.EQ.JP_YSCAL) THEN
            KFLAG(1) = 0
            IF (PVAL.EQ.'Yes') KFLAG(1) = 1
            IF (IFDISTOR.EQ.0) THEN
               IFDISTOR = 1
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_DISTOR, XDLSTR(' '),1,3,IERR)
            END IF
            IF (DISTOR_TYPE.EQ.3) CLR_SPD = .TRUE.
         ELSE IF (ITEM.EQ.JP_TWIST) THEN
            KFLAG(2) = 0
            IF (PVAL.EQ.'Yes') KFLAG(2) = 1
            IF (IFDISTOR.EQ.0) THEN
               IFDISTOR = 1
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_DISTOR, XDLSTR(' '),1,3,IERR)
            END IF
            IF (DISTOR_TYPE.EQ.3) CLR_SPD = .TRUE.
         ELSE IF (ITEM.EQ.JP_TILT) THEN
            KFLAG(3) = 0
            IF (PVAL.EQ.'Yes') KFLAG(3) = 1
            IF (IFDISTOR.EQ.0) THEN
               IFDISTOR = 1
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_DISTOR, XDLSTR(' '),1,3,IERR)
            END IF
            IF (DISTOR_TYPE.EQ.3) CLR_SPD = .TRUE.
         ELSE IF (ITEM.EQ.JP_BULGE.AND.DISTOR_TYPE.EQ.1) THEN
            KFLAG(3) = 0
            IF (PVAL.EQ.'Yes') KFLAG(3) = 1
            IF (IFDISTOR.EQ.0) THEN
               IFDISTOR = 1
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_DISTOR, XDLSTR(' '),1,3,IERR)
            END IF
         ELSE IF (ITEM.EQ.JP_ROFF.AND.DISTOR_TYPE.EQ.2) THEN
            KFLAG(3) = 0
            IF (PVAL.EQ.'Yes') KFLAG(3) = 1
            IF (IFDISTOR.EQ.0) THEN
               IFDISTOR = 1
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_DISTOR, XDLSTR(' '),1,3,IERR)
            END IF
         ELSE IF (ITEM.EQ.JP_TOFF.AND.DISTOR_TYPE.EQ.2) THEN
            KFLAG(4) = 0
            IF (PVAL.EQ.'Yes') KFLAG(4) = 1
            IF (IFDISTOR.EQ.0) THEN
               IFDISTOR = 1
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +              JP_DISTOR, XDLSTR(' '),1,3,IERR)
            END IF
         ELSE IF (ITEM.EQ.JP_SPD.AND.DISTOR_TYPE.EQ.3)THEN
            J = 4
            IF (PVAL.EQ.'Yes') J = 3
            KFLAG(4) = 4 - J
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPDXY, XDLSTR(' '),1,J,IERR)
            KFLAG(5) = 4 - J
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPDX, XDLSTR(' '),1,J,IERR)
            KFLAG(6) = 4 - J
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPDY, XDLSTR(' '),1,J,IERR)
            IF (J.EQ.3) THEN
               CLR_DISTOR = .TRUE.
               CLR_CTOF = .TRUE.
               CLR_XCYC = .TRUE.
            END IF
         ELSE IF (ITEM.EQ.JP_SPDXY.AND.DISTOR_TYPE.EQ.3) THEN
            KFLAG(4) = 0
            IF (PVAL.EQ.'Yes') KFLAG(4) = 1
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPD, XDLSTR(' '),1,3,IERR)
            IF (KFLAG(4).EQ.1) THEN
               CLR_DISTOR = .TRUE.
               CLR_CTOF = .TRUE.
               CLR_XCYC = .TRUE.
            END IF
         ELSE IF (ITEM.EQ.JP_SPDX.AND.DISTOR_TYPE.EQ.3) THEN
            KFLAG(5) = 0
            IF (PVAL.EQ.'Yes') KFLAG(5) = 1
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPD, XDLSTR(' '),1,3,IERR)
            IF (KFLAG(5).EQ.1) THEN
               CLR_DISTOR = .TRUE.
               CLR_CTOF = .TRUE.
               CLR_XCYC = .TRUE.
            END IF
         ELSE IF (ITEM.EQ.JP_SPDY.AND.DISTOR_TYPE.EQ.3) THEN
            KFLAG(6) = 0
            IF (PVAL.EQ.'Yes') KFLAG(6) = 1
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPD, XDLSTR(' '),1,3,IERR)
            IF (KFLAG(6).EQ.1) THEN
               CLR_DISTOR = .TRUE.
               CLR_CTOF = .TRUE.
               CLR_XCYC = .TRUE.
            END IF
         ELSE IF (ITEM.EQ.JP_RFTYP) THEN
            CALL GETOPT (RFSTR, 2, PVAL, IOP, IERR)
            IF (IERR.EQ.2) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, JP_RFTYP,
     +             XDLSTR('**Invalid refinement type**'), 27, IERR)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_POPFR, IERR)
               GO TO 200
            END IF
            IRFN_TYP = IOP
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_RFTYP,
     +           XDLSTR(RFSTR(IRFN_TYP)), 6, 0, IERR)
            DO 144 I = 1,3
               CALL XDLF_PARAM_TABLE_DELITEM (IVH_POPPT, JP_TUNE(I),
     +              IERR)
144         CONTINUE
            IF (IRFN_TYP.EQ.1) THEN
               X = LSR_SHFLM
               WRITE (TMPSTR,'(F10.4)') X
               CALL LJUST(TMPSTR)
               CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(1),
     +           XDLSTR('Shift limit:'), 12, XDLSTR(TMPSTR), 10,
     +           0, 0, IERR)
               X = LSR_DSTEP
               WRITE (TMPSTR,'(E10.3)') X
               CALL LJUST(TMPSTR)
               CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(2),
     +           XDLSTR('Deriv. step:'), 12, XDLSTR(TMPSTR), 10,
     +           0, 0, IERR)
               X = LSR_DAMP
               WRITE (TMPSTR,'(F10.2)') X
               CALL LJUST(TMPSTR)
               CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(3),
     +           XDLSTR('Damp factor:'), 12, XDLSTR(TMPSTR), 10,
     +           0, 0, IERR)
            ELSE
               X = POWELL_ACC
               WRITE (TMPSTR,'(E10.3)') X
               CALL LJUST(TMPSTR)
               CALL XDLF_PARAM_TABLE_SETITEM (IVH_POPPT, JP_TUNE(1),
     +           XDLSTR('Accuracy:'), 9, XDLSTR(TMPSTR), 10,
     +           0, 0, IERR)
            END IF  
         ELSE IF (ITEM.EQ.JP_TUNE(1)) THEN
            ITYP = INTFP(PVAL,X,IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_POPFR, IERR)
               GO TO 200
            END IF
            IF (IRFN_TYP.EQ.1) THEN
               LSR_SHFLM = X
            ELSE IF (IRFN_TYP.EQ.2) THEN
               POWELL_ACC = X
            END IF
         ELSE IF (ITEM.EQ.JP_TUNE(2)) THEN
            ITYP = INTFP(PVAL,X,IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_POPFR, IERR)
               GO TO 200
            END IF
            IF (IRFN_TYP.EQ.1) THEN
               LSR_DSTEP = X
            END IF
         ELSE IF (ITEM.EQ.JP_TUNE(3)) THEN
            ITYP = INTFP(PVAL,X,IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_POPPT, ITEM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_POPFR, IERR)
               GO TO 200
            END IF
            IF (IRFN_TYP.EQ.1) THEN
               LSR_DAMP = X
            END IF
         ELSE IF (ITEM.EQ.JP_RFC) THEN
            IFCELL = 0
            IF (PVAL.EQ.'Yes') IFCELL = 1
            DO 210 I=1, NCP(ISYST)
               J = 4
               IF (IFCELL.EQ.1.AND.I.NE.1) J = 3
               CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, JP_CELL(I),
     +                 XDLSTR(' '), 1, J, IERR)
               JFLAG(I) = 4 - J
210         CONTINUE
         ELSE
            DO 250 I = 1, NCP(ISYST)
               IF (ITEM.EQ.JP_CELL(I)) THEN
                  IF (PVAL.EQ.'Yes') THEN
                     JFLAG(I) = 1
                     IF (IFCELL.EQ.0) THEN
                        IFCELL = 1
                        CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, 
     +                       JP_RFC, XDLSTR(' '), 1, 3, IERR)
                     END IF
                     ALL = .TRUE.
                     DO 245 J = 1, NCP(ISYST)
                        IF (JFLAG(J).EQ.0) ALL = .FALSE.
245                  CONTINUE
                     IF (ALL) THEN
                        JFLAG(1) = 0
                        CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT, 
     +                       JP_CELL(1), XDLSTR(' '), 1, 4, IERR)
                     END IF
                  ELSE
                     JFLAG(I) = 0
                  END IF
               END IF
250         CONTINUE
        END IF
C
C====== Set/unset dependent distortion parameters
C
         IF (CLR_DISTOR) THEN
            IFDISTOR = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_DISTOR, XDLSTR(' '),1,4,IERR)
            KFLAG(1) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_YSCAL, XDLSTR(' '),1,4,IERR)
            KFLAG(2) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_TWIST, XDLSTR(' '),1,4,IERR)
            KFLAG(3) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_TILT, XDLSTR(' '),1,4,IERR)
         END IF
         IF (CLR_SPD) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPD, XDLSTR(' '),1,4,IERR)
            KFLAG(4) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +          JP_SPDXY, XDLSTR(' '),1,4,IERR)
            KFLAG(5) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +          JP_SPDX, XDLSTR(' '),1,4,IERR)
            KFLAG(6) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_SPDY, XDLSTR(' '),1,4,IERR)
         END IF
         IF (CLR_CTOF) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_CTOF, XDLSTR(' '),1,4,IERR)
            IFLAG(4) = 0
         END IF
         IF (CLR_XCYC) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_XC, XDLSTR(' '),1,4,IERR)
            IFLAG(5) = 0
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_POPPT,
     +           JP_YC, XDLSTR(' '),1,4,IERR)
            IFLAG(6) = 0
         END IF
C
C====== Menu input
C
      ELSE IF (IVH.EQ.IVH_POPMN) THEN
         CALL XDLF_MENU_AREA_GETITEM (IVH_POPMN, ITEM, IQUIT)
         IF (IQUIT.EQ.1) THEN
            KQUIT = 1
            GOTO 500
         ELSE
            KQUIT = 0
            GO TO 500
         END IF
      END IF
      GO TO 200
C
C====== Remove pop-up
C
500   CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPMN, IERR)
      CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPPT, IERR)
      CALL XDLF_DELETE_VIEW_OBJECT (IVH_POPFR, IERR)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GNOM_CENTRE      **
C**************************
C
C
      SUBROUTINE GNOM_CENTRE
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Input conic spots (start, middle end) & calculate centre using
C          gnomonic projection coords to minimise the distances of the
C          'middle' points from the lines between the start and end points.
C          i.e. makes use of fact that in the gnomonic projection the
C          conics should be transformed to straight lines
C
C Author:  John W. Campbell, February 1993
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'image.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'spot_box.finc'
      INCLUDE 'conics.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
      INTEGER LENSTR
      EXTERNAL GDIST_FN
C
C====== LOCALS:
C
      LOGICAL CONICS_COMPLETE
      LOGICAL CEN_OK
      INTEGER I
      INTEGER J
      INTEGER M_CENT
      INTEGER M_REDO
      INTEGER NVIEW
      INTEGER IVHLIST(3)
      INTEGER IVH
      INTEGER IQUIT
      INTEGER ITEM
      INTEGER IERR
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER NOVER
      INTEGER ITHRESH
      INTEGER IBG
      INTEGER ISTYP
      INTEGER IOP
      INTEGER ITYP
      INTEGER IV
      INTEGER ITM
      INTEGER IP_STYP
      INTEGER IP_SBOX
      INTEGER IP_THRESH
      INTEGER ICONIC
      INTEGER JCONIC
      INTEGER IFLAG
      INTEGER IYN
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IORD
      INTEGER ISWAP
      INTEGER ND
      INTEGER LISTE(2)
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL CGX
      REAL CGY
      REAL FP
      REAL XTEMP
      REAL YTEMP
      DOUBLE PRECISION CEN(2)
      DOUBLE PRECISION ACC
      DOUBLE PRECISION FMIN
      DOUBLE PRECISION FVECC(MAX_CONICS)
      DOUBLE PRECISION W(12)
      CHARACTER*80 STR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL
      CHARACTER*25 NAMES(2)
      CHARACTER*25 QUITNAM
      CHARACTER*6 SMETHOD(2)
      CHARACTER*6 SMETHOD_UC(2)
      CHARACTER*11 MSG(3)
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     LOGICAL CONICS_COMPLETE   !All allowed conics now input
C     LOGICAL CEN_OK            !Found centre OK flag
C     INTEGER I           !Temp/loop variable
C     INTEGER J           !Temp/loop variable
C     INTEGER M_CENT      !Menu item number for 'Calculate Centre'
C     INTEGER M_REDO      !Menu item number for 'Redo Current Conic'
C     INTEGER NVIEW       !No. of view-objects for getting events
C     INTEGER IVHLIST(3)  !List of view-objects for getting events
C     INTEGER IVH         !Returned view-object handle from events input
C     INTEGER IQUIT       !Quit box selected flag =1 yes, =0 no
C     INTEGER ITEM        !Item no. selected from the menu
C     INTEGER IERR        !Error return flag
C     INTEGER IXPIX       !x pixel value from film image view-object
C     INTEGER IYPIX       !y pixel value from film image view-object
C     INTEGER ISPIX       !Pixel position along slow axis
C     INTEGER IFPIX       !Pixel position along fast axis
C     INTEGER IXSIZ       !Spot box half size x
C     INTEGER IYSIZ       !Spot box half size y
C     INTEGER NOVER       !no. of pixels over the threshold value
C     INTEGER ITHRESH     !Threshold value
C     INTEGER IBG         !Background value at spot position
C     INTEGER ISTYP       !Spot method 1=c_of_g, 2=input (cursor)
C     INTEGER IOP         !Option from GETOPT
C     INTEGER ITYP        !Type of number input flag (from INTFP)
C     INTEGER IV          !Integer value returned from INTFP
C     INTEGER ITM         !Parameter table selected item number
C     INTEGER IP_STYP     !Parameter table 3 item: Spot method
C     INTEGER IP_SBOX     !Parameter table 3 item: Spot box size
C     INTEGER IP_THRESH   !Parameter table 3 item: Spot threshold
C     INTEGER ICONIC      !Count of current conic being input
C     INTEGER JCONIC      !Current spot in conic 1-3, start, middle end
C     INTEGER IFLAG       !Flag from refinement routine / parameter status flag
C     INTEGER IYN         !Return flag fro yes-no notice
C     INTEGER NXRAST      !No. x-rasters
C     INTEGER NYRAST      !No. y-rasters
C     INTEGER IORD        !Axis order flag 1-8
C     INTEGER ISWAP       !Byte swap flag
C     INTEGER ND          !No. of decimal places flag
C     INTEGER LISTE(2)    !Parameter updates list
C     REAL MM_RAST_X      !mm to x-rasters conversion factor
C     REAL MM_RAST_Y      !mm to y-rastrs conversion factor
C     REAL CGX            !x centre of gravity
C     REAL CGY            !y centre of gravity
C     REAL FP             !Floating point value returned from INTFP
C     REAL XTEMP          !Temp. refined x centre position
C     REAL YTEMP          !Temp. refined y centre position
C     DOUBLE PRECISION CEN(2)     !Position of estimated/refined centre
C     DOUBLE PRECISION ACC        !Accuracy parameter for Powell refinement
C     DOUBLE PRECISION FMIN       !Refined minimum value sum of squares
C     DOUBLE PRECISION FVECC(MAX_CONICS) !Calculated function values
C     DOUBLE PRECISION W(12)      !Work array for Powell refinement
C     CHARACTER*80 STR    !Temporary string
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !Return string from parameter table 3
C     CHARACTER*25 NAMES(2)      !Names for the menu items
C     CHARACTER*25 QUITNAM       !Quit box label
C     CHARACTER*6 SMETHOD(2)     !Spot method option strings
C     CHARACTER*6 SMETHOD_UC(2)  !Spot method option strings (upper case)
C     CHARACTER*11 MSG(3)        !Messages indicating which spot to input
C     CHARACTER*2 VALSTR         !paramter value string (dummy)
C     CHARACTER*2 ERRSTR   !Error string (dummy)

      DATA NAMES /'Redo Current Conic',
     +            'Calculate Centre'/
      DATA QUITNAM /'Abort Centre Calculation'/
      DATA SMETHOD /'c_of_g','input'/
      DATA SMETHOD_UC /'C_OF_G','INPUT'/
      DATA MSG/'start spot','middle spot','end spot'/

C-------------------------------------------------------------------------------
C
C
C====== Clear symbols from image
C
      CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
C
C====== Initialisations
C
      CALL LDM_GET_STHR (SPOT_INPUT_THRESH, IFLAG, ND)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CONICS_COMPLETE = .FALSE.
      NUM_CONICS = 0
      ICONIC = 1
      JCONIC = 1
C
C====== Set up parameter table 3
C
      IP_STYP = 1
      IP_SBOX = 3
      IP_THRESH = 4

      ISTYP = 1

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_STYP,
     +     XDLSTR('Spot method:'), 12,
     +     XDLSTR(SMETHOD(1)),6, 0, 0, IERR)
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR3, IP_STYP,
     +     2, XDLSTR(SMETHOD), 6, IERR)
      WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_SBOX,
     +     XDLSTR('Spot box (mm):'), 14,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_THRESH,
     +     XDLSTR('Spot threshold:'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
C
C====== Set up menu
C
      M_REDO = 1
      M_CENT = 2
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 2, XDLSTR(NAMES), 24,
     +                             XDLSTR('Gnomonic Centre Menu'), 20,
     +                             XDLSTR(QUITNAM), 24, 0, IERR)
C
C====== Set up event loop for first menu input
C
50    STR = 'Input Conic'
      CALL STR_ADDI(STR,ICONIC,1)
      CALL STR_ADDS(STR,MSG(JCONIC),1)
      CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +     XDLSTR(STR), 40, IERR)
      NVIEW = 3
      IF (CONICS_COMPLETE) NVIEW = 2
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR3
      IVHLIST(3) = IVH_FILM
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
C
C====== Menu item selected
C
      IF (IVH.EQ.IVH_MENU) THEN
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C====== Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            RETURN
         END IF
C
C====== Redo Current Conic
C
         IF (ITEM.EQ.M_REDO) THEN
            IF (CONICS_COMPLETE) GO TO 100
            IF (JCONIC.EQ.1) GO TO 100
            JCONIC = 1
            CALL XDLF_IMAGE_CLEAR_SYMBOLS(IVH_FILM, IERR)
            IF (NUM_CONICS.EQ.0) GO TO 50
            DO 220 I=1,NUM_CONICS
               DO 210 J=1,3
                  CALL XDLF_IMAGE_SYMBOL(IVH_FILM,
     +                 NINT(XCONIC(J,I)), NINT(YCONIC(J,I)),
     +                 ISYMBTYP(7),ICOLRTYP(7), 1, IERR)
210               CONTINUE
220         CONTINUE
            GO TO 50
C
C====== Calculate Centre
C
         ELSE IF (ITEM.EQ.M_CENT) THEN
            IF (.NOT.CONICS_COMPLETE
     +          .AND.JCONIC.NE.1) THEN
                  CALL ERR_NOTICE(1,'**Last conic not completed**')
                  GO TO 100
            END IF
            IF (NUM_CONICS.LT.3) THEN
               CALL ERR_NOTICE(1,'**Minimum of three conics needed**')
               GO TO 100
            END IF
            CEN(1) = NXRAST/2.0
            CEN(2) = NYRAST/2.0
            ACC = 1.0D-8
            CALL SSQMIN(NUM_CONICS,2,CEN,ACC,100,GDIST_FN,FMIN,
     +                  FVECC,IFLAG,W)
            IF (IFLAG.EQ.-1) THEN
               CALL ERR_NOTICE(1,'**Failure(s) finding line minima**')
               GO TO 100
            END IF
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
               IF (IFLAG.EQ.-1) THEN
                  CALL LMESSAGE(IVH_IOW,
     +            '*Refinement terminated after 100 iterations*')
               ELSE
                  STR = 'Refinement completed after'
                  CALL STR_ADDI(STR,IFLAG,1)
                  CALL STR_ADDS(STR,'iterations',1)
                  CALL LMESSAGE(IVH_IOW,STR)
               ENDIF
               STR = 'Refined centre: x ='
               XTEMP = CEN(1)
               YTEMP = CEN(2)
               CALL STR_ADDF(STR,XTEMP,2,1)
               CALL STR_ADDS(STR,', y =',0)
               CALL STR_ADDF(STR,YTEMP,2,1)
               CALL LMESSAGE(IVH_IOW,STR)
               CEN_OK = .TRUE.
               CALL IOW_ASKQ(IVH_IOW,'Accept value for the centre',
     +                       CEN_OK)
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
               IF (CEN_OK) THEN
                  XCEN_SPOTS = XTEMP
                  YCEN_SPOTS = YTEMP
                  IXCEN_SPOTS = NINT(XCEN_SPOTS)
                  IYCEN_SPOTS = NINT(YCEN_SPOTS)
                  CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
                  RETURN
               END IF
            GO TO 50
         END IF
         GO TO 100
C
C====== Spot position input
C
      ELSE IF (IVH.EQ.IVH_FILM) THEN
         CALL XDLF_IMAGE_GETPIX (IVH_FILM, IXPIX, IYPIX, IERR)
         IF (ISTYP.EQ.1) THEN
            IXSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_X)
            IXSIZ = IXSIZ/2
            IF (IXSIZ.LT.1) IXSIZ = 1
            IF (IXSIZ.GT.MAX_HALF_BOX) THEN
               CALL ERR_NOTICE (0,'**Spot box size too large**')
               GO TO 100
            END IF
            IYSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_Y)
            IYSIZ = IYSIZ/2
            IF (IYSIZ.LT.1) IYSIZ = 1
            IF (IYSIZ.GT.MAX_HALF_BOX) THEN
               CALL ERR_NOTICE (0,'**Spot box size too large**')
               GO TO 100
            END IF
            CALL SFPIX (IXPIX,IYPIX,ISPIX,IFPIX)
            CALL XDLF_BG_VALIMG(ISPIX,IFPIX,IMG_BG,ITYPE,NF_BGOFF,
     +                          NCMP, IBG, IERR)
            ITHRESH = IBG + NINT(SPOT_INPUT_THRESH)
            CALL SPOT_C_OF_G (IXPIX, IYPIX, IXSIZ, IYSIZ, ISPOT_DATA,
     +           ISWORK, ITHRESH, IMG, ITYPE, IORD, NFRASTS,
     +           NXRAST, NYRAST, NOVER,
     +           CGX, CGY, IERR)
            IF (IERR.LT.0) THEN
               CALL ERR_NOTICE (0,'**Error in spot_c_of_g call**')
               GO TO 100
            ELSE IF (IERR.EQ.2) THEN
               CALL ERR_NOTICE (0,
     +              '**Spot box outside range of image**')
               GO TO 100
            ELSE IF (NOVER.EQ.0) THEN
               CALL ERR_NOTICE (0,'**No pixels above threshold**')
               GO TO 100
            END IF
            IXPIX = NINT (CGX)
            IF (IXPIX.LT.1) IXPIX = 1
            IF (IXPIX.GT.NXRAST) IXPIX = NXRAST
            IYPIX = NINT (CGY)
            IF (IYPIX.LT.1) IYPIX = 1
            IF (IYPIX.GT.NYRAST) IYPIX = NYRAST
         END IF
         IF (ISTYP.EQ.1) THEN
            XCONIC(JCONIC,ICONIC) = CGX
            YCONIC(JCONIC,ICONIC) = CGY
         ELSE
            XCONIC(JCONIC,ICONIC) = IXPIX
            YCONIC(JCONIC,ICONIC) = IYPIX
         END IF
C
C====== Display symbol
C
         CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +        NINT(XCONIC(JCONIC,ICONIC)), 
     +        NINT(YCONIC(JCONIC,ICONIC)),
     +        ISYMBTYP(7), ICOLRTYP(7), 1, IERR)
         IF (JCONIC.EQ.3) THEN
            NUM_CONICS = NUM_CONICS + 1
            IF (NUM_CONICS.EQ.MAX_CONICS) THEN
               CALL ERR_NOTICE (1,'*All Allowed Conics now Input*')
               CONICS_COMPLETE = .TRUE.
               GO TO 100
            ELSE
               ICONIC = ICONIC + 1
            END IF
            JCONIC = 1
         ELSE
            JCONIC = JCONIC + 1
         END IF
         GO TO 50
C
C====== Parameter table input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITM.EQ.IP_STYP) THEN
            CALL LJUST (PVAL)
            CALL CCPUPC (PVAL)
            CALL GETOPT (SMETHOD_UC, 2, PVAL, IOP, IERR)
            IF (IERR.EQ.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Ambiguous selection**'), 23, IERR)
               GO TO 100
            END IF
            IF (IERR.EQ.2) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Invalid Method**'), 18, IERR)
               RETURN
            END IF
            ISTYP = IOP
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(SMETHOD(ISTYP)), 6, 0, IERR)
         ELSE IF (ITM.EQ.IP_SBOX) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_INPUT_BOX = FP
            WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
         ELSE IF (ITM.EQ.IP_THRESH) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_INPUT_THRESH = FP
            WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            CALL LDM_SET_STHR (SPOT_INPUT_THRESH, IERR, ERRSTR)
            LISTE(1) = IP_STHR
            CALL SET_PAR1_VALS (1, LISTE)
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE:
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*************************
C**       HCF           **
C*************************
C
C
      INTEGER    FUNCTION  HCF (II,JJ)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: To calculate h.c.f. of 2 integers
C
C Author:  Based on code from GENLAUE by Clifton et al.
C
C Arguments:
C
      INTEGER    II
      INTEGER    JJ
C 
C II    (R)   First integer
C JJ    (R)   Second integer
C
C====== LOCALS:
C
      INTEGER    I, J, ISAV, K
C
C------------------------------------------------------------------------------
C
      I = II
      J = JJ
      IF (I.EQ.J) THEN
         HCF = I
         RETURN
      END IF

      IF (I.LT.J) THEN
         ISAV = I
         I = J
         J = ISAV
      END IF

      IF (J.EQ.0) THEN
         HCF = I
         RETURN
      END IF

 20   K = MOD(I,J)

      IF (K.EQ.0) THEN
         HCF = J
         RETURN
      END IF

      I = J
      J = K
      GO TO 20

      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     IMAGE_COLOURS     **
C***************************
C
      SUBROUTINE IMAGE_COLOURS (IRED, IGREEN, IBLUE)
C
C Purpose: Get 64 colour colourscale for false coloured images
C
C          blue...green...yellow...orange...red (low...high)
C
C Author:  John W. Campbell, December 1993
C
C Arguments:
C
      INTEGER IRED(64)
      INTEGER IGREEN(64)
      INTEGER IBLUE(64)

C   IRED   (W)   Red components for the 64 colours (0-65535)
C   IGREEN (W)   Green components for the 64 colours (0-65535)
C   IBLUE  (W)   Blue components for the 64 colours (0-65535)
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER I
      INTEGER ICOLR
      INTEGER IV
      REAL H
      REAL S
      REAL V
      REAL R
      REAL G
      REAL B
      REAL TH
      REAL P1
      REAL P2
      REAL P3
      REAL FR

C     INTEGER I        !Temp variable
C     INTEGER ICOLR    !Colours loop variable
C     INTEGER IV       !Integer value
C     REAL H           !Hue 0-1.0
C     REAL S           !Saturation 0-1.0
C     REAL V           !Value 0-1.0
C     REAL R           !Red component 0-1.0
C     REAL G           !Green component 0-1.0
C     REAL B           !Blue component
C     REAL TH          !Hue angle
C     REAL P1          !Temp variable
C     REAL P2          !Temp variable
C     REAL P3          !Temp variable
C     REAL FR          !Fraction
C
C-------------------------------------------------------------------------------
C
C====== Loop through the 64 colours
C
      DO 100 ICOLR = 1, 64
         TH = 3.14159*(ICOLR-1)/63.0
         H = 240.0*(1.0-COS(TH))/2.0
         S = 1.0
         V = 1.0
C
C====== Convert to RGB
C         
         IF (H.EQ.360.0) H = 0.0
         H = H/60.0
         IV = FLOAT(INT(H))
         FR = H - IV
         P1 = V * (1.0-S)
         P2 = V * (1.0 - (S*FR))
         P3 = V * (1.0 - (S * (1.0-FR)))
         I = INT(IV)
         IF (I.EQ.0) THEN
            R = V
            G = P3
            B = P1
         ELSE IF (I.EQ.1) THEN
            R = P2
            G = V
            B = P1
         ELSE IF (I.EQ.2) THEN
            R = P1
            G = V
            B = P3
         ELSE IF (I.EQ.3) THEN
            R = P1
            G = P2
            B = V
         ELSE IF (I.EQ.4) THEN
            R = P3
            G = P1
            B = V
         ELSE IF (I.EQ.5) THEN
            R = V
            G = P1
            B = P2
         END IF
C
C====== Store RGB colour components
C
         IRED(65-ICOLR) = 65535*R
         IGREEN(65-ICOLR) = 65535*G
         IBLUE(65-ICOLR) = 65535*B
100    CONTINUE
       RETURN
       END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INDANG           **
C**************************
C
C
      SUBROUTINE INDANG
C
      INCLUDE 'implicit_none.finc'
C
C
C Purpose: This is a dual purpose routine
C          if nref=0 on entry then first generate reflections with small hkl
C          otherwise nref reflections have already been generated
C
C Author:  Modified version of M. Elder's routine
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      LOGICAL ABSNT
      INTEGER I,II,IIT,IITT,ITEST,J,JJ,JJT,JJTT,JTEST,KK,KKT,KKTT,M,MM
      INTEGER ISYST, IFLAG, ND, LATT
      REAL CELL(6)
      INTEGER NMAX,NRAD2
      REAL AA(3,3),AC1(3,3),AC2(3,3),AC3(3,3),AC4(3,3),AC5(3,3)
      REAL AC6(3,3)
      REAL RCELL(6), CCELL(6)
      CHARACTER*80 STR
      CHARACTER*2 VALSTR
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_LATT (VALSTR, LATT, IFLAG)
      IF (NREF_AUT.LE.0) THEN
C
C====== Generate reflections in a sphere, maximum index is limited by
C====== the nrad2 limit which follows
C
         NMAX = MAX_AUTO_INDX
         NRAD2 = NRAD2_AUT
 
         DO 60 II = -NMAX , NMAX
            ITEST = II**2
            IF (ITEST.LE.NRAD2) THEN
               DO 50 JJ = -NMAX , NMAX
                  JTEST = ITEST + JJ**2
                  IF (JTEST.LE.NRAD2) THEN
                     DO 40 KK = -NMAX , NMAX
                        IF ((JTEST+KK**2).GT.NRAD2) GO TO 40
                        IF (II.EQ.0 .AND. JJ.EQ.0 .AND. KK.EQ.0)
     +                      GO TO 40
C
C====== Identify harmonics
C
                        DO 30 M = 2 , NMAX
                           IF ((IABS(MOD(II,M))+IABS(MOD(JJ,M))+IABS(MOD
     +                         (KK,M))).EQ.0) THEN
                              IF (LATT.EQ.1) GO TO 40
                              IIT = II/M
                              JJT = JJ/M
                              KKT = KK/M
                              DO 20 MM = 1 , M - 1
                                 IITT = IIT*MM
                                 JJTT = JJT*MM
                                 KKTT = KKT*MM
C
C====== and eliminate them if the fundamental or lower harmonic is present.
C
                                 CALL LDM_SYSABS(IITT,JJTT,KKTT,ABSNT)
                                 IF (.NOT.ABSNT) GO TO 40
 20                           CONTINUE
                           END IF
 
 30                     CONTINUE
C
C====== Eliminate systematic absences if there are any
C
                        IF (LATT.NE.1) THEN
                           CALL LDM_SYSABS(II,JJ,KK,ABSNT)
                           IF (ABSNT) GO TO 40
                        END IF
 
                        NREF_AUT = NREF_AUT + 1
                        INDX_AUT(NREF_AUT,1) = II
                        INDX_AUT(NREF_AUT,2) = JJ
                        INDX_AUT(NREF_AUT,3) = KK
                        IF (NREF_AUT.EQ.MAX_AUTO_REFS) THEN
                           STR = '*Only room for'
                           CALL STR_ADDI(STR,MAX_AUTO_REFS,1)
                           CALL STR_ADDS(STR,'standard reflections*',1)
                           CALL LMESSAGE (IVH_IOW,STR)
                           CALL LMESSAGE (IVH_IOW,'*Sphere incomplete*')
                           GO TO 70
 
                        END IF
 
 40                  CONTINUE
                  END IF
 50            CONTINUE
            END IF
 60      CONTINUE

         WRITE(STR,'(I10)')NREF_AUT
         CALL LJUST(STR)
         CALL STR_ADDS(STR,'reflections stored',1)
         CALL LMESSAGE(IVH_IOW,STR)
      END IF
C
C====== Evaluate the standard orientation matrix and then the r. l. coords
C
 70   DO 72 I=1,3
         DO 71 J=1,3
            AA(I,J) = 0.0
 71      CONTINUE
 72   CONTINUE
      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 RECCEL(RCELL,CELL,1.0)
      CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
      CALL CELLCX(ISYST,CCELL,RCELL,2,2)
      CALL MATS(AA,AC1,AC2,AC3,AC4,AC5,AC6,CCELL)
      DO 80 I = 1 , NREF_AUT
         XREF_AUT(1,I) = AA(1,1)*INDX_AUT(I,1) + AA(1,2)*INDX_AUT(I,2)
     +                   + AA(1,3)*INDX_AUT(I,3)
         XREF_AUT(2,I) = AA(2,1)*INDX_AUT(I,1) + AA(2,2)*INDX_AUT(I,2)
     +                   + AA(2,3)*INDX_AUT(I,3)
         XREF_AUT(3,I) = AA(3,1)*INDX_AUT(I,1) + AA(3,2)*INDX_AUT(I,2)
     +                   + AA(3,3)*INDX_AUT(I,3)
         XREF_AUT(4,I) = SQRT(XREF_AUT(1,I)**2+XREF_AUT(2,I)**2
     +                       +XREF_AUT(3,I)**2)
 80   CONTINUE
C
C====== Now loop through all pairs of reflections calculating inter-planar
C====== angles
C
      DO 100 I = 1 , NREF_AUT
         DO 90 J = 1 , I
            IF (I.EQ.J) THEN
               A_AUT(I,J) = 0.0
               GO TO 90
 
            END IF
 
            A_AUT(I,J) = (XREF_AUT(1,I)*XREF_AUT(1,J)
     +                   +XREF_AUT(2,I)*XREF_AUT(2,J)
     +                   +XREF_AUT(3,I)*XREF_AUT(3,J))
     +                   /(XREF_AUT(4,I)*XREF_AUT(4,J))
            IF (ABS(A_AUT(I,J)).GT.0.9999) THEN
               A_AUT(I,J) = 1.
            END IF
 
            A_AUT(I,J) = ACOS(A_AUT(I,J))
            A_AUT(J,I) = A_AUT(I,J)
 90      CONTINUE
 100  CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INDCHK           **
C**************************
C
C
      SUBROUTINE INDCHK(I,ITEST)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check to see if reflection in position i of indx is in the
C          unique set of reflections because of lattice symmetry.
C          return itest=1 if so, else itest=0.
C
C Author:  Modified version of M. Elder's routine
C
C Arguments:
C
      INTEGER I
      INTEGER ITEST
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      INTEGER IH,IK,IL,ISYST,IFLAG
      CHARACTER*2 VALSTR
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
      ITEST = 0
      IH = INDX_AUT(I,1)
      IK = INDX_AUT(I,2)
      IL = INDX_AUT(I,3)
      IF (ISYST.EQ.2) THEN
C
C====== Monoclinic
C
         IF (IK.LT.0) RETURN
         IF (IH.LT.0) RETURN
         IF (IH.EQ.0 .AND. IL.LT.0) RETURN
         GO TO 20
      ELSE IF (ISYST.EQ.3) THEN
C
C====== Orthorhombic
C
         IF (IH.LT.0) RETURN
         IF (IK.LT.0) RETURN
         IF (IL.LT.0) RETURN
         GO TO 20
      ELSE IF (ISYST.EQ.4) THEN
C
C====== Tetragonal
C
         IF (IH.LT.0) RETURN
         IF (IK.LT.0) RETURN
         IF (IL.LT.0) RETURN
         IF (IH.GT.IK) RETURN
         GO TO 20
      ELSE IF (ISYST.EQ.5) THEN
C
C====== Hexagonal
C
         IF (IH.LT.0) RETURN
         IF (IL.LT.0) RETURN
         IF (IK.LT.0) RETURN
         IF (IK.GT.IH) RETURN
         GO TO 20
      ELSE IF (ISYST.EQ.6) THEN
C
C====== Rhombohedral
C
         IF (IH.LT.0) RETURN
         IF (IK.LT.0) RETURN
      ELSE IF (ISYST.NE.7) THEN
C
C====== Triclinic
C
         IF (IH.LT.0) RETURN
         IF (IH.EQ.0 .AND. IK.LT.0) RETURN
         IF (IH.EQ.0 .AND. IK.EQ.0 .AND. IL.LT.0) RETURN
         GO TO 20
      END IF
C
C====== Cubic
C
      IF (IH.LT.0) RETURN
      IF (IK.LT.0) RETURN
      IF (IL.LT.0) RETURN
      IF (IH.GT.IK) RETURN
      IF (IK.GT.IL) RETURN
C
C====== Acceptable
C
 20   ITEST = 1
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INDMAT           **
C**************************
C
C
      SUBROUTINE INDMAT(NOBS,ANGL,NSOL,IPSOL,MAX_M)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Try to match the spots
C
C          Target is at least 3 matches of nobs nodals against nref
C          calculated spots.
C
C          Aim at 3 matches (max_m), with angles between spots agreeing with
C          pre-calculated angles to within delta (difference of cosines).
C
C Author:  Modified version of M. Elder's routine
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C Arguments:
C
      INTEGER NOBS
      REAL ANGL(MAX_AUTO_SPOTS,MAX_AUTO_SPOTS)
      INTEGER NSOL
      INTEGER IPSOL(MAX_AUTO_SOLNS,MAX_AUTO_SPOTS)
      INTEGER MAX_M
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      REAL DELTA_ANG
      REAL CTOF
      INTEGER I,IPJ,ITEST,J,K,MC,N
      INTEGER IP(MAX_AUTO_SPOTS),KP(2,3),KPP(2)
      INTEGER IFLAG, ND, IERR
      CHARACTER*2 ERRSTR
C
C-------------------------------------------------------------------------------
C
C====== Set angular tolerance
C
      CALL LDM_GET_CTOF (IPACK, IPLATE, CTOF, IFLAG, ND, IERR, ERRSTR)
      DELTA_ANG = 1.4*ATAN2(1.4*SPERR,CTOF)
      MAX_M = 4
C
C====== NSOL counts equivalent solutions (sets of matches having same max_m)
C====== I moves along the standard reflections (up to nref)
C====== MC counts matches so far in the solution being studied
C====== N moves along the user's measured spots (up to nobs)
C
      NSOL = 0
      I = 1
      MC = 0
      N = 1
C
C====== If there is no match so far then the present possible match must
C====== be assumed to be true
C
 20   IF (MC.EQ.0) THEN
C
C====== Before accepting this first match check that it is not going to
C====== introduce unnecessary ambiguities because of lattice symmetry.
C
         CALL INDCHK(I,ITEST)
         IF (ITEST.EQ.0) GO TO 70
         GO TO 40
 
      END IF
C
C====== Determine if this possible match is compatible with earlier ones
C====== the requirement is that all angle pairs involving this match must
C====== agree with the corresponding calculated standard pairs
C
      DO 30 J = 1 , N - 1
         IPJ = IP(J)
         IF (IPJ.NE.0) THEN
            IF (ABS(ANGL(N,J)-A_AUT(IPJ,I)).GT.DELTA_ANG) GO TO 70
         END IF
 30   CONTINUE
C
C====== All pairs agree so this match is acceptable - add to list
C====== IP is the array containing the matches for the current solution
C
 40   IP(N) = I
      MC = MC + 1
C
C====== Take the next of the spots in the input list
C====== try to match it first against the first standard
C
 50   IF (N.EQ.NOBS) THEN
C
C====== End of a solution - test how many matches
C
         IF (MC.GE.MAX_M) THEN
            IF (MC.GT.MAX_M) THEN
C
C====== The best solution so far
C
               NSOL = 1
               MAX_M = MC
 
            ELSE
C
C====== Another equally good solution
C
               NSOL = NSOL + 1
            END IF
C
C====== Add this solution to the list - but do not overflow the array
C
            IF (NSOL.LE.MAX_AUTO_SOLNS) THEN
               DO 60 K = 1 , NOBS
                  IPSOL(NSOL,K) = IP(K)
 60            CONTINUE
            END IF
         END IF
         GO TO 80
      ELSE
         N = N + 1
         I = 1
         GO TO 20
      END IF
C
C====== Try the next of the standards as a possible match
C
 70   IF (I.EQ.NREF_AUT) THEN
C
C====== This spot can not be matched successfully
C
         IP(N) = 0
C
C====== To avoid wasting time - check that it is still possible to reach
C====== the target (max_m) even if all remaining spots can be matched
C
         IF ((MC+NOBS-N).GE.MAX_M) GO TO 50
      ELSE
         I = I + 1
         GO TO 20
      END IF
C
C====== This point is where the last step in the current solution is
C====== reversed and a new solution looked for
C
 80   I = IP(N)
      IF (I.GT.0) THEN
         MC = MC - 1
         GO TO 70
 
      ELSE
         N = N - 1
         IF (N.GT.0) GO TO 80
C
C====== The end
C
         RETURN
      END IF
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     INIT_FLAGS        **
C***************************
C
      SUBROUTINE INIT_FLAGS
C
C Purpose: Initialise program flags
C
C Author:  John W. Campbell, September 1994
C
C Arguments:
C
C None
C
C====== GLOBALS:
C
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
C
C-------------------------------------------------------------------------------
C
      FILM_READ = .FALSE.
      FILM_OPEN = .FALSE.
      PROCESS = .FALSE. 
      IPACK_OPN = 0
      IPLATE_OPN = 0
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INIT_LIRL        **
C**************************
C
C
      SUBROUTINE INIT_LIRL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Initialise LIRL and integration flags
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LDM_PKMAX
      INTEGER LDM_PLMAX
C
C====== LOCALS:
C
      INTEGER I
      INTEGER NFLAGS
      INTEGER IERR
      INTEGER IARR(2)

C     INTEGER I             !Temp/loop variable
C     INTEGER NFLAGS        !No. of integration flags 
C     INTEGER IERR          !Error flag
C     INTEGER IARR(2)       !Array for setting flag 
C
C-------------------------------------------------------------------------------
C
C====== Initialise or re-initialise LIRL
C
      IF (KDX_LIRL.GE.0) THEN
         CALL LIRLF_FREE (KDX_LIRL, IERR)
         KDX_LIRL = -1
      END IF
     
      CALL LIRLF_INIT (1000, 1000, 0, 0, KDX_LIRL)
      IF (KDX_LIRL.LT.0) THEN
         WRITE (6,2001) KDX_LIRL
         STOP
      END IF
C
C====== Set up integration flags list if required
C
      NFLAGS = LDM_PKMAX(0)*LDM_PLMAX(0)
      IF (KDX_INTFLAGS.LT.0) THEN
         CALL DMLF_INIT (NFLAGS, 10, 1, KDX_INTFLAGS)
         IF (KDX_INTFLAGS.LT.0) THEN
            WRITE (6,2002) KDX_INTFLAGS
            STOP
         END IF
         IARR(1) = 0
         DO 100 I = 1, NFLAGS
            CALL DMLF_ADDREC (KDX_INTFLAGS, IARR, IERR)
 100     CONTINUE
      ELSE
C
C====== Clear integration flags
C
         IARR(1) = 0
         DO 110 I = 1, NFLAGS
            CALL DMLF_PUTREC (KDX_INTFLAGS, I, IARR, IERR)
 110     CONTINUE
      END IF
C
C====== Clear profiles determined flags
C
      IPRF_PK = 0
      IPRF_PL = 0
C
C====== Clear last integrated plate flags
C
      INTEG_LASTPK = 0
      INTEG_LASTPL = 0
C
C====== Format statements
C
2001  FORMAT (/,'**Error** Cannot allocate LIRL, code =',I3,/)
2002  FORMAT (/,'**Error** Cannot allocate integration flags',
     +        ', code =',I3,/)
C
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     INIT_SETTINGS     **
C***************************
C
      SUBROUTINE INIT_SETTINGS
C
C Purpose: Initialise program parameter settings
C
C Author:  John W. Campbell, September 1994
C
C Arguments:
C
C None
C
C
C====== PARAMETERS:
C
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'film_pack.finc'
      INCLUDE 'gnom_rmin.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'spot_sizes.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'matches.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      LOGICAL IDUM_PRF_ROT
      INTEGER IDUM_NPROF
      REAL RDUM_PROMIN

C     LOGICAL IDUM_PRF_ROT !Dummy value for prf_rot (LAUEGEN uses its own
C                         extended LDM parameter value)
C     INTEGER IDUM_NPROF !Dummy value for nprof (LAUEGEN uses its own
C                         extended LDM parameter value)
C     REAL RDUM_PROMIN   !Dummy value for promin (LAUEGEN uses its own
C                         extended LDM parameter value)
C
C-------------------------------------------------------------------------------
C
      IPACK = 1
      IPLATE = 1
      NUM_OBS = 0
      NUM_MATCH = 0
      NUM_SELECT = 0
      NUM_INP_SPOTS = 0
      IFILM_SPOTS = 0
      SPOT_INPUT_BOX = 1.0
      GNOMR = 0.0
      CALL LFN_SOFT_DF (1, MAX_SOFT_BINS,  IDUM_NPROF, IDUM_PRF_ROT, 
     +                 RDUM_PROMIN, SOFT_FRAC, 
     +                 SOFT_SIGTEST, SOFT_FRTEST,
     +                 ISOFT_D_NUMBINS, SOFT_DMIN_WIDTH)
      CALL LFN_SOFT_DF (2,  MAX_SOFT_BINS, IDUM_NPROF, IDUM_PRF_ROT,  
     +                 RDUM_PROMIN, SOFT_FRAC, 
     +                 SOFT_SIGTEST, SOFT_FRTEST,
     +                 ISOFT_L_NUMBINS, SOFT_LMIN_WIDTH)
      CALL SPOTSIZE_DFLTS (ISPOT_NBIN, SPOT_SDCUT, SPOT_THRFAC,
     +                     SPOT_EXPAND)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INPUT_SPOTS      **
C**************************
C
C
      SUBROUTINE INPUT_SPOTS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Input measured spot positions (esp. for auto-indexing)
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'image.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'spot_box.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER I_ADD
      INTEGER I_DEL
      INTEGER IADDEL
      INTEGER NVIEW
      INTEGER IVHLIST(3)
      INTEGER IVH
      INTEGER IQUIT
      INTEGER ITEM
      INTEGER IERR
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER NOVER
      INTEGER ID
      INTEGER IDSQMIN
      INTEGER IDSQLIM
      INTEGER ISPOT
      INTEGER ITHRESH
      INTEGER IBG
      INTEGER ISTYP
      INTEGER IOP
      INTEGER ITYP
      INTEGER IV
      INTEGER ITM
      INTEGER IP_STYP
      INTEGER IP_SBOX
      INTEGER IP_THRESH
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IFLAG
      INTEGER IORD
      INTEGER ISWAP
      INTEGER ND
      INTEGER LISTE(2)
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL CGX
      REAL CGY
      REAL FP
      CHARACTER*80 STR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL
      CHARACTER*25 NAMES(2)
      CHARACTER*25 QUITNAM
      CHARACTER*6 SMETHOD(2)
      CHARACTER*6 SMETHOD_UC(2)
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     INTEGER I           !Loop counter
C     INTEGER I_ADD       !Menu item number for 'Add Spots'
C     INTEGER I_DEL       !Menu item number for 'Delete Spots'
C     INTEGER IADDEL      !Flag =1 add, =2 delete spots
C     INTEGER NVIEW       !No. of view-objects for getting events
C     INTEGER IVHLIST(3)  !List of view-objects for getting events
C     INTEGER IVH         !Returned view-object handle from events input
C     INTEGER IQUIT       !Quit box selected flag =1 yes, =0 no
C     INTEGER ITEM        !Item no. selected from the menu
C     INTEGER IERR        !Error return flag
C     INTEGER IXPIX       !x pixel value from film image view-object
C     INTEGER IYPIX       !y pixel value from film image view-object
C     INTEGER ISPIX       !Pixel position along slow axis
C     INTEGER IFPIX       !Pixel position along fast axis
C     INTEGER IXSIZ       !Spot box half size x
C     INTEGER IYSIZ       !Spot box half size y
C     INTEGER NOVER       !no. of pixels over the threshold value
C     INTEGER ID          !Distance squared
C     INTEGER IDSQMIN     !Minimum distance squared so far found
C     INTEGER IDSQLIM     !Max limit of IDSQMIN to consider a match
C     INTEGER ISPOT       !Spot number of closest selected spot
C     INTEGER ITHRESH     !Threshold value
C     INTEGER IBG         !Background value at spot position
C     INTEGER ISTYP       !Spot method 1=c_of_g, 2=input (cursor)
C     INTEGER IOP         !Option from GETOPT
C     INTEGER ITYP        !Type of number input flag (from INTFP)
C     INTEGER IV          !Integer value returned from INTFP
C     INTEGER ITM         !Parameter table selected item number
C     INTEGER IP_STYP     !Parameter table 3 item: Spot method
C     INTEGER IP_SBOX     !Parameter table 3 item: Spot box size
C     INTEGER IP_THRESH   !Parameter table 3 item: Spot threshold
C     INTEGER NXRAST      !No. x-rasters
C     INTEGER NYRAST      !No. y-rasters
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER IORD        !Axis order flag 1-8
C     INTEGER ISWAP       !Byte swap flag
C     INTEGER ND          !No. of decimal places flag
C     INTEGER LISTE(2)    !Parameter updates list
C     REAL MM_RAST_X      !mm to x-rasters conversion factor
C     REAL MM_RAST_Y      !mm to y-rastrs conversion factor
C     REAL CGX            !x centre of gravity
C     REAL CGY            !y centre of gravity
C     REAL FP             !Floating point value returned from INTFP
C     CHARACTER*80 STR    !Temporary string
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !Return string from parameter table 3
C     CHARACTER*25 NAMES(2)      !Names for the menu items
C     CHARACTER*25 QUITNAM       !Quit box label
C     CHARACTER*6 SMETHOD(2)     !Spot method option strings
C     CHARACTER*6 SMETHOD_UC(2)  !Spot method option strings (upper case)
C     CHARACTER*2 VALSTR         !paramter value string (dummy)
C     CHARACTER*2 ERRSTR   !Error string (dummy)

      DATA NAMES /'Add Spots',
     +            'Delete Spots'/
      DATA QUITNAM /'End Spots Input'/
      DATA SMETHOD /'c_of_g','input'/
      DATA SMETHOD_UC /'C_OF_G','INPUT'/

C-------------------------------------------------------------------------------
C
C====== Set IDSQLIM
C
      IDSQLIM = 18 * NCMP * NCMP
C
C====== Other initialisations
C
      CALL LDM_GET_STHR (SPOT_INPUT_THRESH, IFLAG, ND)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
C
C====== Set up parameter table 3
C
      IP_STYP = 1
      IP_SBOX = 3
      IP_THRESH = 4

      ISTYP = 1

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_STYP,
     +     XDLSTR('Spot method:'), 12,
     +     XDLSTR(SMETHOD(1)),6, 0, 0, IERR)
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR3, IP_STYP,
     +     2, XDLSTR(SMETHOD), 6, IERR)
      WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_SBOX,
     +     XDLSTR('Spot box (mm):'), 14,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_THRESH,
     +     XDLSTR('Spot threshold:'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
C
C====== Set up menu
C
      I_ADD = 1
      I_DEL = 2
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 2, XDLSTR(NAMES), 24,
     *                             XDLSTR('Input Spots'), 11,
     *                             XDLSTR(QUITNAM), 24, 0, IERR)
C
C====== Set up event loop for first menu input
C
      IADDEL = 1
      CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     *     XDLSTR('Input Spot Positions'), 20, IERR)
      NVIEW = 3
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_FILM
      IVHLIST(3) = IVH_PAR3
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
C
C====== Menu item selected
C
      IF (IVH.EQ.IVH_MENU) THEN
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C====== Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            RETURN
         END IF
C
C====== Add spots
C
         IF (ITEM.EQ.I_ADD) THEN
            IADDEL = 1
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     *           XDLSTR('Input Spot Positions'), 20, IERR)
            GO TO 100
C
C====== Delete spots
C
         ELSE IF (ITEM.EQ.I_DEL) THEN
            IADDEL = 2
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     *           XDLSTR('Select Spots to Delete'), 22, IERR)
            GO TO 100
         END IF
         GO TO 100
C
C====== Spot position input
C
      ELSE IF (IVH.EQ.IVH_FILM) THEN
C
C====== Add spot: Find spot
C
         IF (IADDEL.EQ.1) THEN
            CALL XDLF_IMAGE_GETPIX (IVH_FILM, IXPIX, IYPIX, IERR)
            IF (ISTYP.EQ.1) THEN
               IXSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_X)
               IXSIZ = IXSIZ/2
               IF (IXSIZ.LT.1) IXSIZ = 1
               IF (IXSIZ.GT.MAX_HALF_BOX) THEN
                  CALL ERR_NOTICE (1,'**Spot box size too large**')
                  GO TO 100
               END IF
               IYSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_Y)
               IYSIZ = IYSIZ/2
               IF (IYSIZ.LT.1) IYSIZ = 1
               IF (IYSIZ.GT.MAX_HALF_BOX) THEN
                  CALL ERR_NOTICE (1,'**Spot box size too large**')
                  GO TO 100
               END IF
               CALL SFPIX (IXPIX,IYPIX,ISPIX,IFPIX)
               CALL XDLF_BG_VALIMG(ISPIX,IFPIX,IMG_BG,ITYPE,NF_BGOFF,
     +                             NCMP, IBG, IERR)
               ITHRESH = IBG + NINT(SPOT_INPUT_THRESH)
               CALL SPOT_C_OF_G (IXPIX, IYPIX, IXSIZ, IYSIZ, ISPOT_DATA,
     +              ISWORK, ITHRESH, IMG, ITYPE, IORD, NFRASTS,
     +              NXRAST, NYRAST, NOVER,
     +              CGX, CGY, IERR)
               IF (IERR.LT.0) THEN
                  CALL ERR_NOTICE (0,'**Error in spot_c_of_g call**')
                  GO TO 100
               ELSE IF (IERR.EQ.2) THEN
                  CALL ERR_NOTICE (1,
     +                 '**Spot box outside range of image**')
                  GO TO 100
               ELSE IF (NOVER.EQ.0) THEN
                  CALL ERR_NOTICE (1,'**No pixels above threshold**')
                  GO TO 100
               END IF
               IXPIX = NINT (CGX)
               IF (IXPIX.LT.1) IXPIX = 1
               IF (IXPIX.GT.NXRAST) IXPIX = NXRAST
               IYPIX = NINT (CGY)
               IF (IYPIX.LT.1) IYPIX = 1
               IF (IYPIX.GT.NYRAST) IYPIX = NYRAST
            END IF
C
C====== Add spot to spot list
C
            IF (NUM_INP_SPOTS.GE.MAX_MEAS) THEN
               CALL ERR_NOTICE (1,'**Spot list full**')
               GO TO 100
            END IF
            NUM_INP_SPOTS = NUM_INP_SPOTS + 1
            IXINP_SPOTS(NUM_INP_SPOTS) = IXPIX
            IYINP_SPOTS(NUM_INP_SPOTS) = IYPIX
            IF (ISTYP.EQ.1) THEN
               XINP_SPOTS(NUM_INP_SPOTS) = CGX
               YINP_SPOTS(NUM_INP_SPOTS) = CGY
            ELSE
               XINP_SPOTS(NUM_INP_SPOTS) = IXPIX
               YINP_SPOTS(NUM_INP_SPOTS) = IYPIX
            END IF
C
C====== Display symbol
C
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, IXPIX, IYPIX,
     +           ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
            GO TO 100
C
C====== Delete spot: Identify the spot in the list of spots
C
         ELSE IF (IADDEL.EQ.2) THEN
            IF (NUM_INP_SPOTS.EQ.0) THEN
               CALL ERR_NOTICE (1,'**No spots in the list**')
               GO TO 100
            END IF
            CALL XDLF_IMAGE_GETPIX_OVLY (IVH_FILM, 1, IXPIX, IYPIX,
     *                                       IERR)
            IDSQMIN = NXRAST*NXRAST + NYRAST*NYRAST
            DO 200 I = 1, NUM_INP_SPOTS
            ID = (IXPIX-IXINP_SPOTS(I))*(IXPIX-IXINP_SPOTS(I)) +
     *           (IYPIX-IYINP_SPOTS(I))*(IYPIX-IYINP_SPOTS(I))
            IF (ID.LT.IDSQMIN) THEN
               IDSQMIN = ID
               ISPOT = I
            END IF
200         CONTINUE
C
C====== Do not delete closest symbol if too far away
C
            IF (IDSQMIN.GT.IDSQLIM) GO TO 100
C
C====== Delete symbol from the display
C
            CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM, 
     +                IXINP_SPOTS(ISPOT), IYINP_SPOTS(ISPOT), 
     +                ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
C
C====== Delete spot from the spots list
C
            IF (ISPOT.LT.NUM_INP_SPOTS) THEN
               DO 300 I = ISPOT+1, NUM_INP_SPOTS
                  IXINP_SPOTS(I-1) = IXINP_SPOTS(I)
                  IYINP_SPOTS(I-1) = IYINP_SPOTS(I)
                  XINP_SPOTS(I-1) = XINP_SPOTS(I)
                  YINP_SPOTS(I-1) = YINP_SPOTS(I)
300            CONTINUE
            NUM_INP_SPOTS = NUM_INP_SPOTS - 1
            GO TO 100
            END IF
         END IF
C
C====== Parameter table input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITM.EQ.IP_STYP) THEN
            CALL LJUST (PVAL)
            CALL CCPUPC (PVAL)
            CALL GETOPT (SMETHOD_UC, 2, PVAL, IOP, IERR)
            IF (IERR.EQ.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Ambiguous selection**'), 23, IERR)
               GO TO 100
            END IF
            IF (IERR.EQ.2) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Invalid Method**'), 18, IERR)
               RETURN
            END IF
            ISTYP = IOP
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(SMETHOD(ISTYP)), 6, 0, IERR)
         ELSE IF (ITM.EQ.IP_SBOX) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_INPUT_BOX = FP
            WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
         ELSE IF (ITM.EQ.IP_THRESH) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_INPUT_THRESH = FP
            WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            CALL LDM_SET_STHR (SPOT_INPUT_THRESH, IERR, ERRSTR)
            LISTE(1) = IP_STHR
            CALL SET_PAR1_VALS (1, LISTE)
         END IF
         GO TO 100
      END IF
      GO TO 100
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INT_FILNAM       **
C**************************
C
C
      SUBROUTINE INT_FILNAM (INT_TEMPL, FILNAM)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get file name for intensities file for current pack from
C          template, explcit file name & file type parameters
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      CHARACTER*(*) INT_TEMPL
      CHARACTER*(*) FILNAM
C
C INT_TEMPL (R)  Template from which to form file name or blank to form name
C                from the current value of the INT_TEMPLATE parameter
C FILNAM    (W)  Returns intensities file name for current pack (Note that
C                extension will be returned as 'ge*' for .ge1/.ge2 type
C                file output.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I_TYP
      INTEGER IPID
      INTEGER NDIG
      INTEGER LL
      INTEGER I
      INTEGER J
      INTEGER ILEN
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER IERR
      INTEGER ND
      REAL FP
      CHARACTER*(MAXFLEN) FNAM
      CHARACTER*(MAXFLEN) STR1
      CHARACTER*(MAXFLEN) STR2
      CHARACTER*(MAXFLEN) TEMPLATE
      CHARACTER*80 STR
      CHARACTER*8 FRM
      CHARACTER*2 ERRSTR

C     INTEGER I_TYP                 !Intensities file type 1=mtz, 2=.ge1/.ge2
C     INTEGER IPID                  !Pack id.
C     INTEGER NDIG                  !No. of digits in '#' field
C     INTEGER LL                    !String length
C     INTEGER I                     !Temp/loop variable
C     INTEGER J                     !Temp/loop variable
C     INTEGER ILEN                  !File name less extension length
C     INTEGER IVAL                  !Integer parameter value
C     INTEGER IFLAG                 !Parameter status flag
C     INTEGER ITYP                  !Parameter type flag
C     INTEGER IERR                  !Error flag
C     INTEGER ND                    !No. of decimal places flag
C     REAL FP                       !Real parameter value
C     CHARACTER*(MAXFLEN) FNAM      !File name string
C     CHARACTER*(MAXFLEN) STR1      !Temp string
C     CHARACTER*(MAXFLEN) STR2      !Temp string
C     CHARACTER*80 STR              !Temp string
C     CHARACTER*(MAXFLEN) TEMPLATE  !File name template string
C     CHARACTER*8 FRM               !Format string
C     CHARACTER*2 ERRSTR            !Error string (dummy)

      DATA FRM /'(I25.XX)'/
C
C-------------------------------------------------------------------------------
C
C====== Find file type
C
      CALL LDM_GET ('INT_FTYPE', IPACK, IPLATE, STR, FP, ND, IVAL,
     +              IFLAG, ITYP, IERR, ERRSTR)
      I_TYP = 1
      IF (STR.EQ.'ge') I_TYP = 2
C
C====== Form name from template
C
      IF (INT_TEMPL.EQ.' ') THEN
         CALL LDM_GET ('INT_TEMPLATE', IPACK, IPLATE, TEMPLATE, 
     +                 FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      ELSE
         TEMPLATE = INT_TEMPL
      END IF
      NDIG  = 1
      STR1 = ' '
      STR2 = ' '
      LL = LENSTR(TEMPLATE)
      I = 0
      J = 0
10    I = I + 1
      IF (I.LE.LL) THEN
         IF (TEMPLATE(I:I).NE.'#') THEN
            J = J + 1
            STR1(J:J) = TEMPLATE(I:I)
            GO TO 10
         END IF
      END IF
20    I = I + 1
      IF (I.LE.LL) THEN
         IF (TEMPLATE(I:I).EQ.'#') THEN
            NDIG = NDIG + 1
            GO TO 20
         END IF
      END IF
      IF (I.LE.LL) STR2 = TEMPLATE(I:LL)
C
C====== Now add pack_id
C
      CALL LDM_GET_PID (IPACK, IPID, IFLAG, IERR, ERRSTR)
      FNAM = STR1
      WRITE (FRM(6:7),'(I2.2)')NDIG
      WRITE (STR,FRM) IPID
      LL = LENSTR(STR)
      J = 0
      DO 30 I = 1, LL
         IF (STR(I:I).NE.' ') THEN
            STR = STR(I:LL)
            GO TO 40
         END IF
30    CONTINUE
40    CALL STR_ADDS(FNAM,STR,0)
      CALL STR_ADDS (FNAM,STR2,0)
      IF (I_TYP.EQ.1) THEN
         FILNAM = FNAM
      ELSE
         CALL FILEXT (FNAM, 'xxx', FILNAM, ILEN)
         FNAM = FILNAM(1:ILEN)
         CALL FILEXT (FNAM, 'ge*', FILNAM, ILEN)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INT_PTAB3        **
C**************************
C
C
      SUBROUTINE INT_PTAB3 (IOP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up parameter table 3 for integration opion & return current
C          parameter values via common (or update table)
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      INTEGER IOP
C
C IOP        (R)    Flag =0 set up table, 
C                        =1 get value from parameter table & update table
C                        =2 just update table
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER IP_FTYP
      INTEGER IP_TEMPL
      INTEGER IP_NPROF
      INTEGER IP_ROTAT
      INTEGER IP_PROMIN
      INTEGER IP_PRALL
      INTEGER IP_SCAL
      INTEGER IP_OVLIM
      INTEGER ITEM
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER IERR
      INTEGER ND
      INTEGER ITOG
      REAL FP
      CHARACTER*20 STR
      CHARACTER*80 ERRSTR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL 
      CHARACTER*(MAXFLEN) INT_TEMPL 

C     INTEGER IP_FTYP          !Parameter table 3 item: Intensities file type
C     INTEGER IP_TEMPL         !Parameter table 3 item: File template
C     INTEGER IP_NPROF         !Parameter table 3 item: No. profile bins
C     INTEGER IP_ROTAT         !Parameter table 3 item: Rotate profiles flag
C     INTEGER IP_PROMIN        !Parameter table 3 item: Min I for profiles
C     INTEGER IP_PRALL         !Parameter table 3 item: Profiles for all plates
C     INTEGER IP_SCAL          !Parameter table 3 item: Intensities o/p scale
C     INTEGER IP_OVLIM         !Parameter table 3 item: No. allowed ovld. pix.
C     INTEGER ITEM             !Returned parameter table item number
C     INTEGER IVAL             !Integer parameter value
C     INTEGER IFLAG            !Parameter status flag
C     INTEGER ITYP             !Parameter type flag
C     INTEGER IERR             !Error flag
C     INTEGER ND               !No. of decimal places flag
C     INTEGER ITOG             !Parameter table toggle flag
C     REAL FP                  !Real parameter value
C     CHARACTER*20 STR         !Temp string
C     CHARACTER*80 ERRSTR      !Error string 
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL  !Returned parameter value string
C     CHARACTER*(MAXFLEN) INT_TEMPL  !File name template string
C
C-------------------------------------------------------------------------------
C
      IP_FTYP = 1
      IP_TEMPL = 2
      IP_NPROF = 3
      IP_ROTAT = 4
      IP_PROMIN = 5
      IP_PRALL = 6
      IP_OVLIM = 7
      IP_SCAL = 8
C
C====== Get value from parameter table if update option
C
      IF (IOP.EQ.1) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITEM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITEM.EQ.IP_FTYP) THEN
            CALL LDM_SET ('INT_FTYPE', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_TEMPL) THEN
            CALL LDM_SET ('INT_TEMPLATE', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_NPROF) THEN
            CALL LDM_SET ('NPROF', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_ROTAT) THEN
            CALL LDM_SET ('PROF_ROTATE', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_PROMIN) THEN
            CALL LDM_SET ('PROMIN', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_PRALL) THEN
            CALL LDM_SET ('PROF_ALL', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_OVLIM) THEN
            CALL LDM_SET ('OVLIM', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         ELSE IF (ITEM.EQ.IP_SCAL) THEN
            CALL LDM_SET ('SCALE_INT', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 810
         END IF
      END IF
C
C====== Update all parameters
C
C
C====== Intensities file type
C
      CALL LDM_GET ('INT_FTYPE', IPACK, IPLATE, STR, FP, ND, INT_TYP,
     +              IFLAG, ITYP, IERR, ERRSTR)
      INT_TYP = 1
      IF (STR.EQ.'ge') INT_TYP = 2
      IF (IOP.EQ.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_FTYP,
     +     XDLSTR('int_ftype:'), 10,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_FTYP,
     +                   XDLSTR(STR), LENSTR(STR), 0, IERR)
      END IF
C
C====== Intensities file template
C
      CALL LDM_GET ('INT_TEMPLATE', IPACK, IPLATE, INT_TEMPL, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (IOP.EQ.0) THEN 
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_TEMPL,
     +     XDLSTR('int_template:'), 13,
     +     XDLSTR(INT_TEMPL), LENSTR(INT_TEMPL), 0, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_TEMPL,
     +                XDLSTR(INT_TEMPL), LENSTR(INT_TEMPL), 0, IERR)
      END IF
C
C====== No. of profile fitting bins
C
      CALL LDM_GET ('NPROF', IPACK, IPLATE, STR, 
     +              FP, ND, NPROF, IFLAG, ITYP, IERR, ERRSTR)
      WRITE (STR,'(I8)') NPROF
      CALL LJUST(STR)
      IF (IOP.EQ.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_NPROF,
     +     XDLSTR('nprof:'), 6,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_NPROF,
     +                   XDLSTR(STR), LENSTR(STR), 0, IERR)
      END IF
C
C====== Rotate profiles
C
      PRF_ROT = .FALSE.
      CALL LDM_GET ('PROF_ROTATE', IPACK, IPLATE, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (STR.EQ.'yes') PRF_ROT = .TRUE.
      ITOG = 4
      IF (PRF_ROT) ITOG = 3
      IF (IOP.EQ.0) THEN 
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_ROTAT,
     +     XDLSTR('prof_rotate:'), 12,
     +     XDLSTR(' '), 1, ITOG, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_ROTAT,
     +                   XDLSTR(' '), LENSTR(' '), ITOG, IERR)
      END IF
C
C====== PROMIN
C
      CALL LDM_GET ('PROMIN', IPACK, IPLATE, STR, 
     +              PROMIN, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      WRITE (STR,'(F8.1)') PROMIN
      CALL LJUST (STR)
      IF (IOP.EQ.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_PROMIN,
     +     XDLSTR('promin:'), 7,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_PROMIN,
     +                   XDLSTR(STR), LENSTR(STR), 0, IERR)
      END IF
C
C====== Profiles for all bins
C
      IPRF_ALL = 0
      CALL LDM_GET ('PROF_ALL', IPACK, IPLATE, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (STR.EQ.'yes') IPRF_ALL = 1
      IF (IOP.EQ.0) THEN 
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_PRALL,
     +     XDLSTR('prof_all:'), 9,
     +     XDLSTR(' '), 1, 4-IPRF_ALL, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_PRALL,
     +                   XDLSTR(' '), LENSTR(' '), 4-IPRF_ALL, IERR)
      END IF
C
C====== No. of allowed overloaded pixels - OVLIM
C
      CALL LDM_GET ('OVLIM', IPACK, IPLATE, STR, 
     +              FP, ND, NOVLD, IFLAG, ITYP, IERR, ERRSTR)
      WRITE (STR,'(I8)') NOVLD
      CALL LJUST(STR)
      IF (IOP.EQ.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_OVLIM,
     +     XDLSTR('ovlim:'), 6,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_OVLIM,
     +                   XDLSTR(STR), LENSTR(STR), 0, IERR)
      END IF
C
C====== Scale for output intensities - SCALE_INT
C
      CALL LDM_GET ('SCALE_INT', IPACK, IPLATE, STR, 
     +              SCAL_INT, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      WRITE (STR,'(F8.3)') SCAL_INT
      CALL LJUST (STR)
      IF (IOP.EQ.0) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_SCAL,
     +     XDLSTR('scale_int:'), 10,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
      ELSE 
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, IP_SCAL,
     +                   XDLSTR(STR), LENSTR(STR), 0, IERR)
      END IF
      RETURN
C
C====== General Error Condition
C
810   CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITEM,
     +     XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INTEG_SINGSPOT   **
C**************************
C
C
      SUBROUTINE INTEG_SINGSPOT (ISPOT, IMG_DISP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Integrate a single spot and show results
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      INTEGER ISPOT
      LOGICAL IMG_DISP
C
C ISPOT     (R)   No. of spot to be integrated in LRL
C IMG_DISP  (R)   Image is displayed flag
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'image.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      EXTERNAL LFN_SOFT_PROG
      LOGICAL LFN_DUMMY_CNCL
      EXTERNAL LFN_DUMMY_CNCL
C
C====== LOCALS:
C
      LOGICAL DRAW_PLOT
      LOGICAL LOGGED
      LOGICAL PROF_ROT
      LOGICAL BAD
      INTEGER M_PLOT1
      INTEGER M_PLOT2
      INTEGER M_PLOT3
      INTEGER M_LOG
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER IPK
      INTEGER IPL
      INTEGER NPHALF
      INTEGER NUMPIX
      INTEGER NPROFS
      INTEGER NCOLS
      INTEGER NROWS
      INTEGER LL
      INTEGER I
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER ICOL
      INTEGER IROW
      INTEGER IBOLD
      INTEGER KSPOT
      INTEGER KH
      INTEGER KK
      INTEGER KL
      INTEGER NPIX
      INTEGER NREJ
      INTEGER IXMIN
      INTEGER IXMAX
      INTEGER IYMIN
      INTEGER IYMAX
      INTEGER IPLOT_CUR
      INTEGER IXP
      INTEGER IYP
      INTEGER IMASK
      INTEGER IREJ
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IORD
      INTEGER ISWAP
      INTEGER IFLAG
      INTEGER IX
      INTEGER IY
      INTEGER IXLIM
      INTEGER IYLIM
      INTEGER IPIX
      INTEGER NCH
      INTEGER NPAD
      INTEGER ICODE
      REAL PROMIN_DUM
      REAL XPOS
      REAL YPOS
      REAL BACKG(3)
      REAL AI
      REAL SIGI
      REAL PIXMAX
      REAL PRFMAX
      REAL SCPIX
      REAL SCPRF
      REAL PIXV
      REAL PROF
      REAL SUBPR
      REAL SBMIN
      CHARACTER*25 NAMES(4)
      CHARACTER*25 QUITNAM
      CHARACTER*80 STR
      CHARACTER*80 ERRSTR
      CHARACTER*4 FMT
      CHARACTER*5 DOT
      CHARACTER*5 STAR
      CHARACTER*5 OVSP
      CHARACTER*5 OVLD
    
C     LOGICAL DRAW_PLOT     !Drawing of plot required flag
C     LOGICAL LOGGED        !Spot details written to log file flag
C     LOGICAL PROF_ROT      !Rotate profile flag
C     LOGICAL BAD           !Bad spot flag
C     INTEGER M_PLOT1       !Menu item no.: Scaled Pixels Plot
C     INTEGER M_PLOT2       !Menu item no.: BG Subtracted Pixels Plot
C     INTEGER M_PLOT3       !Menu item no.: Scaled Spot Profile Plot
C     INTEGER M_LOG         !Menu item no.: Output Plots to Logfile
C     INTEGER NVIEW         !No. of view-objects for getting events
C     INTEGER IVHLIST(2)    !List of view-object handles for getting events
C     INTEGER IVH           !Returned view-object handle from getting events
C     INTEGER ITEM          !Item no. from menu selection
C     INTEGER IQUIT         !Quit button flage from menu
C     INTEGER IERR          !Error flag
C     INTEGER IPK           !Pack no. from latest profile calculated
C     INTEGER IPL           !Plate no. from latest profile calculated
C     INTEGER NPHALF        !Half width of profile boxes
C     INTEGER NUMPIX        !No. of pixels in profile
C     INTEGER NPROFS        !No. of profile bins
C     INTEGER NCOLS         !No. of columns for profiles text table
C     INTEGER NROWS         !No. of rows for profiles text table
C     INTEGER LL            !Length of character string
C     INTEGER I             !Temp/loop variable
C     INTEGER IXROOT        !Root 'x' position for profiles text table
C     INTEGER IYROOT        !Root 'y' position for profiles text table
C     INTEGER ICOL          !Column no. for character in profiles text table
C     INTEGER IROW          !Row no. for character in profiles text table
C     INTEGER IBOLD         !Bold print & colour flag
C     INTEGER KSPOT         !Spot no. in LRL of integrated spot
C     INTEGER KH            !'h' index of integrated spot
C     INTEGER KK            !'k' index of integrated spot
C     INTEGER KL            !'l' index of integrated spot
C     INTEGER NPIX          !No. of pixels in spot
C     INTEGER NREJ          !No. of rejected pixels
C     INTEGER IXMIN         !Minimum 'x' pixel offset in spot data
C     INTEGER IXMAX         !Maximum 'x' pixel offset in spot data
C     INTEGER IYMIN         !Minimum 'y' pixel offset in spot data
C     INTEGER IYMAX         !Maximum 'y' pixel offset in spot data
C     INTEGER IPLOT_CUR     !Current plot type no.
C     INTEGER IXP           !'x' offset of current pixel
C     INTEGER IYP           !'y' offset of current pixel
C     INTEGER IMASK         !Pixel mask flag
C     INTEGER IREJ          !Reject pixel flag
C     INTEGER NXRAST        !No. x-rasters
C     INTEGER NYRAST        !No. y-rasters
C     INTEGER IORD          !Axis order flag
C     INTEGER ISWAP         !Byte swap flag
C     INTEGER IFLAG         !Parameter status flag
C     INTEGER IX            !Loop counter through 'x' pixel positions
C     INTEGER IY            !Loop counter through 'y' pixel positions
C     INTEGER IXLIM         !Half size limit for 'x' pixels
C     INTEGER IYLIM         !Half size limit for 'y' pixels
C     INTEGER IPIX          !Scaled pixel value for output
C     INTEGER NCH           !No. of characters per pixel value o/p field
C     INTEGER NPAD          !Pad for left hand side of rows data output
C     INTEGER ICODE         !Integration code flag
C     REAL PROMIN_DUM       !Dummy vale for 'PROMIN'
C     REAL XPOS             !'x' position of spot
C     REAL YPOS             !'y' position of spot
C     REAL BACKG(3)         !Background plane parameters
C     REAL AI               !Integrated intensity
C     REAL SIGI             !sig(I)
C     REAL PIXMAX           !Maximum pixel value in spot
C     REAL PRFMAX           !Maximum pixel value in spot profile
C     REAL SCPIX            !Scaling factor for plotting pixel data
C     REAL SCPRF            !Scaling factor for plotting spot profile data
C     REAL PIXV             !Spot pixel value
C     REAL PROF             !Spot profile value
C     REAL SUBPR            !Background subtracted spot profile pixel value
C     REAL SBMIN            !Minimum (scaled) bg subtracted pixel value
C     CHARACTER*25 NAMES(4) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string
C     CHARACTER*80 STR      !Temp string
C     CHARACTER*80 ERRSTR   !Error string
C     CHARACTER*4 FMT       !Format statement for integer field
C     CHARACTER*5 DOT       !String for point not included
C     CHARACTER*5 STAR      !String for omitted pixel border
C     CHARACTER*5 OVSP      !String for omitted overlapped pixel 
C     CHARACTER*5 OVLD      !String for omitted overloaded pixel 

      DATA NAMES /'Scaled Pixels Plot',
     +            'BG Subtracted Pixels Plot',
     +            'Scaled Spot Profile Plot',
     +            'Output Plots to Logfile'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      LOGGED = .FALSE.
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (STR, IORD, ISWAP, IFLAG)
C
C====== Integrate spot
C
      CALL LFN_GET_PROFPARS (IPK, IPL, NPHALF, NUMPIX, NPROFS, 
     +                       PROF_ROT)
      PROMIN_DUM = 100.0
      CALL LFN_SAINT (IPACK, IPLATE, 10+ISPOT, IMG, ITYPE, IORD,
     +                NFRASTS, NXRAST, NYRAST, PROMIN_DUM, NPROFS,
     +                PROF_ROT, NOVLD, LFN_SOFT_PROG, LFN_DUMMY_CNCL, 
     +                IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         IF (IERR.EQ.10) THEN
            CALL ERR_NOTICE (0,'**Too close to integrate**')
         ELSE IF (IERR.EQ.11) THEN 
            CALL ERR_NOTICE (0,
     +              '**<3 non-overlapped background pixels**')
         ELSE IF (IERR.EQ.12) THEN 
            CALL ERR_NOTICE (0,'**No non-overlapped peak pixels**')
         ELSE IF (IERR.EQ.20) THEN
             CALL ERR_NOTICE (0,'**Integration box out of limits**')
         ELSE
            CALL ERR_NOTICE (0,'**Integration error**')
         END IF
         RETURN
      END IF
C
C====== Get spot parameters
C
      CALL LFN_GET_SPOTPARS (KSPOT, KH, KK, KL, XPOS, YPOS, NPIX,
     +                       NREJ, BACKG, AI, SIGI, IERR, ERRSTR)
C
C====== Set up spot plots display window
C
      IPLOT_CUR = 1
      IXMIN = 0
      IXMAX = 0
      IYMIN = 0
      IYMAX = 0
      PIXMAX = 0.0
      PRFMAX = 0.0
      SBMIN = 0.0
      DO 20 I = 1, NPIX
         CALL LFN_GET_SPOTPIX (I, IXP, IYP, IMASK, PIXV, PROF, SUBPR, 
     +                         IREJ, IERR)
         IF (IXP.LT.IXMIN) IXMIN = IXP
         IF (IXP.GT.IXMAX) IXMAX = IXP
         IF (IYP.LT.IYMIN) IYMIN = IYP
         IF (IYP.GT.IYMAX) IYMAX = IYP
         IF (PIXV.GT.PIXMAX) PIXMAX = PIXV
         IF (PROF.GT.PRFMAX) PRFMAX = PROF
         IF (SUBPR.LT.SBMIN) SBMIN = SUBPR
 20   CONTINUE
      IXLIM = IABS(IXMIN)
      IF (IXMAX.GT.IXLIM) IXLIM = IXMAX
      IYLIM = IABS(IYMIN)
      IF (IYMAX.GT.IYLIM) IYLIM = IYMAX
      SCPIX = 1.0
      IF (PIXMAX.GT.0.0) SCPIX = 99.0/PIXMAX
      SCPRF = 1.0
      IF (PRFMAX.GT.0.0) SCPRF = 99.0/PRFMAX
      SBMIN = SCPIX*SBMIN
      I = NINT(-SBMIN)
      NCH = 3
      FMT = '(I3)'
      DOT = '  .'
      STAR = '  *'
      OVSP = '  X'
      OVLD = '  +'
      IF (I.GT.9) THEN
         NCH = 4
         FMT = '(I4)'
         DOT = '   .'
         STAR = '   *'
         OVSP = '   X'
         OVLD = '   +'
      END IF
      IF (I.GT.99) THEN
         NCH = 5
         FMT = '(I5)'
         DOT = '    .'
         STAR = '    *'
         OVSP = '    X'
         OVLD = '    +'
      END IF
      NCOLS = NCH*(2*IXLIM+1) + 1
      I = NCOLS
      IF (NCOLS.LT.60) THEN
         NCOLS = 60
      END IF
      NPAD = (NCOLS-I)/2
      NROWS =2*(2*IYLIM+1) + 7  
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_PAR1,0,0,IXROOT,IYROOT,IERR)
      IF (IMG_DISP) THEN
         IXROOT = IXROOT + 30
         IYROOT = IYROOT + 30
      END IF
      CALL XDLF_TEXT_TABLE (IVH_PROF_TAB, 0, IXROOT, IYROOT, 0, NCOLS,
     +                      NROWS, 0, 0, IFONT, IERR)
      DRAW_PLOT = .TRUE.
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Set up & process menu
C
      M_PLOT1 = 1
      M_PLOT2 = 2
      M_PLOT3 = 3
      M_LOG = 4
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 4, XDLSTR(NAMES), 25,
     +                         XDLSTR('Spot Plots Menu'), 15,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Draw requested spot plot  if needed
C
      IF (DRAW_PLOT) THEN
         CALL XDLF_TEXT_TABLE_CLEAR (IVH_PROF_TAB, IERR)
         STR = 'Spot'
         CALL STR_ADDI (STR, KH, 1)
         CALL STR_ADDI (STR, KK, 1)
         CALL STR_ADDI (STR, KL, 1)
         CALL STR_ADDS (STR, 'at x =', 1)
         CALL STR_ADDF (STR, XPOS, 1, 1)
         CALL STR_ADDS (STR, ', y =', 0)
         CALL STR_ADDF (STR, YPOS, 1, 1)
         CALL STR_ADDS (STR, '(pack',1)
         CALL STR_ADDI (STR, IPACK, 1)
         CALL STR_ADDS (STR, ', plate', 0)
         CALL STR_ADDI (STR, IPLATE, 1)
         CALL STR_ADDS (STR, ')', 0)
         LL = LENSTR(STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              1, 1, 0, IERR)

         STR = 'Intensity ='
         CALL STR_ADDF (STR, AI, 1, 1)
         CALL STR_ADDS (STR, ', sig(I) =', 0)
         CALL STR_ADDF (STR, SIGI, 1, 1)
         CALL LFN_GET_SPOTCODE (BAD, ICODE, IERR, ERRSTR)
         IF (BAD) THEN
            CALL STR_ADDS (STR, '- BAD SPOT, icode =',1)
            CALL STR_ADDI (STR, ICODE, 1)
         END IF
         LL = LENSTR(STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              3, 1, 0, IERR)

         STR = 'BG plane: a ='
         CALL STR_ADDF (STR, BACKG(1), -3, 1)
         CALL STR_ADDS (STR, ', b =', 0)
         CALL STR_ADDF (STR, BACKG(2), -3, 1)
         CALL STR_ADDS (STR, ', c =', 0)
         CALL STR_ADDF (STR, BACKG(3), -3, 1)
         LL = LENSTR(STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              5, 1, 0, IERR)

         STR = ' '
         IF (IPLOT_CUR.EQ.1) THEN
            STR = 'Pixel values plot (scaled to 99 by'
            CALL STR_ADDF (STR, SCPIX, -3, 1)
            CALL STR_ADDS (STR, ')', 0)
         ELSE IF (IPLOT_CUR.EQ.2) THEN
            STR = 
     +   'BG subtracted pixel values (scaled as for pixel values plot)'
         ELSE IF (IPLOT_CUR.EQ.3) THEN
            STR = 'Spot profile plot (scaled to 99 by'
            CALL STR_ADDF (STR, SCPRF, -3, 1)
            CALL STR_ADDS (STR, ')', 0)
         END IF
         LL = LENSTR(STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              NROWS, 1, 0, IERR)
         IF (IPLOT_CUR.EQ.1) THEN
            DO 100 IY = -IYLIM, IYLIM
               DO 90 IX = -IXLIM, IXLIM
                  IBOLD = 1
                  STR = DOT
                  DO 70 I = 1, NPIX
                     CALL LFN_GET_SPOTPIX (I, IXP, IYP, IMASK, PIXV,
     +                                     PROF, SUBPR, IREJ, IERR)
                     IF (IERR.EQ.0) THEN
                        IF (IXP.EQ.IX.AND.IYP.EQ.IY) THEN
                           IPIX = NINT (PIXV*SCPIX)
                           WRITE (STR,FMT) IPIX
                           IBOLD = 1
                           GO TO 80
                        END IF
                     END IF
 70               CONTINUE
 80               ICOL = 1 + NCH*(IX+IXLIM) + NPAD
                  IROW = 7 + 2*(IYLIM-IY)
                  CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, 
     +                                       XDLSTR(STR), NCH, 
     +                                       IROW, ICOL, IBOLD, IERR)
 90            CONTINUE
 100        CONTINUE
         ELSE IF (IPLOT_CUR.EQ.2) THEN
            DO 200 IY = -IYLIM, IYLIM
               DO 190 IX = -IXLIM, IXLIM
                  IBOLD = 1
                  STR = DOT
                  DO 170 I = 1, NPIX
                     CALL LFN_GET_SPOTPIX (I, IXP, IYP, IMASK, PIXV,
     +                                     PROF, SUBPR, IREJ, IERR)
                     IF (IERR.EQ.0) THEN
                        IF (IXP.EQ.IX.AND.IYP.EQ.IY) THEN
                           IF (IMASK.LT.0) THEN
                              IBOLD = 0
                              STR = STAR
                              IF (IMASK.EQ.-2) THEN
                                 STR = OVSP
                              END IF
                              IF (IMASK.EQ.-3) THEN
                                 STR = OVLD
                              END IF
                              GO TO 180
                           END IF 
                           IPIX = NINT (SUBPR*SCPIX)
                           WRITE (STR,FMT) IPIX
                           IBOLD = 3
                           IF (IMASK.LE.1) IBOLD = 10
                           IF (IREJ.EQ.1) IBOLD = 6
                           GO TO 180
                        END IF
                     END IF
 170              CONTINUE
 180              ICOL = 1 + NCH*(IX+IXLIM) + NPAD
                  IROW = 7 + 2*(IYLIM-IY)
                  CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, 
     +                                       XDLSTR(STR), NCH, 
     +                                       IROW, ICOL, IBOLD, IERR)
 190            CONTINUE
 200        CONTINUE
         ELSE IF (IPLOT_CUR.EQ.3) THEN
            DO 300 IY = -IYLIM, IYLIM
               DO 290 IX = -IXLIM, IXLIM
                  IBOLD = 1
                  STR = DOT
                  DO 270 I = 1, NPIX
                     CALL LFN_GET_SPOTPIX (I, IXP, IYP, IMASK, PIXV,
     +                                     PROF, SUBPR, IREJ, IERR)
                     IF (IERR.EQ.0) THEN
                        IF (IXP.EQ.IX.AND.IYP.EQ.IY) THEN
                           IF (IMASK.LT.0) THEN
                              IBOLD = 0
                              STR = STAR
                              IF (IMASK.EQ.-2) THEN
                                 STR = OVSP
                              END IF
                              IF (IMASK.EQ.-3) THEN
                                 STR = OVLD
                              END IF
                              GO TO 280
                           END IF 
                           IPIX = NINT (PROF*SCPRF)
                           WRITE (STR,FMT) IPIX
                           IBOLD = 3
                           IF (IMASK.LE.1) IBOLD = 10
                           GO TO 280
                        END IF
                     END IF
 270              CONTINUE
 280              ICOL = 1 + NCH*(IX+IXLIM) + NPAD
                  IROW = 7 + 2*(IYLIM-IY)
                  CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, 
     +                                       XDLSTR(STR), NCH, 
     +                                       IROW, ICOL, IBOLD, IERR)
 290            CONTINUE
 300        CONTINUE
         END IF
         DRAW_PLOT = .FALSE.
      END IF

C
C
C====== Start event loop
C
500   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_PROF_TAB, IERR)
            RETURN
         END IF 
C
C====== Show First Plot
C
         IF (ITEM.EQ.M_PLOT1) THEN
            IF (IPLOT_CUR.NE.1) THEN
               IPLOT_CUR = 1
               DRAW_PLOT = .TRUE.
            END IF
            GO TO 50
C
C====== Show Second Plot
C
         ELSE IF (ITEM.EQ.M_PLOT2) THEN
            IF (IPLOT_CUR.NE.2) THEN
               IPLOT_CUR = 2
               DRAW_PLOT = .TRUE.
            END IF
            GO TO 50
C
C====== Show Third Plot
C
         ELSE IF (ITEM.EQ.M_PLOT3) THEN
            IF (IPLOT_CUR.NE.3) THEN
               IPLOT_CUR = 3
               DRAW_PLOT = .TRUE.
            END IF
            GO TO 50
C
C====== Log Spot Plots
C
         ELSE IF (ITEM.EQ.M_LOG) THEN
            IF (LOGGED) GO TO 50
            IF (IUN_LOG.GT.0) THEN
               WRITE (IUN_LOG, '('' '')')
               CALL LFN_LIST_INTSPOT (IUN_LOG, 0, .TRUE., .TRUE., 
     +                                .TRUE., .TRUE., IERR, ERRSTR)
            END IF
            LOGGED = .TRUE.
            GO TO 500
         END IF
         GO TO 500
      END IF
      GO TO 500
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INTEG_STATUS     **
C**************************
C
C
      SUBROUTINE INTEG_STATUS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Display/edit integration status
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lirl_pars.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER NUMP
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER M_FIRST
      INTEGER M_NEXT
      INTEGER M_PREV
      INTEGER M_DELPL
      INTEGER M_DELPK
      INTEGER M_CLEAR
      INTEGER ICUR_PK
      INTEGER IPK
      INTEGER IPL
      INTEGER IFLG
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IBUTTON
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      CHARACTER*25 NAMES(6)
      CHARACTER*25 QUITNAM
      CHARACTER*35 STATSTR(3)
      CHARACTER*80 STR

C     INTEGER I               !Temp/loop variable
C     INTEGER NUMP            !No. of packs
C     INTEGER NPLATES         !No. of plates
C     INTEGER IFLAG           !Parameter status flag
C     INTEGER M_FIRST         !Menu item no.: Show  First Pack Status
C     INTEGER M_NEXT          !Menu item no.: Show Next Pack Status 
C     INTEGER M_PREV          !Menu item no.: Show Previous Pack Status
C     INTEGER M_DELPL         !Menu item no.: Delete a Plate
C     INTEGER M_DELPK         !Menu item no.: Delete a Pack
C     INTEGER M_CLEAR         !Menu item no.: Clear All Intensities
C     INTEGER ICUR_PK         !Current pack for status display
C     INTEGER IPK             !Pack number
C     INTEGER IPL             !Plate number
C     INTEGER IFLG            !Integration status flag
C     INTEGER IXROOT          !Root 'x' position for popup notice
C     INTEGER IYROOT          !Root 'y' position for popup notice
C     INTEGER IBUTTON         !Button return from popup notice
C     INTEGER NVIEW           !No. of view-object for getting events
C     INTEGER IVHLIST(2)      !List of view-object handles for getting events
C     INTEGER IVH             !Returned view-object handle from getting events
C     INTEGER ITEM            !Menu item number
C     INTEGER IQUIT           !Quit box selected flag
C     INTEGER IERR            !Error flag
C     CHARACTER*25 NAMES(6)   !Menu item names
C     CHARACTER*25 QUITNAM    !Quit box label
C     CHARACTER*35 STATSTR(3) !Integration status strings
C     CHARACTER*80 STR        !Message string

      DATA NAMES /'Show First Pack Status',
     +            'Show Next Pack Status',
     +            'Show Previous Pack Status',
     +            'Delete a Plate',
     +            'Delete a Pack',
     +            'Clear All Intensities'/
      DATA QUITNAM /'Return to Previous Menu'/
      DATA STATSTR /'Not Integrated',
     +              'Integrated',
     +              'Integrated and written to a file'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      ICUR_PK = 1
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
C
C====== Menu items
C
      M_FIRST = 1
      M_NEXT = 2
      M_PREV = 3
      M_DELPL = 4
      M_DELPK = 5
      M_CLEAR = 6
C
C====== 
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 6, XDLSTR(NAMES), 25,
     +                         XDLSTR('Integration Status Menu'), 23,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Show status of pack ICUR_PK
C
60    CALL LMESSAGE (IVH_IOW, ' ')
      STR = 'Status flags for pack'
      CALL STR_ADDI (STR, ICUR_PK, 1)
      CALL LMESSAGE (IVH_IOW, STR) 
      CALL LMESSAGE (IVH_IOW, ' ')
      DO 70 I = 1, NPLATES
         STR = 'Plate'
         CALL STR_ADDI (STR, I, 1)
         CALL STR_ADDS (STR, ':', 0)
         CALL INTFLAG_GET (ICUR_PK, I, IFLG)
         CALL STR_ADDS (STR, STATSTR(IFLG+1), 1)
         CALL LMESSAGE (IVH_IOW, STR)
70    CONTINUE
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL LMESSAGE (IVH_IOW, ' ')
            CALL LMESSAGE (IVH_IOW, 'Exit from Integration Status')
            CALL LMESSAGE (IVH_IOW, ' ')
            CALL LMESSAGE (IVH_IOW, ' ')
            RETURN
         END IF
C
C====== Status of first pack
C
         IF (ITEM.EQ.M_FIRST) THEN
            IF (ICUR_PK.EQ.1) GO TO 100
            ICUR_PK = 1
            GO TO 60
C
C====== Status of next pack
C
         ELSE IF (ITEM.EQ.M_NEXT) THEN
            IF (ICUR_PK.GE.NUMP) GO TO 100
            ICUR_PK = ICUR_PK + 1
            GO TO 60
C
C====== Status of previous pack
C
         ELSE IF (ITEM.EQ.M_PREV) THEN
            IF (ICUR_PK.LE.1) GO TO 100
            ICUR_PK = ICUR_PK - 1
            GO TO 60
C
C====== Delete a Plate
C
         ELSE IF (ITEM.EQ.M_DELPL) THEN
            IPK = ICUR_PK
            CALL IOW_ASKI (IVH_IOW, 'Pack number', IPK)
            IF (IPK.LT.1.OR.IPK.GT.NUMP) GO TO 100
            IPL = 1 
            CALL IOW_ASKI(IVH_IOW, 'Plate number', IPL) 
            IF (IPK.LT.1.OR.IPK.GT.NPLATES) GO TO 100
            CALL INTFLAG_GET (IPK, IPL, IFLG)
            IF (IFLG.GT.0) THEN 
               CALL LIRLF_DELETE (KDX_LIRL, IPK, IPL, IERR)
               IF (IUN_LOG.GT.0) THEN
                  STR = '*Warning*'
                  CALL STR_ADDS (STR, 
     +                    'Previous intensities deleted for pack', 1)
                  CALL STR_ADDI(STR,IPK,1)
                  CALL STR_ADDS(STR,', plate',0)
                  CALL STR_ADDI(STR,IPL,1)
                  WRITE(IUN_LOG,1010)
                  WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
                  WRITE(IUN_LOG,1010)
               END IF
               CALL INTFLAG_SET (IPK, IPL, 0)
            END IF
            ICUR_PK = IPK
            GO TO 60
C
C====== Delete a Pack
C
         ELSE IF (ITEM.EQ.M_DELPK) THEN
            IPK = ICUR_PK
            IPK = ICUR_PK
            CALL IOW_ASKI (IVH_IOW, 'Pack number', IPK)
            IF (IPK.LT.1.OR.IPK.GT.NUMP) GO TO 100
            DO 120 I = 1, NPLATES
               CALL INTFLAG_GET (IPK, I, IFLG)
               IF (IFLG.EQ.0) GO TO 120
               CALL LIRLF_DELETE (KDX_LIRL, IPK, I, IERR)
               CALL INTFLAG_SET (IPK, I, 0)
 120        CONTINUE
            IF (IUN_LOG.GT.0) THEN
               STR = '*Warning*'
               CALL STR_ADDS (STR, 
     +                 'Previous intensities deleted for pack', 1)
               CALL STR_ADDI(STR,IPK,1)
               WRITE(IUN_LOG,1010)
               WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
               WRITE(IUN_LOG,1010)
            END IF
            ICUR_PK = IPK
            GO TO 60
C
C====== Clear All Intensities
C
         ELSE IF (ITEM.EQ.M_CLEAR) THEN
            CALL NOTICE_POSN(1, IXROOT, IYROOT)
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +      XDLSTR('Are you sure you want to clear all intensities?'), 
     +             47,
     +             XDLSTR(' '), -1,
     +             XDLSTR('Yes'), 3,
     +             XDLSTR('No'), 2,
     +             IFONT, 1, IBUTTON)
            IF (IBUTTON.EQ.2) GO TO 100 
            CALL INIT_LIRL
            IF (IUN_LOG.GT.0) THEN
               STR = '*Warning* All previous intensities cleared'
               WRITE(IUN_LOG,1010)
               WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
               WRITE(IUN_LOG,1010)
            END IF
            ICUR_PK = 1
            GO TO 60
         END IF
      END IF
      GO TO 100
C
C====== Format statements
C
1010  FORMAT(' ')
1020  FORMAT(A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     INTEGRATE_CALC    **
C***************************
C
C
      SUBROUTINE INTEGRATE_CALC (KEYPLATE, KQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Integrate current plate with interactive options to display results
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      INTEGER KEYPLATE
      INTEGER KQUIT
C
C KEYPLATE  (R)  Key plate for current pack
C KQUIT     (W)  Quit flag =0 OK, =1 quit on error
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'image.finc'
      INCLUDE 'lirl_pars.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      EXTERNAL INTEGRATE_PROGRESS
      EXTERNAL LFN_DUMMY_CNCL
C
C====== LOCALS:
C
      LOGICAL OKNOD
      LOGICAL SPOV
      LOGICAL CLOS
      LOGICAL MEAS
      LOGICAL BAD
      LOGICAL OVLD
      LOGICAL DET_PROFS
      INTEGER IORD
      INTEGER ISWAP
      INTEGER IRFL
      INTEGER IFLG
      INTEGER IFLAG
      INTEGER ND
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IBUTTON
      INTEGER IERR
      INTEGER JERR
      INTEGER NF_OFF
      INTEGER IPL_SAV
      INTEGER KPLATE
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NUMSPOTS
      INTEGER ISPOT
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER IH_N
      INTEGER IK_N
      INTEGER IL_N
      INTEGER MULT
      INTEGER MINHARM
      INTEGER MAXHARM
      INTEGER INCHARM
      INTEGER ICODE
      INTEGER ICODE_TYPE
      INTEGER ISPAT
      INTEGER ICLOS
      INTEGER IMEAS
      INTEGER IBAD
      INTEGER IOVLD
      INTEGER NPLATES
      INTEGER NUMREFS
      INTEGER NOV
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL W_F
      REAL ALAM
      REAL DMTHR2
      REAL ALNOD
      REAL DTHR2NOD
      REAL AI
      REAL SIGI
      REAL XD
      REAL YD
      REAL XFD
      REAL YFD
      REAL SPOTW
      CHARACTER*2 VALSTR
      CHARACTER*80 ERRSTR
      CHARACTER*120 STR

C     LOGICAL OKNOD        !Non-overlapped nodal flag
C     LOGICAL SPOV         !Spatial overlap flag
C     LOGICAL CLOS         !Spot too close to integrated flag
C     LOGICAL MEAS         !Intensity measured flag
C     LOGICAL BAD          !Bad spot flag
C     LOGICAL OVLD         !Overload flag
C     LOGICAL DET_PROFS    !Determine profiles flag
C     INTEGER IORD         !Axis order flag 1-8
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER IRFL         !Plate refined flag = 1 yes, = 0 no
C     INTEGER IFLG         !Integrated plate flag
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IXROOT       !Root window x position for popup notice
C     INTEGER IYROOT       !Root window y position for popup notice
C     INTEGER IBUTTON      !Button from popup notice
C     INTEGER IERR         !Error flag
C     INTEGER JERR         !Error flag
C     INTEGER NF_OFF       !Offset between start of slow rasters in image
C     INTEGER IPL_SAV      !Save current plate no.
C     INTEGER KPLATE       !Plate for determinining profiles
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER NUMSPOTS     !No. of spots
C     INTEGER ISPOT        !Spot number
C     INTEGER IH           !'h' index
C     INTEGER IK           !'k' index
C     INTEGER IL           !'l' index
C     INTEGER IH_N         !Nodal 'h' index
C     INTEGER IK_N         !Nodal 'k' index
C     INTEGER IL_N         !Nodal 'l' index
C     INTEGER MULT         !Multiplicity
C     INTEGER MINHARM      !Minimum harmonic
C     INTEGER MAXHARM      !Maximum harmonic
C     INTEGER INCHARM      !Harmonic increment
C     INTEGER ICODE        !Integration routine flags code
C     INTEGER ICODE_TYPE   !Code type of integration routines
C     INTEGER ISPAT        !Spatial overlap flag
C     INTEGER ICLOS        !Spots 'too close to integrate' flag
C     INTEGER IMEAS        !Intensity measured flag
C     INTEGER IBAD         !Bad spot flag
C     INTEGER IOVLD        !Overload spot flag
C     INTEGER NPLATES      !No. of plates in a pack
C     INTEGER NUMREFS      !No. of reflns in LIRL
C     INTEGER NOV          !No. of overloaded pixels ia spot
C     REAL X_CEN_F         !X centre
C     REAL Y_CEN_F         !Y centre
C     REAL W_F             !Omega
C     REAL ALAM            !Lambda value
C     REAL DMTHR2          !Dmin-threshold**2
C     REAL ALNOD           !Nodal lambda value
C     REAL DTHR2NOD        !Nodal dmin-threshold**2 value
C     REAL AI              !Integrated intensity
C     REAL SIGI            !sig(AI)
C     REAL XD              !'x' spot position on detector (rasters)
C     REAL YD              !'y' spot position on detector (rasters)
C     REAL XFD             !'x' coordinate value for spot (mm)
C     REAL YFD             !'y' coordinate value for spot (mm)
C     REAL SPOTW           !Spot width
C     CHARACTER*2 VALSTR   !Paramter value string (dummy)
C     CHARACTER*80 ERRSTR  !Error message string
C     CHARACTER*120 STR    !Message string
C
C-------------------------------------------------------------------------------
C
C
C====== Initialisations
C
      KQUIT = 0
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
C
C====== Get progress bar position
C
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,JPROG_X,JPROG_Y,IERR)
C
C====== Open film/image-plate file if needed
C
      CALL CHK_OPN(IERR)
      IF (IERR.GT.0) THEN
         KQUIT = 1
         RETURN
      END IF
C
C====== Read image if not already read
C
      IF (.NOT.FILM_READ) CALL READ_IMAGE (0, IMG, MAX_IMG_WORDS, 
     +                              ITYPE, NF_OFF, JERR, ERRSTR)
      IF (.NOT.FILM_READ) THEN
         KQUIT = 1
         RETURN
      END IF
      CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
C
C====== Check that plate has been refined
C
      CALL LDM_GET_RFL(IPACK, IPLATE, IRFL, IFLAG, IERR, ERRSTR)
      IF (IRFL.EQ.0) THEN
         CALL NOTICE_POSN(1, IXROOT, IYROOT)
         CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +           XDLSTR('**Plate not yet refined**'), 25,
     +           XDLSTR('Continue in spite of this?'), 26,
     +           XDLSTR('Yes'), 3,
     +           XDLSTR('No'), 2,
     +           IFONT, 1, IBUTTON)
         IF (IBUTTON.EQ.2) THEN
            KQUIT = 1
            RETURN
         END IF
      END IF
C
C====== Check if plate already integrated
C
      CALL INTFLAG_GET (IPACK, IPLATE, IFLG)
      IF (IFLG.GT.0) THEN
         CALL NOTICE_POSN(1, IXROOT, IYROOT)
         CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +   XDLSTR('*Plate already integrated*'), 26,
     +          XDLSTR('Redo integration?'), 17,
     +          XDLSTR('Yes'), 3,
     +          XDLSTR('No'), 2,
     +          IFONT, 1, IBUTTON)
         IF (IBUTTON.EQ.1) THEN
            CALL LIRLF_DELETE (KDX_LIRL, IPACK, IPLATE, IERR)
            IF (IUN_LOG.GT.0) THEN
               STR = '*Warning*'
               CALL STR_ADDS (STR, 
     +                 'Previous intensities deleted for pack', 1)
               CALL STR_ADDI(STR,IPACK,1)
               CALL STR_ADDS(STR,', plate',0)
               CALL STR_ADDI(STR,IPLATE,1)
               WRITE(IUN_LOG,1010)
               WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
               WRITE(IUN_LOG,1010)
            END IF
            CALL INTFLAG_SET (IPACK, IPLATE, 0)
         ELSE
            KQUIT = 1
            RETURN
         END IF
      END IF 
C
C====== Clear last pack/plate integrated flags
C
      INTEG_LASTPK = 0       
      INTEG_LASTPL = 0       
C
C====== Determine required profiles if not already done
C
      DET_PROFS = .FALSE.
      IF (IPRF_ALL.EQ.1) THEN
         IF (IPACK.NE.IPRF_PK.OR.IPLATE.NE.IPRF_PL) THEN
            DET_PROFS = .TRUE.
            KPLATE = IPLATE
         END IF
      ELSE
         IF (IPACK.NE.IPRF_PK.OR.KEYPLATE.NE.IPRF_PL) THEN
            CALL LDM_GET_NPLAT (NPLATES, IFLAG)
            IF (KEYPLATE.GT.NPLATES) THEN
               CALL ERR_NOTICE (1, '**Key plate out of valid range**')
               KQUIT = 1
               RETURN
            END IF
            DET_PROFS = .TRUE.
            KPLATE = KEYPLATE
         END IF
      END IF
      IF (DET_PROFS) THEN
         IPL_SAV = IPLATE
         IPLATE = KPLATE
         CALL CALC_LAUE (.FALSE.)
         IF (IORD.LE.4) THEN
            CALL LRL_SORT (3)
         ELSE
            CALL LRL_SORT (4)
         END IF
         JPROG_PASS = 0
         CALL LFN_SAINT (IPACK, IPLATE, 1, IMG, ITYPE, IORD,
     +                   NFRASTS, NXRAST, NYRAST, PROMIN, NPROF,
     +                   PRF_ROT, NOVLD,
     +                   INTEGRATE_PROGRESS, LFN_DUMMY_CNCL,
     +                   IERR, ERRSTR)
         CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
         IPLATE = IPL_SAV
         IF (IERR.NE.0) THEN
            STR = '**Error**'
            CALL STR_ADDS (STR,ERRSTR,1)
            CALL LMESSAGE (IVH_IOW, STR)
            KQUIT = 1
            RETURN
         END IF
         IPRF_PK = IPACK
         IPRF_PL = KPLATE
         IF (IUN_LOG.GT.0) THEN
            WRITE(IUN_LOG,1010)
            STR = 'Determine integration profiles for pack'
            CALL STR_ADDI(STR,IPACK,1)
            CALL STR_ADDS(STR,', plate',0)
            CALL STR_ADDI(STR,IPLATE,1)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
            STR = 'Number of profile bins ='
            CALL STR_ADDI (STR, NPROF, 1)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
            CALL LDM_GET_SPOTW (IPACK, IPLATE, SPOTW, IFLAG, ND, 
     +                          IERR, ERRSTR)
            IF (PRF_ROT.AND.SPOTW.NE.0.0) THEN
               STR = 'Profiles rotated for elliptical spots'
            ELSE
               STR = 'Profiles not rotated'
            END IF
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
            STR = 'Minimum intensity for inclusion in profiles ='
            CALL STR_ADDF (STR, PROMIN, 1, 1)
            WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
            WRITE(IUN_LOG,1010)
            CALL LFN_LIST_PROFS (IUN_LOG, 0, 0, 0, 80, 2, 2, IERR, 
     +                           ERRSTR)
         END IF
      END IF
C
C====== Integrate spots of current plate
C
      CALL CALC_LAUE (.FALSE.)
      IF (IORD.LE.4) THEN
         CALL LRL_SORT (3)
      ELSE
         CALL LRL_SORT (4)
      END IF
      JPROG_PASS = 0
      CALL LFN_SAINT (IPACK, IPLATE, 2, IMG, ITYPE, IORD,
     +                   NFRASTS, NXRAST, NYRAST, PROMIN, NPROF,
     +                   PRF_ROT, NOVLD,
     +                   INTEGRATE_PROGRESS, LFN_DUMMY_CNCL,
     +                   IERR, ERRSTR)
      CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
      IF (IUN_LOG.GT.0) THEN
         WRITE(IUN_LOG,1010)
         STR = 'Integrate intensities for pack'
         CALL STR_ADDI(STR,IPACK,1)
         CALL STR_ADDS(STR,', plate',0)
         CALL STR_ADDI(STR,IPLATE,1)
         WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
         WRITE(IUN_LOG,1010)
         IF (IPRF_ALL.EQ.1) THEN
            STR = 'Profile determination from each plate in pack'
         ELSE
            STR = 'Profile determination from key plate only'
         END IF
         WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
         WRITE(IUN_LOG,1010)
         STR = 'Number of overload pixels allowed in a spot =' 
         CALL STR_ADDI (STR, NOVLD, 1)      
         WRITE(IUN_LOG,1020) STR(1:LENSTR(STR))
         WRITE(IUN_LOG,1010)
      END IF
      IF (IERR.NE.0) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR,ERRSTR,1)
         CALL LOG_MSG (IVH_IOW, STR, 1)
         KQUIT = 1
         RETURN
      END IF
C
C====== Save pack & plate no.
C
      INTEG_LASTPK = IPACK
      INTEG_LASTPL = IPLATE
C
C====== Save integrated intensities data in LIRL
C
      CALL LRL_NUMSPOTS (NUMSPOTS)
      IF (NUMSPOTS.GT.0) THEN
         CALL LIRLF_NUMREFS (KDX_LIRL, NUMREFS)
         DO 100 ISPOT = 1, NUMSPOTS
            CALL LRL_GET (ISPOT, IH, IK, IL, XD, YD, ALAM, DMTHR2,
     +                    MULT, OKNOD, SPOV, IERR)
            IF (MULT.GT.1) THEN
               CALL LRL_GET_HARM (ISPOT, IH, IK, IL, IH_N, IK_N, IL_N,
     +                            MULT, MINHARM, MAXHARM, INCHARM,
     +                            ALNOD, DTHR2NOD, IERR)
            ELSE
               MINHARM = 0
               MAXHARM = 0
               INCHARM = 0
            END IF
            CALL LRL_GET_XFYFD (ISPOT, XFD, YFD, IERR)
            CALL LRL_GET_OVLP (ISPOT, SPOV, CLOS, IERR)
            CALL LRL_GET_INT (ISPOT, AI, SIGI, MEAS, BAD, OVLD, ICODE, 
     +                        ICODE_TYPE, IERR)
            ISPAT = 0
            ICLOS = 0
            IMEAS = 0
            IBAD = 0
            IOVLD = 0
            IF (SPOV) ISPAT = 1
            IF (CLOS) ICLOS = 1
            IF (MEAS) IMEAS = 1
            IF (BAD) IBAD = 1
            IF (OVLD) IOVLD = 1
            IF (CLOS) THEN
               IMEAS = 0
               AI = 0.0
               SIGI = 0.0
            END IF

            CALL LIRLF_ADDREF (KDX_LIRL, IH, IK, IL, IPACK, IPLATE, 0, 
     +                         XFD, YFD, ALAM, MULT, MINHARM, MAXHARM, 
     +                         INCHARM, AI, SIGI, ISPAT, ICLOS,
     +                         IMEAS, IBAD, IOVLD, ICODE, IERR)
            IF (IERR.LT.0) THEN
                CALL LIRLF_DELETE (KDX_LIRL, IPACK, IPLATE, JERR)
                CALL NOTICE_POSN(1, IXROOT, IYROOT)
                ERRSTR = '**Error** Cannot allocate memory required'
                CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +          XDLSTR(ERRSTR), LENSTR(ERRSTR),
     +          XDLSTR('Integrated intensities deleted'), 30,
     +          XDLSTR('Continue'), 8,
     +          XDLSTR(' '), -1,
     +          IFONT, 1, IBUTTON)
                IF (IUN_LOG.GT.0) THEN
                   WRITE (IUN_LOG,1050) ERRSTR(1:LENSTR(ERRSTR))
                   ERRSTR = '**Error** Integrated intensities deleted'
                   WRITE (IUN_LOG,1050) ERRSTR(1:LENSTR(ERRSTR))
                END IF
                GO TO 110
            END IF
            CALL LRL_GET_OVPIX (ISPOT, NOV, IERR)
            CALL LIRLF_SET_OVPIX (KDX_LIRL, NUMREFS+ISPOT, NOV, IERR)
 100     CONTINUE
 110     CALL INTFLAG_SET (IPACK, IPLATE, 1)
      END IF
C
C====== Log statistics
C
      CALL LOG_INT_TAB1

      RETURN
C
C====== Format statements
C
1010  FORMAT(' ')
1020  FORMAT(A)
1050  FORMAT (/,A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     INTEGRATE_PROGRESS    **
C*******************************
C
C
      SUBROUTINE INTEGRATE_PROGRESS (IPASS, NSPOT, ISPOT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Monitor progess of integration passes
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      INTEGER IPASS
      INTEGER NSPOT
      INTEGER ISPOT
C  
C  IPASS    (R)   Integration pass
C  NSPOT    (R)   Total no. spots to integrate
C  ISPOT    (R)   No. of last spot integrated
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lirl_pars.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
C
C    INTEGER IERR          !Error flag
C
C-------------------------------------------------------------------------------
C
      IF (JPROG_PASS.EQ.IPASS) THEN
         IF (LG_MODE.NE.1) RETURN
         IF (MOD(ISPOT,20).NE.0) RETURN
         CALL XDLF_PROGRESS_BAR_VALUE (IVH_BAR, ISPOT, IERR)
      ELSE
         IF (LG_MODE.EQ.1) THEN
            IF (IPASS.EQ.1) THEN
               CALL XDLF_PROGRESS_BAR (IVH_BAR, JPROG_X, JPROG_Y,
     +              XDLSTR('Forming profiles:'), 17, 150, NSPOT,
     +              2, 1)
            ELSE IF (IPASS.EQ.2) THEN
               CALL XDLF_PROGRESS_BAR (IVH_BAR, JPROG_X, JPROG_Y,
     +              XDLSTR('Integrating spots:'), 18, 150, NSPOT,
     +              2, 5)
            END IF
         ELSE IF (LG_MODE.EQ.2) THEN
            IF (IPASS.EQ.1) THEN
               CALL TWRITE ('==Forming profiles==')
            ELSE IF (IPASS.EQ.2) THEN
               CALL TWRITE ('==Integrating spots==')
            END IF
         END IF
         JPROG_PASS = IPASS
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     INTEGRATE_SHOW     **
C****************************
C
C
      SUBROUTINE INTEGRATE_SHOW
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Examine integration results after an interactive integration request
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER M_PROFS
      INTEGER M_SPOTS
      INTEGER M_STATS
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      CHARACTER*25 NAMES(3)
      CHARACTER*25 QUITNAM
    
C     INTEGER M_PROFS       !Menu item no.: Examine Profiles
C     INTEGER M_SPOTS       !Menu item no.: Examine Individual Spots
C     INTEGER M_STATS       !Menu item no.: Integration Statistics
C     INTEGER NVIEW         !No. of view-objects for getting events
C     INTEGER IVHLIST(2)    !List of view-object handles for getting events
C     INTEGER IVH           !Returned view-object handle from getting events
C     INTEGER ITEM          !Item no. from menu selection
C     INTEGER IQUIT         !Quit button flage from menu
C     INTEGER IERR          !Error flag
C     CHARACTER*25 NAMES(3) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string

      DATA NAMES /'Examine Profiles',
     +            'Examine Individual Spots',
     +            'Integration Statistics'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
      M_PROFS = 1
      M_SPOTS = 2
      M_STATS = 3
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 3, XDLSTR(NAMES), 25,
     +                         XDLSTR('Integration Results Menu'), 24,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) RETURN
C
C====== Show Profiles
C
         IF (ITEM.EQ.M_PROFS) THEN
            CALL SHOW_PROFILES
            GO TO 50
C
C====== Examine Individual Spots 
C
         ELSE IF (ITEM.EQ.M_SPOTS) THEN
            CALL EXAMINE_SPOTS
            GO TO 50
C
C====== Integration Statistics
C
         ELSE IF (ITEM.EQ.M_STATS) THEN
            CALL SHOW_INTSTATS
            GO TO 50
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INTFLAG_GET      **
C**************************
C
C
      SUBROUTINE INTFLAG_GET (IPACK, IPLATE, IFLG)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get integration flag
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IFLG
C
C  IPACK   (R)  Pack no.
C  IPLATE  (R)  Plate no.
C  IFLG    (W)  The flag =0 clear, 
C                        =1 integrated & stored in LIRL
C                        =2 as for 1 but data also written to o/p file
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LDM_PLMAX
C
C====== LOCALS:
C
      INTEGER IREC
      INTEGER IARR(2)
      INTEGER IERR

C     INTEGER IREC          !Record pointer
C     INTEGER IARR(2)       !Record buffer
C     INTEGER IERR          !Error flag
C
C-------------------------------------------------------------------------------
C
      IREC = (IPACK-1)*LDM_PLMAX(0) + IPLATE
      CALL DMLF_GETREC (KDX_INTFLAGS, IREC, IARR, IERR)
      IFLG = IARR(1)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     INTFLAG_SET      **
C**************************
C
C
      SUBROUTINE INTFLAG_SET (IPACK, IPLATE, IFLG)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set integration flag
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IFLG
C
C  IPACK   (R)  Pack no.
C  IPLATE  (R)  Plate no.
C  IFLG    (R)  The flag =0 clear, 
C                        =1 integrated & stored in LIRL
C                        =2 as for 1 but data also written to o/p file
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LDM_PLMAX
C
C====== LOCALS:
C
      INTEGER IREC
      INTEGER IARR(2)
      INTEGER IERR

C     INTEGER IREC          !Record pointer
C     INTEGER IARR(2)       !Record buffer
C     INTEGER IERR          !Error flag
C
C-------------------------------------------------------------------------------
C
      IREC = (IPACK-1)*LDM_PLMAX(0) + IPLATE
      IARR(1) = IFLG
      CALL DMLF_PUTREC (KDX_INTFLAGS, IREC, IARR, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***********************
C**     INTFP         **
C***********************
C
C
       FUNCTION INTFP (CHSTR, FP, IV) 
C
C Purpose:    Decode a character string into a number (floating and integer)
C
C Author:     John W. Campbell
C
C RETURN:     = 0  Syntax error in the number
C             = 1  integer  (no decimal point present)
C             = 2  floating point (decimal point present or E format)
C             = -1 blank string
C                                             
C Arguments:
C
C      CHSTR    (R)     Character string containing the number to be decoded
C                       (Leading spaces ignored; further space terminates
C                        the number string interpreted)
C      FP       (W)     Returns the value as a floating point value (0.0 if
C                       synatx error)
C      IV       (W)     Returns the value as an integer (the nearest integer
C                       if value contained a decimal point) (0 if syntax error)
C
C
C Declarations
C ============
C
C LOCALS:
C
      CHARACTER*(*) CHSTR
      CHARACTER*15 DIG
      LOGICAL END, START
      DOUBLE PRECISION FPVAL, X, S
      DATA DIG /'eE0123456789.+-'/
C
C-------------------------------------------------------------------------------
C
C
C====== Initialisations
C
      FPVAL = 0.0
      FP = 0.0
      IV = 0
      END = .FALSE.
      START = .FALSE.
      IEXP = 0
      M1 = 3
      M2 = 15
      I = 0
      IMAX = LEN (CHSTR) 
      IF (CHSTR.EQ.' ') THEN
         INTFP = -1
         RETURN
      ENDIF
C
C====== Interpret Number
C
100   S = 1.0
      ID = 0
      IFDEC = 0
      X = 0.0
120   I = I + 1
      IF (I.GT.IMAX) THEN
         END = .TRUE.
         IF (IEXP.EQ.1) GO TO 600
         GO TO 500
      ENDIF
      IF (CHSTR(I:I).EQ.' ') THEN
         IF (START) I = IMAX
         GO TO 120
      ENDIF
      J = INDEX(DIG(M1:M2),CHSTR(I:I))
      IF (J.EQ.0) GO TO 800
      START = .TRUE.
      J = J + M1 - 1
      M1 = 1 + 2*IEXP
C
C====== Digit
C
      IF (J.GE.3.AND.J.LE.12) THEN
         ID = ID + IFDEC
         X = 10.0 * X + J - 3
         IF (M2.GT.13) M2 = 13
         GO TO 120
C
C====== Decimal point
C
      ELSE IF (J.EQ.13) THEN
         IF (IEXP.EQ.1) GO TO 800
         IFDEC = 1
         M2 = 12
         GO TO 120
C
C====== Sign
C
      ELSE IF (J.GE.14) THEN
         IF (J.EQ.15) S = -1.0
         M2 = 13
         GO TO 120
C
C====== Exponent
C
      ELSE
         IEXP = 1
         M1 = 3
         M2 = 15
      ENDIF
C
C====== Evaluate number
C
500   FPVAL = S * X / (10**ID)
      IF (END) THEN
         FP = FPVAL
         IV = NINT (FP)
         INTFP = 1
         IF (IFDEC.GT.0) INTFP = 2
         RETURN
      ENDIF
      GO TO 100
C
C====== Evaluate and apply exponent
C
600   IEX = NINT (S*X)
      FPVAL = FPVAL * 10.0**IEX
      FP = FPVAL
      IV = NINT (FP)
      INTFP = 2
      RETURN
C
C====== Error Condition
C
800   INTFP = 0
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     IOW_ASKF         **
C**************************
C
      SUBROUTINE IOW_ASKF (IVH, STR, VALUE, ND)
C
C Purpose: Output a text prompt to an I/O window with a default real value
C          Read in and return a real value.
C
C          If the reply has invalid syntax then the prompt will be repeated
C
C          (Max length for reply and value in prompt is 25 characters)
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      INTEGER IVH
      CHARACTER*(*) STR
      REAL VALUE
      INTEGER ND

C   IVH   (R)    View-object handle for the I/O window
C   STR   (R)    Character string for the question 
C                The default value will be appended as ' [value]: '
C                Total prompt may not exceed 120 characters.
C   VALUE (R/W)  On input:  the default value
C                On output:  the value read in 
C   ND    (R)    The number of decimal places for the value in the prompt
C                (if -ve then use E format) (Max 99)
C
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      REAL FPVAL
C
C====== LOCALS:
C
      LOGICAL ERR
      INTEGER IERR
      INTEGER LL
      INTEGER L
      INTEGER I
      INTEGER IVH_RET
      INTEGER IVHLIST(2)
      REAL    X
      CHARACTER*25 FPSTR
      CHARACTER*120 PROMPT
      CHARACTER*8 FMT

C     LOGICAL ERR          !Floating point number error flag
C     INTEGER IERR         !Error return flag
C     INTEGER LL           !Length of prompt stripped of trailing blanks
C     INTEGER L            !Character counter
C     INTEGER I            !Temp/loop variable
C     INTEGER IVH_RET      !View-object handle from XDLF_GET_EVENTS
C     INTEGER IVHLIST(2)   !View-object handles list for XDLF_GET_EVENTS
C     REAL    X            !Real value input
C     CHARACTER*25 FPSTR   !Value string
C     CHARACTER*120 PROMPT !Prompt string
C     CHARACTER*8 FMT      !Format statement array
C
C-------------------------------------------------------------------------------
C
C====== Get length less trailing blanks
C
      LL = LEN(STR)
      DO 100 L=LL,1,-1
         IF (STR(L:L).NE.' ') GO TO 120
100   CONTINUE
      L=1
C
C====== Write floating point value to a string
C
120   IF (ND.GT.0) THEN
         FMT = '(F25.  )'
         WRITE (FMT(6:7),'(I2.2)') ND
         WRITE (FPSTR,FMT) VALUE
      ELSE IF (ND.LT.0) THEN
         FMT = '(E25.  )'
         WRITE (FMT(6:7),'(I2.2)') -ND
         WRITE (FPSTR,FMT) VALUE
      ELSE
         WRITE (FPSTR,'(I25)') NINT(VALUE)
      ENDIF
C
C====== Form prompt string
C
      PROMPT = STR(1:L)//' ['
      L = L + 2
      DO 130 I=1,25
         IF (FPSTR(I:I).NE.' ') THEN
            L = L + 1
            PROMPT(L:L) = FPSTR(I:I)
         ENDIF
130   CONTINUE
      PROMPT(L+1:) =']: '
      L = L + 3
C
C====== Output prompt
C
200   CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(PROMPT), L, 0, IERR)
C
C====== Get reply
C
      IVHLIST(1) = IVH
      CALL XDLF_GET_EVENTS (1, IVHLIST, IVH_RET)
      CALL XDLF_IO_WINDOW_GETSTRING (IVH, XDLSTR(FPSTR), 25, IERR)
      IF (FPSTR.EQ.' ') RETURN
      X = FLPVAL(FPSTR,ERR)
      IF (ERR) GO TO 200
      VALUE = X
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     IOW_ASKI         **
C**************************
C
      SUBROUTINE IOW_ASKI (IVH, STR, IVALUE)
C
C Purpose: Output a text prompt to an I/O window with a default integer value
C          Read in and return an integer value.
C
C          If the reply has invalid syntax then the prompt will be repeated
C
C          (Max length for reply and value in prompt is 25 characters)
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      INTEGER IVH
      CHARACTER*(*) STR
      INTEGER IVALUE

C   IVH   (R)    View-object handle for the I/O window
C   STR   (R)    Character string for the question 
C                The default value will be appended as ' [value]: '
C                Total prompt may not exceed 120 characters.
C   IVALUE (R/W) On input:  the default value
C                On output:  the value read in (nearest integer if a floating
C                            point number is given)
C
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      REAL FPVAL
C
C====== LOCALS:
C
      LOGICAL ERR
      INTEGER IERR
      INTEGER LL
      INTEGER L
      INTEGER I
      INTEGER IVH_RET
      INTEGER IVHLIST(2)
      REAL    X
      CHARACTER*25 XSTR
      CHARACTER*120 PROMPT

C     LOGICAL ERR          !Floating point number error flag
C     INTEGER IERR         !Error return flag
C     INTEGER LL           !Length of prompt stripped of trailing blanks
C     INTEGER L            !Character counter
C     INTEGER I            !Temp/loop variable
C     INTEGER IVH_RET      !View-object handle from XDLF_GET_EVENTS
C     INTEGER IVHLIST(2)   !View-object handles list for XDLF_GET_EVENTS
C     REAL    X            !Real value input
C     CHARACTER*25 XSTR    !Value string
C     CHARACTER*120 PROMPT !Prompt string
C
C-------------------------------------------------------------------------------
C
C====== Get length less trailing blanks
C
      LL = LEN(STR)
      DO 100 L=LL,1,-1
         IF (STR(L:L).NE.' ') GO TO 120
100   CONTINUE
      L=1
C
C====== Write integer value to a string
C
120   WRITE (XSTR,'(I25)') IVALUE
C
C====== Form prompt string
C
      PROMPT = STR(1:L)//' ['
      L = L + 2
      DO 130 I=1,25
         IF (XSTR(I:I).NE.' ') THEN
            L = L + 1
            PROMPT(L:L) = XSTR(I:I)
         ENDIF
130   CONTINUE
      PROMPT(L+1:) =']: '
      L = L + 3
C
C====== Output prompt
C
200   CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(PROMPT), L, 0, IERR)
C
C====== Get reply
C
      IVHLIST(1) = IVH
      CALL XDLF_GET_EVENTS (1, IVHLIST, IVH_RET)
      CALL XDLF_IO_WINDOW_GETSTRING (IVH, XDLSTR(XSTR), 25, IERR)
      IF (XSTR.EQ.' ') RETURN
      X = FLPVAL(XSTR,ERR)
      IF (ERR) GO TO 200
      IVALUE = NINT(X)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     IOW_ASKQ         **
C**************************
C
      SUBROUTINE IOW_ASKQ (IVH, STR, REPLY)
C
C Purpose: Output a text prompt to an I/O window with yes/no options
C          Read in yes/no reply and return answer as a logical flag
C
C          If the reply has invalid syntax then the prompt will be repeated
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      INTEGER IVH
      CHARACTER*(*) STR
      LOGICAL REPLY

C   IVH   (R)    View-object handle for the I/O window
C   STR   (R)    Character string for the question 
C                (The string ' (y/n) [y]: ' or ' (y/n) [n]: ' will be appended)
C                Total prompt may not exceed 120 characters.
C   REPLY (R/W)  Logical flag: On input  .true.  if default reply is yes
C                                        .false. if default reply is no
C                              On output .true.  if reply was yes
C                                        .false. if reply was no
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
      INTEGER LL
      INTEGER L
      INTEGER I
      INTEGER IVH_RET
      INTEGER IVHLIST(2)
      CHARACTER*20 YESNO
      CHARACTER*120 PROMPT

C     INTEGER IERR         !Error return flag
C     INTEGER LL           !Length of prompt stripped of trailing blanks
C     INTEGER L            !Character counter
C     INTEGER I            !Temp/loop variable
C     INTEGER IVH_RET      !View-object handle from XDLF_GET_EVENTS
C     INTEGER IVHLIST(2)   !View-object handles list for XDLF_GET_EVENTS
C     CHARACTER*20 YESNO   !Reply string
C     CHARACTER*120 PROMPT !Prompt string
C
C-------------------------------------------------------------------------------
C
C====== Get length less trailing blanks
C
      LL = LEN(STR)
      DO 100 L=LL,1,-1
         IF (STR(L:L).NE.' ') GO TO 120
100   CONTINUE
      L=1
C
C====== Form prompt string
C
120   IF (REPLY) THEN
         PROMPT = STR(1:L)//' (y/n) [y]: '
      ELSE
         PROMPT = STR(1:L)//' (y/n) [n]: '
      ENDIF
      L = L + 12
C
C====== Output prompt
C
200   CALL XDLF_IO_WINDOW_PRINT (IVH, XDLSTR(PROMPT), L, 0, IERR)
C
C====== Get reply
C
      IVHLIST(1) = IVH
      CALL XDLF_GET_EVENTS (1, IVHLIST, IVH_RET)
      CALL XDLF_IO_WINDOW_GETSTRING (IVH, XDLSTR(YESNO), 20, IERR)
      IF (YESNO.EQ.' ') RETURN
      DO 300 I=1,20
         IF (YESNO(I:I).NE.' ') THEN
            IF (YESNO(I:I).EQ.'y'.OR.YESNO(I:I).EQ.'Y') THEN
               REPLY = .TRUE.
               RETURN
            ELSE IF (YESNO(I:I).EQ.'n'.OR.YESNO(I:I).EQ.'N') THEN
               REPLY = .FALSE.
               RETURN
            ELSE
               GO TO 200
            ENDIF
         ENDIF
300   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LAM_HIST         **
C**************************
C
C
      SUBROUTINE LAM_HIST (LAMBDA_BINS)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get wavelength histogram (16 bins)
C
C Author:  John W. Campbell, February 1992 (based on LAMBDA_HIST from GENLAUE)
C
C Arguments:
C
      INTEGER LAMBDA_BINS(16)
C
C LAMBDA_BINS(16) (W) Returned histogram
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      LOGICAL SPAT
      LOGICAL NODFLG
      INTEGER I
      INTEGER J
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      INTEGER NUMSPOTS
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER MULT
      REAL DTHR2
      REAL XFD
      REAL YFD
      REAL BIN_CUTOFF(16)
      REAL LAMBDA
      REAL WMIN
      REAL WMAX
      CHARACTER*2 ERRSTR

C     LOGICAL SPAT          !Spatial overlap flag
C     LOGICAL NODFLG        !OK nodal flag
C     INTEGER I             !Loop variable
C     INTEGER J             !Loop variable
C     INTEGER IFLAG         !Parameter status flag
C     INTEGER ND            !No. of decimal places flag
C     INTEGER IERR          !Error flag
C     INTEGER NUMSPOTS      !No. of spots in list
C     INTEGER JH            !'h' index
C     INTEGER JK            !'k' index
C     INTEGER JL            !'l' index
C     INTEGER MULT          !Multiplicity
C     REAL DTHR2            !dmin-thresh**2
C     REAL XFD              !Spot 'x' position
C     REAL YFD              !Spot 'y' position
C     REAL BIN_CUTOFF(16)   !Upper Lambda limits for each bin
C     REAL LAMBDA           !Wavelength of current reflection
C     REAL WMIN             !Lambda-min
C     REAL WMAX             !Lambda-max
C     CHARACTER*2 ERRSTR    !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
C
C====== Set up bins
C
      CALL LDM_GET_LMIN (IPACK, WMIN, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_LMAX (IPACK, WMAX, IFLAG, ND, IERR, ERRSTR)
      DO 20 I = 1 , 16
         BIN_CUTOFF(I) = WMIN + I*(WMAX-WMIN)/15.0
         LAMBDA_BINS(I) = 0
 20   CONTINUE
      BIN_CUTOFF(16) = 100.0
C
C====== Work out histogram
C
      CALL LRL_NUMSPOTS (NUMSPOTS)
      DO 50 J = 1 , NUMSPOTS
         CALL LRL_GET (J, JH, JK, JL, XFD, YFD, LAMBDA, DTHR2, MULT,
     +                       NODFLG, SPAT, IERR)
         DO 30 I = 1 , 16
            IF (LAMBDA.LT.BIN_CUTOFF(I)) GO TO 40
 30      CONTINUE
         I = 16
 40      LAMBDA_BINS(I) = LAMBDA_BINS(I) + 1
 50   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LAUE_SIMS        **
C**************************
C
C
      SUBROUTINE LAUE_SIMS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle Laue simulations program option
C
C Author:  John W. Campbell, July 1992
C
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'gnom_rmin.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      INTEGER INTFP
C
C====== LOCALS:
C
      LOGICAL SIM
      LOGICAL GNOM
      LOGICAL TILTED
      INTEGER NVIEW
      INTEGER I
      INTEGER IVHLIST(4)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER KXROOT
      INTEGER KYROOT
      INTEGER KERR
      INTEGER NUMSPOTS
      INTEGER M_COLR
      INTEGER M_INTER
      INTEGER M_GNOMC
      INTEGER M_GNOMI
      INTEGER M_DIRECT
      INTEGER IFLAG
      INTEGER ND
      INTEGER ITM
      INTEGER ITYP
      INTEGER IP_GNOMR
      INTEGER IV
      REAL RMin
      REAL RMAX
      REAL DTILT
      REAL FP
      CHARACTER*25 NAMES(5)
      CHARACTER*25 QUITNAM
      CHARACTER*2 ERRSTR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL 
      CHARACTER*80 STR

C     LOGICAL SIM         !Simulation is displayed flag .TRUE.=yes, .FALSE.=no
C     LOGICAL GNOM        !Last simulation was a gnomonic projection flag
C     LOGICAL TILTED      !Tilted detector flag
C     INTEGER I           !Temporary/loop variable
C     INTEGER NVIEW       !Number of view-objects from which data is to be input
C     INTEGER IVHLIST(4)  !View-object handles list for getting data
C     INTEGER IVH         !View-object handle of view-object returning data
C     INTEGER ITEM        !Item number selected from menu
C     INTEGER IQUIT       !Quit flag
C     INTEGER IERR        !Error flag
C     INTEGER KXROOT      !x position for Laue simulation view-object
C     INTEGER KYROOT      !y position for Laue simulation view-object
C     INTEGER KERR        !Error flag for finding view-object position
C     INTEGER NUMSPOTS    !Number of spots
C     INTEGER M_COLR      !Menu item number for: Colour simulations
C     INTEGER M_INTER     !Menu item number for: Interactive display
C     INTEGER M_GNOMC     !Menu item number for: Gnomonic colour simulations
C     INTEGER M_GNOMI     !Menu item number for: Gnomonic interactive sims.
C     INTEGER M_DIRECT    !Menu item number for: Set Direction
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER ND          !No. of decimal places flag
C     INTEGER ITM         !Item no. modified in parameter table
C     INTEGER ITYP        !Return flag from INTFP or extended LDM param type
C     INTEGER IP_GNOMR    !Parameter table 3 item no. for Gnomonic 'rmin'
C     INTEGER IV          !Integer value
C     REAL RMIN           !LDM 'rmin' parameter
C     REAL RMAX           !LDM 'rmax' parameter
C     REAL DTILT          !Detector tilt angle
C     REAL FP             !Real value
C     CHARACTER*25 NAMES(5)  !Menu item names
C     CHARACTER*25 QUITNAM   !Quit box label
C     CHARACTER*2 ERRSTR     !Error string (dummy)
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !String for parameter table input value
C     CHARACTER*80 STR     !String

      DATA NAMES /'Colour Coded Display',
     +            'Interactive Display',
     +            'Colour Gnomonic',
     +            'Interactive Gnomonic',
     +            'Set Direction'/
      DATA QUITNAM /'Return to Main Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      SIM = .FALSE.
      GNOM = .FALSE.
      TILTED = .FALSE.
      CALL LDM_GET_DTILT (DTILT, IFLAG, ND)
      IF (DTILT.NE.0.0.AND.DTILT.NE.180.0) TILTED = .TRUE.
      IF (GNOMR.EQ.0.0) THEN
         CALL LDM_GET_RMIN (RMIN, IFLAG, ND)
         CALL LDM_GET_RMAX (RMAX, IFLAG, ND)
         GNOMR = RMAX/10.0
         IF (GNOMR.LT.RMIN) GNOMR = RMIN
      END IF
C
C====== Set up parameter table 3
C
      IP_GNOMR = 1
      WRITE (STR,'(F8.2)') GNOMR
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_GNOMR,
     +     XDLSTR('Gnomonic rmin:'), 13,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
C
C====== Get position for the display
C
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,0,0,KXROOT,KYROOT,KERR)
      KYROOT = KYROOT - 30
      IF (KYROOT.LT.0) KYROOT = 0
C
C====== Set up menu
C
      M_COLR = 1
      M_INTER = 2
      M_GNOMC = 3
      M_GNOMI = 4
      M_DIRECT = 5
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 5, XDLSTR(NAMES), 25,
     +                             XDLSTR('Simulations Menu'), 16,
     +                             XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 4
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2
      IVHLIST(4) = IVH_PAR3
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C====== Quit box selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            IF (SIM) CALL XDLF_DELETE_VIEW_OBJECT (IVH_SIM, IERR)
            RETURN
         END IF
C
C====== Colour simulation
C
         IF (ITEM.EQ.M_COLR) THEN
            IF (SIM) CALL XDLF_DELETE_VIEW_OBJECT (IVH_SIM, IERR)
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
               GO TO 100
            END IF
            CALL LRL_XDLSIM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 300, 0,
     +                       0, 0, IERR)
            SIM = .TRUE.
            GNOM = .FALSE.
            GO TO 100
C
C====== Monochrome simulation with soft limit sliders etc.
C
         ELSE IF (ITEM.EQ.M_INTER) THEN
            IF (SIM) CALL XDLF_DELETE_VIEW_OBJECT (IVH_SIM, IERR)
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
               GO TO 100
            END IF
            CALL LRL_XDLSIM (IVH_SIM, 0, KXROOT, KYROOT, 1, 2, 300, 0,
     +                       0, 0, IERR)
            SIM = .TRUE.
            GNOM = .FALSE.
            GO TO 100
C
C====== Gnomonic colour simulation
C
         ELSE IF (ITEM.EQ.M_GNOMC) THEN
            IF (TILTED) THEN
               CALL ERR_NOTICE(1,
     +                  '**Option not available for tilted detector**')
               GO TO 100
            END IF
            IF (SIM) CALL XDLF_DELETE_VIEW_OBJECT (IVH_SIM, IERR)
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
               GO TO 100
            END IF
            CALL LRL_XDLGNM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 300, 0,
     +                       GNOMR, 0, 0, IERR)
            SIM = .TRUE.
            GNOM = .TRUE.
            GO TO 100
C
C====== Gnomonic monochrome simulation with soft limit sliders etc.
C
         ELSE IF (ITEM.EQ.M_GNOMI) THEN
            IF (TILTED) THEN
               CALL ERR_NOTICE(1,
     +                  '**Option not available for tilted detector**')
               GO TO 100
            END IF
            IF (SIM) CALL XDLF_DELETE_VIEW_OBJECT (IVH_SIM, IERR)
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
               GO TO 100
            END IF
            CALL LRL_XDLGNM (IVH_SIM, 0, KXROOT, KYROOT, 1, 2, 300, 0,
     +                       GNOMR, 0, 0, IERR)
            SIM = .TRUE.
            GNOM = .TRUE.
            GO TO 100
C
C====== Set Direction
C
         ELSE IF (ITEM.EQ.M_DIRECT) THEN
            IF (SIM) CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            CALL SET_DIRECTION (IERR)
            IF (SIM) CALL XDLF_VIEW_OBJECT_RAISE (IVH_SIM, KERR) 
            IF (IERR.NE.0) GO TO 100
            IF (SIM) THEN
               CALL CALC_LAUE (.TRUE.)
               CALL LRL_NUMSPOTS (NUMSPOTS)
               IF (NUMSPOTS.EQ.0) THEN
                  CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
                  GO TO 100
               END IF
               IF (GNOM) THEN
                  CALL LRL_XDLGNM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 
     +                             300, 1, GNOMR, 0, 0, IERR)
               ELSE
                  CALL LRL_XDLSIM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1,  
     +                             300, 1, 0, 0, IERR)
            END IF
               END IF 
            GO TO 100
         END IF
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         TILTED = .FALSE.
         CALL LDM_GET_DTILT (DTILT, IFLAG, ND)
         IF (DTILT.NE.0.0.AND.DTILT.NE.180.0) TILTED = .TRUE.
         IF (SIM) THEN
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
               GO TO 100
            END IF
            IF (GNOM) THEN
               IF (TILTED) THEN
                  CALL XDLF_DELETE_VIEW_OBJECT (IVH_SIM, IERR)
                  SIM = .FALSE.
                  GO TO 100
               END IF
               CALL LRL_XDLGNM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 300, 
     +                       1, GNOMR, 0, 0, IERR)
            ELSE
               CALL LRL_XDLSIM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 300, 
     +                       1, 0, 0, IERR)
            END IF
         END IF
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         CALL PAR1_INPUT
         IF (SIM) THEN
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Reflections**')
               GO TO 100
            END IF
            CALL LRL_XDLSIM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 300, 1,
     +                       0, 0, IERR)
         END IF
         GO TO 100
C
C====== Parameter table 3 input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITM.EQ.IP_GNOMR) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than 0.1**'), 35, IERR)
               GO TO 100
            END IF
            GNOMR = FP
            IF (SIM.AND.GNOM) THEN
               CALL LRL_XDLGNM (IVH_SIM, 0, KXROOT, KYROOT, 1, 1, 300, 
     +                       1, GNOMR, 0, 0, IERR)
            END IF
            GO TO 100
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     LAUEGEN_PROCESS       **
C*******************************
C
C
      SUBROUTINE LAUEGEN_PROCESS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control processing level options of LAUEGEN
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL CONT
      LOGICAL QUIT
      INTEGER NVIEW
      INTEGER IVHLIST(4)
      INTEGER IVHLST2(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IFAIL
      INTEGER I
      INTEGER IERR
      INTEGER M_DISP
      INTEGER M_SPOTSIZE
      INTEGER M_REFINE
      INTEGER M_SOFT
      INTEGER M_INTEG
      INTEGER M_WRPARM
      INTEGER LISTE(2)
      INTEGER IRET
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) PAR_FILE
      CHARACTER*150 CMDLIN

C     LOGICAL CONT            !Continue with writing file flag
C     LOGICAL QUIT            !Program quit flag
C     INTEGER NVIEW           !No. ov view objects for input
C     INTEGER IVHLIST(4)      !View-object handles list
C     INTEGER IVHLST2(2)      !2'nd view-object handles list
C     INTEGER IVH             !Returned view-object handle
C     INTEGER ITEM            !Returned menu item number
C     INTEGER IQUIT           !Quit flag from menu
C     INTEGER IFAIL           !File open failure flag
C     INTEGER I               !Temp/loop variable
C     INTEGER IERR            !Error flag
C     INTEGER M_DISP          !Menu item no.: Display/Measure Image
C     INTEGER M_SPOTSIZE      !Menu item no.: Find Spot Size
C     INTEGER M_REFINE        !Menu item no.: Refine Orientation
C     INTEGER M_SOFT          !Menu item no.: Improve Soft Limits
C     INTEGER M_INTEG         !Menu item no.: Integrate Spots
C     INTEGER M_WRPARM        !Menu item no.: Write Parameters File
C     INTEGER LISTE(2)        !Dummy array for SET_PAR1_VALS call
C     INTEGER IRET            !Return flag from CHECK_INTEGRATED
C     CHARACTER*(MAXFLEN) FILNAM   !Temp. file name string
C     CHARACTER*(MAXFLEN) PAR_FILE !Parameter (.gen) file name
C     CHARACTER*150 CMDLIN         !Command line
C
C-------------------------------------------------------------------------------
C
      PROCESS = .TRUE.
      M_DISP = 1
      M_SPOTSIZE = 2
      M_REFINE = 3
      M_SOFT = 4
      M_INTEG = 5
      M_WRPARM = 6
      CALL LPROMPT (IVH_CMD,'process > ')
C
C====== Log entry to process and LDM parameters and clear LDM  changes flags
C
      IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG,1000)
         WRITE (IUN_LOG,1010)
         CALL LDM_WRITE (IUN_LOG, 3)
         WRITE (IUN_LOG,1020)
      END IF
      CALL LDM_CH_RESET (0)
C
C====== Set up 'Select Functions' Menu
C
100   CALL SET_MENU7
C
C====== Get input from Select Functions menu or Parameter table 1
C
      NVIEW = 4
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2
      IVHLIST(4) = IVH_CMD

      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======= Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_IO_WINDOW_PRINT (IVH_CMD, XDLSTR(' '), 1, 2,
     +                                 IERR)
            CALL CHECK_INTEGRATED (1, 0, IRET)
            IF (IRET.EQ.2) THEN
               CALL LPROMPT (IVH_CMD, 'process > ')       
               GO TO 100
            END IF
            PROCESS = .FALSE.
            RETURN
         END IF
C
C====== Display/Measure Image
C
         IF (ITEM.EQ.M_DISP) THEN
            CALL DISPLAY_OPT
            GO TO 100
C
C====== Determine spot size
C
         ELSE IF (ITEM.EQ.M_SPOTSIZE) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Determine Spot Size (menu request)',3)
            CALL SEL_SPOTSIZE
            GO TO 100
C
C====== Refine Orientation
C
         ELSE IF (ITEM.EQ.M_REFINE) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Refine Orientation',3)
            CALL SEL_REFINE
            GO TO 100
C
C====== Improve Soft Limits
C
         ELSE IF (ITEM.EQ.M_SOFT) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Improve Soft Limits (menu request)',3)
            CALL SET_PROMIN
            CALL SEL_SOFT
            GO TO 100
C
C====== Integrate Spots
C
         ELSE IF (ITEM.EQ.M_INTEG) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL LOG_HEAD ('Integrate Spots (menu request)',3)
            CALL SET_PROMIN
            CALL SET_SCALINT
            CALL SEL_INTEGRATE
            GO TO 100
C
C====== Write Parameters File
C
         ELSE IF (ITEM.EQ.M_WRPARM) THEN
110         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.ldm): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') GO TO 100
            CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
            CALL LGFILE_EXISTS (PAR_FILE, CONT)
            IF (.NOT.CONT) GO TO 110
            IFAIL = 1
            CALL CCPDPN (-IUN_GEN, PAR_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 110
            END IF
            CALL WRITE_PARFIL (PAR_FILE)
            CLOSE (UNIT=IUN_GEN)
            GO TO 100
         END IF
         GO TO 100
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         GO TO 100
C
C====== Command window input
C
      ELSE IF (IVH.EQ.IVH_CMD) THEN
         CALL XDLF_IO_WINDOW_GETSTRING (IVH_CMD, XDLSTR(CMDLIN),
     +     150, IERR)
         CALL CMD_INPUT (CMDLIN, QUIT)
         IF (.NOT.PROCESS) THEN
            CALL CHECK_INTEGRATED (1, 1, IRET)
            IF (IRET.EQ.2) THEN
                PROCESS = .TRUE.
            ELSE
               RETURN
            END IF
         END IF
         CALL LPROMPT (IVH_CMD, 'process > ')       
         GO TO 100
      END IF
      GO TO 100
C
C====== Format statements
C
1000  FORMAT (/,'Process Mode Entered',/,
     +          '====================',/)
1010  FORMAT ('Current LDM parameter values:-',/)
1020  FORMAT (' ')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*************************
C**     LAUEGEN_RIMG    **
C*************************
C
C
      SUBROUTINE LAUEGEN_RIMG (IPK, IPL, ITYPE, NF_OFF, IMG, MAXIMG,
     +                          KERR, KERRSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Open/Read image routine to be passed to auto_refinement routine
C          LFN_AUTO_REFN or auto soft limit routine LFN_AUTO_SOFT; also
C          Used in automatic detemination of spotsize and automatic
C          integration routines.
C
C Author:  John W. Campbell, October 1994
C
C Arguments:
C
      INTEGER IPK
      INTEGER IPL
      INTEGER ITYPE
      INTEGER NF_OFF
      INTEGER IMG(*)
      INTEGER MAXIMG
      INTEGER KERR
      CHARACTER*(*) KERRSTR
C  
C
C IPK     i  (R)  Pack number
C IPL     i  (R)  Plate number
C ITYPE   i  (M)  Image data type as stored 
C NF_OFF  i  (M)  Fast offset between (slow) rasters of image
C IMG(*)  i  (W)  Image array
C MAXIMG  i  (R)  Maximum size of image array
C KERR    i  (W)  Error return flag: Routine must
C                 set this to 0 if image read was
C                 successful or to a non-zero
C                 value if there was an error.
C KERRSTR c  (W)  Error message string set by the
C                 routine if an error was
C                 encountered when opening/reading image.
C
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER IFTYPE
      INTEGER KFLAG
      INTEGER IERR
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL W_F
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*2 VALSTR
      CHARACTER*80 STR

C     INTEGER IFTYPE                  !Image file type flag
C     INTEGER KFLAG                   !Parameter status flag
C     INTEGER IERR                    !Error flag
C     REAL X_CEN_F                    !X centre
C     REAL Y_CEN_F                    !Y centre
C     REAL W_F                        !Omega
C     CHARACTER*(MAXFLEN) FILNAM      !File name
C     CHARACTER*2 VALSTR              !Parameter value string (dummy)
C     CHARACTER*80 STR                !Temp string

C
C-------------------------------------------------------------------------------
C
      KERR = 0
      KERRSTR = ' '
C
C====== Set current pack and plate
C
      IPACK = IPK
      IPLATE = IPL
C
C====== Open image file
C
      IF (IPACK.EQ.IPACK_OPN.AND.IPLATE.EQ.IPLATE_OPN
     +    .AND.FILM_OPEN) GO TO 100
      CALL LDM_GET_IMDAT (VALSTR, IFTYPE, KFLAG)
      IF (IFTYPE.LT.1.OR.IFTYPE.GT.4) THEN
         KERR = 1
         KERRSTR = 'Cannot handle requested image data type'
         RETURN
      END IF
      IF (FILM_OPEN) THEN
         IF (IFTYPE.EQ.1) THEN
            CALL XDLF_CLOSE_FILM_FILE (IFD, IERR)
         ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
            CALL XDLF_CLOSE_I2 (IFD, IERR)
         END IF
         FILM_OPEN = .FALSE.
         FILM_READ = .FALSE.
         IPACK_OPN = 0
         IPLATE_OPN = 0
      END IF
      CALL LDM_FILENAME (IPACK, IPLATE, FILNAM)
      IF (FILNAM.EQ.' ') THEN
         KERR = 1
         KERRSTR = 'Blank file name'
         RETURN
      END IF
      STR = FILNAM
      CALL CCPUPC (STR)
      IF (STR.EQ.'MISSING') THEN
         KERR = 1
         KERRSTR = 'Image file declared as missing'
         RETURN
      END IF
      IF (IFTYPE.EQ.1) THEN
         CALL XDLF_OPEN_FILM_FILE (XDLSTR(FILNAM),LENSTR(FILNAM),
     +             IFD, IERR)
      ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
         CALL XDLF_OPEN_I2(XDLSTR(FILNAM),LENSTR(FILNAM),
     +             IFD, IERR)
      END IF
      IF (IERR.NE.0) THEN
         STR = 'Cannot open file:'
         CALL STR_ADDS(STR,FILNAM,1)
         KERR = 1
         KERRSTR = STR
         RETURN
      END IF

      FILM_OPEN = .TRUE.
      IPACK_OPN = IPACK
      IPLATE_OPN = IPLATE

C
C====== Read image
C
 100  IF (.NOT.FILM_READ) CALL READ_IMAGE (1, IMG, MAXIMG, ITYPE, 
     +    NF_OFF, KERR, KERRSTR)
      CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     LG_CLEARINT_PROMPT    **
C*******************************
C
C
      SUBROUTINE LG_CLEARINT_PROMPT (LINE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Prompt for clear intensities intensities lists command
C          initiated by lg_clearint commandvia the command line input
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      CHARACTER*(*) LINE
      INTEGER IERR

C LINE     (M)  On input, the remainder of the input line following the command
C               On output, unchanged unless line starts with '>' in which
C               case a new line is constructed and returned.
C IERR     (W)  Error flag = 0 OK
C                          = 1 Error 
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      CHARACTER*80 PRMPSTR
      CHARACTER*120 REPSTR

C     LOGICAL EOF     !End of file flag
C     INTEGER II      !Return flag from next token routine
C     INTEGER IL      !Last character processed of string
C     INTEGER M1      !Index of first character of token in string
C     INTEGER M2      !Index of final character of token in string
C     CHARACTER*80 PRMPSTR !Prompt string
C     CHARACTER*120 REPSTR !Reply string
      
C
C-------------------------------------------------------------------------------
CC
C====== Check request
C
      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.EQ.0) RETURN
      IF (LINE(M1:M1).NE.'>') RETURN
      IF (LG_MODE.EQ.3) THEN
         CALL CMD_MSG (IVH_CMD, 
     +   '**Error** Prompt request invalid in batch/background mode')
         IERR = 1
         RETURN
      END IF

      LINE = ' '
      PRMPSTR = 'Scope (plate, pack, all) [pack]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C********************************
C**     LG_INTEGRATE_PROMPT    **
C********************************
C
C
      SUBROUTINE LG_INTEGRATE_PROMPT (LINE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Prompt for auto-integrate parameters when auto-integration is
C          initiated via the command line input
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      CHARACTER*(*) LINE
      INTEGER IERR

C LINE     (M)  On input, the remainder of the input line following the command
C               On output, unchanged unless line starts with '>' in which
C               case a new line is constructed and returned.
C IERR     (W)  Error flag = 0 OK
C                          = 1 Error 
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EOF
      LOGICAL PRALL
      LOGICAL PRALL_SAV
      LOGICAL PR_ROT
      LOGICAL PR_ROT_SAV
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER ND
      INTEGER KERR
      INTEGER IVAL
      INTEGER ISAV
      REAL FVAL
      REAL FP
      REAL RSAV
      CHARACTER*60 PRMPSTR
      CHARACTER*80 REPSTR
      CHARACTER*20 STR
      CHARACTER*2 DUMSTR

C     LOGICAL EOF          !End of file flag
C     LOGICAL PRALL        !Profiles for all plates flag
C     LOGICAL PRALL_SAV    !Saves value of PRALL
C     LOGICAL PR_ROT       !Profile rotate flag
C     LOGICAL PR_ROT_SAV   !Saves value of PR_ROT
C     INTEGER II           !Return flag from next token routine
C     INTEGER IL           !Last character processed of string
C     INTEGER M1           !Index of first character of token in string
C     INTEGER M2           !Index of final character of token in string
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ITYP         !Parameter type flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER KERR         !Error flag
C     INTEGER IVAL         !Integer parameter value
C     INTEGER ISAV         !Save integer parameter value
C     REAL FVAL            !Real parameter value
C     REAL FP              !Real parameter value
C     REAL RSAV            !Save real parameter value
C     CHARACTER*60 PRMPSTR !Prompt string
C     CHARACTER*80 REPSTR  !Reply string
C     CHARACTER*20 STR     !Parameter value string
C     CHARACTER*2 DUMSTR   !Dummy string      
C
C-------------------------------------------------------------------------------
C
C====== Get current values for NPROF, PROMIN, IPRF_ALL, NOVLD
C
      IERR = 0
      CALL LDM_GET ('NPROF', IPACK, IPLATE, STR, 
     +              FP, ND, NPROF, IFLAG, ITYP, KERR, DUMSTR)
      PRF_ROT = .FALSE.
      CALL LDM_GET ('PROF_ROTATE', IPACK, IPLATE, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, KERR, DUMSTR)
      IF (STR.EQ.'yes') PRF_ROT = .TRUE.
      CALL LDM_GET ('PROMIN', IPACK, IPLATE, STR, 
     +              PROMIN, ND, IVAL, IFLAG, ITYP, KERR, DUMSTR)
      IPRF_ALL = 0
      CALL LDM_GET ('PROF_ALL', IPACK, IPLATE, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, KERR, DUMSTR)
      IF (STR.EQ.'yes') IPRF_ALL = 1
      CALL LDM_GET ('OVLIM', IPACK, IPLATE, STR, 
     +              FP, ND, NOVLD, IFLAG, ITYP, KERR, DUMSTR)
C
C====== Check request
C
      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.EQ.0) RETURN
      IF (LINE(M1:M1).NE.'>') RETURN
      IF (LG_MODE.EQ.3) THEN
         CALL CMD_MSG (IVH_CMD, 
     +   '**Error** Prompt request invalid in batch/background mode')
         IERR = 1
         RETURN
      END IF
C
C====== Prompt for parameters
C
      LINE = ' '
      PRMPSTR = 'Scope (plate, pack, all) [pack]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)

      PRMPSTR = 'Number intensity profile bins {nprof}'
      IVAL = NPROF
      ISAV = NPROF
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, IVAL)
      ELSE
         CALL TASKI (PRMPSTR, IVAL, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (IVAL.NE.ISAV) THEN
         CALL STR_ADDS (LINE, 'nprof=', 1)
         CALL STR_ADDI (LINE, IVAL, 0)
      END IF

      PR_ROT = PRF_ROT
      PR_ROT_SAV = PR_ROT
      PRMPSTR = 'Rotate profiles if elliptical spots {prof_rotate}'
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKQ (IVH_CMD, PRMPSTR, PR_ROT)
      ELSE
         CALL TASKQ(PRMPSTR, PR_ROT, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (PR_ROT.NEQV.PR_ROT_SAV) THEN
         CALL STR_ADDS (LINE, 'prof_rotate=', 1)
         IF (PR_ROT) THEN
            CALL STR_ADDS (LINE, 'yes', 0)
         ELSE
            CALL STR_ADDS (LINE, 'no', 0)
         END IF
      END IF

      PRMPSTR = 'Minimum intensity for profiles {promin}'
      FVAL = PROMIN
      RSAV = PROMIN
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'promin=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF

      PRALL = .FALSE.
      IF (IPRF_ALL.EQ.1) PRALL = .TRUE.
      PRALL_SAV = PRALL
      PRMPSTR = 'Profiles for all plates in pack {prof_all}'
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKQ (IVH_CMD, PRMPSTR, PRALL)
      ELSE
         CALL TASKQ(PRMPSTR, PRALL, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (PRALL.NEQV.PRALL_SAV) THEN
         CALL STR_ADDS (LINE, 'prof_all=', 1)
         IF (PRALL) THEN
            CALL STR_ADDS (LINE, 'yes', 0)
         ELSE
            CALL STR_ADDS (LINE, 'no', 0)
         END IF
      END IF

      PRMPSTR = 'Number of overload pixels allowed in a spot {ovlim}'
      IVAL = NOVLD
      ISAV = NOVLD
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, IVAL)
      ELSE
         CALL TASKI (PRMPSTR, IVAL, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (IVAL.NE.ISAV) THEN
         CALL STR_ADDS (LINE, 'ovlim=', 1)
         CALL STR_ADDI (LINE, IVAL, 0)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     LG_REFINE_PROMPT    **
C*****************************
C
C
      SUBROUTINE LG_REFINE_PROMPT (LINE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Prompt for auto-refine parameters when auto-refinement initiated
C          via the command line input
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      CHARACTER*(*) LINE
      INTEGER IERR

C LINE     (M)  On input, the remainder of the input line following the command
C               On output, unchanged unless line starts with '>' in which
C               case a new line is constructed and returned.
C IERR     (W)  Error flag = 0 OK
C                          = 1 Error 
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER NNOD
      CHARACTER*60 PRMPSTR
      CHARACTER*80 REPSTR

C     LOGICAL EOF     !End of file flag
C     INTEGER II      !Return flag from next token routine
C     INTEGER IL      !Last character processed of string
C     INTEGER M1      !Index of first character of token in string
C     INTEGER M2      !Index of final character of token in string
C     INTEGER NNOD    !Final number of nodals or final nodal index
C     CHARACTER*60 PRMPSTR !Prompt string
C     CHARACTER*80 REPSTR  !Reply string
      
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.EQ.0) RETURN
      IF (LINE(M1:M1).NE.'>') RETURN
      IF (LG_MODE.EQ.3) THEN
         CALL CMD_MSG (IVH_CMD, 
     +   '**Error** Prompt request invalid in batch/background mode')
         IERR = 1
         RETURN
      END IF

      LINE = ' '
      PRMPSTR = 'Scope (plate, pack, all) [pack]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)

      PRMPSTR = 'Refine cell (cell, nocell) [cell]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)

      PRMPSTR = 'Start number of nodals or nodal index'
      NNOD = 4
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, NNOD)
      ELSE
         CALL TASKI (PRMPSTR, NNOD, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDI (LINE, NNOD, 1)

      PRMPSTR = 'Final number of nodals or nodal index'
      NNOD = 6
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, NNOD)
      ELSE
         CALL TASKI (PRMPSTR, NNOD, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDI (LINE, NNOD, 1)
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     LG_SOFT_PROMPT      **
C*****************************
C
C
      SUBROUTINE LG_SOFT_PROMPT (IOPT, LINE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Prompt for soft_limits determination parameters when soft_limits
C          improvement initiated via the command line input
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER IOPT
      CHARACTER*(*) LINE
      INTEGER IERR

C IOPT     (R)  =1 determining dmin, =2 determining lambda-min
C LINE     (M)  On input, the remainder of the input line following the command
C               On output, unchanged unless line starts with '>' in which
C               case a new line is constructed and returned.
C IERR     (W)  Error flag = 0 OK
C                          = 1 Error 
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'auto_soft.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EOF
      LOGICAL IDUM_PRF_ROT
      LOGICAL PR_ROT
      LOGICAL PR_ROT_SAV
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER ISAV
      INTEGER IVAL
      INTEGER IDUM_NPROF
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER ND
      INTEGER KERR
      REAL FP
      REAL FVAL
      REAL RSAV
      REAL RDUM_PROMIN
      CHARACTER*60 PRMPSTR
      CHARACTER*20 REPSTR
      CHARACTER*20 STR
      CHARACTER*2 DUMSTR

C     LOGICAL EOF          !End of file flag
C     LOGICAL IDUM_PRF_ROT !Dummy value for PRF_ROT flag
C     LOGICAL PR_ROT       !Profile rotate flag
C     LOGICAL PR_ROT_SAV   !Saves value of PR_ROT
C     INTEGER II         !Return flag from next token routine
C     INTEGER IL         !Last character processed of string
C     INTEGER M1         !Index of first character of token in string
C     INTEGER M2         !Index of final character of token in string
C     INTEGER ISAV       !Saved integer value
C     INTEGER IVAL       !Integer value
C     INTEGER IDUM_NPROF !dummy value for no. of profile bins
C     INTEGER IFLAG      !Parameter status flag
C     INTEGER ITYP       !Parameter type flag
C     INTEGER ND         !No. of decimal places flag
C     INTEGER KERR       !Error flag
C     REAL FP            !Real parameter value
C     REAL FVAL          !Real value
C     REAL RSAV          !Saved real value
C     REAL RDUM_PROMIN   !Dummy value for PROMIN
C     CHARACTER*60 PRMPSTR !Prompt string
C     CHARACTER*20 REPSTR  !Reply string
C     CHARACTER*20 STR     !Parameter value string
C     CHARACTER*2 DUMSTR   !Dummy string      
      
C
C-------------------------------------------------------------------------------
C
      IERR = 0
C
C====== Get default parameters
C
      CALL LFN_SOFT_DF (IOPT, MAX_SOFT_BINS, IDUM_NPROF, IDUM_PRF_ROT,
     +                  RDUM_PROMIN, FRAC_AUT, SIGTEST_AUT, FRTEST_AUT,  
     +                  NUMBINS_AUT, BINW_AUT)

      CALL LDM_GET ('NPROF', 1, 1, STR, 
     +              FP, ND, NPROF, IFLAG, ITYP, KERR, DUMSTR)
      PRF_ROT = .FALSE.
      CALL LDM_GET ('PROF_ROTATE', 1, 1, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, KERR, DUMSTR)
      IF (STR.EQ.'yes') PRF_ROT = .TRUE.
      CALL LDM_GET ('PROMIN', 1, 1, STR, 
     +              PROMIN, ND, IVAL, IFLAG, ITYP, KERR, DUMSTR)
C
C====== Check call
C
      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.EQ.0) RETURN
      IF (LINE(M1:M1).NE.'>') RETURN
      IF (LG_MODE.EQ.3) THEN
         CALL CMD_MSG (IVH_CMD, 
     +   '**Error** Prompt request invalid in batch/background mode')
         IERR = 1
         RETURN
      END IF
C
C====== Service prompts
C
      LINE = ' '
      PRMPSTR = 'Scope (pack, all) [pack]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)

      PRMPSTR = 'Number intensity profile bins {nprof}'
      IVAL = NPROF
      ISAV = NPROF
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, IVAL)
      ELSE
         CALL TASKI (PRMPSTR, IVAL, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (IVAL.NE.ISAV) THEN
         CALL STR_ADDS (LINE, 'nprof=', 1)
         CALL STR_ADDI (LINE, IVAL, 0)
      END IF

      PR_ROT = PRF_ROT
      PR_ROT_SAV = PR_ROT
      PRMPSTR = 'Rotate profiles if elliptical spots {prof_rotate}'
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKQ (IVH_CMD, PRMPSTR, PR_ROT)
      ELSE
         CALL TASKQ(PRMPSTR, PR_ROT, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (PR_ROT.NEQV.PR_ROT_SAV) THEN
         CALL STR_ADDS (LINE, 'prof_rotate=', 1)
         IF (PR_ROT) THEN
            CALL STR_ADDS (LINE, 'yes', 0)
         ELSE
            CALL STR_ADDS (LINE, 'no', 0)
         END IF
      END IF

      PRMPSTR = 'Minimum intensity for profiles {promin}'
      FVAL = PROMIN
      RSAV = PROMIN
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'promin=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF

      IF (IOPT.EQ.1) THEN
         PRMPSTR = 'Number of ''dmin'' bins {nbins}'
      ELSE
         PRMPSTR = 'Number of ''lmin'' bins {nbins}'
      END IF
      IVAL = NUMBINS_AUT
      ISAV = NUMBINS_AUT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, IVAL)
      ELSE
         CALL TASKI (PRMPSTR, IVAL, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (IVAL.NE.ISAV) THEN
         CALL STR_ADDS (LINE, 'nbins=', 1)
         CALL STR_ADDI (LINE, IVAL, 0)
      END IF

      IF (IOPT.EQ.1) THEN
         PRMPSTR = 'Bin width for ''dmin'' {binw}'
      ELSE
         PRMPSTR = 'Bin width for ''lmin'' {binw}'
      END IF
      FVAL = BINW_AUT
      RSAV = BINW_AUT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 2)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 2, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'binw=', 1)
         CALL STR_ADDF (LINE, FVAL, 4, 0)
      END IF

      IF (IOPT.EQ.1) THEN
         PRMPSTR = 'Start fraction of current ''dmin'' {frac}'
      ELSE
         PRMPSTR = 'Start fraction of current ''lmin'' {frac}'
      END IF
      FVAL = FRAC_AUT
      RSAV = FRAC_AUT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 2)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 2, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'frac=', 1)
         CALL STR_ADDF (LINE, FVAL, 3, 0)
      END IF

      PRMPSTR = 'Sigma test for significant intensity {sigtest}'
      FVAL = SIGTEST_AUT
      RSAV = SIGTEST_AUT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'sigtest=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF

      PRMPSTR = 'Fraction test for soft limit significance {frtest}'
      FVAL = FRTEST_AUT
      RSAV = FRTEST_AUT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 2)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 2, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'frtest=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     LG_SPOTSIZE_PROMPT    **
C*******************************
C
C
      SUBROUTINE LG_SPOTSIZE_PROMPT (LINE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Prompt for spot size determination parameters when spot size
C          determination initiated via the command line input
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
      CHARACTER*(*) LINE
      INTEGER IERR

C LINE     (M)  On input, the remainder of the input line following the command
C               On output, unchanged unless line starts with '>' in which
C               case a new line is constructed and returned.
C IERR     (W)  Error flag = 0 OK
C                          = 1 Error 
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER ISAV
      INTEGER NBINS
      INTEGER IVAL
      REAL FVAL
      REAL RSAV
      REAL SDCUT
      REAL THRFAC
      REAL EXPAND
      CHARACTER*60 PRMPSTR
      CHARACTER*20 REPSTR
      CHARACTER*2 VALSTR

C     LOGICAL EOF     !End of file flag
C     INTEGER II      !Return flag from next token routine
C     INTEGER IL      !Last character processed of string
C     INTEGER M1      !Index of first character of token in string
C     INTEGER M2      !Index of final character of token in string
C     INTEGER ISAV    !Saved integer value
C     INTEGER NBINS   !No. of angular bins for spot size analysis
C     INTEGER IVAL    !Integer parameter value
C     REAL FVAL       !Real parameter value
C     REAL RSAV       !Saved real value
C     REAL SDCUT      !Standard deviation cutoff
C     REAL THRFAC     !Threshold factor (*background) for spots
C     REAL EXPAND     !Expansion factor: ave obs. -> proposed
C     CHARACTER*60 PRMPSTR !Prompt string
C     CHARACTER*20 REPSTR  !Reply string
C     CHARACTER*2 VALSTR   !Dummy parameter value string
      
C
C-------------------------------------------------------------------------------
C
      IERR = 0

      CALL SPOTSIZE_DFLTS (NBINS, SDCUT, THRFAC, EXPAND)

      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.EQ.0) RETURN
      IF (LINE(M1:M1).NE.'>') RETURN
      IF (LG_MODE.EQ.3) THEN
         CALL CMD_MSG (IVH_CMD, 
     +   '**Error** Prompt request invalid in batch/background mode')
         IERR = 1
         RETURN
      END IF

      LINE = ' '
      PRMPSTR = 'Scope (pack, all) [pack]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)

      PRMPSTR = 'Threshold factor (*background) for search {thresh}'
      FVAL = THRFAC
      RSAV = THRFAC
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'thresh=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF

      PRMPSTR = 'Number angular analysis bins {nbins}'
      IVAL = NBINS
      ISAV = NBINS
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKI (IVH_CMD, PRMPSTR, IVAL)
      ELSE
         CALL TASKI (PRMPSTR, IVAL, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (IVAL.NE.ISAV) THEN
         CALL STR_ADDS (LINE, 'nbins=', 1)
         CALL STR_ADDI (LINE, IVAL, 0)
      END IF

      PRMPSTR = 'Standard deviation cutoff for good spots {sdcut}'
      FVAL = SDCUT
      RSAV = SDCUT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'sdcut=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF

      PRMPSTR = 'Expansion factor - observed->proposed size {expand}'
      FVAL = EXPAND
      RSAV = EXPAND
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'expand=', 1)
         CALL STR_ADDF (LINE, FVAL, 2, 0)
      END IF
      
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     LG_WRITEINT_PROMPT    **
C*******************************
C
C
      SUBROUTINE LG_WRITEINT_PROMPT (LINE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Prompt for write intensities files parameters wheninitiated 
C          via the command line input
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      CHARACTER*(*) LINE
      INTEGER IERR

C LINE     (M)  On input, the remainder of the input line following the command
C               On output, unchanged unless line starts with '>' in which
C               case a new line is constructed and returned.
C IERR     (W)  Error flag = 0 OK
C                          = 1 Error 
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EOF
      INTEGER II
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER KERR
      INTEGER ND
      REAL FVAL
      REAL RSAV
      REAL FP
      CHARACTER*80 PRMPSTR
      CHARACTER*120 REPSTR
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*6 INT_FTYP

C     LOGICAL EOF     !End of file flag
C     INTEGER II      !Return flag from next token routine
C     INTEGER IL      !Last character processed of string
C     INTEGER M1      !Index of first character of token in string
C     INTEGER M2      !Index of final character of token in string
C     INTEGER IVAL    !Integer parameter value
C     INTEGER IFLAG   !Parameter status flag
C     INTEGER ITYP    !Parameter type flag
C     INTEGER KERR    !Error flag
C     INTEGER ND      !No. of decimal places flag
C     REAL FVAL       !Real parameter value
C     REAL RSAV       !Saved real value
C     REAL FP         !Real parameter value
C     CHARACTER*80 PRMPSTR !Prompt string
C     CHARACTER*120 REPSTR !Reply string
C     CHARACTER*2 VALSTR   !Dummy parameter value string
C     CHARACTER*2 ERRSTR   !Dummy error string
C     CHARACTER*6 INT_FTYP !File type string
      
C
C-------------------------------------------------------------------------------
C
C
C====== Get current values for INT_FTYPE, INT_TEMPLATE & SCALE_INT 
C
      IERR = 0
      CALL LDM_GET ('INT_FTYPE', 1, 1, INT_FTYP, FP, ND, IVAL,
     +              IFLAG, ITYP, KERR, ERRSTR)
      INT_TYP = 1
      CALL CCPUPC(INT_FTYP)
      IF (INT_FTYP.EQ.'GE') INT_TYP = 2
      CALL LDM_GET ('INT_TEMPLATE', 1, 1, INT_TEMPLATE, 
     +              FP, ND, IVAL, IFLAG, ITYP, KERR, ERRSTR)
      CALL LDM_GET ('SCALE_INT', 1, 1, VALSTR, 
     +              SCAL_INT, ND, IVAL, IFLAG, ITYP, KERR, ERRSTR)
C
C====== Check request
C
      IL = 0
      II = NXTTOK (LINE, ' ,', IL, M1, M2)
      IF (II.EQ.0) RETURN
      IF (LINE(M1:M1).NE.'>') RETURN
      IF (LG_MODE.EQ.3) THEN
         CALL CMD_MSG (IVH_CMD, 
     +   '**Error** Prompt request invalid in batch/background mode')
         IERR = 1
         RETURN
      END IF

      LINE = ' '
      PRMPSTR = 'Scope (pack, all) [pack]: '
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      CALL STR_ADDS (LINE, REPSTR, 1)

      PRMPSTR = 'File type (ge/mtz) {int_ftype} ['
      INT_FTYP = 'mtz'
      IF (INT_TYP.EQ.2) INT_FTYP = 'ge'
      CALL STR_ADDS (PRMPSTR, INT_FTYP, 0)
      CALL STR_ADDS (PRMPSTR, ']: ', 0)
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (REPSTR.NE.' ') THEN
         CALL STR_ADDS (LINE, 'int_ftype=', 1)
         CALL STR_ADDS (LINE, REPSTR, 0)
      END IF

      PRMPSTR = 'File template {int_template} ['
      CALL STR_ADDS (PRMPSTR, INT_TEMPLATE, 0)
      CALL STR_ADDS (PRMPSTR, ']: ', 0)
      IF (LG_MODE.EQ.1) THEN
         CALL LPROMPT (IVH_CMD, PRMPSTR)
         CALL LREAD (IVH_CMD, REPSTR)
      ELSE
         CALL TPROMP (PRMPSTR)
         CALL TREAD (REPSTR, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (REPSTR.NE.' ') THEN
         CALL STR_ADDS (LINE, 'int_template=', 1)
         CALL STR_ADDS (LINE, REPSTR, 0)
      END IF

      PRMPSTR = 'Scale factor for output intensities {scale_int}'
      FVAL = SCAL_INT
      RSAV = SCAL_INT
      IF (LG_MODE.EQ.1) THEN
         CALL IOW_ASKF (IVH_CMD, PRMPSTR, FVAL, 1)
      ELSE
         CALL TASKF (PRMPSTR, FVAL, 1, EOF)
         IF (EOF) THEN
            IERR = 1
            RETURN
         END IF
      END IF
      IF (FVAL.NE.RSAV) THEN
         CALL STR_ADDS (LINE, 'scale_int=', 1)
         CALL STR_ADDF (LINE, FVAL, -5, 0)
      END IF

      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C******************************
C**     LGFILE_EXISTS        **
C******************************
C
C
      SUBROUTINE LGFILE_EXISTS (FILNAM, CONT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: See if output file exists and, if it does ask whether or not
C          to overwrite it  (Interactive commands only)
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      CHARACTER*(*) FILNAM
      LOGICAL CONT
C
C FILNAM   (R)  Name of the file
C CONT     (W)  =.TRUE, continue with writing, =.FALSE. do not
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL EXISTS

C     LOGICAL EXISTS    !File exists flag
C
C-------------------------------------------------------------------------------
C
      CONT = .TRUE.
      EXISTS = CCPEXS (FILNAM)
      IF (EXISTS) THEN
         CALL LMESSAGE(IVH_IOW,'**File already exists**')
         CONT = .FALSE.
         CALL IOW_ASKQ (IVH_IOW, 'Overwrite file', CONT)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************
C**     LJUST     **
C*******************
C
C
      SUBROUTINE LJUST (CHSTR)
C
C Purpose:    Left jusify text in a character string (eliminate leading blanks)
C
C Author:     John W. Campbell, September 1990
C
C Arguments:
C
      CHARACTER*(*) CHSTR
C
C    CHSTR  (M)  Character string containing the text
C
C Declarations
C ============
C
C GLOBALS:
C

C
C LOCALS:
C
      INTEGER NC
      INTEGER I

C     INTEGER NC   !No. of characters in the string
C     INTEGER I    !Loop counter
C
C-------------------------------------------------------------------------------
C
C====== Shift as needed
C
      NC = LEN (CHSTR)
      DO 100 I = 1, NC
         IF (CHSTR(I:I).NE.' ') THEN
            CHSTR = CHSTR(I:NC)
            RETURN
         ENDIF
100   CONTINUE
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LMESSAGE         **
C**************************
C
      SUBROUTINE LMESSAGE (IVH_W, CHSTR)
C
C      IMPLICIT NONE
C
C Purpose:    Output a message string to an io-window followed by a newline
C
C Author:     John W. Campbell, September 1990
C
C Arguments:
C
      INTEGER IVH_W
      CHARACTER*(*) CHSTR
C
C    IVH_W    (R)   View-object handle for the io-window
C    CHSTR    (R)   The message string
C
C Declarations
C ============
C
C GLOBALS:
C
      INTEGER XDLSTR
C
C LOCALS:
C
      INTEGER LENS
      INTEGER I
      INTEGER IERR
      INTEGER NCH

C     INTEGER LENS   !Length of the character string
C     INTEGER I      !Loop counter
C     INTEGER IERR   !Error return
C     INTEGER NCH    !No. characters up to last non-blank character
C
C-------------------------------------------------------------------------------
C
C====== Find length of message string up to last non-blank
C
      LENS = LEN (CHSTR)
      NCH = 1
      DO 100 I = LENS, 1, -1
      IF (CHSTR(I:I).NE.' ') THEN
         NCH = I
         GO TO 200
      ENDIF
100   CONTINUE
C
C====== Output the message
C
200   CALL XDLF_IO_WINDOW_PRINT (IVH_W, XDLSTR(CHSTR), NCH, 2, IERR)
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LOG_CHANGES      **
C**************************
C
C
      SUBROUTINE LOG_CHANGES (ICHAN)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Write changed parameters to log file
C
C Author:  John W. Campbell, April 1994
C
C Arguments:
C
      INTEGER ICHAN
C  
C ICHAN    (R)   Channel no. for reporting changed parameters (1-16)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL LDM_ANY_CH
C
C====== LOCALS:
C

C
C-------------------------------------------------------------------------------
C
      IF (IUN_LOG.EQ.0) RETURN
      IF (ICHAN.LT.1.OR.ICHAN.GT.16) RETURN
      IF (.NOT.LDM_ANY_CH(ICHAN)) RETURN
      WRITE (IUN_LOG,1000)
      CALL LDM_WRITE (IUN_LOG, -ICHAN)
      WRITE (IUN_LOG,1010)
      RETURN
C
C====== Format statements
C
1000  FORMAT (/,'Changed LDM parameters:-',/)
1010  FORMAT (' ')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LOG_HEAD         **
C**************************
C
      SUBROUTINE LOG_HEAD (CHSTR, ITYP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Output heading to log file
C
C Author:     John W. Campbell, October 1993
C
C Arguments:
C
      CHARACTER*(*) CHSTR
      INTEGER ITYP
C
C    CHSTR    (R)   The message string
C    ITYP     (R)   Heading type flag =1, standard (preceeded by 1 blank line)
C                                     =2, as for 1 but underlined with '---'
C                                     =3, as for 1 but underlined with '==='
C
C Declarations
C ============
C
C GLOBALS:
C
      INCLUDE 'file_units.finc'
C
C LOCALS:
C
      INTEGER LENS
      INTEGER I
      INTEGER NCH

C     INTEGER LENS   !Length of the character string
C     INTEGER I      !Loop counter
C     INTEGER NCH    !No. characters up to last non-blank character
C
C-------------------------------------------------------------------------------
C
      IF (IUN_LOG.EQ.0) RETURN
C
C====== Find length of message string up to last non-blank
C
      LENS = LEN (CHSTR)
      NCH = 1
      DO 100 I = LENS, 1, -1
      IF (CHSTR(I:I).NE.' ') THEN
         NCH = I
         GO TO 200
      ENDIF
100   CONTINUE
C
C====== Output the heading
C
200   IF (ITYP.LE.3) THEN
         WRITE(IUN_LOG,1000)
         WRITE (IUN_LOG,1001) CHSTR(1:NCH)
      END IF
      IF (ITYP.EQ.2) THEN
         WRITE(IUN_LOG,1002) ('-',I=1,NCH)
      ELSE IF (ITYP.EQ.3) THEN
         WRITE(IUN_LOG,1002) ('=',I=1,NCH)
      END IF
      RETURN
C
C====== Format statements
C
1000  FORMAT (' ')
1001  FORMAT (A)
1002  FORMAT (120A1)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LOG_INT_TAB1     **
C**************************
C
C
      SUBROUTINE LOG_INT_TAB1
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Output intensity statistics table 1 to log file
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'lirl_pars.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER NS(5)
      INTEGER NG(5)
      INTEGER NO(5)
      INTEGER NN(5)
      INTEGER NB(5)
      INTEGER N3(5)
      INTEGER N10(5)
      INTEGER IERR
      REAL AIM(5)
      REAL AIS(5)

C     INTEGER NS(5)   !No. of spots present for the 5 spot categories
C     INTEGER NG(5)   !No. of spots integrated & good for the 5 spot categories
C     INTEGER NO(5)   !No. of overload spots flagged for the 5 spot categories
C     INTEGER NN(5)   !No. of OK negative intensities for the 5 spot categories
C     INTEGER NB(5)   !No. of bad spots spots flagged for the 5 spot categories
C     INTEGER N3(5)   !No. OK spots with I>3*sig(I) for the 5 spot categories
C     INTEGER N10(5)  !No. OK spots wit I>10*sig(I) for the 5 spot categories
C     INTEGER IERR    !Error flag
C     REAL AIM(5)     !Mean I value for the 5 spot categories (for OK positive
C                      intensities only)
C     REAL AIS(5)     !Mean I/sig(I) values for the 5 spot categories (for
C                      OK positive intensities only)
C
C-------------------------------------------------------------------------------
C
      CALL LFN_INT_STATS1 (KDX_LIRL, IPACK, IPLATE, NS, NG, NO, NN,  
     +                     NB, AIM, AIS, N3, N10, IERR)
      IF (IERR.EQ.0.AND.IUN_LOG.GT.0) THEN 
         CALL LFN_INT_TAB1 (IUN_LOG, 0, KEY_LOG, NS, NG, NO, NN, NB, 
     +                      AIM, AIS, N3, N10)
         KEY_LOG = 0
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LOG_MSG          **
C**************************
C
      SUBROUTINE LOG_MSG (IVH_W, CHSTR, NL)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Output a message string to an io-window or the terminal if
C             required by the program mode and to the log file
C
C Author:     John W. Campbell, October 1993
C
C Arguments:
C
      INTEGER IVH_W
      CHARACTER*(*) CHSTR
      INTEGER NL
C
C    IVH_W    (R)   View-object handle for the io-window
C    CHSTR    (R)   The message string
C    NL       (R)   No. of blank lines before message when written to log file
C
C Declarations
C ============
C
C GLOBALS:
C
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C LOCALS:
C
      INTEGER LENS
      INTEGER I
      INTEGER IERR
      INTEGER NCH

C     INTEGER LENS   !Length of the character string
C     INTEGER I      !Loop counter
C     INTEGER IERR   !Error return
C     INTEGER NCH    !No. characters up to last non-blank character
C
C-------------------------------------------------------------------------------
C
C====== Find length of message string up to last non-blank
C
      LENS = LEN (CHSTR)
      NCH = 1
      DO 100 I = LENS, 1, -1
      IF (CHSTR(I:I).NE.' ') THEN
         NCH = I
         GO TO 200
      ENDIF
100   CONTINUE
C
C====== Output the message to io/window or terminal if appropriate
C
200   IF (LG_MODE.EQ.1) THEN
         CALL XDLF_IO_WINDOW_PRINT (IVH_W, XDLSTR(CHSTR), NCH, 2, IERR)
      ELSE IF (LG_MODE.EQ.2) THEN
         CALL TWRITE (CHSTR)
      END IF
C
C====== Now output to log file
C
      IF (IUN_LOG.LE.0) RETURN
      IF (NL.GT.0) THEN
         DO 210 I = 1, NL
            WRITE(IUN_LOG,1000)
210      CONTINUE
      END IF
      WRITE (IUN_LOG,1001) CHSTR(1:NCH)
      RETURN
C
C====== Format statements
C
1000  FORMAT (' ')
1001  FORMAT (A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LPROMPT          **
C**************************
C
      SUBROUTINE LPROMPT (IVH_W, CHSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Output a prompt string to an io-window
C
C Author:     John W. Campbell, September 1990
C
C Arguments:
C
      INTEGER IVH_W
      CHARACTER*(*) CHSTR
C
C    IVH_W    (R)   View-object handle for the io-window
C    CHSTR    (R)   The prompt string
C
C Declarations
C ============
C
C GLOBALS:
C
      INTEGER XDLSTR
C
C LOCALS:
C
      INTEGER LENS
      INTEGER I
      INTEGER IERR
      INTEGER NCH

C     INTEGER LENS   !Length of the character string
C     INTEGER I      !Loop counter
C     INTEGER IERR   !Error return
C     INTEGER NCH    !No. characters up to last non-blank character
C
C-------------------------------------------------------------------------------
C
C====== Get the length of the string to the last non-blank
C
      LENS = LEN (CHSTR)
      NCH = 1
      DO 100 I = LENS, 1, -1
      IF (CHSTR(I:I).NE.' ') THEN
         NCH = I
         GO TO 200
      ENDIF
100   CONTINUE
200   IF (CHSTR(LENS:LENS).EQ.' '.AND.NCH.LT.LENS) NCH = NCH + 1
C
C====== Output the prompt
C
      CALL XDLF_IO_WINDOW_PRINT (IVH_W, XDLSTR(CHSTR), NCH, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C************************
C**     LREAD          **
C************************
C
      SUBROUTINE LREAD (IVH_W, CHSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Read reply string from an io-window
C
C Author:     John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER IVH_W
      CHARACTER*(*) CHSTR
C
C    IVH_W    (R)   View-object handle for the io-window
C    CHSTR    (W)   The reply string
C
C Declarations
C ============
C
C GLOBALS:
C
      INTEGER XDLSTR
C
C LOCALS:
C
      INTEGER LENS
      INTEGER IVH
      INTEGER IERR
      INTEGER IVHLIST(2)

C     INTEGER LENS       !Length of the character string
C     INTEGER IVH        !Returned view-object handle
C     INTEGER IERR       !Error return
C     INTEGER IVHLIST(2) !List of view-object handles
C
C-------------------------------------------------------------------------------
C
C====== Get the length of the character sting
C
      LENS = LEN (CHSTR)
      IVHLIST(1) = IVH_W
      CALL XDLF_GET_EVENTS (1, IVHLIST, IVH)
      CALL XDLF_IO_WINDOW_GETSTRING (IVH_W, XDLSTR(CHSTR), LENS, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MATCH_SPOTS      **
C**************************
C
C
      SUBROUTINE MATCH_SPOTS (IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Display image and match pairs of predicted and observed spots.
C
C Author:  John W. Campbell, July 1991
C
C Arguments:
C
      INTEGER IERR
C 
C  IERR  (W)   Error flag =0 OK, =1 cannot open image file or display image
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'image.finc'
      INCLUDE 'matches.finc'
      INCLUDE 'spot_box.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'symbol_types.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      INTEGER INTFP
      INTEGER NXTTOK
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL EXISTS 
      LOGICAL CONT
      LOGICAL REPLY
      LOGICAL CLEAR
      LOGICAL SPAT
      LOGICAL NODFLG
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) MATCH_FILE
      INTEGER I
      INTEGER J
      INTEGER KERR
      INTEGER IVHLIST(3)
      INTEGER IVHLST2(2)
      INTEGER NVIEW
      INTEGER I_ADD
      INTEGER I_DEL
      INTEGER IADDEL
      INTEGER IPRMEAS
      INTEGER IDISP
      INTEGER ITEM
      INTEGER IVH
      INTEGER M_ALL
      INTEGER M_NODALS
      INTEGER M_CLEAR
      INTEGER M_INPUT
      INTEGER M_DELETE
      INTEGER M_READ
      INTEGER M_WRITE
      INTEGER IQUIT
      INTEGER IDSQLIM
      INTEGER IDSQMIN
      INTEGER IXP
      INTEGER IYP
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER ID
      INTEGER ISPOT
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER ITHRESH
      INTEGER IBG
      INTEGER NOVER
      INTEGER ITM
      INTEGER IP_SBOX
      INTEGER IP_THRESH
      INTEGER IV
      INTEGER ITYP
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IRETN
      INTEGER IFAIL
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER NADD
      INTEGER NERR
      INTEGER NVALS
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IFLAG
      INTEGER ND
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER MULT
      INTEGER NUMSPOTS
      INTEGER IORD
      INTEGER ISWAP
      INTEGER LISTE(2)
      REAL    MM_RAST_X
      REAL    MM_RAST_Y
      REAL    VALUES(20)
      REAL    FP
      REAL    CGX
      REAL    CGY
      REAL    OMEGA
      REAL    X_CEN
      REAL    Y_CEN
      REAL    X_CEN_F
      REAL    Y_CEN_F
      REAL    XSPOT_MM
      REAL    YSPOT_MM
      REAL    X_C
      REAL    Y_C
      REAL    XFD
      REAL    YFD
      REAL    ALAM
      REAL    DTHR2

C     LOGICAL EXISTS       !File exists flag
C     LOGICAL CONT         !Continue to write file flag
C     LOGICAL REPLY        !Yes/no reply flag (.TRUE./.FALSE.)
C     LOGICAL CLEAR        !Clear matches list flag
C     LOGICAL SPAT         !Spatial overlap flag
C     LOGICAL NODFLG       !Nodal spot flag
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C     CHARACTER*80 STR     !Character string for messages
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !Return string from parameter table 3
C     CHARACTER*(MAXFLEN) FILNAM       !File name as input
C     CHARACTER*(MAXFLEN) MATCH_FILE   !Spot matches file name
C     INTEGER I            !Temp/loop variable
C     INTEGER J            !Temp/loop variable
C     INTEGER KERR         !Error return flag
C     INTEGER IVHLIST(3)   !List of view-object handles for getting events
C     INTEGER IVHLST2(2)   !Second list of view-objects for getting events
C     INTEGER NVIEW        !Number of view-objects for getting events
C     INTEGER I_ADD        !Add option value flag for IADDEL
C     INTEGER I_DEL        !Delete option value flag for IADDEL
C     INTEGER IADDEL       !Add/Delete matched spots flag (I_ADD or I_DEL)
C     INTEGER IPRMEAS      !Input predicted (1) or measured spot (2) position
C     INTEGER IDISP        !Display predicted spots flag =0 all, =1 nodals
C     INTEGER ITEM         !Menu item number selected
C     INTEGER IVH          !View-object handle of view object returning event
C     INTEGER M_ALL        !Menu item no.: Display all predicted reflections
C     INTEGER M_NODALS     !Menu item no.: Display nodals only
C     INTEGER M_CLEAR      !Menu item no.: Clear matches list
C     INTEGER M_INPUT      !Menu item no.: Input (add) matches
C     INTEGER M_DELETE     !Menu item no.: Delete matches
C     INTEGER M_READ       !Menu item no.: Read matches file
C     INTEGER M_WRITE      !Menu item no.: Write matches file
C     INTEGER IQUIT        !Quit return flag from menu input
C     INTEGER IDSQLIM      !Distance squared tolerance for pixel selection 
C     INTEGER IDSQMIN      !Min distance squared founf in pixel selection
C     INTEGER IXP          !Returned x pixel value from film-image display
C     INTEGER IYP          !Returned y pixel value from film-image display
C     INTEGER ISPIX        !Pixel position along slow axis
C     INTEGER IFPIX        !Pixel position along fast axis
C     INTEGER ID           !Distance squared from pixel
C     INTEGER ISPOT        !Index in list of nearest spot/symbol found
C     INTEGER IXSIZ        !Half box size (x) for spot find
C     INTEGER IYSIZ        !Half box size (y) for spot find
C     INTEGER ITHRESH      !Threshold for spot find
C     INTEGER IBG          !Background at spot position
C     INTEGER NOVER        !No. of pixels over threshold value in found spot
C     INTEGER ITM          !Parameter table 2 input item number
C     INTEGER IP_SBOX      !Parameter table 2 item: Match spot box size
C     INTEGER IP_THRESH    !Parameter table 2 item: Match spot threshold
C     INTEGER IV           !Integer value from INTFP routine
C     INTEGER ITYP         !Type of value from INTFP routine
C     INTEGER IXROOT       !X root position for popup notice
C     INTEGER IYROOT       !Y root position for popup notice
C     INTEGER IRETN        !Return flag fro yesno_notice etc.
C     INTEGER IFAIL        !Error flag for CCPDPN routine
C     INTEGER IH           !Reflection h index
C     INTEGER IK           !Reflection k index
C     INTEGER IL           !Reflection l index
C     INTEGER M1           !Token start position
C     INTEGER M2           !Token end position
C     INTEGER NADD         !Number of matches added from input matches file
C     INTEGER NERR         !Number of errors reading matches file
C     INTEGER NVALS        !Number of numerical values in matches file record
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER JH           !h index
C     INTEGER JK           !k index
C     INTEGER JL           !l index
C     INTEGER MULT         !Multiplicity
C     INTEGER NUMSPOTS     !No. of spots in generated spots list
C     INTEGER IORD         !Axis order flag 1-8
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER LISTE(2)     !Parameter updates list
C     REAL MM_RAST_X       !mm to x-rasters conversion factor
C     REAL MM_RAST_Y       !mm to y-rastrs conversion factor
C     REAL    VALUES(20)   !Numerical values from matches file record
C     REAL    FP           !Real value from INTFP routine
C     REAL    CGX          !Found x c-of-g of spot (raster units)
C     REAL    CGY          !Found y c-of-g of spot (raster units)
C     REAL    OMEGA        !Corrected omega (degrees)
C     REAL    X_CEN        !Corrected x centre (rasters)
C     REAL    Y_CEN        !Corrected y centre (rasters)
C     REAL    X_CEN_F      !x centre from fids or input (rasters)
C     REAL    Y_CEN_F      !y centre from fids or input (rasters)
C     REAL    XSPOT_MM     !Observed spot x position (mm from centre)
C     REAL    YSPOT_MM     !Observed spot y position (mm from centre)
C     REAL    X_C          !x_c value (mm)
C     REAL    Y_C          !y_c value (mm)
C     REAL    XFD          !X coordinate on detector (rast) (distort. corrected)
C     REAL    YFD          !Y coordinate on detector (rast) (distort. corrected)
C     REAL    ALAM         !Wavelength
C     REAL    DTHR2        !dmin-threshold**2
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CALL LRL_NUMSPOTS (NUMSPOTS)
      CALL LDM_GET_STHR (SPOT_INPUT_THRESH, IFLAG, ND)
C
C====== Set up parameter table 3
C
      IP_SBOX = 1
      IP_THRESH = 2

      WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_SBOX,
     +     XDLSTR('Match box (mm):'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, KERR)
      WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_THRESH,
     +     XDLSTR('Spot threshold:'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, KERR)
C
C====== Check that film centre info is available
C
      CALL CHK_OPN (IERR)
      IF (IERR.GT.0) RETURN
      CALL FILM_CENTRE(X_CEN_F,Y_CEN_F,OMEGA)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, KERR, ERRSTR)
      X_CEN = X_CEN_F + X_C*MM_RAST_X
      Y_CEN = Y_CEN_F + Y_C*MM_RAST_Y
C
C====== Display image
C
      CALL SHOW_IMAGE (1, IERR)
      IF (IERR.EQ.1) RETURN
C
C====== Set max limit for IDSQMIN to consider as a position match
C
      IDSQLIM = 18*NCMP*NCMP
C
C====== Determine whether to display all reflns or nodals at start
C
      IDISP = 0
      IF (NUMSPOTS.GT.MAX_DISP) THEN
         CALL FIND_SEL_NODS (1, 1, 1, 1, 0, 0, 0)
         IDISP = 1
      END IF
C
C====== Display predicted positions
C
      NUM_MATCH = 0
      CALL PLOT_SYMBS (IDISP, 1)
C
C====== Set up Match Spots Options Menu
C
      M_ALL = 1
      M_NODALS = 2
      M_CLEAR = 3
      M_INPUT = 4
      M_DELETE = 5
      M_READ = 6
      M_WRITE = 7
      CALL SET_MENU4
C
C====== Service Match Spots Menu and Film Image Display
C
      I_ADD = 1
      I_DEL = 2
      IADDEL = 0
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR3
      IVHLIST(3) = IVH_FILM
      NVIEW = 2

100   CALL XDLF_GET_EVENTS(NVIEW,IVHLIST,IVH)

C
C====== Menu item selected
C
      IF (IVH.EQ.IVH_MENU) THEN
         CALL XDLF_MENU_AREA_GETITEM(IVH_MENU,ITEM,IQUIT)
C
C====== Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, KERR)
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, KERR)
            CALL XDLF_DELETE_VIEW_OBJECT(IVH_FILM,KERR)
            RETURN
         END IF
C
C====== Display all predicted reflections
C
         IF (ITEM.EQ.M_ALL) THEN
            IF (NUMSPOTS.GT.MAX_DISP) THEN
               CALL ERR_NOTICE (1,'**Too many reflections to display**')
               GO TO 100
            END IF
            IDISP = 0
            IPRMEAS = 1
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            CALL PLOT_SYMBS (IDISP, 1)
            GO TO 100
C
C====== Display nodals only
C
         ELSE IF (ITEM.EQ.M_NODALS) THEN
            CALL FIND_SEL_NODS (1, 1, 1, 1, 0, 0, 0)
            IDISP = 1
            IPRMEAS = 1
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            CALL PLOT_SYMBS (IDISP, 1)
            GO TO 100
C
C====== Clear Matches List
C
         ELSE IF (ITEM.EQ.M_CLEAR) THEN
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            NUM_MATCH = 0
            CALL PLOT_SYMBS (IDISP, 1)
            NVIEW = 2
            GO TO 100
C
C====== Input Matches
C
         ELSE IF (ITEM.EQ.M_INPUT) THEN
            NVIEW = 3
            IADDEL = I_ADD
            IPRMEAS = 1
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +           XDLSTR('Input predicted position of matching pair'),
     +                   41,KERR)
            GO TO 100
C
C====== Delete Matches
C
         ELSE IF (ITEM.EQ.M_DELETE) THEN
            IF (IPRMEAS.EQ.2) THEN
               CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM,
     +              IXPIX_MATCH(NUM_MATCH+1), IYPIX_MATCH(NUM_MATCH+1),
     +              ISYMBTYP(3), ICOLRTYP(3), 1, KERR)
            END IF
            NVIEW = 3
            IADDEL = I_DEL
            IPRMEAS = 1
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +           XDLSTR(
     +      'Input predicted position of matching pair to delete'),
     +                   51,KERR)
            GO TO 100
C
C====== Read Matches File
C
         ELSE IF (ITEM.EQ.M_READ) THEN
            IF (NUMSPOTS.EQ.0) THEN
               CALL ERR_NOTICE (1,'**No spots predicted**')
               GO TO 100
            END IF
            CLEAR = .FALSE.
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, KERR)
            IF (NUM_MATCH.GT.0) THEN
               REPLY = .FALSE.
               CALL IOW_ASKQ (IVH_IOW, 'Add to existing matches', REPLY)
               IF (.NOT.REPLY) THEN
                  CALL IOW_ASKQ (IVH_IOW, 'Overwrite existing matches',
     +            REPLY)
                  IF (.NOT.REPLY) THEN
                     CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, KERR)
                     GO TO 100
                  END IF
                  CLEAR = .TRUE.
              END IF
            END IF
            NVIEW = 2
102         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.matches): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, KERR)
            IF (FILNAM.EQ.' ') THEN
               CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
               GO TO 100
            END IF
            CALL FILEXT (FILNAM, 'matches', MATCH_FILE, I)
            EXISTS = CCPEXS (MATCH_FILE)
            IF (.NOT.EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**File not found**')
               GO TO 102
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_MATCH, MATCH_FILE,'READONLY','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 102
            END IF
            READ (IUN_MATCH,'(A)',END=104) STR
            J = 0
            IF (NXTTOK (STR, ' ', J, M1, M2).EQ.0) THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''matches:'' keyword**')
               CLOSE (IUN_MATCH)
               GO TO 102
            END IF
            CALL CCPUPC(STR)
            IF (STR(M1:M2).NE.'MATCHES:') THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''matches:'' keyword**')
               CLOSE (IUN_MATCH)
               GO TO 102
            END IF
            IF (CLEAR) NUM_MATCH = 0
            NERR = 0
            NADD = 0
103         READ (IUN_MATCH,'(A)',END=104) STR
            IF (STR.EQ.' ') GO TO 103
            CALL STRVAL (STR, ' =', 20, VALUES, NVALS)
            IF (NVALS.NE.5) THEN
               CALL LMESSAGE(IVH_IOW,'**Invalid format in record**')
               NERR = NERR + 1
               GO TO 103
            END IF
            IF (NUM_MATCH.GE.MAX_MATCH) THEN
               CALL LMESSAGE (IVH_IOW,'**Matches list full**')
               NERR = NERR + 1
               GO TO 104
            END IF
            IH = NINT(VALUES(1))
            IK = NINT(VALUES(2))
            IL = NINT(VALUES(3))
            XSPOT_MM = VALUES(4)
            YSPOT_MM = VALUES(5)
            DO 350 I=1,NUMSPOTS
               CALL LRL_GET (I, JH, JK, JL, XFD, YFD, ALAM, DTHR2, MULT,
     +                       NODFLG, SPAT, KERR)
               IF (IH.EQ.JH.AND.IK.EQ.JK.AND.IL.EQ.JL) THEN
                  NUM_MATCH = NUM_MATCH + 1
                  IREF_MATCH(NUM_MATCH) = I
                  IXPIX_MATCH(NUM_MATCH)=NINT(XFD)
                  IYPIX_MATCH(NUM_MATCH)=NINT(YFD)
                  XSPOT_MATCH(NUM_MATCH) = X_CEN + XSPOT_MM*MM_RAST_X
                  YSPOT_MATCH(NUM_MATCH) = Y_CEN + YSPOT_MM*MM_RAST_Y
                  IXSP_MATCH(NUM_MATCH) = NINT(XSPOT_MATCH(NUM_MATCH))
                  IYSP_MATCH(NUM_MATCH) = NINT(YSPOT_MATCH(NUM_MATCH))
                  NADD = NADD + 1
                  GO TO 103
               END IF
350         CONTINUE
            STR = '**Cannot find reflection'
            CALL STR_ADDI (STR, IH, 1)
            CALL STR_ADDI (STR, IK, 1)
            CALL STR_ADDI (STR, IL, 1)
            CALL STR_ADDS (STR, 'in the predicted reflections list**',
     +        1)
            CALL LMESSAGE (IVH_IOW, STR)
            NERR = NERR + 1
            GO TO 103
104         CLOSE (IUN_MATCH)
            STR = 'Number of reflection matches added ='
            CALL STR_ADDI (STR, NADD, 1)
            CALL LMESSAGE (IVH_IOW, STR)
            IF (NERR.GT.0) THEN
               STR = '**Number of errors ='
               CALL STR_ADDI (STR, NERR, 1)
               CALL STR_ADDS (STR,'**',1)
               CALL LMESSAGE (IVH_IOW, STR)
            END IF
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, KERR)
            CALL PLOT_SYMBS (IDISP, 1)
            IF (NERR.EQ.0) CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
            GO TO 100
C
C====== Write Matches File
C
         ELSE IF (ITEM.EQ.M_WRITE) THEN
            CALL NOTICE_POSN (1,IXROOT,IYROOT)
            NVIEW = 2
            IF (NUM_MATCH.LE.0) THEN
               CALL ERR_NOTICE(1,'**No spots in list of matches**')
               GO TO 100
            END IF
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, KERR)
105         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.matches): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, KERR)
            IF (FILNAM.EQ.' ') THEN
               CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
               GO TO 100
            END IF
            CALL FILEXT (FILNAM, 'matches', MATCH_FILE, I)
            CALL LGFILE_EXISTS (MATCH_FILE, CONT)
            IF (.NOT.CONT) GO TO 105
            IFAIL = 1
            CALL CCPDPN (-IUN_MATCH, MATCH_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 105
            END IF
            WRITE (IUN_MATCH,'(''matches:'')')
            DO 106 I=1,NUM_MATCH
               J = IREF_MATCH(I)
               XSPOT_MM = (XSPOT_MATCH(I)-X_CEN)/MM_RAST_Y
               YSPOT_MM = (YSPOT_MATCH(I)-Y_CEN)/MM_RAST_Y
               CALL LRL_GET (J, JH, JK, JL, XFD, YFD, ALAM, DTHR2, MULT,
     +                       NODFLG, SPAT, KERR)
               WRITE (IUN_MATCH,'(3I5,2F8.2)') 
     +               JH, JK, JL,
     +               XSPOT_MM, YSPOT_MM
106         CONTINUE
            CLOSE (IUN_MATCH)
            CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
            GO TO 100
         ELSE
            GO TO 100
         END IF
C
C====== Input from parameter table
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, KERR)
         IF (ITM.EQ.IP_SBOX) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, KERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, KERR)
               GO TO 100
            END IF
            SPOT_INPUT_BOX = FP
            WRITE (STR,'(F8.2)') SPOT_INPUT_BOX
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, KERR)
         ELSE IF (ITM.EQ.IP_THRESH) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, KERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, KERR)
               GO TO 100
            END IF
            SPOT_INPUT_THRESH = FP
            WRITE (STR,'(F8.1)') SPOT_INPUT_THRESH
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, KERR)
            CALL LDM_SET_STHR (SPOT_INPUT_THRESH, IERR, ERRSTR)
            LISTE(1) = IP_STHR
            CALL SET_PAR1_VALS (1, LISTE)
         END IF
         GO TO 100
C
C====== Input from film/image-plate image display
C
      ELSE IF (IVH.EQ.IVH_FILM) THEN
         IF (IADDEL.EQ.I_ADD) THEN
            IF (IPRMEAS.EQ.1) THEN
               CALL XDLF_IMAGE_GETPIX_OVLY (IVH_FILM, 1,
     +            IXP, IYP, KERR)
               IF (NUM_DISP.LE.0) GO TO 100
               IDSQMIN = NXRAST*NXRAST + NYRAST*NYRAST
               ISPOT = 0
               DO 200 I=1,NUM_DISP
                  ID = (IXP-IXPIX_DISP(I))**2 + (IYP-IYPIX_DISP(I))**2
                  IF (ID.GT.IDSQLIM) GO TO 200
                  IF (ID.LT.IDSQMIN) THEN
                     IF (NUM_MATCH.GT.0) THEN
                        DO 190 J=1,NUM_MATCH
                           IF (IREF_MATCH(J).EQ.IREF_DISP(I)) GO TO 200
190                     CONTINUE
                     END IF
                     ISPOT = I
                     IDSQMIN = ID
                  END IF
200            CONTINUE
               IF (ISPOT.EQ.0) GO TO 100
               IF (NUM_MATCH.GE.MAX_MATCH) THEN
                  CALL ERR_NOTICE (0,'**Matches list is full**')
                  GO TO 100
               END IF
               IXPIX_MATCH(NUM_MATCH+1) = IXPIX_DISP(ISPOT)
               IYPIX_MATCH(NUM_MATCH+1) = IYPIX_DISP(ISPOT)
               IREF_MATCH(NUM_MATCH+1) = IREF_DISP(ISPOT)
               XSPOT_MATCH(NUM_MATCH+1) = 0.0
               YSPOT_MATCH(NUM_MATCH+1) = 0.0
               IXSP_MATCH(NUM_MATCH+1) = 0
               IYSP_MATCH(NUM_MATCH+1) = 0
               CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM,
     +              IXPIX_DISP(ISPOT), IYPIX_DISP(ISPOT),
     +              ISYMBTYP(ISYMB_DISP(ISPOT)), 
     +              ICOLRTYP(ISYMB_DISP(ISPOT)),
     +              1, KERR)
               CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +              IXPIX_MATCH(NUM_MATCH+1), IYPIX_MATCH(NUM_MATCH+1),
     +              ISYMBTYP(3), ICOLRTYP(3), 1, KERR)
               IPRMEAS = 2
               CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +         XDLSTR('Input observed spot position of matching pair'),
     +                   45,KERR)
            ELSE IF(IPRMEAS.EQ.2) THEN
               CALL XDLF_IMAGE_GETPIX (IVH_FILM, IXP, IYP, KERR)
               IXSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_X)
               IXSIZ = IXSIZ/2
               IF (IXSIZ.LT.1) IXSIZ = 1
               IF (IXSIZ.GT.MAX_HALF_BOX) THEN   
                  CALL ERR_NOTICE (0,'**Spot box size too large**')
                  GO TO 100
               ENDIF
               IYSIZ = NINT (SPOT_INPUT_BOX*MM_RAST_Y)
               IYSIZ = IYSIZ/2
               IF (IYSIZ.LT.1) IYSIZ = 1
               IF (IYSIZ.GT.MAX_HALF_BOX) THEN
                  CALL ERR_NOTICE (0,'**Spot box size too large**')
                  GO TO 100
               ENDIF
               CALL SFPIX (IXP,IYP,ISPIX,IFPIX)
               CALL XDLF_BG_VALIMG(ISPIX,IFPIX,IMG_BG,ITYPE,NF_BGOFF,
     +                             NCMP, IBG, KERR)
               ITHRESH = IBG + NINT(SPOT_INPUT_THRESH)
               CALL SPOT_C_OF_G (IXP, IYP, IXSIZ, IYSIZ, ISPOT_DATA, 
     +              ISWORK, ITHRESH, IMG, ITYPE, IORD, NFRASTS,
     +              NXRAST, NYRAST, NOVER,
     +              CGX, CGY, KERR)
               IF (KERR.LT.0) THEN
                  CALL ERR_NOTICE (0,'**Error in spot_c_of_g call**')
                  GO TO 100
               ELSE IF (KERR.EQ.2) THEN
                  CALL ERR_NOTICE (0,
     +                 '**Spot box outside range of image**')
                  GO TO 100
               ELSE IF (NOVER.EQ.0) THEN
                  CALL ERR_NOTICE (0,
     +                 '**No pixels above threshold**')
                  GO TO 100
               ENDIF
               IXP = NINT (CGX)
               IF (IXP.LT.1) IXP = 1
               IF (IXP.GT.NXRAST) IXP = NXRAST
               IYP = NINT (CGY)
               IF (IYP.LT.1) IYP = 1
               IF (IYP.GT.NYRAST) IYP = NYRAST
               NUM_MATCH = NUM_MATCH + 1
               XSPOT_MATCH(NUM_MATCH) = CGX
               YSPOT_MATCH(NUM_MATCH) = CGY
               IXSP_MATCH(NUM_MATCH) = IXP
               IYSP_MATCH(NUM_MATCH) = IYP
               CALL XDLF_IMAGE_SYMBOL (IVH_FILM, IXP, IYP,
     +              ISYMBTYP(4), ICOLRTYP(4), 2, KERR)
               IF (KERR.GE.4) THEN
                  CALL ERR_NOTICE (0,
     +                 '**Unable to allocate memory for new symbol**')
                  GO TO 100
               END IF
               IPRMEAS = 1
               CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +              XDLSTR('Input predicted position of matching pair'),
     +                   41,KERR)
            END IF
         ELSE IF (IADDEL.EQ.I_DEL) THEN
            CALL XDLF_IMAGE_GETPIX_OVLY (IVH_FILM, 1,
     +            IXP, IYP, KERR)
            IF (NUM_MATCH.LE.0) GO TO 100
            IDSQMIN = NXRAST*NXRAST + NYRAST*NYRAST
            DO 180 I=1,NUM_MATCH
               ID = (IXP-IXPIX_MATCH(I))**2 + (IYP-IYPIX_MATCH(I))**2
               IF (ID.LT.IDSQMIN) THEN
                  ISPOT = I
                  IDSQMIN = ID
               END IF
180         CONTINUE
            IF (IDSQMIN.GT.IDSQLIM) GO TO 100
            CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM,
     +           IXPIX_MATCH(ISPOT), IYPIX_MATCH(ISPOT),
     +           ISYMBTYP(3), ICOLRTYP(3), 1, KERR)
            CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM,
     +           IXSP_MATCH(ISPOT), IYSP_MATCH(ISPOT),
     +           ISYMBTYP(4), ICOLRTYP(4), 2, KERR)
            DO 250 I=1,NUM_DISP
               IF (IREF_DISP(I).EQ.IREF_MATCH(ISPOT)) THEN
                  CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +                 IXPIX_DISP(I), IYPIX_DISP(I),
     +                 ISYMBTYP(ISYMB_DISP(I)), ICOLRTYP(ISYMB_DISP(I)),
     +                 1, KERR)
                  GO TO 260
               END IF
250         CONTINUE
260         IF (ISPOT.EQ.NUM_MATCH) THEN
               NUM_MATCH = NUM_MATCH - 1
            ELSE
               DO 280 I = ISPOT, NUM_MATCH - 1
                  IREF_MATCH(I) = IREF_MATCH(I+1)
                  IXPIX_MATCH(I) = IXPIX_MATCH(I+1)
                  IYPIX_MATCH(I) = IYPIX_MATCH(I+1)
                  XSPOT_MATCH(I) = XSPOT_MATCH(I+1)
                  YSPOT_MATCH(I) = YSPOT_MATCH(I+1)
                  IXSP_MATCH(I) = IXSP_MATCH(I+1)
                  IYSP_MATCH(I) = IYSP_MATCH(I+1)
280            CONTINUE
               NUM_MATCH = NUM_MATCH -1
            END IF
         END IF
         GO TO 100
      ELSE
         GO TO 100
      END IF

      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MATCH_TO_OBS     **
C**************************
C
C
      SUBROUTINE MATCH_TO_OBS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Transfer matched spots list to observed spots list for refinement
C
C Author:  John W. Campbell, January 1991
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'matches.finc'
      INCLUDE 'lauegen_observed_spots.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER IABS
C
C====== LOCALS:
C
      LOGICAL SPAT
      LOGICAL NODFLG
      INTEGER I
      INTEGER H, K, L
      INTEGER JH, JK, JL
      INTEGER MULT
      INTEGER ISPOT
      INTEGER IERR
      REAL ALAM
      REAL DTHR2
      REAL XFD
      REAL YFD
C
C     LOGICAL SPAT         !Spatial overlap flag
C     LOGICAL NODFLG       !Nodal spot flag
C     INTEGER I            !Temp/loop variable
C     INTEGER H, K, L      !Reflection indices
C     INTEGER JH, JK, JL   !Reflection indices (predicted)
C     INTEGER MULT         !Multiplicity
C     INTEGER ISPOT        !Pointer to spot in LRL list
C     INTEGER IERR         !Error flag
C     REAL ALAM            !Lambda 
C     REAL DTHR2           !dmin-threshol**2
C     REAL XFD             !Predicted x position on detector
C     REAL YFD             !Predicted y position on detector
C
C-------------------------------------------------------------------------------
C
      IF (NUM_MATCH.GT.0) THEN
         DO 100 I=1,NUM_MATCH
            ISPOT = IREF_MATCH(I)
            CALL LRL_GET (ISPOT, JH, JK, JL, XFD, YFD, ALAM, 
     +                    DTHR2, MULT, NODFLG, SPAT, IERR)
            H = JH
            K = JK
            L = JL
            NODAL_H_S(I) = H
            NODAL_K_S(I) = K
            NODAL_L_S(I) = L
            XM_OBS(I) = XSPOT_MATCH(I)
            YM_OBS(I) = YSPOT_MATCH(I)
            HKL_KEY(I) = IABS(H) + IABS(K) + IABS(L)
100      CONTINUE
      END IF
      NUM_OBS = NUM_MATCH
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MATS             **
C**************************
C
C
      SUBROUTINE MATS (AM,AA,AB,AC,AD,AE,AF,CELL)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:
C
C Generalised matrix and derivative builder
C the reciprocal cell parameters come in cell(1-6) but only the
C unique ones ... cell(1) is astar, cell(2) alphastar for rhombohedra
C for example.
C am returns the A matrix ... row 1 is components of reciprocal cell
C along X, row 2 along Y, row 3 along Z.
C aa, ab etc are the derivative matrices for A wrt the unique cell
C parameters in order ... thus aa is dA/dastar, ab dA/alphastar for
C rhombohedral.
C
C Modified by Pella Machin and T.Tjahjadi
C reset AM,AA,AB,AC,AD,AE,AF TO 0, otherwise problem arise if orientatio
C by poles is used after a triclinic case is run because only parameters
C relevant to a particular lattice type are reset, the rest remain
C unchanged.
C
C ***This version assumes angles in degrees***
C
C Arguments:
C
      REAL AM(3,3)
      REAL AA(3,3)
      REAL AB(3,3)
      REAL AC(3,3)
      REAL AD(3,3)
      REAL AE(3,3)
      REAL AF(3,3)
      REAL CELL(6)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      INTEGER I,J,K
      INTEGER N1,N2,N3
      INTEGER IROT, IBEAM, ISYST, IFLAG
      REAL SI,SJ,SK
      REAL A,C,S,FUN,COSPSI,TMPRT,COSRHO
      REAL RL(3),CC(3),SS(3)
      REAL DA(3,3,3),DB(3,3,3)
      REAL DTORAD
      CHARACTER*2 VALSTR
C
C-------------------------------------------------------------------------------
C
      DTORAD = 3.14159265/180.0
      CALL LDM_GET_ROT (VALSTR, IROT, IFLAG)
      CALL LDM_GET_BEAM (VALSTR, IBEAM, IFLAG)
      CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
C
C====== Reset matrix elements
C
      DO 30 I = 1 , 3
         DO 20 J = 1 , 3
            AM(I,J) = 0
            AA(I,J) = 0
            AB(I,J) = 0
            AC(I,J) = 0
            AD(I,J) = 0
            AE(I,J) = 0
            AF(I,J) = 0
 20      CONTINUE
 30   CONTINUE
C
C====== I refers to IROT, the crystal rotation axis, z
C
      I = IABS(IROT)
      SI = 1.0
      IF (IROT.LT.0) SI = -1.0
C
C====== J refers to IBEAM, the xray beam axis, x
C
      J = IABS(IBEAM)
      SJ = 1.0
      IF (IBEAM.LT.0) SJ = -1.0
C
C====== K is therefore the other axis, y
C
      K = 6 - I - J
C
C====== The sign of k relies on i,j,k and X,Y,Z being right-handed
C
      IF (K.EQ.J+1 .OR. K.EQ.J-2) THEN
         SK = SI*SJ
      ELSE
         SK = -SI*SJ
      END IF
      IF (ISYST.EQ.2) THEN
C
C====== Monoclinic
C
         RL(1) = CELL(1)
         RL(2) = CELL(2)
         RL(3) = CELL(3)
 
         CC(1) = 0.0
         CC(2) = COS(CELL(4)*DTORAD)
         CC(3) = 0.0
 
         SS(1) = 1.0
         SS(2) = SIN(CELL(4)*DTORAD)
         SS(3) = 1.0
C
C====== A matrix
C
         AM(1,J) = SJ*RL(J)*SS(K)
         AM(1,K) = SJ*RL(K)*CC(I)
         AM(2,K) = SK*RL(K)*SS(I)*SS(J)
         AM(3,I) = SI*RL(I)
         AM(3,J) = SI*RL(J)*CC(K)
         AM(3,K) = SI*RL(K)*CC(J)
C
C====== Derivatives wrt reciprocal cell lengths
C
         DO 60 N1 = 1 , 3
            DO 50 N2 = 1 , 3
               DO 40 N3 = 1 , 3
                  DA(N1,N2,N3) = 0.
 40            CONTINUE
 50         CONTINUE
 60      CONTINUE
 
         DA(3,I,I) = SI
         DA(1,J,J) = SJ*SS(K)
         DA(3,J,J) = SI*CC(K)
         DA(1,K,K) = SJ*CC(I)
         DA(2,K,K) = SK*SS(I)*SS(J)
         DA(3,K,K) = SI*CC(J)
 
         DO 90 N1 = 1 , 3
            DO 80 N2 = 1 , 3
               DO 70 N3 = 1 , 3
                  IF (DA(N1,N2,N3).NE.0.0) THEN
                     IF (N3.EQ.1) AA(N1,N2) = DA(N1,N2,N3)
                     IF (N3.EQ.2) AB(N1,N2) = DA(N1,N2,N3)
                     IF (N3.EQ.3) AC(N1,N2) = DA(N1,N2,N3)
                  END IF
 70            CONTINUE
 80         CONTINUE
 90      CONTINUE
C
C====== Derivatives wrt reciprocal cell angles (only ss(2) and cc(2))
C
         IF (I.EQ.2) THEN
            AD(1,K) = -SJ*RL(K)*SS(I)
            AD(2,K) = SK*RL(K)*CC(I)
         END IF
         IF (J.EQ.2) THEN
            AD(2,K) = SK*RL(K)*CC(J)
            AD(3,K) = -SI*RL(K)*SS(J)
         END IF
         IF (K.EQ.2) THEN
            AD(1,J) = SJ*RL(J)*CC(K)
            AD(3,J) = -SI*RL(J)*SS(K)
         END IF
         RETURN
      ELSE IF (ISYST.EQ.3) THEN
C
C====== Orthorhombic
C
         RL(1) = CELL(1)
         RL(2) = CELL(2)
         RL(3) = CELL(3)
         AM(1,J) = SJ*RL(J)
         AM(2,K) = SK*RL(K)
         AM(3,I) = SI*RL(I)
C
C====== Derivatives
C
         IF (J.EQ.1) AA(1,1) = SJ
         IF (K.EQ.1) AA(2,1) = SK
         IF (I.EQ.1) AA(3,1) = SI
 
         IF (J.EQ.2) AB(1,2) = SJ
         IF (K.EQ.2) AB(2,2) = SK
         IF (I.EQ.2) AB(3,2) = SI
 
         IF (J.EQ.3) AC(1,3) = SJ
         IF (K.EQ.3) AC(2,3) = SK
         IF (I.EQ.3) AC(3,3) = SI
         RETURN
      ELSE IF (ISYST.EQ.4) THEN
C
C====== Tetragonal
C
         RL(1) = CELL(1)
         RL(2) = CELL(1)
         RL(3) = CELL(2)
         AM(1,J) = SJ*RL(J)
         AM(2,K) = SK*RL(K)
         AM(3,I) = SI*RL(I)
C
C====== Derivatives
C
         IF (J.EQ.1) AA(1,1) = SJ
         IF (K.EQ.1) AA(2,1) = SK
         IF (I.EQ.1) AA(3,1) = SI
 
         IF (J.EQ.2) AA(1,2) = SJ
         IF (K.EQ.2) AA(2,2) = SK
         IF (I.EQ.2) AA(3,2) = SI
 
         IF (J.EQ.3) AB(1,3) = SJ
         IF (K.EQ.3) AB(2,3) = SK
         IF (I.EQ.3) AB(3,3) = SI
         RETURN
      ELSE IF (ISYST.EQ.5) THEN
C
C====== Hexagonal
C
         RL(1) = CELL(1)
         RL(2) = CELL(1)
         RL(3) = CELL(2)
 
         CC(1) = 0.0
         CC(2) = 0.0
         CC(3) = 0.5
 
         SS(1) = 1.0
         SS(2) = 1.0
         SS(3) = SQRT(3.)/2.
C
C====== A matrix
C
         AM(1,J) = SJ*RL(J)*SS(K)
         AM(1,K) = SJ*RL(K)*CC(I)
         AM(2,K) = SK*RL(K)*SS(I)*SS(J)
         AM(3,I) = SI*RL(I)
         AM(3,J) = SI*RL(J)*CC(K)
         AM(3,K) = SI*RL(K)*CC(J)
C
C======  Derivatives wrt reciprocal cell lengths
C
         DO 120 N1 = 1 , 3
            DO 110 N2 = 1 , 3
               DO 100 N3 = 1 , 3
                  DA(N1,N2,N3) = 0.
 100           CONTINUE
 110        CONTINUE
 120     CONTINUE
 
         DA(3,I,I) = SI
         DA(1,J,J) = SJ*SS(K)
         DA(3,J,J) = SI*CC(K)
         DA(1,K,K) = SJ*CC(I)
         DA(2,K,K) = SK*SS(I)*SS(J)
         DA(3,K,K) = SI*CC(J)
 
         DO 150 N1 = 1 , 3
            DO 140 N2 = 1 , 3
               DO 130 N3 = 1 , 3
                  IF (DA(N1,N2,N3).NE.0.0) THEN
                     IF (N3.EQ.1 .OR. N3.EQ.2) AA(N1,N2) = DA(N1,N2,N3)
                     IF (N3.EQ.3) AB(N1,N2) = DA(N1,N2,N3)
                  END IF
 130           CONTINUE
 140        CONTINUE
 150     CONTINUE
         RETURN
      ELSE IF (ISYST.EQ.6) THEN
C
C====== Rhombohedral
C
         A = CELL(1)
         C = COS(CELL(2)*DTORAD)
         S = SIN(CELL(2)*DTORAD)
         FUN = SQRT(1.-3.*C**2+2.*C**3)
         AM(1,J) = SJ*A*S
         AM(1,K) = SJ*A*C*(1.-C)/S
         AM(2,K) = SK*A*FUN/S
         AM(3,I) = SI*A
         AM(3,J) = SI*A*C
         AM(3,K) = SI*A*C
 
         AA(1,J) = SJ*S
         AA(1,K) = AM(1,K)/A
         AA(2,K) = AM(2,K)/A
         AA(3,I) = SI
         AA(3,J) = SI*C
         AA(3,K) = SI*C
 
         AB(1,J) = SJ*A*C
         AB(1,K) = SJ*A*(C-(1.-C)/S**2)
         AB(2,K) = SK*A*(3.*C*(1.-C)/FUN-FUN*C/S**2)
         AB(3,J) = -SI*A*S
         AB(3,K) = -SI*A*S
         RETURN
      ELSE IF (ISYST.EQ.7) THEN
C
C====== Cubic
C
         A = CELL(1)
         AM(1,J) = SJ*A
         AM(2,K) = SK*A
         AM(3,I) = SI*A
 
         AA(1,J) = SJ
         AA(2,K) = SK
         AA(3,I) = SI
         RETURN
      ELSE
C
C====== Triclinic
C
         RL(1) = CELL(1)
         RL(2) = CELL(2)
         RL(3) = CELL(3)
 
         CC(1) = COS(CELL(4)*DTORAD)
         CC(2) = COS(CELL(5)*DTORAD)
         CC(3) = COS(CELL(6)*DTORAD)
 
         SS(1) = SIN(CELL(4)*DTORAD)
         SS(2) = SIN(CELL(5)*DTORAD)
         SS(3) = SIN(CELL(6)*DTORAD)
C
C====== See Buerger's Xray Crystallography for the next formulae, p348
C
         COSPSI = (CC(I)-CC(K)*CC(J))/SS(K)
         TMPRT = ABS(1.-CC(I)**2-CC(J)**2-CC(K)**2+2.*CC(I)*CC(J)*CC(K))
         COSRHO = SQRT(TMPRT)/SS(K)
C
C====== A matrix
C
         AM(1,J) = SJ*RL(J)*SS(K)
         AM(1,K) = SJ*RL(K)*COSPSI
         AM(2,K) = SK*RL(K)*COSRHO
         AM(3,I) = SI*RL(I)
         AM(3,J) = SI*RL(J)*CC(K)
         AM(3,K) = SI*RL(K)*CC(J)
C
C====== Derivatives wrt reciprocal cell lengths
C
         DO 180 N1 = 1 , 3
            DO 170 N2 = 1 , 3
               DO 160 N3 = 1 , 3
                  DA(N1,N2,N3) = 0.
                  DB(N1,N2,N3) = 0.
 160           CONTINUE
 170        CONTINUE
 180     CONTINUE
 
         DA(3,I,I) = SI
         DA(1,J,J) = SJ*SS(K)
         DA(3,J,J) = SI*CC(K)
         DA(1,K,K) = SJ*COSPSI
         DA(2,K,K) = SK*COSRHO
         DA(3,K,K) = SI*CC(J)
 
         DO 210 N1 = 1 , 3
            DO 200 N2 = 1 , 3
               DO 190 N3 = 1 , 3
                  IF (DA(N1,N2,N3).NE.0.0) THEN
                     IF (N3.EQ.1) AA(N1,N2) = DA(N1,N2,N3)
                     IF (N3.EQ.2) AB(N1,N2) = DA(N1,N2,N3)
                     IF (N3.EQ.3) AC(N1,N2) = DA(N1,N2,N3)
                  END IF
 190           CONTINUE
 200        CONTINUE
 210     CONTINUE
C
C====== Derivatives wrt reciprocal cell angles
C
         DB(1,K,I) = -SJ*RL(K)*SS(I)/SS(K)
         DB(2,K,I) = SK*RL(K)*SS(I)*(CC(I)-CC(J)*CC(K))
     +               /(SS(K)**2*COSRHO)
         DB(1,K,J) = SJ*RL(K)*CC(K)*SS(J)/SS(K)
         DB(2,K,J) = SK*RL(K)*SS(J)*(CC(J)-CC(I)*CC(K))
     +               /(SS(K)**2*COSRHO)
         DB(3,K,J) = -SI*RL(K)*SS(J)
         DB(1,J,K) = SJ*RL(J)*CC(K)
         DB(1,K,K) = SJ*RL(K)*(CC(J)-CC(K)*CC(I))/SS(K)**2
         DB(2,K,K) = SK*RL(K)*((CC(K)-CC(I)*CC(J))/(COSRHO*SS(K))-CC(K)
     +               *COSRHO/SS(K))
         DB(3,J,K) = -SI*RL(J)*SS(K)
 
         DO 240 N1 = 1 , 3
            DO 230 N2 = 1 , 3
               DO 220 N3 = 1 , 3
                  IF (DB(N1,N2,N3).NE.0.0) THEN
                     IF (N3.EQ.1) AD(N1,N2) = DB(N1,N2,N3)
                     IF (N3.EQ.2) AE(N1,N2) = DB(N1,N2,N3)
                     IF (N3.EQ.3) AF(N1,N2) = DB(N1,N2,N3)
                  END IF
 220           CONTINUE
 230        CONTINUE
 240     CONTINUE
         RETURN
      END IF
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MEASURE_IMG      **
C**************************
C
C
      SUBROUTINE MEASURE_IMG
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Measure centre/spot positions etc. for an image
C
C Author:  John W. Campbell, February 1992
C
C Note:    Assumes image already displayed
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'meas_spots.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER XDLSTR
      INTEGER NXTTOK
C
C====== LOCALS:
C
      LOGICAL EXISTS
      LOGICAL CONT
      LOGICAL CLEAR
      LOGICAL USE_CEN
      LOGICAL REPLY
      LOGICAL CENTRE_READ
      INTEGER I
      INTEGER J
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVHLST2(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER IFAIL
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER IYN
      INTEGER LISTE(4)
      INTEGER M_CENT
      INTEGER M_CONIC
      INTEGER M_GCEN
      INTEGER M_SETCEN
      INTEGER M_INPUT
      INTEGER M_READ
      INTEGER M_WRITE
      INTEGER M_CLEAR
      INTEGER M_BG
      INTEGER M1
      INTEGER M2
      INTEGER NADD
      INTEGER NERR
      INTEGER NVALS 
      INTEGER IFID
      INTEGER IFLAG
      INTEGER KPACK
      INTEGER KPLATE
      REAL    VALUES(20)
      CHARACTER*80 STR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) SPOTS_FILE
      CHARACTER*25 NAMES(9)
      CHARACTER*25 QUITNAM
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     LOGICAL EXISTS      !File exists flag
C     LOGICAL CONT        !Continue writing file flag
C     LOGICAL CLEAR       !Clear current spots list flag
C     LOGICAL USE_CEN     !Use measured centre from input file flag
C     LOGICAL REPLY       !Reply flag
C     LOGICAL CENTRE_READ !Centre read from file flag
C     INTEGER I           !Temp/loop variable
C     INTEGER J           !Temp/loop variable
C     INTEGER NVIEW       !Number of view-objects from which data is to be input
C     INTEGER IVHLIST(2)  !View-object handles list for getting events
C     INTEGER IVHLST2(2)  !2'nd view-object handles list for getting events
C     INTEGER IVH         !View-object handle of view-object returning data
C     INTEGER ITEM        !Item number selected from menu
C     INTEGER IQUIT       !Quit box selection flag
C     INTEGER IERR        !Error flag
C     INTEGER IFAIL       !File open failure flag
C     INTEGER IXROOT      !X root position for popup notice
C     INTEGER IYROOT      !Y root position for popup notice
C     INTEGER IXPIX       !Input x pixel position from image
C     INTEGER IYPIX       !Input y pixel position from image
C     INTEGER IYN         !Reply flag from YESNO_NOTICE
C     INTEGER LISTE(4)    !List of parameter table entry numbers for update
C     INTEGER M_CENT      !Menu item number for: Cursor in Centre
C     INTEGER M_CONIC     !Menu item number for: Find Conics Centre
C     INTEGER M_GCEN      !Menu item number for: Gnomonic Centre
C     INTEGER M_SETCEN    !Menu item number for: Reset x_cen_f,y_cen_f,x_c,y_c
C     INTEGER M_INPUT     !Menu item number for: Input Spot Positions
C     INTEGER M_READ      !Menu item number for: Read Spots File
C     INTEGER M_WRITE     !Menu item number for: Write Spots File
C     INTEGER M_CLEAR     !Menu item number for: Clear Spots List
C     INTEGER M_BG        !Menu item number for: Get Background Image
C     INTEGER M1          !Token start position
C     INTEGER M2          !Token end position
C     INTEGER NADD        !Number of spots added from input spots file
C     INTEGER NERR        !Number of errors reading spots file
C     INTEGER NVALS       !Number of numerical values in spots file record
C     INTEGER IFID        !Fiducials flag
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER KPACK       !Pack no., 0 = all packs
C     INTEGER KPLATE      !Plate no., 0 = all plates
C     REAL    VALUES(20)  !Numerical values from spots file record
C     CHARACTER*80 STR                 !Temp character string
C     CHARACTER*(MAXFLEN) FILNAM       !File name as input
C     CHARACTER*(MAXFLEN) SPOTS_FILE   !Spots file name
C     CHARACTER*25 NAMES(9)            !Menu item names
C     CHARACTER*25 QUITNAM             !Quit box label
C     CHARACTER*2 VALSTR               !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR               !Error message string (dummy)

      DATA NAMES /'Cursor in Centre',
     +            'Find Conics Centre',
     +            'Gnomonic Centre',
     +            'Reset x_cen_f, y_cen_f',
     +            'Input Spot Positions',
     +            'Read Spots File',
     +            'Write Spots File',
     +            'Clear Spots List',
     +            'Get Background Image'/
      DATA QUITNAM /'Measurement Complete'/
C
C-------------------------------------------------------------------------------
C
C====== Set currently measured film/plate flag & clear spots list if needed
C
      IF (IPLATE.NE.IFILM_SPOTS) THEN
         NUM_INP_SPOTS = 0
         IFILM_SPOTS = IPLATE
      END IF
C
C====== Display any spots in current input spots list
C
      IF (NUM_INP_SPOTS.GT.0) THEN
         DO 10 I = 1, NUM_INP_SPOTS
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +                IXINP_SPOTS(I), IYINP_SPOTS(I),
     +                ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
10       CONTINUE
      END IF

C
C====== Set up menu
C
      M_CENT = 1
      M_CONIC = 2
      M_GCEN = 3
      M_SETCEN = 4
      M_INPUT = 5
      M_READ = 6
      M_WRITE = 7
      M_CLEAR = 8
      M_BG = 9
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 9, XDLSTR(NAMES), 25,
     +                             XDLSTR('Measure Image Menu'), 18,
     +                             XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C====== Quit box selected
C
         IF (IQUIT.EQ.1) RETURN
C
C====== Cursor in Centre
C
         IF (ITEM.EQ.M_CENT) THEN
            CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM, IXCEN_SPOTS,
     +           IYCEN_SPOTS, ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +           XDLSTR('Input Centre Position'), 21, IERR)
            IVHLST2(1) = IVH_FILM
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IMAGE_GETPIX (IVH_FILM, IXPIX, IYPIX, IERR)
            XCEN_SPOTS = IXPIX
            YCEN_SPOTS = IYPIX
            IXCEN_SPOTS = IXPIX
            IYCEN_SPOTS = IYPIX
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, IXPIX, IYPIX,
     +           ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            GO TO 500
C
C====== Find Conics Centre
C
         ELSE IF (ITEM.EQ.M_CONIC) THEN
            CALL CONIC_CENTRE
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
            IF (NUM_INP_SPOTS.GT.0) THEN
               DO 60 I = 1, NUM_INP_SPOTS
                  CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +                      IXINP_SPOTS(I), IYINP_SPOTS(I),
     +                      ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
60             CONTINUE
            END IF
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +           IXCEN_SPOTS, IYCEN_SPOTS,
     +           ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            GO TO 500
C
C====== Gnomonic Centre
C
         ELSE IF (ITEM.EQ.M_GCEN) THEN
            CALL GNOM_CENTRE
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
            IF (NUM_INP_SPOTS.GT.0) THEN
               DO 70 I = 1, NUM_INP_SPOTS
                  CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +                      IXINP_SPOTS(I), IYINP_SPOTS(I),
     +                      ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
70             CONTINUE
            END IF
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +           IXCEN_SPOTS, IYCEN_SPOTS,
     +           ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            GO TO 500
C
C====== Reset x_cen_f, y_cen_f
C
         ELSE IF (ITEM.EQ.M_SETCEN) THEN
            GO TO 510
C
C====== Input spots
C
         ELSE IF (ITEM.EQ.M_INPUT) THEN
            CALL INPUT_SPOTS
            GOTO 50
C
C====== Read Spots File
C
         ELSE IF (ITEM.EQ.M_READ) THEN
            CLEAR = .FALSE.
            USE_CEN = .TRUE.
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            IF (NUM_INP_SPOTS.GT.0) THEN
               REPLY = .FALSE.
               CALL IOW_ASKQ (IVH_IOW, 'Add to existing spots list',
     +                        REPLY)
               IF (.NOT.REPLY) THEN
                  CALL IOW_ASKQ (IVH_IOW, 'Overwrite existing spots',
     +                           REPLY)
                  IF (.NOT.REPLY) THEN
                     CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
                     GO TO 100
                  END IF
                  CLEAR = .TRUE.
               ELSE
                  USE_CEN = .FALSE.
                  CALL IOW_ASKQ (IVH_IOW, 
     +                 'Use measured centre from file',USE_CEN)
               END IF
            END IF
102         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.spots): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') THEN
               CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, IERR)
               GO TO 100
            END IF
            CALL FILEXT (FILNAM, 'spots', SPOTS_FILE, I)
            EXISTS = CCPEXS (SPOTS_FILE)
            IF (.NOT.EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**File not found**')
               GO TO 102
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_SPOTS, SPOTS_FILE,'READONLY','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 102
            END IF
            READ (IUN_SPOTS,'(A)',END=104) STR
            J = 0
            IF (NXTTOK (STR, ' ', J, M1, M2).EQ.0) THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''spots:'' keyword**')
               CLOSE (IUN_SPOTS)
               GO TO 102
            END IF
            CALL CCPUPC(STR)
            IF (STR(M1:M2).NE.'SPOTS:') THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''spots:'' keyword**')
               CLOSE (IUN_SPOTS)
               GO TO 102
            END IF
            IF (CLEAR) NUM_INP_SPOTS = 0
            NERR = 0
            NADD = 0
            CENTRE_READ = .FALSE.
103         READ (IUN_SPOTS,'(A)',END=104) STR
            IF (STR.EQ.' ') GO TO 103
            CALL STRVAL (STR, ' =', 20, VALUES, NVALS)
            IF (NVALS.NE.2) THEN
               CALL LMESSAGE(IVH_IOW,'**Invalid format in record**')
               NERR = NERR + 1
               GO TO 103
            END IF
            IF (.NOT.CENTRE_READ) THEN
               IF (USE_CEN) THEN
                  XCEN_SPOTS = VALUES(1)
                  YCEN_SPOTS = VALUES(2)
                  IXCEN_SPOTS = NINT(XCEN_SPOTS)
                  IYCEN_SPOTS = NINT(YCEN_SPOTS)
               END IF
               CENTRE_READ = .TRUE.
               GO TO 103
            END IF
            IF (NUM_INP_SPOTS.GE.MAX_MEAS) THEN
               CALL LMESSAGE (IVH_IOW,'**Spots list full**')
               NERR = NERR + 1
               GO TO 104
            END IF
            NUM_INP_SPOTS = NUM_INP_SPOTS + 1
            XINP_SPOTS(NUM_INP_SPOTS) = VALUES(1)
            YINP_SPOTS(NUM_INP_SPOTS) = VALUES(2)
            IXINP_SPOTS(NUM_INP_SPOTS) = NINT(XINP_SPOTS(NUM_INP_SPOTS))
            IYINP_SPOTS(NUM_INP_SPOTS) = NINT(YINP_SPOTS(NUM_INP_SPOTS))
            NADD = NADD + 1
            GO TO 103
104         CLOSE (IUN_SPOTS)
            STR = 'Number of spots added ='
            CALL STR_ADDI (STR, NADD, 1)
            CALL LMESSAGE (IVH_IOW, STR)
            IF (NERR.GT.0) THEN
               STR = '**Number of errors ='
               CALL STR_ADDI (STR, NERR, 1)
               CALL STR_ADDS (STR,'**',1)
               CALL LMESSAGE (IVH_IOW, STR)
            END IF
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
            IF (NUM_INP_SPOTS.GT.0) THEN
               DO 160 I = 1, NUM_INP_SPOTS
                  CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +                      IXINP_SPOTS(I), IYINP_SPOTS(I),
     +                      ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
160            CONTINUE
            END IF
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +           IXCEN_SPOTS, IYCEN_SPOTS,
     +           ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            IF (NERR.EQ.0) CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, IERR)
            GO TO 100
C
C====== Write spots file
C
         ELSE IF (ITEM.EQ.M_WRITE) THEN
            CALL NOTICE_POSN (1,IXROOT,IYROOT)
            IF (NUM_INP_SPOTS.LE.0) THEN
               CALL ERR_NOTICE(1,'**No input spots**')
               GO TO 100
            END IF
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
105         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.spots): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') THEN
               CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, IERR)
               GO TO 100
            END IF
            CALL FILEXT (FILNAM, 'spots', SPOTS_FILE, I)
            CALL LGFILE_EXISTS (SPOTS_FILE, CONT)
            IF (.NOT.CONT) GO TO 105
            IFAIL = 1
            CALL CCPDPN (-IUN_SPOTS, SPOTS_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 105
            END IF
            WRITE (IUN_SPOTS,'(''spots:'')')
            WRITE (IUN_SPOTS,'(2F9.3)') XCEN_SPOTS, YCEN_SPOTS
            DO 106 I=1,NUM_INP_SPOTS
               WRITE (IUN_SPOTS,'(2F8.2)') XINP_SPOTS(I), YINP_SPOTS(I)
106         CONTINUE
            CLOSE (IUN_SPOTS)
            CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, IERR)
            GO TO 100
C
C====== Clear spots list
C
         ELSE IF (ITEM.EQ.M_CLEAR) THEN
            NUM_INP_SPOTS = 0
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM, 
     +           IXCEN_SPOTS, IYCEN_SPOTS,
     +           ISYMBTYP(5), ICOLRTYP(5), 1, IERR)
            GO TO 100
C
C====== Get Background Image
C
         ELSE IF (ITEM.EQ.M_BG) THEN
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            CALL BG_CALC 
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
            GO TO 50
         END IF
      END IF
      GO TO 100
C
C====== Updates for centre input options
C
500   CALL YESNO_NOTICE (1,
     + 'Update x_cen_f, y_cenf & zero x_c, y_c ?',
     + IYN)
      IF (IYN.EQ.2) GO TO 50
510   CALL OTHERS_UPD (2, UPD_CENT, KPACK, KPLATE)
      CALL LDM_SET_XCENF (KPACK, KPLATE, XCEN_SPOTS, IERR, ERRSTR)
      CALL LDM_SET_YCENF (KPACK, KPLATE, YCEN_SPOTS, IERR, ERRSTR)
      CALL OTHERS_UPD (2, UPD_XCYC, KPACK, KPLATE)
      CALL LDM_SET_XC (KPACK, KPLATE, 0.0, IERR, ERRSTR)
      CALL LDM_SET_YC (KPACK, KPLATE, 0.0, IERR, ERRSTR)
      LISTE(1) = IP_XCENF
      LISTE(2) = IP_YCENF
      LISTE(3) = IP_XC
      LISTE(4) = IP_YC
      CALL SET_PAR2_VALS (4, LISTE)
      GO TO 50
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MINV_AUT         **
C**************************
C
C
      SUBROUTINE MINV_AUT(A,AI,ICOD)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Any 3*3 matrix inverter
C 
C Author:
C
C Arguments:
C
      INTEGER ICOD
      REAL A(3,3)
      REAL AI(3,3)
C
C====== Parameter statements
C 
      
C
C====== GLOBALS:
C
      
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      REAL DET
      INTEGER I,J
C
C-------------------------------------------------------------------------------
C
      DET = A(1,1)*A(2,2)*A(3,3) + A(1,2)*A(2,3)*A(3,1) + A(1,3)*A(2,1)
     +      *A(3,2) - A(1,2)*A(2,1)*A(3,3) - A(1,1)*A(2,3)*A(3,2)
     +      - A(1,3)*A(2,2)*A(3,1)
      IF (ABS(DET).LT.0.2E-20) THEN
         ICOD = 1
         RETURN
 
      ELSE
         ICOD = 0
      END IF
C
C ====== Set and transpose co-factors
C
      AI(1,1) = A(2,2)*A(3,3) - A(3,2)*A(2,3)
      AI(2,1) = A(2,3)*A(3,1) - A(2,1)*A(3,3)
      AI(3,1) = A(2,1)*A(3,2) - A(3,1)*A(2,2)
      AI(1,2) = A(1,3)*A(3,2) - A(1,2)*A(3,3)
      AI(2,2) = A(1,1)*A(3,3) - A(1,3)*A(3,1)
      AI(3,2) = A(3,1)*A(1,2) - A(1,1)*A(3,2)
      AI(1,3) = A(1,2)*A(2,3) - A(2,2)*A(1,3)
      AI(2,3) = A(1,3)*A(2,1) - A(1,1)*A(2,3)
      AI(3,3) = A(1,1)*A(2,2) - A(1,2)*A(2,1)
      DO 40 I = 1 , 3
         DO 30 J = 1 , 3
            AI(I,J) = AI(I,J)/DET
 30      CONTINUE
 40   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MTZ_CHK1         **
C**************************
C
C
      SUBROUTINE MTZ_CHK1 (FILNAM, IRET)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check for presence of MTZ file & whether can be overwritten if
C          presence
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      CHARACTER*(*) FILNAM
      INTEGER IRET
C 
C FILNAM    (R)   Name of file
C IRET      (W)   Return flag = 0 file not present
C                             = 1 file present env. var. CCP4_OPEN is not 
C                                 set to 'UNKNOWN'
C                             = 2 file present env. var. CCP4_OPEN is set
C                                 to 'UNKNOWN'
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      CHARACTER*50 STR

C     CHARACTER*50 STR     !String
C
C-------------------------------------------------------------------------------
C
      IRET = 0
      IF (.NOT.CCPEXS(FILNAM)) RETURN
      IRET = 1
      CALL UGTENV ('CCP4_OPEN', STR)
      CALL CCPUPC (STR)
      IF (STR.EQ.'UNKNOWN') IRET = 2
      RETURN 
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     MTZ_CHK2         **
C**************************
C
C
      SUBROUTINE MTZ_CHK2 (FILNAM, IRET)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: See if MTZ o/p file can be opened
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
      CHARACTER*(*) FILNAM
      INTEGER IRET
C 
C FILNAM    (R)   Name of file
C IRET      (W)   Return flag = 0 OK
C                             = 1 Cannot open file 
C                                 to 'UNKNOWN'
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER IOS

C     INTEGER I         !Return flag from MTZ_CHK1
C     INTEGER IOS       !File open status flag
C
C-------------------------------------------------------------------------------
C
      IRET = 0
      CALL MTZ_CHK1 (FILNAM, I)
      IF (I.EQ.1) THEN
         IRET = 1
         RETURN
      ELSE IF (I.EQ.0) THEN
         OPEN (UNIT=21, FILE=FILNAM, STATUS='NEW', IOSTAT=IOS)
         IF (IOS.GT.0) THEN
            CLOSE(UNIT=21)
            IRET = 1
            RETURN
         END IF
         CLOSE (UNIT=21, STATUS='DELETE')
         RETURN
      ELSE IF (I.EQ.2) THEN
         OPEN (UNIT=21, FILE=FILNAM, STATUS='UNKNOWN', ACCESS='DIRECT',
     +         FORM='UNFORMATTED', RECL=2, IOSTAT=IOS)
         IF (IOS.GT.0) IRET = 1
         CLOSE (UNIT=21)
      END IF
      RETURN 
      END
C LAST UPDATE:
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C******************************
C**       NODAL_INDEX        **
C******************************
C
C
      INTEGER   FUNCTION NODAL_INDEX (H, K, L)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: To calculate the "nodal spot selection index" at which a
C          nodal would be selected.
C
C Author:  Based on code from GENLAUE by Clifton et al.
C
C Arguments:
C
      INTEGER   H
      INTEGER   K
      INTEGER   L
C
C H    (R)   h index
C K    (R)   k index
C L    (R)   l index
C
C====== FUNCTION TYPES:
C
      INTEGER HCF
C
C====== LOCALS:
C
      INTEGER   HCF1, HCF2
      INTEGER   H1, K1, L1
      INTEGER   HI, LO
C
C------------------------------------------------------------------------------
C
      H1 = H
      K1 = K
      L1 = L
      HCF1 = HCF(H1,K1)
      HCF2 = HCF(HCF1,L1)
      H1 = H1/HCF2
      K1 = K1/HCF2
      L1 = L1/HCF2
C
      HI = MAX0(H1,K1,L1)
      LO = MIN0(H1,K1,L1)
      NODAL_INDEX = MAX0(HI,-LO)
C
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     NOTICE_POSN      **
C**************************
C
C
      SUBROUTINE NOTICE_POSN (ITYP, IXROOT, IYROOT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get screen position for a popup_notice for 'lauegen'
C
C Author:  John W. Campbell, August 1991
C
C Arguments:
C
      INTEGER ITYP
      INTEGER IXROOT
      INTEGER IYROOT
C
C ITYP    (R)  = 0, get default notice position
C              = 1, get position from last selected menu item
C              = 2, get position from last selected menu item 
C                   on autoindexing solutions menu area
C              = 3. position on command window
C IXROOT  (W)  Root x position for the notice
C IYROOT  (W)  Root y position for the notice
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      INTEGER IERR
C
C      INTEGER IERR    !Error return flag
C
C-------------------------------------------------------------------------------
C
C====== Initialise
C
      IXROOT = 0
      IYROOT = 0
      
      IF (ITYP.EQ.0) THEN
C
C====== Default position
C
         CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW, 0, 0, IXROOT, IYROOT,
     +        IERR)
         RETURN
    
      ELSE IF (ITYP.EQ.1) THEN
C
C====== Last menu item selected position
C
         CALL XDLF_MENU_AREA_GETROOTXY (IVH_MENU, IXROOT, IYROOT)
         RETURN
      ELSE IF (ITYP.EQ.2) THEN
C
C====== Last menu item on autoindexing solutions menu area
C
         CALL XDLF_MENU_AREA_GETROOTXY (IVH_MENU_AUT, IXROOT, IYROOT)
         RETURN
      ELSE IF (ITYP.EQ.3) THEN
C
C====== Position on command window
C
         CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_CMD, 0, 0, IXROOT, IYROOT,
     +        IERR)

      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     OTHER_REFPARS    **
C**************************
C
C
      SUBROUTINE OTHER_REFPARS (IPACK, IPLATE, IFLAG, KFLAG)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Update refined parameters for other packs/plates if required
C
C Author:  John W. Campbell, June 1994
C
C Arguments:
C
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IFLAG(*)
      INTEGER KFLAG(*)
C 
C IPACK      (R)  Pack number
C IPLATE     (R)  Plate number
C IFLAG      (R)  Parameter refine flags, phis, ctof, x_c, y_c, w_c (see
C                 REFINE_CALC)
C KFLAG      (R)  Parameter refine flags for distortion (see REFINE_CALC)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LDM_SPDMAX
C
C====== LOCALS:
C
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER IERR
      INTEGER KERR
      INTEGER LFLAG
      INTEGER ND
      INTEGER DISTOR_TYPE
      INTEGER I
      INTEGER MAX_SPD
      INTEGER IVAL
      REAL VALUE(2)
      REAL VAL
      CHARACTER*2 ERRSTR
      CHARACTER*2 VALSTR

C     INTEGER KPACK          !Pack number or 0 for all packs
C     INTEGER KPLATE         !Plate number or 0 for all pates
C     INTEGER IERR           !Error flag
C     INTEGER KERR           !Error flag
C     INTEGER LFLAG          !Parameter status flag
C     INTEGER ND             !No. of decimal places flag
C     INTEGER DISTOR_TYPE    !Distortion type flag
C     INTEGER I              !Temp/loop variable
C     INTEGER MAX_SPD        !Maximum polynomial coefficient
C     INTEGER IVAL           !Integer parameter value
C     REAL VALUE(2)          !Real parameter values array
C     REAL VAL               !Real parameter value
C     CHARACTER*2 ERRSTR     !Error string (dummy)
C     CHARACTER*2 VALSTR     !Parameter value string (dummy)

C
C-------------------------------------------------------------------------------
C
C
C====== Update LDM
C
      MAX_SPD = LDM_SPDMAX(0)
      IF (IFLAG(1).EQ.1) THEN
         CALL LDM_GET_PHIX (IPACK, VAL, LFLAG, ND, IERR, ERRSTR)
         CALL OTHERS_UPD (1, UPD_PHIS, KPACK, KPLATE)
         CALL LDM_SET_PHIX (KPACK, VAL, KERR, ERRSTR)
      END IF
      IF (IFLAG(2).EQ.1) THEN
         CALL LDM_GET_PHIY (IPACK, VAL, LFLAG, ND, IERR, ERRSTR)
         CALL OTHERS_UPD (1, UPD_PHIS, KPACK, KPLATE)
         CALL LDM_SET_PHIY (KPACK, VAL, KERR, ERRSTR)
      END IF
      IF (IFLAG(3).EQ.1) THEN
         CALL LDM_GET_PHIZ (IPACK, VAL, LFLAG, ND, IERR, ERRSTR)
         CALL OTHERS_UPD (1, UPD_PHIS, KPACK, KPLATE)
         CALL LDM_SET_PHIZ (KPACK, VAL, KERR, ERRSTR)
      END IF
      IF (IFLAG(4).EQ.1) THEN
         CALL LDM_GET_CTOF (IPACK, IPLATE, VAL, LFLAG, ND, IERR, ERRSTR)        
         CALL OTHERS_UPD (2, UPD_CTOF, KPACK, KPLATE)
         CALL LDM_SET_CTOF (KPACK, KPLATE, VAL, KERR, ERRSTR)
      END IF
      IF (IFLAG(5).EQ.1) THEN
         CALL LDM_GET_XC (IPACK, IPLATE, VAL, LFLAG, ND, IERR, ERRSTR)        
         CALL OTHERS_UPD (2, UPD_XCYC, KPACK, KPLATE)
         CALL LDM_SET_XC (KPACK, KPLATE, VAL, KERR, ERRSTR)
      END IF
      IF (IFLAG(6).EQ.1) THEN
         CALL LDM_GET_YC (IPACK, IPLATE, VAL, LFLAG, ND, IERR, ERRSTR)        
         CALL OTHERS_UPD (2, UPD_XCYC, KPACK, KPLATE)
         CALL LDM_SET_YC (KPACK, KPLATE, VAL, KERR, ERRSTR)
      END IF
      IF (IFLAG(7).EQ.1) THEN
         CALL LDM_GET_WC (IPACK, IPLATE, VAL, LFLAG, ND, IERR, ERRSTR)        
         CALL OTHERS_UPD (2, UPD_WC, KPACK, KPLATE)
         CALL LDM_SET_WC (KPACK, KPLATE, VAL, KERR, ERRSTR)
      END IF

      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, LFLAG)
      IF (DISTOR_TYPE.EQ.1) THEN
         IF (KFLAG(1).EQ.1) THEN
            CALL LDM_GET_YSCAL (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_YSCAL, KPACK, KPLATE)
            CALL LDM_SET_YSCAL (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(2).EQ.1) THEN
            CALL LDM_GET_TWIST (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
            CALL LDM_SET_TWIST (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(3).EQ.1) THEN
            CALL LDM_GET_TILT (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
            CALL LDM_SET_TILT (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(4).EQ.1) THEN
            CALL LDM_GET_BULGE (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_BULG, KPACK, KPLATE)
            CALL LDM_SET_BULGE (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
      ELSE IF (DISTOR_TYPE.EQ.2) THEN
         IF (KFLAG(1).EQ.1) THEN
            CALL LDM_GET_YSCAL (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_YSCAL, KPACK, KPLATE)
            CALL LDM_SET_YSCAL (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(2).EQ.1) THEN
            CALL LDM_GET_TWIST (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
            CALL LDM_SET_TWIST (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(3).EQ.1) THEN
            CALL LDM_GET_TILT (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
            CALL LDM_SET_TILT (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(4).EQ.1) THEN
            CALL LDM_GET_ROFF (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_RTOFF, KPACK, KPLATE)
            CALL LDM_SET_ROFF (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(5).EQ.1) THEN
            CALL LDM_GET_TOFF (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_RTOFF, KPACK, KPLATE)
            CALL LDM_SET_TOFF (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
      ELSE IF (DISTOR_TYPE.EQ.3) THEN
         IF (KFLAG(1).EQ.1) THEN
            CALL LDM_GET_YSCAL (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_YSCAL, KPACK, KPLATE)
            CALL LDM_SET_YSCAL (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(2).EQ.1) THEN
            CALL LDM_GET_TWIST (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
            CALL LDM_SET_TWIST (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(3).EQ.1) THEN
            CALL LDM_GET_TILT (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
            CALL LDM_SET_TILT (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(4).EQ.1) THEN
            CALL LDM_GET_SPDXY (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET_SPDXY (KPACK, KPLATE, VAL, KERR, ERRSTR)
         END IF
         IF (KFLAG(5).EQ.1) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_GET_SPDXN (IPACK, IPLATE, IVAL, LFLAG, 
     +           IERR, ERRSTR)        
            CALL LDM_SET_SPDXN (KPACK, KPLATE, IVAL, KERR, ERRSTR)
            CALL LDM_GET_SXMIN (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL LDM_SET_SXMIN (KPACK, KPLATE, VAL, KERR, ERRSTR)
            CALL LDM_GET_SXMAX (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL LDM_SET_SXMAX (KPACK, KPLATE, VAL, KERR, ERRSTR)
            DO 100 I = 1, MAX_SPD
               CALL LDM_GET_SPDX (I, IPACK, IPLATE, VALUE, LFLAG, ND,
     +                         KERR, ERRSTR)
               CALL LDM_SET_SPDX (I, KPACK, KPLATE, VALUE,
     +                         KERR, ERRSTR)
100         CONTINUE
         END IF
         IF (KFLAG(6).EQ.1) THEN
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_GET_SPDYN (IPACK, IPLATE, IVAL, LFLAG, 
     +           IERR, ERRSTR)        
            CALL LDM_SET_SPDYN (KPACK, KPLATE, IVAL, KERR, ERRSTR)
            CALL LDM_GET_SYMIN (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL LDM_SET_SYMIN (KPACK, KPLATE, VAL, KERR, ERRSTR)
            CALL LDM_GET_SYMAX (IPACK, IPLATE, VAL, LFLAG, ND, 
     +           IERR, ERRSTR)        
            CALL LDM_SET_SYMAX (KPACK, KPLATE, VAL, KERR, ERRSTR)
            DO 110 I = 1, MAX_SPD
               CALL LDM_GET_SPDY (I, IPACK, IPLATE, VALUE, LFLAG, ND,
     +                         KERR, ERRSTR)
               CALL LDM_SET_SPDY (I, KPACK, KPLATE, VALUE,
     +                         KERR, ERRSTR)
110         CONTINUE
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     OTHERS_UPD       **
C**************************
C
C
      SUBROUTINE OTHERS_UPD (ITYP, UPD_FLAG, KPACK, KPLATE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set global pack/plate update flags for parameter updates
C          as appropriate
C
C Author:  John W. Campbell, June 1994
C
C Arguments:
C
      INTEGER ITYP
      LOGICAL UPD_FLAG
      INTEGER KPACK
      INTEGER KPLATE
C
C  ITYP    (R)   Parameter class =1 pack based parameter (soft limits, phis)
C                                =2 plate based parameter
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER KEYPLATE
      INTEGER IFLAG
      INTEGER IERR
      CHARACTER*2 ERRSTR

C     INTEGER KEYPLATE         !Key plate
C     INTEGER IFLAG            !Parameter status flag
C     INTEGER IERR             !Error flag
C     CHARACTER*2 ERRSTR       !Error string flag (dummy)
C
C-------------------------------------------------------------------------------
C
      KPACK = IPACK
      KPLATE = IPLATE
      IF (.NOT.UPD_FLAG) RETURN
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
      IF (ITYP.EQ.1) THEN
         IF (IPACK.EQ.1) KPACK = 0
      ELSE
         IF (IPLATE.EQ.KEYPLATE) THEN
            KPLATE = 0
            IF (IPACK.EQ.1) KPACK = 0
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**     PARFIL_ERR            **
C*******************************
C
C
      SUBROUTINE PARFIL_ERR (ERRSTR, ERRSTR2) 
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle command line read/write LDM parameters files errors errors
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
C
C Parameters:
C
C ERRSTR      c  (R)  Error string (max 80 chars)
C ERRSTR2     c  (R)  Subsidiary error string - may be blank (max 80
C                     chars)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      CHARACTER*120 STR

C     LOGICAL EOF             !End of file flag

C
C-------------------------------------------------------------------------------
C
C
C====== Write message to log file if required
C
      IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG,6010) ERRSTR(1:LENSTR(ERRSTR))
         IF (ERRSTR2.NE.' ') WRITE (IUN_LOG,6010) 
     +                       ERRSTR2(1:LENSTR(ERRSTR2))
      END IF
C
C====== Output message etc. depending on program mode
C
      IF (LG_MODE.EQ.1) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL LMESSAGE (IVH_CMD, STR)
         IF (ERRSTR2.NE.' ') THEN
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR2, 1)
            CALL LMESSAGE (IVH_CMD, STR)
         END IF
         RETURN

      ELSE IF (LG_MODE.EQ.2) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL TWRITE (STR)
         IF (ERRSTR2.NE.' ') THEN
            STR = '**Error**'
            CALL STR_ADDS (STR, ERRSTR2, 1)
            CALL TWRITE (STR)
         END IF
         RETURN
      END IF

      RETURN
C
C====== Format statements
C
 6000 FORMAT (A)
 6010 FORMAT ('**Error** ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     PAR1_INPUT       **
C**************************
C
C
      SUBROUTINE PAR1_INPUT
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle parameter table 1 input
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'cell_input.finc'
      INCLUDE 'process_omit.finc'
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      INTEGER INTFP
C
C====== LOCALS:
C
      INTEGER I
      INTEGER ITEM
      INTEGER IERR
      INTEGER LISTE(3)
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER IPACK_SAV
      INTEGER IPLATE_SAV
      INTEGER ITYP
      INTEGER IV
      INTEGER ND
      REAL    FP
      CHARACTER*(MAX_PSCROLL_CHARS) PVAL
      CHARACTER*80 ERRSTR
      CHARACTER*2 VALSTR

C     INTEGER I          !Temp/loop variable
C     INTEGER ITEM       !Returned parameter table item number
C     INTEGER IERR       !Error flag
C     INTEGER LISTE(3)   !List of changed parameters array
C     INTEGER KPACK      !Pack number  or 0 for all packs
C     INTEGER KPLATE     !Plate number or 0 for all plates
C     INTEGER IVAL       !Integer parameter value
C     INTEGER IFLAG      !Parameter status flag
C     INTEGER IPACK_SAV  !Saves current pack value
C     INTEGER IPLATE_SAV !Saves current plate value
C     INTEGER ITYP       !Type of number flag
C     INTEGER IV         !Integer value
C     INTEGER ND         !No. of decimal places flag
C     REAL    FP         !Real value
C     CHARACTER*(MAX_PSCROLL_CHARS) PVAL  !Returned parameter value string
C     CHARACTER*80 ERRSTR              !Error string
C     CHARACTER*2 VALSTR               !Dummy value string

C
C-------------------------------------------------------------------------------
C
C====== Find item number and value
C
      CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR1, ITEM, XDLSTR(PVAL),
     +     MAX_PSCROLL_CHARS, IERR)
      IF (PVAL.EQ.' ') THEN
         CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +        XDLSTR('**Value must be given**'), 23, IERR)
         RETURN
      END IF
C
C====== See if value may be changed currently
C
      IF (PROCESS) THEN
         DO 10 I = 1, NOMITP
            IF (ITEM.EQ.IP_OMIT(I)) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +           XDLSTR('**Cannot change in process mode**'),
     +                  33, IERR)
               RETURN
            END IF
10       CONTINUE
      END IF
C
C====== Interpret and check validity of the value
C
C
C====== Pack and plate number
C
      IF (ITEM.EQ.IP_PACK) THEN
         IPACK_SAV = IPACK
         IPLATE_SAV = IPLATE
         IF (PVAL(1:1).EQ.'+') THEN
            IPACK = IPACK + 1
            CALL LDM_GET_NUMP (IVAL, IFLAG)
            IF (IPACK.GT.IVAL) IPACK = IVAL
            IF (IPACK.LT.1) IPACK = 1
         ELSE IF (PVAL(1:1).EQ.'-') THEN
            IPACK = IPACK - 1
            IF (IPACK.LT.1) IPACK = 1
         ELSE
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0.OR.ITYP.EQ.2) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +         XDLSTR('**Invalid value syntax**'), 24, IERR)
               RETURN
            END IF
            IF (IV.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               RETURN
            END IF
            IPACK = IV
            CALL LDM_GET_NUMP (IVAL, IFLAG)
            IF (IPACK.GT.IVAL) IPACK = IVAL
            IF (IPACK.LT.1) IPACK = 1
         END IF
         IF (IPACK.NE.IPACK_SAV) THEN
            IPLATE = 1
            CALL SET_PAR1_VALS (0, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
         ELSE
            LISTE(1) = IP_PACK
            CALL SET_PAR1_VALS (1, LISTE)
         END IF

      ELSE IF (ITEM.EQ.IP_PLATE) THEN
         IPLATE_SAV = IPLATE
         IF (PVAL(1:1).EQ.'+') THEN
            IPLATE = IPLATE + 1
            CALL LDM_GET_NPLAT (IVAL, IFLAG)
            IF (IPLATE.GT.IVAL) IPLATE = IVAL
            IF (IPLATE.LT.1) IPLATE = 1
         ELSE IF (PVAL(1:1).EQ.'-') THEN
            IPLATE = IPLATE - 1
            IF (IPLATE.LT.1) IPLATE = 1
         ELSE
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0.OR.ITYP.EQ.2) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +         XDLSTR('**Invalid value syntax**'), 24, IERR)
               RETURN
            END IF
            IF (IV.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               RETURN
            END IF
            IPLATE = IV
            CALL LDM_GET_NPLAT (IVAL, IFLAG)
            IF (IPLATE.GT.IVAL) IPLATE = IVAL
            IF (IPLATE.LT.1) IPLATE = 1
         END IF
         LISTE(1) = IP_PLATE
         CALL SET_PAR1_VALS (1, LISTE)
         IF (IPLATE.NE.IPLATE_SAV) CALL SET_PAR2_VALS (0, LISTE)
C
C====== Crystal system or Lattice type
C
      ELSE IF (ITEM.EQ.IP_SYST) THEN
         CALL LDM_SET ('SYSTEM', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_SET_A (CELL_INPUT(1), IERR, ERRSTR)
         CALL LDM_SET_B (CELL_INPUT(2), IERR, ERRSTR)
         CALL LDM_SET_C (CELL_INPUT(3), IERR, ERRSTR)
         CALL LDM_SET_ALPHA (CELL_INPUT(4), IERR, ERRSTR)
         CALL LDM_SET_BETA (CELL_INPUT(5), IERR, ERRSTR)
         CALL LDM_SET_GAMMA (CELL_INPUT(6), IERR, ERRSTR)
         CALL RESET_CELL
         LISTE(1) = IP_SYST
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_LATT) THEN
         CALL LDM_SET ('LATTICE', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_LATT
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Symmetry
C
      ELSE IF (ITEM.EQ.IP_SYMM) THEN
         CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +         XDLSTR('**Use command window to change symmetry**'), 
     +                41, IERR)
         RETURN
C
C====== Setting axes
C
      ELSE IF (ITEM.EQ.IP_ROT) THEN
         CALL LDM_SET ('ROTATION_AXIS', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_ROT
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_BEAM) THEN
         CALL LDM_SET ('BEAM_AXIS', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_BEAM
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Pack id
C
      ELSE IF (ITEM.EQ.IP_PACKID) THEN
         CALL LDM_SET ('PACK_ID', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_PACKID
         CALL SET_PAR1_VALS (1, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
C
C====== Spindle
C
      ELSE IF (ITEM.EQ.IP_SPINDL) THEN
         CALL LDM_SET ('SPINDLE', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_SPINDL
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Cell Parameters
C
      ELSE IF (ITEM.EQ.IP_A) THEN
         CALL LDM_SET ('A', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_A (CELL_INPUT(1), IFLAG, ND)
         CALL RESET_CELL
         LISTE(1) = IP_A
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_B) THEN
         CALL LDM_SET ('B', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_B (CELL_INPUT(2), IFLAG, ND)
         CALL RESET_CELL
         LISTE(1) = IP_B
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_C) THEN
         CALL LDM_SET ('C', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_C (CELL_INPUT(3), IFLAG, ND)
         CALL RESET_CELL
         LISTE(1) = IP_C
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_ALPH) THEN
         CALL LDM_SET ('ALPHA', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_ALPHA (CELL_INPUT(4), IFLAG, ND)
         CALL RESET_CELL
         LISTE(1) = IP_ALPH
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_BETA) THEN
         CALL LDM_SET ('BETA', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_BETA (CELL_INPUT(5), IFLAG, ND)
         CALL RESET_CELL
         LISTE(1) = IP_BETA
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_GAMM) THEN
         CALL LDM_SET ('GAMMA', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_GAMMA (CELL_INPUT(6), IFLAG, ND)
         CALL RESET_CELL
         LISTE(1) = IP_GAMM
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Soft Limits
C
      ELSE IF (ITEM.EQ.IP_WMIN) THEN
         CALL OTHERS_UPD (1, UPD_LAMS, KPACK, KPLATE)
         CALL LDM_SET ('LMIN', KPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_WMIN
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_WMAX) THEN
         CALL OTHERS_UPD (1, UPD_LAMS, KPACK, KPLATE)
         CALL LDM_SET ('LMAX', KPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_WMAX
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_DMIN) THEN
         CALL OTHERS_UPD (1, UPD_DMIN, KPACK, KPLATE)
         CALL LDM_SET ('DMIN', KPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_DMIN
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Setting Phi's 
C
      ELSE IF (ITEM.EQ.IP_PHIX) THEN
         CALL OTHERS_UPD (1, UPD_PHIS, KPACK, KPLATE)
         CALL LDM_SET ('PHIX', KPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_PHIX
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_PHIY) THEN
         CALL OTHERS_UPD (1, UPD_PHIS, KPACK, KPLATE)
         CALL LDM_SET ('PHIY', KPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_PHIY
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_PHIZ) THEN
         CALL OTHERS_UPD (1, UPD_PHIS, KPACK, KPLATE)
         CALL LDM_SET ('PHIZ', KPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_PHIZ
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Image type
C
      ELSE IF (ITEM.EQ.IP_IMTYP) THEN
         CALL LDM_SET ('IMAGE_TYPE', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_IMTYP
         CALL SET_PAR1_VALS (1, LISTE)
         FILM_READ = .FALSE.
C
C====== Image data type
C
      ELSE IF (ITEM.EQ.IP_IMDAT) THEN
         CALL LDM_SET ('IMAGE_DATA', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_IMDAT
         CALL SET_PAR1_VALS (1, LISTE)
         FILM_READ = .FALSE.
C
C====== Number of packs and plates
C
      ELSE IF (ITEM.EQ.IP_NUMP) THEN
         CALL LDM_SET ('NUMPACK', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         IPACK = 1
         IPLATE = 1
         CALL SET_PAR1_VALS (0, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)

      ELSE IF (ITEM.EQ.IP_NPLAT) THEN
         CALL LDM_SET ('NPLATES', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         IPACK = 1
         IPLATE = 1
         CALL SET_PAR1_VALS (0, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
C
C====== Fiducials option
C
      ELSE IF (ITEM.EQ.IP_FIDT) THEN
         CALL LDM_SET ('FIDTYPE', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         CALL LDM_GET_FIDT (VALSTR, IVAL, IFLAG)
         IF (IVAL.EQ.1) CALL EDIT_FIDS
         LISTE(1) = IP_FIDT
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== Distortion type
C
      ELSE IF (ITEM.EQ.IP_DISTOR) THEN
         CALL LDM_SET ('DISTORTION_TYPE', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_DISTOR
         CALL SET_PAR1_VALS (1, LISTE)

C
C====== Detector geometry
C
      ELSE IF (ITEM.EQ.IP_DGEOM) THEN
         CALL LDM_SET ('DGEOM', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_DGEOM
         CALL SET_PAR1_VALS (1, LISTE)

C
C====== Detector tilt
C
      ELSE IF (ITEM.EQ.IP_DTILT) THEN
         CALL LDM_SET ('DTILT', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_DTILT
         CALL SET_PAR1_VALS (1, LISTE)

C
C====== Spot epsilon
C
      ELSE IF (ITEM.EQ.IP_EPS) THEN
         CALL LDM_SET ('SPOT_EPSILON', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_EPS
         CALL SET_PAR1_VALS (1, LISTE)

C
C====== Thresholds
C
      ELSE IF (ITEM.EQ.IP_STHR) THEN
         CALL LDM_SET ('STHRESH', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_STHR
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_OVPIX) THEN
         CALL LDM_SET ('OVERLOAD_PIXEL', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_OVPIX
         CALL SET_PAR1_VALS (1, LISTE)

C
C====== Template for file names
C
      ELSE IF (ITEM.EQ.IP_TEMPL) THEN
         CALL LDM_SET ('TEMPLATE', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_TEMPL
         CALL SET_PAR1_VALS (1, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
         FILM_READ = .FALSE.
         FILM_OPEN = .FALSE.
         IPACK_OPN = 0
         IPLATE_OPN = 0
C
C====== Raster parameters
C
      ELSE IF (ITEM.EQ.IP_NXRAST) THEN
         CALL LDM_SET ('NXRAST', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_NXRAST
         CALL SET_PAR1_VALS (1, LISTE)
         FILM_READ = .FALSE.

      ELSE IF (ITEM.EQ.IP_NYRAST) THEN
         CALL LDM_SET ('NYRAST', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_NYRAST
         CALL SET_PAR1_VALS (1, LISTE)
         FILM_READ = .FALSE.

      ELSE IF (ITEM.EQ.IP_RAST) THEN
         CALL LDM_SET ('RASTER_SIZE', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_RAST
         CALL SET_PAR1_VALS (1, LISTE)

C
C====== Axis order
C
      ELSE IF (ITEM.EQ.IP_AXORD) THEN
         CALL LDM_SET ('AXORD', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_AXORD
         CALL SET_PAR1_VALS (1, LISTE)
         FILM_READ = .FALSE.
C
C====== Film radii
C
      ELSE IF (ITEM.EQ.IP_RMIN) THEN
         CALL LDM_SET ('RMIN', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_RMIN
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_RMAX) THEN
         CALL LDM_SET ('RMAX', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_RMAX
         CALL SET_PAR1_VALS (1, LISTE)
C
C====== XY Limits
C
      ELSE IF (ITEM.EQ.IP_XLOW) THEN
         CALL LDM_SET ('XLOW', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_XLOW
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_XHIGH) THEN
         CALL LDM_SET ('XHIGH', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_XHIGH
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_YLOW) THEN
         CALL LDM_SET ('YLOW', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_YLOW
         CALL SET_PAR1_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_YHIGH) THEN
         CALL LDM_SET ('YHIGH', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_YHIGH
         CALL SET_PAR1_VALS (1, LISTE)

      END IF

      RETURN
C
C====== Error Conditions
C
800   CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR1, ITEM,
     +     XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR)
      RETURN

      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     PAR2_INPUT       **
C**************************
C
C
      SUBROUTINE PAR2_INPUT
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle parameter table 2 input
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER ITEM
      INTEGER IERR
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER LISTE(3)
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER DISTOR_TYPE
      CHARACTER*(MAX_P2SCROLL_CHARS) PVAL
      CHARACTER*80 ERRSTR
      CHARACTER*2 VALSTR

C     INTEGER I          !Temp/loop variable
C     INTEGER ITEM       !Returned parameter table item number
C     INTEGER IERR       !Error flag
C     INTEGER IVAL       !Integer parameter value
C     INTEGER IFLAG      !Parameter status flag
C     INTEGER LISTE(3)   !List of changed parameters array
C     INTEGER KPACK      !Pack number or 0=all
C     INTEGER KPLATE     !Plate number or 0=all
C     INTEGER DISTOR_TYPE                  !Distortion type flag
C     CHARACTER*(MAX_P2SCROLL_CHARS) PVAL  !Returned parameter value string
C     CHARACTER*80 ERRSTR                  !Error string
C     CHARACTER*2 VALSTR                   !Value string (dummy)
C

C
C-------------------------------------------------------------------------------
C
C====== Get current distortion type
C
      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, IFLAG)
C
C====== Find item number and value
C
      CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR2, ITEM, XDLSTR(PVAL),
     +     MAX_P2SCROLL_CHARS, IERR)
      IF (PVAL.EQ.' ') THEN
         CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR2, ITEM,
     +        XDLSTR('**Value must be given**'), 23, IERR)
         RETURN
      END IF
C
C====== Interpret and check validity of the value
C
C
C====== Filename
C
      IF (ITEM.EQ.IP_FNAM) THEN
         CALL LDM_SET ('FILENAME', IPACK, IPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_FNAM
         CALL SET_PAR2_VALS (1, LISTE)
         FILM_READ = .FALSE.
         FILM_OPEN = .FALSE.
         IPACK_OPN = 0
         IPLATE_OPN = 0
C
C====== Crystal to film distance
C
      ELSE IF (ITEM.EQ.IP_CTOF) THEN
         CALL OTHERS_UPD (2, UPD_CTOF, KPACK, KPLATE)
         CALL LDM_SET ('CTOF', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_CTOF
         CALL SET_PAR2_VALS (1, LISTE)
C
C====== x_cen_f, y_cen_f
C
      ELSE IF (ITEM.EQ.IP_XCENF) THEN
         CALL OTHERS_UPD (2, UPD_CENT, KPACK, KPLATE)
         CALL LDM_SET ('X_CEN_F', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_XCENF
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_YCENF) THEN
         CALL OTHERS_UPD (2, UPD_CENT, KPACK, KPLATE)
         CALL LDM_SET ('Y_CEN_F', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_YCENF
         CALL SET_PAR2_VALS (1, LISTE)
C
C====== Centre offsets
C
      ELSE IF (ITEM.EQ.IP_XC) THEN
         CALL OTHERS_UPD (2, UPD_XCYC, KPACK, KPLATE)
         CALL LDM_SET ('X_C', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_XC
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_YC) THEN
         CALL OTHERS_UPD (2, UPD_XCYC, KPACK, KPLATE)
         CALL LDM_SET ('Y_C', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_YC
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_WC) THEN
         CALL OTHERS_UPD (2, UPD_WC, KPACK, KPLATE)
         CALL LDM_SET ('W_C', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_WC
         CALL SET_PAR2_VALS (1, LISTE)
C
C====== Raster scaling parameter
C
      ELSE IF (ITEM.EQ.IP_YSCAL) THEN
         CALL OTHERS_UPD (2, UPD_YSCAL, KPACK, KPLATE)
         CALL LDM_SET ('Y_SCALE', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_YSCAL
         CALL SET_PAR2_VALS (1, LISTE)
C
C====== Distortion offsets
C
      ELSE IF (ITEM.EQ.IP_TWIST) THEN
         CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
         CALL LDM_SET ('TWIST', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_TWIST
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_TILT) THEN
         CALL OTHERS_UPD (2, UPD_TT, KPACK, KPLATE)
         CALL LDM_SET ('TILT', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_TILT
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_BULGE.AND.DISTOR_TYPE.EQ.1) THEN
         CALL OTHERS_UPD (2, UPD_BULG, KPACK, KPLATE)
         CALL LDM_SET ('BULGE', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_BULGE
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_ROFF.AND.DISTOR_TYPE.EQ.2) THEN
         CALL OTHERS_UPD (2, UPD_RTOFF, KPACK, KPLATE)
         CALL LDM_SET ('ROFF', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_ROFF
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_TOFF.AND.DISTOR_TYPE.EQ.2) THEN
         CALL OTHERS_UPD (2, UPD_RTOFF, KPACK, KPLATE)
         CALL LDM_SET ('TOFF', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_TOFF
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_SPDXY.AND.DISTOR_TYPE.EQ.3) THEN
         CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
         CALL LDM_SET ('SPDXY', KPACK, KPLATE, PVAL, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_SPDXY
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_SPDX.AND.DISTOR_TYPE.EQ.3) THEN
         CALL CCPUPC(PVAL)
         IF (PVAL.EQ.'EDIT') THEN
            LISTE(1) = IP_SPDX
            CALL SET_PAR2_VALS (1, LISTE)
            CALL EDIT_SPD ()
         ELSE
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDX_N', KPACK, KPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            LISTE(1) = IP_SPDX
            CALL SET_PAR2_VALS (1, LISTE)
         END IF

      ELSE IF (ITEM.EQ.IP_SPDY.AND.DISTOR_TYPE.EQ.3) THEN
         CALL CCPUPC(PVAL)
         IF (PVAL.EQ.'EDIT') THEN
            LISTE(1) = IP_SPDY
            CALL SET_PAR2_VALS (1, LISTE)
            CALL EDIT_SPD ()
         ELSE
            CALL OTHERS_UPD (2, UPD_SPD, KPACK, KPLATE)
            CALL LDM_SET ('SPDY_N', KPACK, KPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) GO TO 800
            LISTE(1) = IP_SPDY
            CALL SET_PAR2_VALS (1, LISTE)
         END IF
C
C====== Spot size/overlap parameters
C
      ELSE IF (ITEM.EQ.IP_STRK_L) THEN
         CALL OTHERS_UPD (2, UPD_SPOT, KPACK, KPLATE)
         CALL LDM_SET ('SPOT_LENGTH', KPACK, KPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_STRK_L
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_STRK_W) THEN
         CALL OTHERS_UPD (2, UPD_SPOT, KPACK, KPLATE)
         CALL LDM_SET ('SPOT_WIDTH', KPACK, KPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_STRK_W
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_STRK_F) THEN
         CALL OTHERS_UPD (2, UPD_SPOT, KPACK, KPLATE)
         CALL LDM_SET ('SPOT_FACTOR', KPACK, KPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_STRK_F
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_STRK_BW) THEN
         CALL OTHERS_UPD (2, UPD_SPOT, KPACK, KPLATE)
         CALL LDM_SET ('SPOT_BORDER', KPACK, KPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_STRK_BW
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_DELTA) THEN
         CALL OTHERS_UPD (2, UPD_SPOT, KPACK, KPLATE)
         CALL LDM_SET ('SPOT_DELTA', KPACK, KPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_DELTA
         CALL SET_PAR2_VALS (1, LISTE)

      ELSE IF (ITEM.EQ.IP_RFL) THEN
         CALL LDM_SET ('RFL', IPACK, IPLATE, PVAL, 
     +                  IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
         LISTE(1) = IP_RFL
         CALL SET_PAR2_VALS (1, LISTE)

      END IF
      RETURN
C
C====== General Error Conditions
C
800   CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR2, ITEM,
     +     XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR)
      RETURN

      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     PAR_CHK          **
C**************************
C
C
      SUBROUTINE PAR_CHK (KEYWORD, OK)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Check which LDM parameters may currently be updated (and
C          indicate which if any cell parameters updated)
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
      CHARACTER*(*) KEYWORD
      LOGICAL  OK
C
C KEYWORD      (R)   LDM parameter name (full)
C OK           (W)   Return .TRUE. if update OK else return .FALSE.
C
C====== Parameter statements
C 
C
C====== GLOBALS:
C
      INCLUDE 'prog_flags.finc'
      INCLUDE 'view_handles.finc'
      INCLUDE 'cell_input.finc'
      INCLUDE 'process_omit.finc'
C
C====== FUNCTION TYPES:
C
C
C====== LOCALS:
C
      INTEGER I
      CHARACTER*80 STR

C     INTEGER I                 !Temp/loop variable
C     CHARACTER*80 STR          !Message string
C
C-------------------------------------------------------------------------------
C
      OK = .TRUE.
C
C====== Set cell change flags
C
      IF (KEYWORD.EQ.'SYSTEM') SYST_CH = .TRUE.
      IF (KEYWORD.EQ.'A') CELL_CH(1) = .TRUE.      
      IF (KEYWORD.EQ.'B') CELL_CH(2) = .TRUE.      
      IF (KEYWORD.EQ.'C') CELL_CH(3) = .TRUE.      
      IF (KEYWORD.EQ.'ALPHA') CELL_CH(4) = .TRUE.      
      IF (KEYWORD.EQ.'BETA') CELL_CH(5) = .TRUE.      
      IF (KEYWORD.EQ.'GAMMA') CELL_CH(6) = .TRUE.
C
C====== Disable certain parameter changes when 'PROCESS = .TRUE.'
C
      IF (.NOT.PROCESS) RETURN
      DO 100 I = 1, NOMITK
         IF (KEYWORD.EQ.OMIT(I)) THEN
            STR = '**Error** Cannot change'
            CALL STR_ADDS (STR, KEYWORD, 1)
            CALL STR_ADDS (STR, 'in process mode', 1)
            CALL CMD_MSG (IVH_CMD, STR)
            OK = .FALSE.
            RETURN
         END IF
100   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     PLOT_DIFF        **
C**************************
C
C
      SUBROUTINE PLOT_DIFF
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Plot difference map
C
C Author:  John W. Campbell, Jan 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'spot_box.finc'
      INCLUDE 'image.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'refine_params.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER IERR
      INTEGER IBUTTON
      INTEGER H
      INTEGER K
      INTEGER L
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER IX2PIX
      INTEGER IY2PIX
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER ITHRESH
      INTEGER IBG
      INTEGER NOVER
      INTEGER IVH
      INTEGER IVHLIST(2)
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER MAGUPD
      INTEGER IFLAG
      INTEGER ND
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IORD
      INTEGER ISWAP
      INTEGER IFTYPE
      REAL SPOTL
      REAL SPOTW 
      REAL SPOTB
      REAL X_C
      REAL Y_C
      REAL XFD 
      REAL YFD 
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL DX
      REAL DY
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL X_CEN
      REAL Y_CEN
      REAL OMEGA
      REAL XM
      REAL YM
      REAL CGX
      REAL CGY
      REAL SPOT_B
      REAL STHRESH
      REAL DEG_TO_RAD
      REAL COSOM
      REAL SINOM
      REAL ORIENT(3,3)
      REAL AMAT(3,3)
      REAL DELTA
      CHARACTER*20 NAMES(2)
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     INTEGER I            !Temp/loop variable
C     INTEGER IERR         !Error flag
C     INTEGER IBUTTON      !Button return from pop-up notice
C     INTEGER H            !Reflection h index
C     INTEGER K            !Reflection k index
C     INTEGER L            !Reflection l index
C     INTEGER IXPIX        !Nearest x pixel position of observed spot
C     INTEGER IYPIX        !Nearest y pixel position of observed spot
C     INTEGER ISPIX        !Pixel position along slow axis
C     INTEGER IFPIX        !Pixel position along fast axis
C     INTEGER IX2PIX       !X end of vector for difference vector
C     INTEGER IY2PIX       !Y end of vector for difference vector
C     INTEGER IXSIZ        !Half box x size for finding spot
C     INTEGER IYSIZ        !Half box y size for finding spot
C     INTEGER ITHRESH      !Threshold above background for finding spots
C     INTEGER IBG          !Background value at spot position
C     INTEGER NOVER        !No. of pixels in box above threshold
C     INTEGER IVH          !View-object handle returned from XDLF_GET_EVENTS
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER ITEM         !Menu item number selected
C     INTEGER IQUIT        !Menu selection quit flag
C     INTEGER MAGUPD       !Update magnifying window 1=yes, 0=no
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !Number of decimal places flag
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER IORD         !Data order flag
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER IFTYPE       !Image file type
C     REAL SPOTL           !Spot length
C     REAL SPOTW           !Spot width
C     REAL SPOTB           !Spot border
C     REAL X_C             !x_c value (mm)
C     REAL Y_C             !y_c value (mm)
C     REAL XFD             !X coordinate on detector (rast) (distort. corrected)
C     REAL YFD             !Y coordinate on detector (rast) (distort. corrected)
C     REAL MM_RAST_X       !Conversion mm to x-rasters
C     REAL MM_RAST_Y       !Conversion mm to y-rasters
C     REAL DX              !X offset for difference vector
C     REAL DY              !Y offset for difference vector
C     REAL X_CEN_F         !Uncorrected x centre in rasters
C     REAL Y_CEN_F         !Uncorrected y-centre in rasters
C     REAL X_CEN           !Corrected x centre in rasters
C     REAL Y_CEN           !Corrected y centre in rasters
C     REAL OMEGA           !Corrected omega in degrees
C     REAL XM              !Calculated x position of spot in rasters
C     REAL YM              !Calculated y position of spot in rasters
C     REAL CGX             !Found spot c_of_g x position
C     REAL CGY             !Found spot c_of_g y position
C     REAL SPOT_B          !Box size for normal or radially masked spots (mm)
C     REAL STHRESH         !Spot search threshold
C     REAL DEG_TO_RAD      !Conversion factor degrees to radians
C     REAL COSOM           !cos(omega)
C     REAL SINOM           !sin(omega)
C     REAL ORIENT(3,3)     !Orientation matrix
C     REAL AMAT(3,3)       !'A' matrix
C     REAL DELTA           !Spot separation delta
C     CHARACTER*20 NAMES(2) !Item names for menu
C     CHARACTER*2 VALSTR    !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR    !Error string (dummy)
C
      DATA NAMES/'Continue',' '/
      DATA DEG_TO_RAD/0.0174533/
C
C-------------------------------------------------------------------------------
C
C====== Get centre
C
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      IF (ISWAP.EQ.2) IORD = - IORD
      CALL LDM_GET_IMDAT (VALSTR, IFTYPE, IFLAG)
      IF (IFTYPE.EQ.1) THEN
         ITYPE = 1
      ELSE IF (IFTYPE.EQ.2) THEN
         ITYPE = 2
      ELSE IF (IFTYPE.EQ.3) THEN
         ITYPE = 4
      ELSE IF (IFTYPE.EQ.4) THEN
         ITYPE = 2
      END IF
      CALL LDM_GET_STHR (STHRESH, IFLAG, ND)
      CALL LDM_GET_SPOTD (IPACK, IPLATE, DELTA, IFLAG, ND, 
     +                       IERR, ERRSTR)
      CALL LRL_MK_ORIENT (ORIENT)
      CALL LRL_A_CALC (IPACK, ORIENT, AMAT)
      CALL CHK_OPN(IERR)
      IF (IERR.NE.0) RETURN
      CALL FILM_CENTRE(X_CEN_F,Y_CEN_F,OMEGA)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, IERR, ERRSTR)
      X_CEN = X_CEN_F + X_C*MM_RAST_X
      Y_CEN = Y_CEN_F + Y_C*MM_RAST_Y
      COSOM = COS(OMEGA*DEG_TO_RAD)
      SINOM = SIN(OMEGA*DEG_TO_RAD)
C
C====== Display image
C
      CALL SHOW_IMAGE (1, IERR)
      IF (IERR.EQ.1) RETURN
C
C====== Get box size for normal or radially streaked spots
C
      CALL LDM_GET_SPOTW (IPACK, IPLATE, SPOTW, IFLAG, ND, 
     +                       IERR, ERRSTR)
      IF (SPOTW.NE.0.0) THEN
         CALL LDM_GET_SPOTL (IPACK, IPLATE, SPOTL, IFLAG, ND, 
     +                       IERR, ERRSTR)
         CALL LDM_GET_SPOTB (IPACK, IPLATE, SPOTB, IFLAG, ND, 
     +                       IERR, ERRSTR)
         SPOT_B = SPOTL + (2.0 + SPOTB)/MM_RAST_X
      ELSE
         SPOT_B = SPOTBOX
      END IF
      IXSIZ = NINT(SPOT_B*MM_RAST_X/2.0)
      IF (IXSIZ.LE.0) IXSIZ = 1
      IYSIZ = NINT(SPOT_B*MM_RAST_Y/2.0)
      IF (IYSIZ.LE.0) IYSIZ = 1
C
C====== Get calculated positions & distance errors
C
      MAGUPD = 0
      DO 200 I = 1,NUM_REF_SPOTS
         H = NODAL_H_S(I)
         K = NODAL_K_S(I)
         L = NODAL_L_S(I)
         CALL LRL_CALC_POS(IPACK,IPLATE,X_CEN,Y_CEN,COSOM,SINOM,
     +                     AMAT,H,K,L,XFD,YFD,IERR)
         IXPIX = NINT(XM_OBS(I))
         IYPIX = NINT(YM_OBS(I))
         CALL SFPIX (IXPIX,IYPIX,ISPIX,IFPIX)
         CALL XDLF_BG_VALIMG(ISPIX,IFPIX,IMG_BG,ITYPE,NF_BGOFF,
     +                       NCMP,IBG, IERR)
         ITHRESH = IBG + NINT(STHRESH)
         IF (SPOTW.NE.0.0) THEN
            CALL SPOT_RADIAL (IXPIX, IYPIX, IXSIZ, IYSIZ, ISPOT_DATA, 
     +                        ISWORK, ITHRESH, IMG, ITYPE, IORD, 
     +                        NFRASTS, NXRAST, NYRAST,
     +                        X_CEN, Y_CEN, NOVER, 
     +                        CGX, CGY, IERR)
         ELSE
            CALL SPOT_C_OF_G (IXPIX, IYPIX, IXSIZ, IYSIZ, ISPOT_DATA, 
     +           ISWORK, ITHRESH, IMG, ITYPE, IORD, NFRASTS,
     +           NXRAST, NYRAST, NOVER, 
     +           CGX, CGY, IERR)
         END IF
         IF (NOVER.EQ.0.OR.IERR.GT.0) THEN
            CALL XDLF_IMAGE_SYMBOL(IVH_FILM,IXPIX,IYPIX,
     +                   24,1,1,IERR)
         ELSE
C
C====== See if still near old spot on film
C
            IF (  ((CGX-XM_OBS(I))/MM_RAST_X)**2
     +          + ((CGY-YM_OBS(I))/MM_RAST_Y)**2 
     +          .GT. DELTA**2) THEN
               CALL XDLF_IMAGE_SYMBOL(IVH_FILM,IXPIX,IYPIX,
     +                   24,1,1,IERR)
            ELSE
               CALL XDLF_IMAGE_SYMBOL(IVH_FILM,IXPIX,IYPIX,
     +                   22,5,1,IERR)
            END IF
         END IF
C
C====== Exaggerate vector by a factor of 25
C
         DX = 25.0*(XFD-XM_OBS(I))
         DY = 25.0*(YFD-YM_OBS(I))
         IX2PIX = NINT (XM_OBS(I)+DX)
         IY2PIX = NINT (YM_OBS(I)+DY)
         IF (I.EQ.NUM_REF_SPOTS) MAGUPD = 1
         CALL XDLF_IMAGE_VECT(IVH_FILM,1,IXPIX,IYPIX,
     +                        IX2PIX,IY2PIX,5,1,MAGUPD,IERR)
200   CONTINUE
C
C===== Get continue command from menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 1, XDLSTR(NAMES), 20,
     +     XDLSTR(' '), -1, XDLSTR(' '), -1, 0, IERR)
      IVHLIST(1) = IVH_MENU
      CALL XDLF_GET_EVENTS(1, IVHLIST, IVH)
      CALL XDLF_MENU_AREA_GETITEM(IVH_MENU, ITEM, IQUIT)
      CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
      CALL XDLF_DELETE_VIEW_OBJECT(IVH_FILM, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     PLOT_SYMBS         **
C****************************
C
C
      SUBROUTINE PLOT_SYMBS (IDISP, IMS)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Display symbols (predicted and matched) for matching option
C          or (predicted and selected) for select reflections option or
C          predicted positions only
C
C Author:  John W. Campbell, July 1991
C
C Arguments:
C
      INTEGER IDISP
      INTEGER IMS
C
C IDISP (R)   =0 display all reflns, =1 display selected nodals
C IMS   (R)   flag =1 match option
C                  =2 select reflections option
C                  =3 predicted reflections only
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'selrefs.finc'
      INCLUDE 'matches.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL SPAT
      LOGICAL NODFLG
      LOGICAL NODAL
      CHARACTER*80 STR
      INTEGER I
      INTEGER II
      INTEGER J
      INTEGER IERR
      INTEGER NOUT
      INTEGER IXPIX_TEMP(MAX_DISP)
      INTEGER IYPIX_TEMP(MAX_DISP)
      INTEGER ISYMB_TEMP(MAX_DISP)
      INTEGER ICOLR_TEMP(MAX_DISP)
      INTEGER IOVLY_TEMP(MAX_DISP)
      INTEGER JH, JK, JL
      INTEGER MULT
      INTEGER ISPOT
      INTEGER NUMSPOTS
      REAL ALAM 
      REAL DTHR2
      REAL XFD
      REAL YFD

C     LOGICAL SPAT         !Spatial overlap flag
C     LOGICAL NODFLG       !Nodal spot flag
C     LOGICAL NODAL        !Nodal spot flag
C     CHARACTER*80 STR     !Character string for messages
C     INTEGER I            !Temp/loop variable
C     INTEGER II           !Temp/loop variable
C     INTEGER J            !Temp/loop variable
C     INTEGER IERR         !Error return flag
C     INTEGER NOUT         !No. of symbols to output
C     INTEGER IXPIX_TEMP(MAX_DISP) !Temp array of symbol x pixels positions
C     INTEGER IYPIX_TEMP(MAX_DISP) !Temp array of symbol y pixels positions
C     INTEGER ISYMB_TEMP(MAX_DISP) !Temp array of symbol types
C     INTEGER ICOLR_TEMP(MAX_DISP) !Temp array of symbol colours
C     INTEGER IOVLY_TEMP(MAX_DISP) !Temp array of overlay types
C     INTEGER JH, JK, JL   !Reflection indices (predicted)
C     INTEGER MULT         !Multiplicity
C     INTEGER ISPOT        !Pointer to spot in LRL list
C     INTEGER NUMSPOTS     !No. of spots in generated spots list
C     REAL ALAM            !Lambda 
C     REAL DTHR2           !dmin-threshol**2
C     REAL XFD             !Predicted x position on detector
C     REAL YFD             !Predicted y position on detector
C
C-------------------------------------------------------------------------------
C
C====== Display predicted positions
C
      CALL LRL_NUMSPOTS (NUMSPOTS)
      NUM_DISP = 0
      IF (IDISP.EQ.0) THEN
         IF (NUMSPOTS.LE.0) THEN
            CALL ERR_NOTICE(0,'**No predicted spots**')
            RETURN
         END IF 
         NUM_DISP = NUMSPOTS
      ELSE
         IF (NUM_SELECT.LE.0) THEN
            CALL ERR_NOTICE(0,'**No selected reflections**')
            RETURN
         END IF
         NUM_DISP = NUM_SELECT
      END IF
      NOUT = 0
      DO 50 I=1,NUM_DISP
         IF (IDISP.EQ.0) THEN
            NODAL = .FALSE.
            ISPOT = I
            CALL LRL_GET (ISPOT, JH, JK, JL, XFD, YFD, ALAM, 
     +                    DTHR2, MULT, NODFLG, SPAT, IERR)
            NODAL = NODFLG
         ELSE
            ISPOT = SEL_REFS(I)
            CALL LRL_GET (ISPOT, JH, JK, JL, XFD, YFD, ALAM, 
     +                    DTHR2, MULT, NODFLG, SPAT, IERR)
            NODAL = .TRUE.
         END IF
         IREF_DISP(I)=ISPOT
         IXPIX_DISP(I)=NINT(XFD)
         IYPIX_DISP(I)=NINT(YFD)
         ISYMB_DISP(I)=1
         IF (NODAL) ISYMB_DISP(I)=2
         IF (IMS.NE.3.AND.NUM_MATCH.GT.0) THEN
            DO 10 II=1,NUM_MATCH
               IF (IREF_MATCH(II).EQ.ISPOT) GO TO 50
10          CONTINUE
         END IF
         NOUT = NOUT + 1
         IXPIX_TEMP(NOUT) = IXPIX_DISP(I)
         IYPIX_TEMP(NOUT) = IYPIX_DISP(I)
         ISYMB_TEMP(NOUT) = ISYMBTYP(ISYMB_DISP(I))
         ICOLR_TEMP(NOUT) = ICOLRTYP(ISYMB_DISP(I))
         IOVLY_TEMP(NOUT) = 1
50    CONTINUE

      IF (NOUT.GT.0) THEN
         CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NOUT,
     +                IXPIX_TEMP, IYPIX_TEMP,
     +                ISYMB_TEMP,ICOLR_TEMP,IOVLY_TEMP,0,
     +                IERR)
         IF (IERR.GT.0) THEN
            STR = '**Error code'
            CALL STR_ADDI(STR,IERR,1)
            CALL STR_ADDS(STR,'from xdl_view symbol plot routine**',1)
            CALL ERR_NOTICE(0,STR)
            RETURN
         END IF
      END IF

      IF (IMS.EQ.3) RETURN

      IF (NUM_MATCH.GT.0) THEN
         IF (NUM_MATCH.LT.10) THEN
            DO 100 I=1,NUM_MATCH
               CALL XDLF_IMAGE_SYMBOL(IVH_FILM,
     +             IXPIX_MATCH(I), IYPIX_MATCH(I),
     +             ISYMBTYP(3),ICOLRTYP(3),
     +             1, IERR)
               IF (IERR.GT.0) THEN
                  STR = '**Error code'
                  CALL STR_ADDI(STR,IERR,1)
                  CALL STR_ADDS(STR,
     +                 'from xdl_view symbol plot routine**',1)
                  CALL ERR_NOTICE(0,STR)
                  RETURN
               END IF
               IF (IMS.EQ.1) THEN
                  CALL XDLF_IMAGE_SYMBOL(IVH_FILM,
     +                IXSP_MATCH(I), IYSP_MATCH(I),
     +                ISYMBTYP(4),ICOLRTYP(4),
     +                2, IERR)
                  IF (IERR.GT.0) THEN
                     STR = '**Error code'
                     CALL STR_ADDI(STR,IERR,1)
                     CALL STR_ADDS(STR,
     +                    'from xdl_view symbol plot routine**',1)
                     CALL ERR_NOTICE(0,STR)
                     RETURN
                  END IF
               END IF
100         CONTINUE
         ELSE
           
            CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NUM_MATCH,
     +                IXPIX_MATCH, IYPIX_MATCH,
     +                ISYMBTYP(3),ICOLRTYP(3),1,1,
     +                IERR)
            IF (IERR.GT.0) THEN
               STR = '**Error code'
               CALL STR_ADDI(STR,IERR,1)
               CALL STR_ADDS(STR,
     +              'from xdl_view symbols plot routine**',1)
               CALL ERR_NOTICE(0,STR)
               RETURN
            END IF
            IF (IMS.EQ.1) THEN
               CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NUM_MATCH,
     +                   IXSP_MATCH, IYSP_MATCH,
     +                   ISYMBTYP(4),ICOLRTYP(4),2,1,
     +                   IERR)
               IF (IERR.GT.0) THEN
                  STR = '**Error code'
                  CALL STR_ADDI(STR,IERR,1)
                  CALL STR_ADDS(STR,
     +                 'from xdl_view symbols plot routine**',1)
                  CALL ERR_NOTICE(0,STR)
                  RETURN
               END IF
            END IF
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     PREPARE_REFIN      **
C****************************
C
C
      SUBROUTINE PREPARE_REFIN (IQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Some preparations before refinement
C          1) Select no. of refinement spots to be used
C          2) Calculate RMS deviation
C          3) Display pre-refinement difference vectors
C
C Author:  John W. Campbell, August 1991
C
C Arguments:
C
      INTEGER IQUIT
C
C IQUIT  (W)    Returns 0=OK, =1 error (quit refinement)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'refine_params.finc'
      INCLUDE 'image.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL DIFFPL
      INTEGER I
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IERR
      INTEGER IBUTTON
      INTEGER J
      INTEGER H
      INTEGER K
      INTEGER L
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER IX2PIX
      INTEGER IY2PIX
      INTEGER IVH
      INTEGER IVHLIST(2)
      INTEGER ITEM
      INTEGER MAGUPD
      INTEGER IFLAG
      INTEGER ND
      REAL SUMSQ
      REAL DIST2
      REAL DX
      REAL DY
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL X_CEN
      REAL Y_CEN
      REAL OMEGA
      REAL ORIENT(3,3)
      REAL AMAT(3,3)
      REAL DELTA
      REAL X_C 
      REAL Y_C 
      REAL XFD 
      REAL YFD  
      REAL COSOM 
      REAL SINOM 
      REAL MM_RAST_X
      REAL MM_RAST_Y
      CHARACTER*80 STR
      CHARACTER*20 NAMES(2)
      CHARACTER*2 ERRSTR

C
C     LOGICAL DIFFPL       !Difference plot required flag
C     INTEGER I            !Temp/loop variable
C     INTEGER IXROOT       !Root x position for view-object
C     INTEGER IYROOT       !Root y position for view-object
C     INTEGER IERR         !Error flag
C     INTEGER IBUTTON      !Button return from pop-up notice
C     INTEGER J            !Pointer to current reflection
C     INTEGER H            !Reflection h index
C     INTEGER K            !Reflection k index
C     INTEGER L            !Reflection l index
C     INTEGER IXPIX        !Nearest x pixel position of observed spot
C     INTEGER IYPIX        !Nearest y pixel position of observed spot
C     INTEGER IX2PIX       !X end of vector for difference vector
C     INTEGER IY2PIX       !Y end of vector for difference vector
C     INTEGER IVH          !View-object handle returned from XDLF_GET_EVENTS
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER ITEM         !Menu item number selected
C     INTEGER MAGUPD       !Update magnifying window 1=yes, 0=no
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     REAL SUMSQ           !Sum of square of obs-calc position differences
C     REAL DIST2           !Square of obs-calc distance
C     REAL DX              !X offset for difference vector
C     REAL DY              !Y offset for difference vector
C     REAL X_CEN_F         !Uncorrected x centre in rasters
C     REAL Y_CEN_F         !Uncorrected y-centre in rasters
C     REAL X_CEN           !Corrected x centre in rasters
C     REAL Y_CEN           !Corrected y centre in rasters
C     REAL OMEGA           !Corrected omega in degrees
C     REAL ORIENT(3,3)     !Orientation matrix
C     REAL AMAT(3,3)       !'A' matrix
C     REAL DELTA           !Spot separation delta
C     REAL X_C             !x_c value (mm)
C     REAL Y_C             !y_c value (mm)
C     REAL XFD             !X coordinate on detector (rast) (distort. corrected)
C     REAL YFD             !Y coordinate on detector (rast) (distort. corrected)
C     REAL COSOM           !cos(omega)
C     REAL SINOM           !sin(omega)
C     REAL MM_RAST_X       !Conversion mm to x-rasters
C     REAL MM_RAST_Y       !Conversion mm to y-rasters
C     CHARACTER*80 STR     !Temporary o/p message string
C     CHARACTER*20 NAMES(2) !Item names for menu
C     CHARACTER*2 ERRSTR    !Error string (dummy)
C
      DATA NAMES/'Continue Refinement',' '/
C
C-------------------------------------------------------------------------------
C
      DOUBLE PRECISION COSD, SIND
      EXTERNAL COSD, SIND
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LRL_MK_ORIENT (ORIENT)
      CALL LRL_A_CALC (IPACK, ORIENT, AMAT)
      CALL LDM_GET_SPOTD (IPACK, IPLATE, DELTA, IFLAG, ND, 
     +                       IERR, ERRSTR)
C
C====== Get no. of spots to use in refinement
C
      IF (NUM_OBS.EQ.0) THEN
         CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_IOW, 0,  0, IXROOT, IYROOT,
     +                                IERR)
         CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT,
     +             XDLSTR('**No spots in refinement list**'), 31,
     +             XDLSTR(' '), -1, XDLSTR('Continue'), 8,
     +             XDLSTR(' '), -1, IFONT, 0, IBUTTON)
         IQUIT = 1
         RETURN
      END IF
50    NUM_REF_SPOTS = NUM_OBS
      CALL IOW_ASKI (IVH_IOW, 'Number of spots to use in refinement',
     +               NUM_REF_SPOTS)
      IF (NUM_REF_SPOTS.LE.0) THEN
         CALL XDLF_IO_WINDOW_ROOTXY (IVH_IOW, IXROOT, IYROOT, IERR)
         CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT,
     +             XDLSTR('**Value must be greater than 0**'), 32,
     +             XDLSTR(' '), -1, XDLSTR('Continue'), 8,
     +             XDLSTR(' '), -1, IFONT, 1, IBUTTON)
         GO TO 50
      END IF
      NUM_REF_SPOTS = MIN(NUM_REF_SPOTS,NUM_OBS)
C
C====== Index reflections on hkl_key
C
      CALL INDXIV(HKL_KEY,NUM_OBS,REF_NODALS)
      CALL LFN_CLROBS
      DO 60 I = 1, NUM_OBS
         J = REF_NODALS(I)
         CALL LFN_ADDOBS (NODAL_H_S(J), NODAL_K_S(J), NODAL_L_S(J),
     +                    XM_OBS(J), YM_OBS(J), IERR)
         IF (IERR.GT.0) THEN
            CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT,
     +                XDLSTR('**Too many refinement observations**'),
     +                36, XDLSTR(' '), -1, XDLSTR('Continue'), 8,
     +                XDLSTR(' '), -1, IFONT, 0, IBUTTON)
            GO TO 70
         END IF            
60    CONTINUE
C
C====== Initialisations
C
70    SUMSQ = 0.0
C
C====== See if difference plot required
C
      DIFFPL = .FALSE.
      CALL IOW_ASKQ(IVH_IOW, 'Difference plot required', DIFFPL)
C
C====== Get centre
C
      CALL CHK_OPN (IERR)
      IF (IERR.EQ.1) THEN
         IQUIT = 1
         RETURN
      END IF
      CALL FILM_CENTRE(X_CEN_F,Y_CEN_F,OMEGA)
      COSOM = COSD(OMEGA)
      SINOM = SIND(OMEGA)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, IERR, ERRSTR)
      X_CEN = X_CEN_F + X_C*MM_RAST_X
      Y_CEN = Y_CEN_F + Y_C*MM_RAST_Y
C
C====== Display image for difference map plot if required
C
      IF (DIFFPL) THEN
         CALL SHOW_IMAGE (1, IERR)
         IF (IERR.EQ.1) THEN
            IQUIT = 1
            RETURN
         END IF
C
C====== Get calculated positions & distance errors
C
         MAGUPD = 0
         DO 200 I = 1,NUM_REF_SPOTS
            J = REF_NODALS(I)
            H = NODAL_H_S(J)
            K = NODAL_K_S(J)
            L = NODAL_L_S(J)
            CALL LRL_CALC_POS(IPACK,IPLATE,X_CEN,Y_CEN,COSOM,SINOM,
     +                        AMAT,H,K,L,XFD,YFD,IERR)
            IXPIX = NINT(XM_OBS(J))
            IYPIX = NINT(YM_OBS(J))
            DIST2 = (XFD-XM_OBS(J))**2 + (YFD-YM_OBS(J))**2
            SUMSQ = SUMSQ + DIST2
            IF (DIST2.GT.(MM_RAST_X*DELTA)**2) THEN
               CALL XDLF_IMAGE_SYMBOL(IVH_FILM,IXPIX,IYPIX,
     +                   4,1,1,IERR)
               CALL XDLF_IMAGE_SYMBOL(IVH_FILM,IXPIX,IYPIX,
     +                   14,1,1,IERR)
            ELSE
               CALL XDLF_IMAGE_SYMBOL(IVH_FILM,IXPIX,IYPIX,
     +                   24,5,1,IERR)
            END IF
C
C====== Exaggerate vector by a factor of 25
C
           DX = 25.0*(XFD-XM_OBS(J))
           DY = 25.0*(YFD-YM_OBS(J))
           IX2PIX = NINT (XM_OBS(J)+DX)
           IY2PIX = NINT (YM_OBS(J)+DY)
           IF (I.EQ.NUM_REF_SPOTS) MAGUPD = 1
           CALL XDLF_IMAGE_VECT(IVH_FILM,1,IXPIX,IYPIX,
     +                          IX2PIX,IY2PIX,5,1,MAGUPD,IERR)
200      CONTINUE
C
C===== Get continue command from menu
C
         CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 1, XDLSTR(NAMES), 20,
     +        XDLSTR(' '), -1, XDLSTR('Quit Refinement'), 
     +        15, 0, IERR)
         IVHLIST(1) = IVH_MENU
         CALL XDLF_GET_EVENTS(1, IVHLIST, IVH)
         CALL XDLF_MENU_AREA_GETITEM(IVH_MENU, ITEM, IQUIT)
         CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
         CALL XDLF_DELETE_VIEW_OBJECT(IVH_FILM, IERR)
         IF (IQUIT.EQ.1) RETURN
      ELSE
C
C====== Get calculated positions & distance errors
C
         DO 300 I = 1,NUM_REF_SPOTS
            J = REF_NODALS(I)
            H = NODAL_H_S(J)
            K = NODAL_K_S(J)
            L = NODAL_L_S(J)
            CALL LRL_CALC_POS(IPACK,IPLATE,X_CEN,Y_CEN,COSOM,SINOM,
     +                        AMAT,H,K,L,XFD,YFD,IERR)
            DIST2 = (XFD-XM_OBS(J))**2 + (YFD-YM_OBS(J))**2
            SUMSQ = SUMSQ + DIST2
300      CONTINUE
      END IF
C
C====== Calculate and save RMS
C
      RMS = SQRT(SUMSQ/NUM_REF_SPOTS)/MM_RAST_X
      OLD_RMS = RMS
      STR = 'RMS ='
      CALL STR_ADDF(STR, RMS, 3, 1)
      CALL STR_ADDS(STR, 'mm. for the', 1)
      CALL STR_ADDI(STR, NUM_REF_SPOTS, 1)
      CALL STR_ADDS(STR,'spots to be used for refining', 1)
      CALL LMESSAGE(IVH_IOW, STR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     READ_IMAGE       **
C**************************
C
C
      SUBROUTINE READ_IMAGE (ICNTXT, KIMG, MAXIMG, KTYPE, NF_OFF, KERR,
     +                       KERRSTR) 
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Read film/image-plate image and get default background
C
C Return:  Note: FILM_READ will be returned as .FALSE. if error in read 
C
C Author:  John W. Campbell, October 1994
C
C Arguments:
C
      INTEGER ICNTXT
      INTEGER KIMG(*)
      INTEGER MAXIMG
      INTEGER KTYPE
      INTEGER NF_OFF
      INTEGER KERR
      CHARACTER*(*) KERRSTR
C 
C ICNTXT  (R)   Context option = 0 normal calls from LAUEGEN
C                              = 1 call via auto-refinement routines
C                                  or command line input of soft limit requests
C                                  or command line input of spotsize 
C                                  or command line input of integration 
C                                  determination
C KIMG    (W)   Image array
C MAXIMG  (R)   Max allowed size of KIMG in words
C KTYPE   (W)   Returns image data storage type option 
C NF_OFF  (W)   Returns fast rasters offset between successive slow rasters
C KERR    (W)   Error return flag = 0 OK
C                                 = 1 Error
C KERRSTR (W)   Error string if KERR is non-zero (max 80 chars)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPBYT
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER NPBOX
      INTEGER IXR
      INTEGER IYR
      INTEGER IERR
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NXR
      INTEGER NYR
      INTEGER NS_RAS
      INTEGER NF_RAS
      INTEGER IFLAG
      INTEGER IFTYPE
      INTEGER IORD
      INTEGER ISWAP
      INTEGER NWORDS
      INTEGER NBW
      INTEGER IOPT
      INTEGER KORD
      INTEGER NXP
      INTEGER NYP
      INTEGER IP
      INTEGER IVBAR
      INTEGER LISTE(5)
      CHARACTER*2 VALSTR
      CHARACTER*80 STR
      CHARACTER*2 ERRSTR
C
C     INTEGER NPBOX        !Box size in pixels for background strip calcn
C     INTEGER IXR          !Root x position for read image progress bar
C     INTEGER IYR          !Root y position for read image progress bar
C     INTEGER IERR         !Error flag
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER NXR          !No. x-rasters returned from 'mar' file
C     INTEGER NYR          !No. y-rasters returned from 'mar' file
C     INTEGER NS_RAS       !No. slow rasters
C     INTEGER NF_RAS       !No. fast rasters
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER IFTYPE       !Image type flag
C     INTEGER IORD         !Axis order flag
C     INTEGER ISWAP        !Byte sawp flag
C     INTEGER NWORDS       !No. words required for full image
C     INTEGER NBW          !No. bytes/word
C     INTEGER IOPT         !Background option flag
C     INTEGER KORD         !Order flag for reading data
C     INTEGER NXP          !Minimum image compression required along x
C     INTEGER NYP          !Minimum image compression required along y
C     INTEGER IVBAR        !Handle for progress bar; 0 if not required
C     INTEGER IP           !Count of parameters to update
C     INTEGER LISTE(5)     !List of parameter table entries to be updated
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*80 STR     !Character string for messages
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
      KERR = 0
      KERRSTR = ' '
      CALL LDM_GET_IMDAT (VALSTR, IFTYPE, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      KORD = 1
      IF (ISWAP.EQ.2) KORD = -1
      IF (ICNTXT.EQ.0) THEN 
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE(IVH_IOW,
     +                 '===Reading image data now===')
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE('===Reading image data now===')
         END IF
      END IF
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      IF (.NOT.CCPBYT(NBW)) THEN
         IF (IFTYPE.GE.1.AND.IFTYPE.LE.4) THEN
            IF (ICNTXT.EQ.0) CALL LOG_MSG (IVH_IOW,
     +                   '**Error** Byte handling not available',1)
            FILM_READ = .FALSE.
            KERR = 1
            KERRSTR = 'Byte handling not available'
            RETURN
         END IF
      END IF
      NWORDS = ((NXRAST*NYRAST) + NBW - 1)/NBW
      IF (NWORDS.GT.MAXIMG) THEN
         IF (ICNTXT.EQ.0) CALL LOG_MSG (IVH_IOW,
     +              '**Error** Image too big for program',1)
         FILM_READ = .FALSE.
         KERR = 1
         KERRSTR = 'Image too big for program'
         RETURN
      END IF
      
      NXP = (NXRAST + MAX_DISP_WIDTH - 1)/MAX_DISP_WIDTH
      NYP = (NYRAST + MAX_DISP_HEIGHT - 1)/MAX_DISP_HEIGHT
      NCMP = MAX(NXP,NYP)
      IXR = 0
      IYR = 0
      IVBAR = 0
      IF (LG_MODE.EQ.1) THEN
         IF (ICNTXT.EQ.1) THEN
            CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_CMD,8,35,
     +                                    IXR,IYR,IERR)
         ELSE
            CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,IXR,IYR,IERR)
         END IF
         IVBAR = IVH_BAR
      END IF
      IF (IFTYPE.EQ.1) THEN
         CALL XDLF_READ_FULL_FILM(IFD,KORD,NXRAST,NYRAST,
     +                     IVBAR,IXR,IYR,KIMG,IERR)
         IF (IERR.GT.0) THEN
            STR = '**Error** Error in reading record'
            CALL STR_ADDI(STR,IERR,1)
            IF (ICNTXT.EQ.0) CALL LOG_MSG(IVH_IOW,STR,1)
            FILM_READ = .FALSE.
            KERR = 1
            KERRSTR = STR
            RETURN
         END IF
         KTYPE = 1
         MINVAL = 0
         MAXVAL = 255
         MINTHR = 0
         MAXTHR = 255
         ICONTRAST = 1024
      ELSE IF (IFTYPE.EQ.2) THEN
         CALL XDLF_READ_FULL_I2(IFD,KORD,NXRAST,NYRAST,
     +                          IVBAR,IXR,IYR,KIMG,
     +                          MINVAL,MAXVAL,IERR)
         IF (IERR.GT.0) THEN
            STR = '**Error** Error in reading record'
            CALL STR_ADDI(STR,IERR,1)
            IF (ICNTXT.EQ.0) CALL LOG_MSG(IVH_IOW,STR,1)
            FILM_READ = .FALSE.
            KERR = 1
            KERRSTR = STR
            RETURN
         END IF
         KTYPE = 2
         MINTHR = 0
         MAXTHR = MAXVAL/20
         ICONTRAST = 1024
      ELSE IF (IFTYPE.EQ.3) THEN
         CALL XDLF_RDSQUASH_MAR (IFD,IVBAR,IXR,IYR,KIMG,
     +                           NXR,NYR,NS_RAS,NF_RAS,
     +                           MINVAL,MAXVAL,IERR)
         IF (IERR.GT.0) THEN
            STR = '**Error** Error in reading record'
            CALL STR_ADDI(STR,IERR,1)
            IF (ICNTXT.EQ.0) CALL LOG_MSG(IVH_IOW,STR,1)
            FILM_READ = .FALSE.
            KERR = 1
            KERRSTR = STR
            RETURN
         END IF
         KTYPE = 4
         MINTHR = 0
         MAXTHR = MAXVAL/20
         ICONTRAST = 1024
         IP = 0
         IF (NXR.NE.NXRAST) THEN
            NXRAST = NXR
            CALL LDM_SET_NXRAS (NXR, IERR, ERRSTR)
            IP = IP + 1
            LISTE(IP) = IP_NXRAST
         END IF
         IF (NYR.NE.NYRAST) THEN
            NYRAST = NYR
            CALL LDM_SET_NYRAS (NXR, IERR, ERRSTR)
            IP = IP + 1
            LISTE(IP) = IP_NYRAST
         END IF
         IF (IORD.NE.3) THEN
            IORD = 3
            CALL LDM_SET_AXORD ('-xy',IERR,ERRSTR)
            IP = IP + 1
            LISTE(IP) = IP_AXORD
         END IF
         IF (IP.GT.0.AND.LG_MODE.EQ.1) THEN
             CALL SET_PAR1_VALS (IP, LISTE)
         END IF
         NWORDS = ((NXRAST*NYRAST) + NBW - 1)/NBW
         IF (NWORDS.GT.MAXIMG) THEN
            IF (ICNTXT.EQ.0) CALL LOG_MSG (IVH_IOW,
     +                 '**Error** Image too big for program',1)
            FILM_READ = .FALSE.
            KERR = 1
            KERRSTR = 'Image too big for program'
            RETURN
         END IF
      
         NXP = (NXRAST + MAX_DISP_WIDTH - 1)/MAX_DISP_WIDTH
         NYP = (NYRAST + MAX_DISP_HEIGHT - 1)/MAX_DISP_HEIGHT
         NCMP = MAX(NXP,NYP)
      ELSE IF (IFTYPE.EQ.4) THEN
         CALL XDLF_READ_PFBYTE (IFD,KORD,NXRAST,NYRAST,
     +                          IVBAR,IXR,IYR,KIMG, IERR)
         IF (IERR.GT.0) THEN
            STR = '**Error** Error in reading record'
            CALL STR_ADDI(STR,IERR,1)
            IF (ICNTXT.EQ.0) CALL LOG_MSG(IVH_IOW,STR,1)
            FILM_READ = .FALSE.
            KERR = 1
            KERRSTR = STR
            RETURN
         END IF
         KTYPE = 2
         MINVAL = 0
         MAXVAL = 10000
         MINTHR = 0
         MAXTHR = MAXVAL/20
         ICONTRAST = 1024
      ELSE
         FILM_READ = .FALSE.
         KERR = 1
         KERRSTR = 'Invalid image file type'
         RETURN
      END IF
      IF (NCMP.GT.1.AND.LG_MODE.EQ.1.AND.ICNTXT.EQ.0) THEN
         STR = '*Image will be compressed by'
         CALL STR_ADDI(STR,NCMP,1)
         CALL STR_ADDS(STR,'to 1 for display*',1)
         CALL LMESSAGE(IVH_IOW,STR)
      END IF
      IF (ICNTXT.EQ.0) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE(IVH_IOW,
     +         '===Calculating default radial background now===')
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE
     +        ('===Calculating default radial background now===')
         END IF
      END IF
      IF (IORD.LT.5) THEN      
         NSRASTS = NXRAST
         NFRASTS = NYRAST
         IOPT = 2
      ELSE
         NSRASTS = NYRAST
         NFRASTS = NXRAST
         IOPT = 1
      END IF
      NF_OFF = NFRASTS
      NPBOX = 2 * ((NFRASTS/NCMP)/50) + 1
      CALL XDLF_BG_STRIP(IMG,KTYPE,NSRASTS,NFRASTS,NFRASTS,NCMP,
     +                   NPBOX,50,IOPT,IBGAVE,NBG,IERR)
      CALL XDLF_BG_RADIMG(KTYPE,NSRASTS/NCMP,NFRASTS/NCMP,NFRASTS/NCMP,
     +                    IBGAVE,NBG,IMG_BG,IERR)
      NF_BGOFF = NFRASTS/NCMP
      IF (ICNTXT.EQ.0) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE(IVH_IOW,'===Done===')
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE ('===Done===')
         END IF
      END IF
      FILM_READ = .TRUE.
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     READ_PAR_FILE    **
C**************************
C
C
      SUBROUTINE READ_PAR_FILE (OPENED, PFIL)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Read in parameters (.gen) file
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      LOGICAL OPENED
      CHARACTER*(*) PFIL

C OPENED    (R)  File already opened (on unit IUN_GEN) flag. If false then
C                request file name from main i/o window
C PFIL      (R)  Name of file if OPENED = .TRUE. otherwise may be blank
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'gnom_rmin.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'cell_input.finc'
      INCLUDE 'spot_box.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'spot_sizes.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL EXISTS
      LOGICAL EOF
      LOGICAL NONLDM
      LOGICAL IDUM_PRF_ROT
      INTEGER I
      INTEGER IERR
      INTEGER KFLAG
      INTEGER INDIRECT
      INTEGER IFAIL
      INTEGER LISTE (2)
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER IFLAG
      INTEGER ND
      INTEGER IMTYP
      INTEGER IDUM_NPROF
      REAL RDUM_PROMIN
      CHARACTER*2 VALSTR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) PAR_FILE
      CHARACTER*120 STR
      CHARACTER*80 ERRSTR
      CHARACTER*80 BADTOK
      CHARACTER*250 LIN

C     LOGICAL EXISTS          !File exists flag
C     LOGICAL EOF             !End of file flag
C     LOGICAL NONLDM          !Non LDM data found flag
C     LOGICAL IDUM_PRF_ROT    !Dummy rotate profiles flag
C     INTEGER I               !Temp/loop variable
C     INTEGER IERR            !Error flag
C     INTEGER KFLAG           !Flag from LDM_PARSE routine
C     INTEGER INDIRECT        !Indirection level counter for file reads
C     INTEGER IFAIL           !File open error flag
C     INTEGER NE              !No. entries to update in parameter table 1
C     INTEGER LISTE (2)       !List of entries to update (dummy)
C     INTEGER NVIEW           !No. of view-object for getting events
C     INTEGER IVHLIST(2)      !List of view-object handles for getting events
C     INTEGER IVH             !Returned view-object handle from getting events
C     INTEGER IFLAG           !Parameter status flag
C     INTEGER ND              !Number of decimal places flag
C     INTEGER IMTYP           !Image type flag (LDM)
C     INTEGER IDUM_NPROF      !Dummy value for NPROF (not used by LAUEEGEN)
C     REAL RDUM_PROMIN        !Dummy value for PROMIN (not used by LAUEEGEN)
C     CHARACTER*2 VALSTR      !Parameter value string (dummy)
C     CHARACTER*(MAXFLEN) FILNAM   !Temp file name
C     CHARACTER*(MAXFLEN) PAR_FILE !Parameters file name
C     CHARACTER*120 STR            !Message string
C     CHARACTER*80 ERRSTR          !Error string
C     CHARACTER*80 BADTOK          !Bad token string
C     CHARACTER*250 LIN            !Input line from file
C
C
C-------------------------------------------------------------------------------
C
      PAR_FILE = PFIL
      IF (OPENED) GO TO 110
C
C====== Read in file name
C
100   CALL LPROMPT (IVH_IOW, 'File name (default ext=.ldm): ')       
      NVIEW = 1
      IVHLIST(1) = IVH_IOW
      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +     MAXFLEN, IERR)
      IF (FILNAM.EQ.' ') RETURN
      CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
      EXISTS = CCPEXS (PAR_FILE)
      IF (.NOT.EXISTS) THEN
         CALL LMESSAGE (IVH_IOW, '**File not found**')
         GO TO 100
      END IF
      IFAIL = 1
      CALL CCPDPN (-IUN_GEN, PAR_FILE, 'READONLY', 'F', 0, IFAIL)
      IF (IFAIL.LT.0) THEN
         CALL LMESSAGE (IVH_IOW, '**Error in opening file**')
         GO TO 100
      END IF
C
C====== Reset some default flags
C
110   IPACK = 1
      IPLATE = 1
      FILM_READ = .FALSE.
      FILM_OPEN = .FALSE.
      IPACK_OPN = 0
      IPLATE_OPN = 0
C
C====== Reset default LDM parameters
C
      CALL LDM_RESET (' ', 0, 0, IERR, ERRSTR)
C
C====== Log name of parameters file
C
      IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG, 1010) PAR_FILE(1:LENSTR(PAR_FILE))
      END IF
C
C====== Read in parameters file
C
      NONLDM = .FALSE.
      INDIRECT = 0
150   CALL LDM_READLINE (IUN_GEN, 10, INDIRECT, LIN, EOF, IERR)
      IF (EOF) GO TO 200
      IF (IERR.GT.0) THEN
         STR = '**Error** LDM_READLINE error, ierr='
         CALL STR_ADDI (STR,IERR,0)
         CALL LMESSAGE(IVH_IOW, STR)
         GO TO 200
      END IF
      CALL LDM_PARSE (LIN, KFLAG, BADTOK, ERRSTR)
      IF (KFLAG.LT.0) THEN
         CALL LMESSAGE (IVH_IOW, '**Error** LDM_PARSE error')
         STR = 'Line:'
         CALL STR_ADDS (STR, LIN, 1)
         CALL LMESSAGE (IVH_IOW, STR)
         STR = 'Bad token:'
         CALL STR_ADDS (STR, BADTOK, 1)
         CALL LMESSAGE (IVH_IOW, STR)
         STR = 'Error message:'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL LMESSAGE (IVH_IOW, STR)
         GO TO 150
      END IF
      IF (KFLAG.EQ.1) NONLDM = .TRUE.
      GO TO 150
C
C====== End of file (or fatal error)
C
200   IF (NONLDM) CALL LMESSAGE (IVH_IOW, 
     +            '*Warning* Non-LDM data present')
C
C====== Save input values of cell parameters and reset to be consistent with
C====== crystal system
C
      CALL LDM_GET_A (CELL_INPUT(1), IFLAG, ND)
      CALL LDM_GET_B (CELL_INPUT(2), IFLAG, ND)
      CALL LDM_GET_C (CELL_INPUT(3), IFLAG, ND)
      CALL LDM_GET_ALPHA (CELL_INPUT(4), IFLAG, ND)
      CALL LDM_GET_BETA (CELL_INPUT(5), IFLAG, ND)
      CALL LDM_GET_GAMMA (CELL_INPUT(6), IFLAG, ND)
      CALL RESET_CELL
      CALL LDM_CH_RESET(0)
C
C====== Update parameter tables
C
      CALL SET_PAR1_VALS (0, LISTE)
      CALL SET_PAR2_VALS (0, LISTE)
      CLOSE (IUN_GEN)
C
C====== Set default spot search box
C
      SPOT_INPUT_BOX = 1.0
C
C====== Reset gnomonic radius to 0.0 (undefined)
C
      GNOMR = 0.0
C
C====== Reset default soft limit determination parameters
C
      CALL LFN_SOFT_DF (1, MAX_SOFT_BINS,  IDUM_NPROF, IDUM_PRF_ROT,
     +                 RDUM_PROMIN, SOFT_FRAC, 
     +                 SOFT_SIGTEST, SOFT_FRTEST,
     +                 ISOFT_D_NUMBINS, SOFT_DMIN_WIDTH)
      CALL LFN_SOFT_DF (2,  MAX_SOFT_BINS, IDUM_NPROF, IDUM_PRF_ROT,  
     +                 RDUM_PROMIN, SOFT_FRAC, 
     +                 SOFT_SIGTEST, SOFT_FRTEST,
     +                 ISOFT_L_NUMBINS, SOFT_LMIN_WIDTH)
C
C====== Reset default spot size determiantion parameters
C
      CALL SPOTSIZE_DFLTS (ISPOT_NBIN, SPOT_SDCUT, SPOT_THRFAC,
     +                        SPOT_EXPAND)
C
C====== Clear LIRL & integration flags
C
      CALL INIT_LIRL
      RETURN
C
C====== Format statements
C
1000  FORMAT(A)
1010  FORMAT(/,'Reading New LDM Parameters File',/,
     +         '===============================',//,
     +         'Name of file: ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     REFIN_AUT        **
C**************************
C
C
      SUBROUTINE REFIN_AUT (ISOLN)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Re-refine a stored auto-indexing solution
C
C Author:  J.W. Campbell (based on INDEXL code by M. Elder)
C
C Arguments:
C
      INTEGER ISOLN
C
C ISOLN  (R)  Number of the solution to be re-refined
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'lauegen_auto_params.finc'
C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      INTEGER I
      INTEGER K
      INTEGER NOBS
      INTEGER IDET
      INTEGER IHKL(3,MAX_AUTO_SPOTS)
      INTEGER ITCNT
      INTEGER IDIR
      INTEGER ITIM
      REAL RMSD
      REAL DEV
      REAL DEVSAV
      REAL SOL(3,3)
      REAL NEWSOL(3,3)
      REAL ADJ
      REAL ANG(3)
      REAL XC(5,MAX_AUTO_SPOTS)
      CHARACTER*80 STR

C     INTEGER I            !Temp/loop variable
C     INTEGER K            !Temp/loop variable
C     INTEGER NOBS         !No. of observations for evaluating orientation
C                           and missetting angles
C     INTEGER IDET         !Error flag from EVANGL
C     INTEGER IHKL(3,MAX_AUTO_SPOTS)           !Indices of reflections used
C                                               for evaluating orientation
C     INTEGER ITCNT        !Iteration count for refining angles
C     INTEGER IDIR         !Refinement flag
C     INTEGER ITIM         !Refinement flag
C     REAL RMSD            !Rms deviation
C     REAL DEV             !Current rms deviation for solution
C     REAL DEVSAV          !Saved value of DEV from previous iteration
C     REAL SOL(3,3)        !Rotation matrix
C     REAL NEWSOL(3,3)     !New rotation matrix
C     REAL ADJ             !Adjustment step for refining angles
C     REAL ANG(3)          !Current values of missetting angles
C     REAL XC(5,MAX_AUTO_SPOTS)                !Positions of reflections used
C                                               for evaluating orientation
C                                               (observed and calculated)
C     CHARACTER*80 STR     !String for output messages
C
C-------------------------------------------------------------------------------
C
      NOBS = STNOBS(ISOLN)
      DO 100 I = 1 , NOBS
         IHKL(1,I) = STHKL(ISOLN,1,I)
         IHKL(2,I) = STHKL(ISOLN,2,I)
         IHKL(3,I) = STHKL(ISOLN,3,I)
         XC(1,I) = STXC(ISOLN,1,I)
         XC(2,I) = STXC(ISOLN,2,I)
 100  CONTINUE

      CALL EVANGL(NOBS,IHKL,XC,ANG,RMSD,DEV,SOL,IDET)

      IF (IDET.EQ.2) THEN
         CALL LMESSAGE(IVH_IOW_AUT,'**Cannot refine**')
         RETURN
      END IF
C
C====== Set angles to current refined values
C
      ANG(1) = STANG(ISOLN,1)
      ANG(2) = STANG(ISOLN,2)
      ANG(3) = STANG(ISOLN,3)
C
C====== Perform refinement of angles
C
      ADJ = DEV/20.
      ITCNT = 0
 270  DO 290 K = 1 , 4
         I = K
         IF (I.GT.3) I = I - 3
         IDIR = 1
         ITIM = 0
 280     DEVSAV = DEV
         ITIM = ITIM + 1
         ANG(I) = ANG(I) - ADJ*(IDIR-2)
         CALL EROTMT(ANG,NEWSOL,SOL,RMSD)
         CALL EVCOOR(NEWSOL,XC,DEV,NOBS,IDET)
         ITCNT = ITCNT + 1
         IF (ITCNT.GE.100) GO TO 300
         IF (DEV.LT.DEVSAV) GO TO 280
         ANG(I) = ANG(I) + ADJ*(IDIR-2)
         DEV = DEVSAV
         IF (ITIM.LE.1) THEN
            IF (IDIR.LE.1) THEN
               IDIR = 3
               ITIM = 0
               GO TO 280
            END IF
         END IF
 290  CONTINUE
      IF (ADJ.LT.0.02) GO TO 300
      ADJ = ADJ/5.
      GO TO 270
 
 300  STR = 'Starting PhiX ='
      CALL STR_ADDF(STR,STANG(ISOLN,1),2,1)
      CALL STR_ADDS(STR,', PhiY =',0)
      CALL STR_ADDF(STR,STANG(ISOLN,2),2,1)
      CALL STR_ADDS(STR,', PhiZ =',0)
      CALL STR_ADDF(STR,STANG(ISOLN,3),2,1)
      CALL LMESSAGE(IVH_IOW_AUT,STR)
      STANG(ISOLN,1) = ANG(1)
      STANG(ISOLN,2) = ANG(2)
      STANG(ISOLN,3) = ANG(3)
      STR = 'Refined  PhiX ='
      CALL STR_ADDF(STR,STANG(ISOLN,1),2,1)
      CALL STR_ADDS(STR,', PhiY =',0)
      CALL STR_ADDF(STR,STANG(ISOLN,2),2,1)
      CALL STR_ADDS(STR,', PhiZ =',0)
      CALL STR_ADDF(STR,STANG(ISOLN,3),2,1)
      CALL LMESSAGE(IVH_IOW_AUT,STR)
      STR = 'rms deviation ='
      CALL STR_ADDF(STR,DEV,3,1)
      CALL STR_ADDS(STR,'from',1)
      CALL STR_ADDF(STR,STDEV(ISOLN),3,1)
      CALL LMESSAGE(IVH_IOW_AUT,STR)
      STDEV(ISOLN) = DEV
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     REFINE_CALC      **
C**************************
C
C
      SUBROUTINE REFINE_CALC
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Refine setting & cell parameters
C
C Author:  John W. Campbell, September 1993
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'refine_params.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL ACCEPT
      LOGICAL DIFPLT
      LOGICAL RERUN
      INTEGER IFLAG(7)
      INTEGER JFLAG(6)
      INTEGER KFLAG(6)
      INTEGER IFCELL
      INTEGER IQUIT
      INTEGER IERR
      INTEGER IFL
      INTEGER NE
      INTEGER LISTE(10)
      INTEGER ND
      INTEGER KERR
      REAL    OMEGA
      REAL    X_CEN_F
      REAL    Y_CEN_F
      REAL    X_C
      REAL    Y_C
      REAL    TUNE(3)
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*80 MESSAGE
      CHARACTER*80 STR
C
C     LOGICAL ACCEPT                 !Accept refined parameters flag
C     LOGICAL DIFPLT                 !Output difference plot flag
C     LOGICAL RERUN                  !Rerun refinement immediately flag
C     INTEGER IFLAG(7)               !Flags of general parameters selected for
C                                     refinement 1=yes, 0=no
C     INTEGER JFLAG(6)               !Flags of cell parameters to be refined
C     INTEGER KFLAG(6)               !Flags of distortion parameters to be
C                                     refined
C     INTEGER IFCELL                 !Flag if cell to be refined 1=yes, 0=no
C     INTEGER IQUIT                  !Quit flag
C     INTEGER IERR                   !Error flag
C     INTEGER IFL                    !Return flag from refinement routines
C     INTEGER NE                     !No. entries to update in parameter tables
C     INTEGER KERR                   !Error flag
C     INTEGER LISTE(10)              !List of param entries to update
C     INTEGER ND                     !No. of decimal places flag
C     REAL    TUNE(3)                !Refinement tuning parameters
C     REAL    OMEGA                  !Corrected omega (degrees)
C     REAL    X_CEN_F                !x centre from fids or input (rasters)
C     REAL    Y_CEN_F                !y centre from fids or input (rasters)
C     REAL    X_C                    !x_c value (mm)
C     REAL    Y_C                    !y_c value (mm)
C     CHARACTER*2 VALSTR             !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR             !Error string (dummy)
C     CHARACTER*80 MESSAGE           !Message from refinement routine
C     CHARACTER*80 STR               !Temporary string
C
C     
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      IRFN_TYP = 1
      LSR_SHFLM = 0.001
      LSR_DSTEP = 1.0D-6
      LSR_DAMP = 0.5
      POWELL_ACC = 0.000001
      CALL FILM_CENTRE(X_CEN_F,Y_CEN_F,OMEGA)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, KERR, ERRSTR)
C
C====== Get parameters to be refined
C
1     CALL GET_REFPARS (IFLAG, JFLAG, KFLAG, IFCELL, IQUIT)
      IF (IQUIT.EQ.1) RETURN
      IF (IRFN_TYP.EQ.1) THEN
         TUNE(1) = LSR_SHFLM 
         TUNE(2) = LSR_DSTEP
         TUNE(3) = LSR_DAMP
      ELSE
         TUNE(1) = POWELL_ACC
         POWELL_ACC = 0.000001
      END IF
      CALL LDM_SAVERP (IPACK, IPLATE)
      CALL LFN_RFN (IPACK, IPLATE, IFLAG, JFLAG, KFLAG, 
     +              X_CEN_F, Y_CEN_F,
     +              IRFN_TYP, TUNE, RMS, IERR, MESSAGE)
      CALL LMESSAGE (IVH_IOW, MESSAGE)
C
C====== Output refined parameters
C
      CALL LFN_SHOW_XDL (IVH_IOW, IPACK, IPLATE, RMS, OLD_RMS)
C
C====== Log refined parameters if required
C
      IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG,'('' '')')
         STR = 'Refinement for pack'
         CALL STR_ADDI (STR, IPACK, 1)
         CALL STR_ADDS (STR, ', plate', 0)
         CALL STR_ADDI (STR, IPLATE, 1)
         WRITE (IUN_LOG, '(A)') STR(1:LENSTR(STR))
         CALL LFN_SHOWREF (IUN_LOG, 0, IPACK, IPLATE, RMS, OLD_RMS)
      END IF
C
C====== See if difference plot required
C
      DIFPLT = .FALSE.
      CALL IOW_ASKQ(IVH_IOW,'Display difference plot',DIFPLT)
      IF (DIFPLT) THEN
         CALL PLOT_DIFF
         ACCEPT = .TRUE.
         CALL IOW_ASKQ(IVH_IOW, 'Accept refined parameters', ACCEPT)
         IF (.NOT.ACCEPT) THEN
            CALL LDM_RESTRP (IPACK, IPLATE)
            RERUN = .FALSE.
            CALL IOW_ASKQ(IVH_IOW,
     +                     'Continue refinement with current spots',
     +                     RERUN)
            IF (RERUN) GO TO 1
            RETURN
         END IF
      ELSE
         ACCEPT = .TRUE.
         CALL IOW_ASKQ(IVH_IOW, 'Accept refined parameters', ACCEPT)
         IF (ACCEPT) THEN
            CALL LDM_SET_RFL (IPACK, IPLATE, 1, IERR, ERRSTR)
         ELSE
            CALL LDM_RESTRP (IPACK, IPLATE)
C
C====== See if immediate rerun required
C
            RERUN = .FALSE.
            CALL IOW_ASKQ(IVH_IOW,
     +              'Continue refinement with current spots',
     +              RERUN)
            IF (RERUN) GO TO 1
            RETURN
         END IF
      END IF
C
C====== Refined parameters accepted, update parameter tables
C
      IF (IFCELL.EQ.1) CALL RESET_CELL
      NE = 0
      NE = NE + 1
      LISTE(NE) = IP_PHIX
      NE = NE + 1
      LISTE(NE) = IP_PHIY
      NE = NE + 1
      LISTE(NE) = IP_PHIZ
      NE = NE + 1
      LISTE(NE) = IP_A
      NE = NE + 1
      LISTE(NE) = IP_B
      NE = NE + 1
      LISTE(NE) = IP_C
      NE = NE + 1
      LISTE(NE) = IP_ALPH
      NE = NE + 1
      LISTE(NE) = IP_BETA
      NE = NE + 1
      LISTE(NE) = IP_GAMM
      CALL SET_PAR1_VALS (NE, LISTE)
      CALL SET_PAR2_VALS (0, LISTE)
C
C====== Update other packs/plates if required
C
      CALL OTHER_REFPARS (IPACK, IPLATE, IFLAG, KFLAG)
C
C====== Save old rms value
C               
      OLD_RMS = RMS
C
C====== See if immediate rerun required
C
      RERUN = .FALSE.
      CALL IOW_ASKQ(IVH_IOW,'Continue refinement with current spots',
     +              RERUN)
      IF (RERUN) GO TO 1
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     REFINE_PROGRESS     **
C*****************************
C
C
      SUBROUTINE REFINE_PROGRESS (IUN_LOG, ISTAGE, IPACK, IPLATE, IGEN,
     +                         NSEARCH, NOBS, OLD_RMS, RMS, RFMSG,
     +                         IFLAG, JFLAG, KFLAG)
C
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Log auto-refinement results 
C
C Author:  John W. Campbell, October 1994
C
      INTEGER IUN_LOG
      INTEGER ISTAGE
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IGEN
      INTEGER NSEARCH
      INTEGER NOBS
      REAL    OLD_RMS
      REAL    RMS
      CHARACTER*(*) RFMSG
      INTEGER IFLAG(*)
      INTEGER JFLAG(*)
      INTEGER KFLAG(*)
C
C Parameters as for LFN_REFN_LOG
C
C IUN_LOG     i  (R)  Unit number for log file as passed to LFN_AUTO_REFN
C ISTAGE      i  (R)  Refinement stage to be logged (ipack, iplate are
C                     always passed unless ISTAGE is 0 or 8; other 
C                     parameters which need to be set for a particular 
C                     stage are shown in brackets):
C 

C                     = 0  Main heading for auto 
C                          refinement
C                     = 1  Current pack/plate 
C                     = 2  'INITIAL SEARCH' phase started
C                     = 3  Start image read
C                     = 4  End image read
C                     = 5  Start spots list generation
C                     = 6  End spots list generation
C                     = 7  Spot generation results
C                          (IGEN)
C                     = 8  Start spots search
C                     = 9  End spots search
C                     = 10 Initial spot search results 
C                          for the current plate
C                          (NSEARCH, NOBS, RMS)
C                     = 11 Other spot search results  
C                          (NSEARCH, NOBS, RMS)
C                     = 12 'INITIAL REFINEMENT' phase
C                           started 
C                     = 13 List of parameters to be
C                          refined (IFLAG, JFLAG,
C                          KFLAG)
C                     = 14 Start refinement cycle
C                     = 15 End refinement cycle
C                     = 16 Refinement results except
C                          for last cycle.
C                          (NOBS, OLD_RMS, RMS,
C                          RFMSG, IFLAG, JFLAG, 
C                          KFLAG)
C                     = 17 Refinement results for 
C                          last cycle.
C                          (NOBS, OLD_RMS, RMS,
C                          RFMSG, IFLAG, JFLAG, 
C                          KFLAG)
C                     = 18 'MAIN REFINEMENT' phase
C                     = 19 'FINAL REFINEMENT' phase
C                     = 20  Refinement completed
C
C IPACK       i  (R)  Current pack number
C IPLATE      i  (R)  Current plate number
C IGEN(6)     i  (R)  Counts from reflection generation (the 6 parameters
C                     returned from LRL_COUNTS)
C NSEARCH     i  (R)  No. of spots searched for.
C NOBS        i  (R)  No. spots found and used in refinement
C OLD_RMS     i  (R)  Rms from spot search prior to refinement
C RMS         i  (R)  Rms from spot search or refinement
C RFMSG       c  (R)  Message string from refinement routine
C IFLAG(7)    i  (R)  See LFN_RFN routine
C JFLAG(6)    i  (R)  See LFN_RFN routine
C KFLAG(6)    i  (R)  SEe LFN_RFN routine      
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'autorefn_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL RFCL
      INTEGER I
      INTEGER J
      INTEGER ICYC
      INTEGER IERR
      INTEGER MAXC
      INTEGER LFLAG
      INTEGER IDSTYP
      INTEGER ISYST
      INTEGER LCY
      INTEGER LCP
      INTEGER LCS
      INTEGER LRP
      INTEGER LSP
      INTEGER LRF
      INTEGER LRS
      INTEGER NE
      INTEGER LISTE(20)
      INTEGER NCP(7)
      INTEGER ICOLR
      REAL TH_XO
      REAL TH_YO
      REAL YMX
      REAL RMS_MIN
      REAL YY
      REAL PX1(3)
      REAL PX2(3)
      REAL PY(3)
      REAL SX(3)
      REAL SY(3)
      CHARACTER*60 STR
      CHARACTER*2 VALSTR

C     LOGICAL RFCL                 !Refine cell parameters flag
C     INTEGER I                    !Temp/loop variable
C     INTEGER J                    !Temp/loop variable
C     INTEGER ICYC                 !Refinement cycle number
C     INTEGER IERR                 !Error flag
C     INTEGER MAXC                 !Maximum column no. used in text table
C     INTEGER LFLAG                !Parameter status flag
C     INTEGER IDSTYP               !Distortion type flag
C     INTEGER ISYST                !Crystal system flag
C     INTEGER LCY                  !Line number for Cycle output
C     INTEGER LCP                  !Line number for Current phase output
C     INTEGER LCS                  !Line number for Current step output
C     INTEGER LRP                  !Line number for Refineable parameters
C     INTEGER LSP                  !Line number for Spot search results
C     INTEGER LRF                  !Line number for Refinement cycle results
C     INTEGER LRS                  !Line number for Rms summary
C     INTEGER NE                   !No. parameters to be updated
C     INTEGER LISTE(20)            !List of parameters to be updated
C     INTEGER NCP(7)               !No. unique cell parms. for crystal systems
C     INTEGER ICOLR                !Colour flag
C     REAL TH_XO                   !X origin for 'thermometer'
C     REAL TH_YO                   !Y origin for 'thermometer'
C     REAL YMX                     !Maximum Y for 'thermometer'
C     REAL RMS_MIN                 !Minimum rms found so far for current plate
C     REAL YY                      !Y value for current rms for 'thermometer'
C     REAL PX1(3)                  !X positions for rms minimum mark (lhs)
C     REAL PX2(3)                  !X positions for rms minimum mark (rhs)
C     REAL PY(3)                   !Y positions for rms minimum marks
C     REAL SX(3)                   !X positions for 'above maximum' marks
C     REAL SY(3)                   !Y positions for 'above maximum' marks
C     CHARACTER*60 STR             !Temp string
C     CHARACTER*2 VALSTR           !Dummy value string

      SAVE RMS_MIN
      SAVE ICYC

      DATA NCP/6,4,3,2,2,2,1/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      TH_XO = 50.0
      TH_YO = 50.0
      PX1(1) = TH_XO - 4.0
      PX1(2) = TH_XO - 12.0
      PX1(3) = TH_XO - 12.0
      PX2(1) = TH_XO + 4.0
      PX2(2) = TH_XO + 12.0
      PX2(3) = TH_XO + 12.0
      SX(1) = TH_XO - 15.0
      SY(1) = TH_YO + 155.0
      SX(2) = TH_XO
      SY(2) = TH_YO + 165.0
      SX(3) = TH_XO + 15.0
      SY(3) = TH_YO + 155.0
      MAXC = 50
      LCY = 1
      LCP = 3
      LCS = 5
      LRP = 8
      LSP = 19
      LRF = 21
      LRS = 23
      CALL LDM_GET_DSTOR (VALSTR, IDSTYP, LFLAG)
      CALL LDM_GET_SYST (VALSTR, ISYST, LFLAG)
C
C====== Update rms results histogram if last cycle for plate
C
      IF (ISTAGE.EQ.17) THEN
         I = 11*(RMS/.11) + 1
         IF (I.LT.1) I = 1
         IF (I.GT.11) I = 11
         NRMS(I) = NRMS(I) + 1
      END IF

C
C====== Output to auto-refinement screen if X-windows mode & called from menu
C====== =====================================================================
C

      IF (LG_MODE.EQ.1.AND.MEN_INP) THEN
         
C
C====== Start of new plate
C
         IF (ISTAGE.EQ.1) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, 1, 1,
     +                                      LRS+1, MAXC, IERR)
            STR = 'Refinement for pack'
            CALL STR_ADDI (STR, IPACK, 1)
            CALL STR_ADDS (STR, ', plate',0)
            CALL STR_ADDI (STR, IPLATE, 1)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, XDLSTR(STR),
     +                                 LENSTR(STR), 1, 1, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Current phase:'),15,
     +                                 LCP, 1, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Current step:'),13,
     +                                 LCS, 1, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Refineable parameters'),
     +                                 21, LRP, 1, 1, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('phix, phiy, phiz'), 16,
     +                                 LRP+2, 4, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('ctof'), 4,
     +                                 LRP+3, 4, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('x_c, y_c'), 8,
     +                                 LRP+4, 4, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('w_c'), 3,
     +                                 LRP+5, 4, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('cell'), 4,
     +                                 LRP+6, 4, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('y_scale'), 7,
     +                                 LRP+7, 4, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('tilt, twist'), 11,
     +                                 LRP+8, 4, 0, IERR)

            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Refinement rms summary'),
     +                                 22, LRS, 1, 1, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +      XDLSTR('< .01 .02 .03 .04 .05 .06 .07 .08 .09 .10 >=.10'),
     +      47, LRS+1, 1, 0, IERR)
      
            IF (IDSTYP.EQ.1) THEN
               CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                    XDLSTR('bulge'), 5,
     +                                    LRP+9, 4, 0, IERR)
            ELSE IF (IDSTYP.EQ.2) THEN
               CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                    XDLSTR('roff, toff'), 10,
     +                                    LRP+9, 4, 0, IERR)
            ELSE IF (IDSTYP.EQ.3) THEN
               CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                    XDLSTR('spd terms'), 9,
     +                                    LRP+9, 4, 0, IERR)
            END IF
            CALL XDLF_GRAPH_WIN_DELETE (IVH_AUTR_GRA, 2, IERR)
            CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 2, 2, -1, IERR)
            CALL XDLF_GRAPH_WIN_RECTANGLE (IVH_AUTR_GRA, 
     +                                     TH_XO-2.5, TH_YO,
     +                                     TH_XO+2.5, TH_YO+150.0,
     +                                     1, IERR)
            CALL XDLF_GRAPH_WIN_POLYSYMBOL (IVH_AUTR_GRA, SX, SY, 3,
     +                                      1, 6.0, 1, IERR)
            CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 6, -1, -1, IERR)
            RMS_MIN = 1000.0
            YY = TH_YO+150.0
            PY(1) = YY
            PY(2) = YY+4.0
            PY(3) = YY-4.0
            CALL XDLF_GRAPH_WIN_POLYGON (IVH_AUTR_GRA, PX1, PY, 3,
     +                                   1, IERR)
            CALL XDLF_GRAPH_WIN_POLYGON (IVH_AUTR_GRA, PX2, PY, 3,
     +                                   1, IERR)
            
            ICYC = 1
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Cycle'), 5,
     +                                 LCY, 40, 0, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('1'), 1,
     +                                 LCY, 46, 11, IERR)

            STR = '==Automatic refinement for pack'
            CALL STR_ADDI (STR, IPACK, 1)
            CALL STR_ADDS (STR, ', plate',0)
            CALL STR_ADDI (STR, IPLATE, 1)
            CALL STR_ADDS (STR, '==', 0)
            CALL LMESSAGE (IVH_IOW, STR)
C
C====== Start of 'Initial Search' phase
C
         ELSE IF (ISTAGE.EQ.2) THEN
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('INITIAL SEARCH'), 14,
     +                                LCP, 17, 11, IERR)
C
C====== Start reading image
C
         ELSE IF (ISTAGE.EQ.3) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Reading image'),
     +                                 13, LCS, 15, 11, IERR)
C
C====== End reading image
C
         ELSE IF (ISTAGE.EQ.4) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
C
C====== Start generating spots list
C
         ELSE IF (ISTAGE.EQ.5) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Generating spots list'),
     +                                 21, LCS, 15, 11, IERR)
C
C====== End of spots list generation
C
         ELSE IF (ISTAGE.EQ.6) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
C
C====== Start spots search
C
         ELSE IF (ISTAGE.EQ.8) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Spot search'),
     +                                 11, LCS, 15, 11, IERR)
C
C====== End of spots search
C
         ELSE IF (ISTAGE.EQ.9) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
C
C====== Spot search results first and other times
C
         ELSE IF (ISTAGE.EQ.10.OR.ISTAGE.EQ.11) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LSP, 1,
     +                                      LSP, MAXC, IERR)
            STR = 'Found'
            CALL STR_ADDI (STR, NOBS, 1)
            CALL STR_ADDS (STR, 'of', 1)
            CALL STR_ADDI (STR, NSEARCH, 1)
            CALL STR_ADDS (STR, 'spots, rms =', 1)
            CALL STR_ADDF (STR, RMS, 3, 1)
            CALL STR_ADDS (STR,'mm',1)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR(STR), LENSTR(STR),
     +                                 LSP, 1, 0, IERR)

            YMX = 500.0*RMS
            IF (YMX.GT.150.0) YMX = 150.0
            CALL XDLF_GRAPH_WIN_DELETE (IVH_AUTR_GRA, 2, IERR)
            CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 2, 2, -1, IERR)
            CALL XDLF_GRAPH_WIN_RECTANGLE (IVH_AUTR_GRA, 
     +                                     TH_XO-2.5, TH_YO,
     +                                     TH_XO+2.5, TH_YO+YMX,
     +                                     1, IERR)
            IF (RMS.GT.0.3) CALL XDLF_GRAPH_WIN_POLYSYMBOL
     +                                      (IVH_AUTR_GRA, SX, SY, 3,
     +                                      1, 6.0, 1, IERR)
            IF (RMS.LT.RMS_MIN) RMS_MIN = RMS
            YY = 500.0*RMS_MIN
            IF (YY.GT.150.0) YY = 150.0
            YY = TH_YO+YY
            PY(1) = YY
            PY(2) = YY+4.0
            PY(3) = YY-4.0
            CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 6, -1, -1, IERR)
            CALL XDLF_GRAPH_WIN_POLYGON (IVH_AUTR_GRA, PX1, PY, 3,
     +                                   1, IERR)
            CALL XDLF_GRAPH_WIN_POLYGON (IVH_AUTR_GRA, PX2, PY, 3,
     +                                   1, IERR)

            IF (ISTAGE.EQ.10) THEN
                STR = 'At start: Found'
                CALL STR_ADDI (STR, NOBS, 1)
                CALL STR_ADDS (STR, 'of', 1)
                CALL STR_ADDI (STR, NSEARCH, 1)
                CALL STR_ADDS (STR, 'spots, rms =', 1)
                CALL STR_ADDF (STR, RMS, 3, 1)
                CALL STR_ADDS (STR,'mm',1)
                CALL LMESSAGE (IVH_IOW, STR)
            END IF
C
C====== Start of 'Initial Refinement' phase
C
         ELSE IF (ISTAGE.EQ.12) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCP, 17,
     +                                      LCP, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('INITIAL REFINEMENT'), 18,
     +                                 LCP, 17, 11, IERR)
C
C======  List of parameters to be refined
C
         ELSE IF (ISTAGE.EQ.13) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LRP+2, 2,
     +                                      LRP+9, 2, IERR)
            IF (IFLAG(1).GT.0.OR.IFLAG(2).GT.0.OR.IFLAG(3).GT.0)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+2, 
     +                                      2, 3, IERR)
            IF (IFLAG(4).GT.0)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+3, 
     +                                      2, 3, IERR)
            IF (IFLAG(5).GT.0.OR.IFLAG(6).GT.0)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+4, 
     +                                      2, 3, IERR)
            IF (IFLAG(7).GT.0)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+5, 
     +                                      2, 3, IERR)
            RFCL = .FALSE.
            DO 20 I = 1, NCP(ISYST)
               IF (JFLAG(I).GT.0) RFCL = .TRUE.
 20         CONTINUE
            IF (RFCL)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+6, 
     +                                      2, 3, IERR)
            IF (KFLAG(1).GT.0)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+7, 
     +                                      2, 3, IERR)
            IF (KFLAG(2).GT.0.OR.KFLAG(3).GT.0)
     +         CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+8, 
     +                                      2, 3, IERR)
            IF (IDSTYP.EQ.1) THEN

               IF (KFLAG(4).GT.0)
     +            CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+9, 
     +                                         2, 3, IERR)
            ELSE IF (IDSTYP.EQ.2) THEN
               IF (KFLAG(4).GT.0.OR.KFLAG(5).GT.0)
     +            CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+9, 
     +                                         2, 3, IERR)
            ELSE IF (IDSTYP.EQ.3) THEN
               IF (KFLAG(4).GT.0.OR.KFLAG(5).GT.0.OR.KFLAG(6).GT.0)
     +            CALL XDLF_TEXT_TABLE_SYMBOL (IVH_AUTR_TAB, 1, LRP+9, 
     +                                         2, 3, IERR)
            END IF
C
C====== Start of refinement step
C
         ELSE IF (ISTAGE.EQ.14) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Refining'),
     +                                 8, LCS, 15, 11, IERR)
C
C====== End of refinement step
C
         ELSE IF (ISTAGE.EQ.15) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCS, 15,
     +                                      LCS, MAXC, IERR)
C
C====== Refinement results (all cycles)
C
         ELSE IF (ISTAGE.EQ.16.OR.ISTAGE.EQ.17) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LRF, 1,
     +                                      LRF, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('Refined rms ='), 13,
     +                                 LRF, 1, 0, IERR)
            STR = ' '
            CALL STR_ADDF (STR, RMS, 3, 0)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR(STR), LENSTR(STR),
     +                                 LRF, 15, 11, IERR)
            I = 16 + LENSTR(STR)
            STR = 'mm for'
            CALL STR_ADDI (STR, NOBS, 1)
            CALL STR_ADDS (STR, 'spots', 1)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR(STR), LENSTR(STR),
     +                                 LRF, I, 0, IERR)

            YMX = 500.0*RMS
            IF (YMX.GT.150.0) YMX = 150.0
            CALL XDLF_GRAPH_WIN_DELETE (IVH_AUTR_GRA, 2, IERR)
            CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 2, 2, -1, IERR)
            CALL XDLF_GRAPH_WIN_RECTANGLE (IVH_AUTR_GRA, 
     +                                     TH_XO-2.5, TH_YO,
     +                                     TH_XO+2.5, TH_YO+YMX,
     +                                     1, IERR)
            IF (RMS.GT.0.3) CALL XDLF_GRAPH_WIN_POLYSYMBOL 
     +                                      (IVH_AUTR_GRA, SX, SY, 3,
     +                                      1, 6.0, 1, IERR)
            IF (RMS.LT.RMS_MIN) RMS_MIN = RMS
            YY = 500.0*RMS_MIN
            IF (YY.GT.150.0) YY = 150.0
            YY = TH_YO+YY
            PY(1) = YY
            PY(2) = YY+4.0
            PY(3) = YY-4.0
            CALL XDLF_GRAPH_WIN_STYLE (IVH_AUTR_GRA, 6, -1, -1, IERR)
            CALL XDLF_GRAPH_WIN_POLYGON (IVH_AUTR_GRA, PX1, PY, 3,
     +                                   1, IERR)
            CALL XDLF_GRAPH_WIN_POLYGON (IVH_AUTR_GRA, PX2, PY, 3,
     +                                   1, IERR)

            IF (ISTAGE.EQ.16) THEN
               ICYC = ICYC + 1
               CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCY, 46,
     +                                      LCY, MAXC, IERR)
               STR = ' '
               CALL STR_ADDI (STR, ICYC, 0)
               CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR(STR), LENSTR(STR),
     +                                 LCY, 46, 11, IERR)
            ELSE
               CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCP, 17,
     +                                         LCP, MAXC, IERR)
            END IF
            CALL RESET_CELL
            NE = 0
            NE = NE + 1
            LISTE(NE) = IP_PACK
            NE = NE + 1
            LISTE(NE) = IP_PLATE
            NE = NE + 1
            LISTE(NE) = IP_PHIX
            NE = NE + 1
            LISTE(NE) = IP_PHIY
            NE = NE + 1
            LISTE(NE) = IP_PHIZ
            NE = NE + 1
            LISTE(NE) = IP_A
            NE = NE + 1
            LISTE(NE) = IP_B
            NE = NE + 1
            LISTE(NE) = IP_C
            NE = NE + 1
            LISTE(NE) = IP_ALPH
            NE = NE + 1
            LISTE(NE) = IP_BETA
            NE = NE + 1
            LISTE(NE) = IP_GAMM
            CALL SET_PAR1_VALS (NE, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)

            IF (ISTAGE.EQ.17) THEN
               CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LRS+2, 1,
     +                                         LRS+2, MAXC, IERR)
               DO 40 I = 1, 11
                  IF (NRMS(I).LE.0) GO TO 40
                  J = 4*I - 1
                  IF (I.EQ.11) J = J + 2
                  WRITE (STR,'(I3)') NRMS(I)
                  ICOLR = 11
                  IF (I.GT.5) ICOLR = 3
                  WRITE (STR(1:3),'(I3)') NRMS(I)
                  CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR(STR), 3,
     +                                 LRS+2, J, ICOLR, IERR)
 40            CONTINUE

               STR = 'At end: Refined rms ='
               CALL STR_ADDF (STR, RMS, 3, 1)
               CALL STR_ADDS (STR, 'mm for', 1)
               CALL STR_ADDI (STR, NOBS, 1)
               CALL STR_ADDS (STR, 'spots', 1)
               CALL LMESSAGE (IVH_IOW, STR)
            END IF
C
C====== Start of 'Main Refinement' phase
C
         ELSE IF (ISTAGE.EQ.18) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCP, 17,
     +                                      LCP, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('MAIN REFINEMENT'), 15,
     +                                 LCP, 17, 11, IERR)
C
C====== Start of 'Final Refinement' phase
C
         ELSE IF (ISTAGE.EQ.19) THEN
            CALL XDLF_TEXT_TABLE_CLEARSECT (IVH_AUTR_TAB, LCP, 17,
     +                                      LCP, MAXC, IERR)
            CALL XDLF_TEXT_TABLE_TEXT (IVH_AUTR_TAB, 
     +                                 XDLSTR('FINAL REFINEMENT'), 16,
     +                                 LCP, 17, 11, IERR)
         END IF
C
C====== X-windows mode & called from command window
C====== ===========================================
C
      ELSE IF (LG_MODE.EQ.1.AND..NOT.MEN_INP) THEN
C
C====== Start refinement for the next plate
C
         IF (ISTAGE.EQ.1) THEN
            STR = '==Refinement for pack'
            CALL STR_ADDI (STR, IPACK, 1)
            CALL STR_ADDS (STR, ', plate',0)
            CALL STR_ADDI (STR, IPLATE, 1)
            CALL STR_ADDS (STR, '==', 0)
            CALL LMESSAGE (IVH_IOW, STR)
C
C====== Start 'Initial Refinement' phase
C
         ELSE IF (ISTAGE.EQ.2) THEN
           CALL LMESSAGE (IVH_IOW, '==Initial Search Phase==')
C
C====== Start reading image
C
         ELSE IF (ISTAGE.EQ.3) THEN
            CALL LMESSAGE (IVH_IOW, '==Reading Image==')
C
C====== Spot search results
C
         ELSE IF (ISTAGE.EQ.10.OR.ISTAGE.EQ.11) THEN
            STR = 'Found'
            CALL STR_ADDI (STR, NOBS, 1)
            CALL STR_ADDS (STR, 'of', 1)
            CALL STR_ADDI (STR, NSEARCH, 1)
            CALL STR_ADDS (STR, 'spots, rms =', 1)
            CALL STR_ADDF (STR, RMS, 3, 1)
            CALL STR_ADDS (STR,'mm',1)
            CALL LMESSAGE (IVH_IOW, STR)
C
C====== Start of 'Initial Refinement' phase
C
         ELSE IF (ISTAGE.EQ.12) THEN
            CALL LMESSAGE (IVH_IOW, '==Initial Refinement Phase==')
C
C====== Refinement results
C
         ELSE IF (ISTAGE.EQ.16.OR.ISTAGE.EQ.17) THEN
            STR = 'Refined rms ='
            CALL STR_ADDF (STR, RMS, 3, 1)
            CALL STR_ADDS (STR, 'mm for', 1)
            CALL STR_ADDI (STR, NOBS, 1)
            CALL STR_ADDS (STR, 'spots', 1)
            CALL LMESSAGE (IVH_IOW, STR)
            CALL RESET_CELL
            NE = 0
            NE = NE + 1
            LISTE(NE) = IP_PACK
            NE = NE + 1
            LISTE(NE) = IP_PLATE
            NE = NE + 1
            LISTE(NE) = IP_PHIX
            NE = NE + 1
            LISTE(NE) = IP_PHIY
            NE = NE + 1
            LISTE(NE) = IP_PHIZ
            NE = NE + 1
            LISTE(NE) = IP_A
            NE = NE + 1
            LISTE(NE) = IP_B
            NE = NE + 1
            LISTE(NE) = IP_C
            NE = NE + 1
            LISTE(NE) = IP_ALPH
            NE = NE + 1
            LISTE(NE) = IP_BETA
            NE = NE + 1
            LISTE(NE) = IP_GAMM
            CALL SET_PAR1_VALS (NE, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
C
C====== Start of 'Main Refinement' phase
C
         ELSE IF (ISTAGE.EQ.18) THEN
            CALL LMESSAGE (IVH_IOW, '==Main Refinement Phase==')
C
C====== Start of 'Final Refinement' phase
C
         ELSE IF (ISTAGE.EQ.19) THEN
            CALL LMESSAGE (IVH_IOW, '==Final Refinement Phase==')
         END IF

C
C====== Terminal mode
C====== =============
C

      ELSE IF (LG_MODE.EQ.2) THEN
C
C====== Start refinement for the next plate
C
         IF (ISTAGE.EQ.1) THEN
            STR = '==Refinement for pack'
            CALL STR_ADDI (STR, IPACK, 1)
            CALL STR_ADDS (STR, ', plate',0)
            CALL STR_ADDI (STR, IPLATE, 1)
            CALL STR_ADDS (STR, '==', 0)
            CALL TWRITE (STR)
C
C====== Start 'Initial Refinement' phase
C
         ELSE IF (ISTAGE.EQ.2) THEN
            CALL TWRITE ('==Initial Search Phase==')
C
C====== Start reading image
C
         ELSE IF (ISTAGE.EQ.3) THEN
            CALL TWRITE ('==Reading Image==')
C
C====== Spot search results
C
         ELSE IF (ISTAGE.EQ.10.OR.ISTAGE.EQ.11) THEN
            STR = 'Found'
            CALL STR_ADDI (STR, NOBS, 1)
            CALL STR_ADDS (STR, 'of', 1)
            CALL STR_ADDI (STR, NSEARCH, 1)
            CALL STR_ADDS (STR, 'spots, rms =', 1)
            CALL STR_ADDF (STR, RMS, 3, 1)
            CALL STR_ADDS (STR,'mm',1)
            CALL TWRITE (STR)
C
C====== Start of 'Initial Refinement' phase
C
         ELSE IF (ISTAGE.EQ.12) THEN
            CALL TWRITE ('==Initial Refinement Phase==')
C
C====== Refinement results
C
         ELSE IF (ISTAGE.EQ.16.OR.ISTAGE.EQ.17) THEN
            STR = 'Refined rms ='
            CALL STR_ADDF (STR, RMS, 3, 1)
            CALL STR_ADDS (STR, 'mm for', 1)
            CALL STR_ADDI (STR, NOBS, 1)
            CALL STR_ADDS (STR, 'spots', 1)
            CALL TWRITE (STR)
C
C====== Start of 'Main Refinement' phase
C
         ELSE IF (ISTAGE.EQ.18) THEN
            CALL TWRITE ('==Main Refinement Phase==')
C
C====== Start of 'Final Refinement' phase
C
         ELSE IF (ISTAGE.EQ.19) THEN
            CALL TWRITE ('==Final Refinement Phase==')

         END IF

      END IF

C
C====== Write to log file if required
C====== =============================
C
      IF (IUN_LOG.GT.0) THEN
         IF (ISTAGE.EQ.0) THEN
            WRITE(IUN_LOG,2000)
         ELSE
            IF (ISTAGE.EQ.20) THEN
               WRITE (IUN_LOG,2010) 'Refinement rms summary:'
               WRITE (IUN_LOG,2020)
               WRITE (IUN_LOG,2030)
               STR = ' '
               DO 50 I = 1, 11
                  IF (NRMS(I).LE.0) GO TO 50
                  J = 4*I - 1
                  IF (I.EQ.11) J = J + 2
                  WRITE (STR(J:J+2),'(I3)') NRMS(I)
 50            CONTINUE
               WRITE (IUN_LOG,2010) STR
               WRITE (IUN_LOG,2020)
            END IF
            IF (ISTAGE.NE.7.AND.ISTAGE.NE.13) THEN
               CALL  LFN_REFN_LOG (IUN_LOG, ISTAGE, 
     +                        IPACK, IPLATE, IGEN,
     +                        NSEARCH, NOBS, OLD_RMS, RMS, RFMSG,
     +                        IFLAG, JFLAG, KFLAG)
            END IF
         END IF
      END IF

      RETURN
C
C====== Format statements
C
 2000 FORMAT (/,'==Automatic Parameter Refinement==')
 2010 FORMAT(A)
 2020 FORMAT ('-----------------------------------------------') 
 2030 FORMAT ('< .01 .02 .03 .04 .05 .06 .07 .08 .09 .10 >=.10')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     RESET_CELL       **
C**************************
C
C
      SUBROUTINE RESET_CELL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Reset LDM cell parameters as appropriate for the current
C          crystal system
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER IFLAG
      INTEGER ND
      INTEGER NDA
      INTEGER NDAL
      INTEGER IERR
      INTEGER ISYST
      REAL CELLP(6)
      CHARACTER*2 ERRSTR
      CHARACTER*20 VALSTR

C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER NDA          !No. of decimal places flag for 'A'
C     INTEGER NDAL         !No. of decimal places flag for 'ALPHA'
C     INTEGER IERR         !Error flag
C     INTEGER ISYST        !Crystal system no.
C     REAL CELLP(6)        !Cell parameters before reset
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C     CHARACTER*20 VALSTR  !Parameter value string
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_A (CELLP(1), IFLAG, NDA)
      CALL LDM_GET_B (CELLP(2), IFLAG, ND)
      CALL LDM_GET_C (CELLP(3), IFLAG, ND)
      CALL LDM_GET_ALPHA (CELLP(4), IFLAG, NDAL)
      CALL LDM_GET_BETA (CELLP(5), IFLAG, ND)
      CALL LDM_GET_GAMMA (CELLP(6), IFLAG, ND)
      CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
      IF (ISYST.EQ.2) THEN
         CALL LDM_SET ('ALPHA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('GAMMA', 1, 1, '90.0', IERR, ERRSTR)
      ELSE IF (ISYST.EQ.3) THEN
         CALL LDM_SET ('ALPHA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('BETA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('GAMMA', 1, 1, '90.0', IERR, ERRSTR)
      ELSE IF (ISYST.EQ.4) THEN
         VALSTR = ' '
         CALL STR_ADDF (VALSTR, CELLP(1), NDA, 0)
         CALL LDM_SET ('B', 1, 1, VALSTR, IERR, ERRSTR)
         CALL LDM_SET ('ALPHA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('BETA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('GAMMA', 1, 1, '90.0', IERR, ERRSTR)
      ELSE IF (ISYST.EQ.5) THEN            
         VALSTR = ' '
         CALL STR_ADDF (VALSTR, CELLP(1), NDA, 0)
         CALL LDM_SET ('B', 1, 1, VALSTR, IERR, ERRSTR)
         CALL LDM_SET ('ALPHA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('BETA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('GAMMA', 1, 1, '120.0', IERR, ERRSTR)
      ELSE IF (ISYST.EQ.6) THEN
         VALSTR = ' '
         CALL STR_ADDF (VALSTR, CELLP(1), NDA, 0)
         CALL LDM_SET ('B', 1, 1, VALSTR, IERR, ERRSTR)
         CALL LDM_SET ('C', 1, 1, VALSTR, IERR, ERRSTR)
         VALSTR = ' '
         CALL STR_ADDF (VALSTR, CELLP(4), NDAL, 0)
         CALL LDM_SET ('BETA', 1, 1, VALSTR, IERR, ERRSTR)
         CALL LDM_SET ('GAMMA', 1, 1, VALSTR, IERR, ERRSTR)
      ELSE IF (ISYST.EQ.7) THEN
         VALSTR = ' '
         CALL STR_ADDF (VALSTR, CELLP(1), NDA, 0)
         CALL LDM_SET ('B', 1, 1, VALSTR, IERR, ERRSTR)
         CALL LDM_SET ('C', 1, 1, VALSTR, IERR, ERRSTR)
         CALL LDM_SET ('ALPHA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('BETA', 1, 1, '90.0', IERR, ERRSTR)
         CALL LDM_SET ('GAMMA', 1, 1, '90.0', IERR, ERRSTR)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     RESTORE_PKPL     **
C**************************
C
C
      SUBROUTINE RESTORE_PKPL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Restore pack and plate saved via SAVE_PKPL
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'save_pkpl.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER LISTE(2)

C     INTEGER LISTE(2)           !List of parameter table entries to be updated
C
C-------------------------------------------------------------------------------
C
      IPACK = IPACK_SAVE
      IPLATE = IPLATE_SAVE
      IF (LG_MODE.EQ.1) THEN
         CALL SET_PAR1_VALS (0, LISTE)
         CALL SET_PAR2_VALS (0, LISTE)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SAVE_PKPL        **
C**************************
C
C
      SUBROUTINE SAVE_PKPL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Ssve current pack and plate no. (restore with RESTORE_PKPL)
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'save_pkpl.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C

C
C-------------------------------------------------------------------------------
C
      IPACK_SAVE = IPACK
      IPLATE_SAVE = IPLATE
      RETURN
      END
      
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SCREEN_SETUP     **
C**************************
C
C
      SUBROUTINE SCREEN_SETUP
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up initial screen
C
C Author:  John W. Campbell, August 1990
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'ip2_entries.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
      INTEGER XDLSTR
C
C====== LOCALS:
C
C====== Layout parameters
C
      INTEGER  IWIDTH_FRAME
      INTEGER  IHEIGHT_FRAME
      INTEGER  IP1W
      INTEGER  IP1H
      INTEGER  IP2W
      INTEGER  IP2H
      INTEGER  IP3W
      INTEGER  IP3H
      INTEGER  MENW
      INTEGER  MENH
      INTEGER  IOW_W
      INTEGER  IOW_H
      INTEGER  ICMDW
      INTEGER  ICMDH
      INTEGER  IX
      INTEGER  IY
      INTEGER  IW
      INTEGER  IH

C     INTEGER  IWIDTH_FRAME        ! Width of the base frame
C     INTEGER  IHEIGHT_FRAME       ! Height of the base frame
C     INTEGER  IP1W                ! Parameter table 1 width required
C     INTEGER  IP1H                ! Parameter table 1 height required
C     INTEGER  IP2W                ! Parameter table 2 width required
C     INTEGER  IP2H                ! Parameter table 2 height required
C     INTEGER  IP3W                ! Parameter table 3 width required
C     INTEGER  IP3H                ! Parameter table 3 height required
C     INTEGER  MENW                ! Menu width required
C     INTEGER  MENH                ! Menu height required
C     INTEGER  IOW_W               ! io_window text area width needed
C     INTEGER  IOW_H               ! io_window text area height needed
C     INTEGER  ICMDW               ! Command window width required
C     INTEGER  ICMDH               ! Command window height required
C     INTEGER  IX                  ! X position for a view-object
C     INTEGER  IY                  ! Y position for w view-object
C     INTEGER  IW                  ! Required width for layout or object
C     INTEGER  IH                  ! Required height for layout or object
C
C====== Miscellaneous parameters
C
      INTEGER IERR
      CHARACTER*80 HEADER
C
C     INTEGER IERR        !Error return flag
C     CHARACTER*80 HEADER !Header for title bar
C
C-------------------------------------------------------------------------------
C
C
C====== Calculate size requirements and layout parameters
C
      CALL XDLF_MENU_AREA_GETSIZE (MAX_MEN_ITMS, MAX_MEN_NAME,
     +     IFONT, 1, MAX_MEN_TITLE, MENW, MENH)
      CALL XDLF_PARAM_TABLE_GETSIZE (NP1_COLS, NP1_ROWS, 
     +     MAX_PNAME_CHARS, MAX_PVAL_CHARS, 
     +     1, IFONT, 1, IP1W, IP1H)
      CALL XDLF_PARAM_TABLE_GETSIZE (NP2_COLS, NP2_ROWS, 
     +     MAX_P2NAME_CHARS, MAX_P2VAL_CHARS, 
     +     1, IFONT, 1, IP2W, IP2H)
      CALL XDLF_PARAM_TABLE_GETSIZE (NP3_COLS, NP3_ROWS, 
     +     MAX_P3NAME_CHARS, MAX_P3VAL_CHARS, 
     +     1, IFONT, 1, IP3W, IP3H)
      CALL XDLF_IO_WINDOW_GETSIZE (MIN_IOW_COLS, MIN_IOW_ROWS, IFONT, 1,
     +     IOW_W, IOW_H)
      CALL XDLF_IO_WINDOW_GETSIZE (MIN_CMD_COLS, MIN_CMD_ROWS, IFONT, 1,
     +     ICMDW, ICMDH)
C
C====== Get layout parameters
C
      CALL XDLF_LAYOUT_INIT (IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('menu'), 4, MENW, MENH,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('par1'), 4, IP1W, IP1H,
     +                             1, 1, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('par2'), 4, IP2W, IP2H,
     +                             2, 1, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('par3'), 4, IP3W, IP3H,
     +                             1, 2, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('iow'), 3, IOW_W, IOW_H,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_SINGLE (XDLSTR('cmd'), 3, ICMDW, ICMDH,
     +                             0, 0, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (1, 1, XDLSTR('mp3'), 3, 
     +                           XDLSTR('menu'), 4,
     +                           XDLSTR('par3'), 4,
     +                           0, 0, ISEP, 80, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (1, 1, XDLSTR('iowcmd'), 6, 
     +                           XDLSTR('iow'), 3,
     +                           XDLSTR('cmd'), 3, 
     +                           0, 0, ISEP, 80, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (0, 3, XDLSTR('p1'), 2, 
     +                           XDLSTR('iowcmd'), 6,
     +                           XDLSTR('par2'), 4,
     +                           0, 0, ISEP, 80, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (1, 2, XDLSTR('p2'), 2, 
     +                           XDLSTR('par1'), 4, 
     +                           XDLSTR('p1'), 2,
     +                           0, 0, ISEP, 10, IERR)
      CALL XDLF_LAYOUT_SET_PAIR (0, 1, XDLSTR('top'), 3, 
     +                           XDLSTR('mp3'), 3,
     +                           XDLSTR('p2'), 2,
     +                           0, 0, ISEP, 10, IERR)
      CALL XDLF_LAYOUT (XDLSTR('top'), 3, IBORDER, IBORDER, IW, IH,
     +                  IERR)
C
C====== Create main frame
C
      IWIDTH_FRAME = IW + 2*IBORDER
      IHEIGHT_FRAME = IH + 2*IBORDER
      HEADER = 'CCLRC Daresbury Laboratory program ''lauegen'' version'
      CALL STR_ADDS (HEADER, VERSTR, 1)
      CALL XDLF_BASE_FRAME (IVH_BASE, IWIDTH_FRAME, IHEIGHT_FRAME,
     +     XDLSTR(HEADER), LENSTR(HEADER), XDLSTR('laue'), 4, -1, -1)
C
C====== Set up parameter table 1
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('par1'), 4, IX, IY, 
     +                               IW, IH, IERR)
      CALL XDLF_PARAM_TABLE (IVH_PAR1, IVH_BASE, IX, IY,
     +     0, NP1_COLS, NP1_ROWS, MAX_PNAME_CHARS, 
     +     MAX_PVAL_CHARS, MAX_PSCROLL_CHARS,
     +     XDLSTR('Crystallographic/pack Parameters'), 32, 
     +     IFONT, 1, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2002) IERR
         STOP
      ENDIF
C
C====== Set up parameter table 2
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('par2'), 4, IX, IY, 
     +                               IW, IH, IERR)
      CALL XDLF_PARAM_TABLE (IVH_PAR2, IVH_BASE, IX, IY,
     +     0, NP2_COLS, NP2_ROWS, MAX_P2NAME_CHARS, 
     +     MAX_P2VAL_CHARS, MAX_P2SCROLL_CHARS,
     +     XDLSTR(' '), 1, 
     +     IFONT, 1, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2002) IERR
         STOP
      ENDIF
C
C====== Set up parameter table 3
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('par3'), 4, IX, IY, 
     +                               IW, IH, IERR)
      CALL XDLF_PARAM_TABLE (IVH_PAR3, IVH_BASE, IX, IY,
     +     0, NP3_COLS, NP3_ROWS, MAX_P3NAME_CHARS, 
     +     MAX_P3VAL_CHARS, MAX_P3SCROLL_CHARS,
     +     XDLSTR(' '), 1, 
     +     IFONT, 1, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2002) IERR
         STOP
      ENDIF
C
C====== Set up menu area
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('menu'), 4, IX, IY, 
     +                               IW, IH, IERR)
      CALL XDLF_MENU_AREA (IVH_MENU, IVH_BASE, IX, IY, 0,
     +     MAX_MEN_ITMS, MAX_MEN_NAME, IFONT, 1, MAX_MEN_TITLE,
     +     IW, IH, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2003) IERR
         STOP
      ENDIF
C
C====== Set up main io-window area
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('iow'), 3, IX, IY, 
     +                               IW, IH, IERR)
      CALL XDLF_IO_WINDOW (IVH_IOW, IVH_BASE, IX, IY, 0, 0, 0,
     +     IW, IH, IFONT, 100, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2004) IERR
         STOP
      ENDIF
C
C====== Set up command io-window area
C
      CALL XDLF_LAYOUT_GET_POSITION (XDLSTR('cmd'), 3, IX, IY, 
     +                               IW, IH, IERR)
      CALL XDLF_IO_WINDOW (IVH_CMD, IVH_BASE, IX, IY, 0, 0, 0,
     +     IW, IH, IFONT, 100, IERR)
      IF (IERR.GT.0) THEN
         WRITE (6,2004) IERR
         STOP
      ENDIF
      CALL XDLF_IO_WINDOW_INPUT_MESSAGE (IVH_CMD, 
     +   XDLSTR('Enter command'), 13, IERR)
C
C====== Return
C
      RETURN
C
C====== Format statements
C
2002  FORMAT (/,'**Error code', I2, ' from xdlf_param_table**')        
2003  FORMAT (/,'**Error code', I2, ' from xdlf_menu_area**')
2004  FORMAT (/,'**Error code', I2, ' from xdlf_io_window**')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SEARCH_SPOTS     **
C**************************
C
C
      SUBROUTINE SEARCH_SPOTS (IQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Search for spots near predicted positions for refinement
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
      INTEGER IQUIT
C
C  IQUIT (W)  Error flag =0 OK, =1, cannot open file for search or no spots
C             for search or cannot read image
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'spot_box.finc'
      INCLUDE 'image.finc'
      INCLUDE 'selrefs.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'spot_data.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER NBITST
C
C====== LOCALS:
C
      LOGICAL SPAT
      LOGICAL NODFLG
      INTEGER I
      INTEGER IERR
      INTEGER KERR
      INTEGER H
      INTEGER K
      INTEGER L
      INTEGER IXC
      INTEGER IYC
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER ITHRESH
      INTEGER IBG
      INTEGER NOVER
      INTEGER CUR_OBS
      INTEGER ISPOT
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER IORD
      INTEGER ISWAP
      INTEGER IFLAG 
      INTEGER ND
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER MULT
      INTEGER NUMSPOTS
      INTEGER LISTE(2)
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL SUMSQ
      REAL DIST2
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL X_CEN
      REAL Y_CEN
      REAL OMEGA
      REAL COSOM
      REAL SINOM
      REAL DEG_TO_RAD
      REAL TOO_FAR
      REAL SPOT_B
      REAL SPOT_D
      REAL CGX
      REAL CGY
      REAL RMS
      REAL STHRESH
      REAL STHRESH_SAV
      REAL SPOTL
      REAL SPOTW
      REAL SPOTB
      REAL SPOTD
      REAL X_C
      REAL Y_C
      REAL XFD
      REAL YFD
      REAL ALAM 
      REAL DTHR2        
      CHARACTER*80 STR
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR  

C     LOGICAL SPAT         !Spatial overlap flag
C     LOGICAL NODFLG       !Nodal spot flag
C     INTEGER I            !Temp/loop variable
C     INTEGER IERR         !Error flag
C     INTEGER KERR         !Error flag
C     INTEGER H            !Reflection h index
C     INTEGER K            !Reflection k index
C     INTEGER L            !Reflection l index
C     INTEGER IXC          !Nearest x pixel position of box centre
C     INTEGER IYC          !Nearest y pixel position of box centre
C     INTEGER ISPIX        !Pixel position along slow axis
C     INTEGER IFPIX        !Pixel position along fast axis
C     INTEGER IXSIZ        !Half box x size for finding spot
C     INTEGER IYSIZ        !Half box y size for finding spot
C     INTEGER ITHRESH      !Threshold above background for finding spots
C     INTEGER IBG          !Background value at spot position
C     INTEGER NOVER        !No. of pixels in box above threshold
C     INTEGER CUR_OBS      !Count of spots found
C     INTEGER ISPOT        !Pointer to predicted spots list
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER NF_OFF       !Offset between start of slow rasters in image
C     INTEGER IORD         !Axis order flag
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER JH           !h index
C     INTEGER JK           !k index
C     INTEGER JL           !l index
C     INTEGER MULT         !Multiplicity
C     INTEGER NUMSPOTS     !No. of spots in generated spots list
C     INTEGER LISTE(2)     !Parameter update flags
C     REAL MM_RAST_X       !mm to x-rasters conversion factor
C     REAL MM_RAST_Y       !mm to y-rastrs conversion factor
C     REAL SUMSQ           !Sum of square of obs-calc position differences
C     REAL DIST2           !Square of obs-calc distance
C     REAL X_CEN_F         !Uncorrected x centre in rasters
C     REAL Y_CEN_F         !Uncorrected y-centre in rasters
C     REAL X_CEN           !Corrected x centre in rasters
C     REAL Y_CEN           !Corrected y centre in rasters
C     REAL OMEGA           !Corrected omega in degrees
C     REAL COSOM           !Cos(omega)
C     REAL SINOM           !Sin(omega)
C     REAL DEG_TO_RAD      !Degrees to radians conversion
C     REAL TOO_FAR         !Max shift poss. (mm) with all spot inside box
C     REAL SPOT_B          !Spot box size to use
C     REAL SPOT_D          !Spot diameter to use in closeness calculations
C     REAL CGX             !Found spot c_of_g x position
C     REAL CGY             !Found spot c_of_g y position
C     REAL RMS             !Rms deviation obs. to calc.
C     REAL STHRESH         !Spot search threshold
C     REAL STHRESH_SAV     !Save spot search threshold
C     REAL SPOTL           !Spot length
C     REAL SPOTW           !Spot width
C     REAL SPOTB           !Spot border
C     REAL SPOTD           !Spot delta
C     REAL X_C             !x_c value (mm)
C     REAL Y_C             !y_c value (mm)
C     REAL XFD             !X coordinate on detector (rast) (distort. corrected)
C     REAL YFD             !Y coordinate on detector (rast) (distort. corrected)
C     REAL ALAM            !Wavelength
C     REAL DTHR2           !dmin-threshold**2
C     CHARACTER*80 STR     !Temporary o/p message string
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C
      DATA DEG_TO_RAD/0.0174533/
C
C-------------------------------------------------------------------------------
C
      IQUIT = 0
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
C
C====== Check that some spots selected for search
C
      IF (NUM_SELECT.LE.0) THEN
         CALL ERR_NOTICE(0,'**No reflections selected for search**')
         IQUIT = 1
         RETURN
      END IF
C
C====== Open film/image-plate file if needed
C
      CALL CHK_OPN(IERR)
      IF (IERR.GT.0) THEN
         IQUIT = 1
         RETURN
      END IF
C
C====== Read image if not already read
C
      IF (.NOT.FILM_READ) CALL READ_IMAGE (0, IMG, MAX_IMG_WORDS, 
     +                              ITYPE, NF_OFF, IERR, ERRSTR)
      IF (.NOT.FILM_READ) THEN
         IQUIT = 1
         RETURN
      END IF
C
C====== See if radial masking to be used in spot position determination
C
      CALL LDM_GET_SPOTW (IPACK, IPLATE, SPOTW, IFLAG, ND, IERR, ERRSTR)
      IF (SPOTW.NE.0.0) THEN 
         USE_RADIAL = .TRUE.
         CALL IOW_ASKQ(IVH_IOW,
     +     'Use radial masks in spot position determination',USE_RADIAL)
      ELSE
         USE_RADIAL = .FALSE.
      END IF
C
C====== Set up box size and spot diameter for local use for normal or
C====== radially streaked spots
C
      IF (USE_RADIAL) THEN
         CALL LDM_GET_SPOTL (IPACK, IPLATE, SPOTL, IFLAG, ND, 
     +                       IERR, ERRSTR)
         CALL LDM_GET_SPOTB (IPACK, IPLATE, SPOTB, IFLAG, ND, 
     +                       IERR, ERRSTR)
         SPOT_B = SPOTL + (2.0 + SPOTB)/MM_RAST_X
         SPOT_D = SPOTW
      ELSE
         CALL LDM_GET_SPOTL (IPACK, IPLATE, SPOTL, IFLAG, ND, 
     +                       IERR, ERRSTR)
         CALL LDM_GET_SPOTD (IPACK, IPLATE, SPOTD, IFLAG, ND, 
     +                       IERR, ERRSTR)
         IF (ABS(SPOTL-SPOTL_LAST).GT.0.001.OR.
     +      ABS(SPOTD-SPOTD_LAST).GT.0.001) THEN
            SPOTBOX = 2.0*SPOTD - SPOTL
            SPOTD_LAST = SPOTD
            SPOTL_LAST = SPOTL
         END IF
         CALL IOW_ASKF(IVH_IOW,'Box size (mm)',SPOTBOX,2)
         SPOT_B = SPOTBOX
         SPOT_D = SPOTL
      END IF
C
C====== Too_far (mm) is max. shift possible with all the spot inside box.
C
      TOO_FAR = (SPOT_B - SPOT_D)/2.0
C
C====== Get threshold
C
      CALL LDM_GET_STHR (STHRESH, IFLAG, ND)
      STHRESH_SAV = STHRESH
      CALL IOW_ASKF(IVH_IOW,
     +           'Threshold above background for c_of_g calc',       
     +           STHRESH,1)
      IF (STHRESH.NE.STHRESH_SAV) THEN
         CALL LDM_SET_STHR (STHRESH, IERR, ERRSTR)
         LISTE(1) = IP_STHR
         CALL SET_PAR1_VALS (1, LISTE)
      END IF
C
C====== Search for reflections
C
      CALL LMESSAGE(IVH_IOW,'===Searching for Reflections===')

      CUR_OBS = 0
C
C====== Prepare for transform from recip. space to scanner space
C
      CALL FILM_CENTRE(X_CEN_F,Y_CEN_F,OMEGA)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, KERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, KERR, ERRSTR)
      X_CEN = X_CEN_F + X_C*MM_RAST_X
      Y_CEN = Y_CEN_F + Y_C*MM_RAST_Y

      DEG_TO_RAD = 3.1415926536/180.0
      COSOM = COS(OMEGA*DEG_TO_RAD)
      SINOM = SIN(OMEGA*DEG_TO_RAD)

      SUMSQ = 0.0
      
      DO 30 I = 1 , NUM_SELECT

         IXSIZ = MM_RAST_X*SPOT_B/2.0
         IYSIZ = MM_RAST_Y*SPOT_B/2.0

         ISPOT = SEL_REFS(I)
         CALL LRL_GET (ISPOT, JH, JK, JL, XFD, YFD, ALAM, 
     +                    DTHR2, MULT, NODFLG, SPAT, IERR)
C
C====== Reject if spatially overlapped
C
         IF (.NOT.SPAT) THEN
C
C====== Round to nearest integer to be in scanner space
C
               IXC = NINT(XFD)
               IYC = NINT(YFD)
C
C====== Get background and threshold
C
               CALL SFPIX (IXC,IYC,ISPIX,IFPIX)
               CALL XDLF_BG_VALIMG(ISPIX,IFPIX,IMG_BG,ITYPE,NF_BGOFF,
     +                             NCMP,IBG, IERR)
            ITHRESH = IBG + NINT(STHRESH)
            IF (USE_RADIAL) THEN
               CALL SPOT_RADIAL (IXC, IYC, IXSIZ, IYSIZ, ISPOT_DATA, 
     +                           ISWORK, ITHRESH, IMG, ITYPE, IORD, 
     +                           NFRASTS, NXRAST, NYRAST,
     +                           X_CEN, Y_CEN, NOVER, 
     +                           CGX, CGY, IERR)
            ELSE
               CALL SPOT_C_OF_G (IXC, IYC, IXSIZ, IYSIZ, ISPOT_DATA, 
     +            ISWORK, ITHRESH, IMG, ITYPE, IORD, NFRASTS,
     +            NXRAST, NYRAST, NOVER, 
     +            CGX, CGY, IERR)
            END IF
            IF (NOVER.GT.0) THEN
               DIST2 = (XFD-CGX)**2 + (YFD-CGY)**2
C
C====== Check each coord to see if some of spot is outside c of g box.
C
               IF (ABS(XFD-CGX).GT.(TOO_FAR*MM_RAST_X)) THEN
C
C====== Because some of spot is outside box, expect true c of g to be
C====== further towards edge of box. An approximation of distance
C====== to move is the amount of spot that`s been cut off.
C====== ie. (cgx-xfd) + spot_diam/2 - box_size/2 (put into right units)
C
                  IXC = CGX + (CGX-XFD)
     +            + ((SPOT_D - SPOT_B)/2.*MM_RAST_X)
               ELSE
                  IXC = CGX
               END IF
C
               IF (ABS(YFD-CGY).GT.(TOO_FAR*MM_RAST_Y)) THEN
                  IYC = CGY + (CGY-YFD)
     +            + ((SPOT_D - SPOT_B)/2.*MM_RAST_Y)
               ELSE
                  IYC = CGY
               END IF
C
C====== Re-centre if we didn`t get a true centre of gravity.
C
               IF (ABS(XFD-CGX).GT.(TOO_FAR*MM_RAST_X) .OR. 
     +             ABS(YFD-CGY).GT.(TOO_FAR*MM_RAST_Y)) THEN
C
C====== True c of g should be within a spot radius of here, but
C====== make box 1.5 times bigger just in case.
C
                  IXSIZ = SPOT_D/2.0*1.5*MM_RAST_X
                  IYSIZ = SPOT_D/2.0*1.5*MM_RAST_Y
                  IF (USE_RADIAL) THEN
                     CALL SPOT_RADIAL (IXC, IYC, IXSIZ, IYSIZ, 
     +                    ISPOT_DATA, ISWORK, ITHRESH, IMG, ITYPE,
     +                    IORD, NFRASTS, NXRAST, NYRAST,
     +                    X_CEN, Y_CEN, NOVER, 
     +                    CGX, CGY, IERR)
                  ELSE
                     CALL SPOT_C_OF_G (IXC, IYC, IXSIZ, IYSIZ, 
     +                    ISPOT_DATA, ISWORK, ITHRESH, IMG, ITYPE, IORD, 
     +                    NFRASTS, NXRAST, NYRAST, NOVER, 
     +                    CGX, CGY, IERR)
                  END IF
                  DIST2 = (XFD-CGX)**2 + (YFD-CGY)**2
               END IF
            END IF
            IF (NOVER.GT.0) THEN
               CUR_OBS = CUR_OBS + 1
               XM_OBS(CUR_OBS) = CGX
               YM_OBS(CUR_OBS) = CGY
               H = JH
               K = JK
               L = JL
               NODAL_H_S(CUR_OBS) = H
               NODAL_K_S(CUR_OBS) = K
               NODAL_L_S(CUR_OBS) = L
               HKL_KEY(CUR_OBS) = IABS(H) + IABS(K) + IABS(L)
               SUMSQ = SUMSQ + DIST2
            END IF

         END IF

 30   CONTINUE
C
C====== Make sure at least one spot was found
C
      IF (CUR_OBS.LE.0) THEN
         CALL ERR_NOTICE(0,'**No reflections found in search**')
         IQUIT = 1
         RETURN
      END IF
C
C====== Give rms for all spots
C
      RMS = SQRT(SUMSQ/CUR_OBS)/MM_RAST_X
      STR = 'RMS ='
      CALL STR_ADDF(STR,RMS,3,1)
      CALL STR_ADDS(STR,'for',1)
      CALL STR_ADDI(STR,CUR_OBS,1)
      CALL STR_ADDS(STR,'spots',1)
      CALL LMESSAGE(IVH_IOW,STR)
C
C====== Set NUM_SRCH
C
      NUM_OBS = CUR_OBS
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SEL_FUNC         **
C**************************
C
C
      SUBROUTINE SEL_FUNC
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle input from select functions menu and parameter tables 1&2
C
C Author:  John W. Campbell, June 1991
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'screen_params.finc'
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL CONT
      LOGICAL QUIT
      INTEGER NVIEW
      INTEGER IVHLIST(4)
      INTEGER IVHLST2(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IFAIL
      INTEGER I
      INTEGER IERR
      INTEGER M_RPARM
      INTEGER M_WRPARM
      INTEGER M_LAUE
      INTEGER M_DISP
      INTEGER M_FIND
      INTEGER M_PROCESS
      INTEGER LISTE(2)
      INTEGER IRET
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) PAR_FILE
      CHARACTER*150 CMDLIN

C     LOGICAL CONT            !Continue to write file flag
C     LOGICAL QUIT            !Quit program flag
C     INTEGER NVIEW           !No. ov view objects for input
C     INTEGER IVHLIST(4)      !View-object handles list
C     INTEGER IVHLST2(2)      !2'nd view-object handles list
C     INTEGER IVH             !Returned view-object handle
C     INTEGER ITEM            !Returned menu item number
C     INTEGER IQUIT           !Quit flag from menu
C     INTEGER IFAIL           !File open failure flag
C     INTEGER I               !Temp/loop variable
C     INTEGER IERR            !Error flag
C     INTEGER M_RPARM         !Menu item no.: Read parameters file
C     INTEGER M_WRPARM        !Menu item no.: Write Parameters File
C     INTEGER M_LAUE          !Menu item no.: Simulate Laue Patterns
C     INTEGER M_DISP          !Menu item no.: Display/Measure Film
C     INTEGER M_FIND          !Menu item no.: Find Orientation
C     INTEGER M_PROCESS       !Menu item no.: Process
C     INTEGER LISTE(2)        !Dummy array for SET_PAR1_VALS call
C     INTEGER IRET            !Return flag from CHECK_INTEGRATE
C     CHARACTER*(MAXFLEN) FILNAM   !Temp. file name string
C     CHARACTER*(MAXFLEN) PAR_FILE !Parameter (.ldm) file name
C     CHARACTER*150 CMDLIN         !Command line
C
C-------------------------------------------------------------------------------
C
C
C====== Intitialise menu item numbers
C
      M_RPARM = 1
      M_WRPARM = 2
      M_LAUE = 3
      M_DISP = 4
      M_FIND = 5
      M_PROCESS = 6
      CALL LPROMPT (IVH_CMD, '> ')       
C
C====== Set up 'Select Functions' Menu
C
100   CALL SET_MENU1
C
C====== Get input from Select Functions menu or Parameter table 1
C
      NVIEW = 4
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2
      IVHLIST(4) = IVH_CMD

      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======= Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL CHECK_INTEGRATED (2, 0, IRET)
            IF (IRET.LT.2) RETURN
            GO TO 100
         END IF
C
C====== Read parameters file
C
         IF (ITEM.EQ.M_RPARM) THEN
            CALL CHECK_INTEGRATED (4, 0, IRET)
            IF (IRET.EQ.2) GO TO 100 
            CALL READ_PAR_FILE (.FALSE., ' ')
            GO TO 100
C
C====== Write Parameters File
C
         ELSE IF (ITEM.EQ.M_WRPARM) THEN
110         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.ldm): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') GO TO 100
            CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
            CALL LGFILE_EXISTS (PAR_FILE, CONT)
            IF (.NOT.CONT) GO TO 110
            IFAIL = 1
            CALL CCPDPN (-IUN_GEN, PAR_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 110
            END IF
            CALL WRITE_PARFIL (PAR_FILE)
            CLOSE (UNIT=IUN_GEN)
            GO TO 100
C
C====== Laue Simulations
C
         ELSE IF (ITEM.EQ.M_LAUE) THEN
            CALL LAUE_SIMS
            GO TO 100
C
C====== Display/Measure Film
C
         ELSE IF (ITEM.EQ.M_DISP) THEN
            CALL DISPLAY_OPT
            GO TO 100
C
C====== Find Orientation
C
         ELSE IF (ITEM.EQ.M_FIND) THEN
            CALL AUTO_CNTL
            GO TO 100
C
C====== Process
C
         ELSE IF (ITEM.EQ.M_PROCESS) THEN
            CALL CHECK_INTEGRATED (5, 0, IRET)
            CALL XDLF_IO_WINDOW_PRINT (IVH_CMD, XDLSTR(' '), 1, 2,
     +                                 IERR)
            CALL LAUEGEN_PROCESS
            CALL LPROMPT (IVH_CMD, '> ') 
            GO TO 100
         END IF
         GO TO 100
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         GO TO 100
C
C====== Command window input
C
      ELSE IF (IVH.EQ.IVH_CMD) THEN
         CALL XDLF_IO_WINDOW_GETSTRING (IVH_CMD, XDLSTR(CMDLIN),
     +     150, IERR)
         CALL CMD_INPUT (CMDLIN, QUIT)
         IF (PROCESS) THEN
            CALL CHECK_INTEGRATED (5, 1, IRET)
            CALL LAUEGEN_PROCESS
            CALL LPROMPT (IVH_CMD, '> ') 
            GO TO 100
         END IF
         CALL LPROMPT (IVH_CMD, '> ')
         IF (QUIT) THEN
            CALL CHECK_INTEGRATED (2, 1, IRET)
            IF (IRET.LT.2) RETURN  
         END IF     
         GO TO 100
      END IF
      GO TO 100

      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**    SEL_INTEGRATE     **
C**************************
C
C
      SUBROUTINE SEL_INTEGRATE
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Integrate Spots control routine
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'integ_pars.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
      INTEGER LENSTR
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL ALL_INT
      LOGICAL ANY_INT
      LOGICAL ALL_WRITTEN
      LOGICAL ANY_PRES
      LOGICAL EXISTS
      LOGICAL SKIP_INT
      INTEGER M_RESET
      INTEGER M_INTEG
      INTEGER M_LAST
      INTEGER M_NEXTPL
      INTEGER M_AUTOPK
      INTEGER M_WRINT
      INTEGER M_NEXTPK
      INTEGER M_STAT
      INTEGER NUMP
      INTEGER NPLATES
      INTEGER NVIEW
      INTEGER IVHLIST(4)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER IFLAG
      INTEGER KEYPLATE
      INTEGER IPL
      INTEGER IFLG
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IBUTTON
      INTEGER IRET
      INTEGER JLEN
      INTEGER ILEN
      INTEGER IFAIL
      CHARACTER*2 ERRSTR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) MTZ_FILE
      CHARACTER*(MAXFLEN) GE1_FILE
      CHARACTER*(MAXFLEN) GE2_FILE

C     LOGICAL ALL_INT      !Intensties present for all plates flag
C     LOGICAL ANY_INT      !Any intensities present flag
C     LOGICAL ALL_WRITTEN  !All intensities for current pack already written
C     LOGICAL ANY_PRES     !.ge1 and/or .ge2 file already present flag
C     LOGICAL EXISTS       !File exists flag
C     LOGICAL SKIP_INT     !Skip plates already integrated flag
C     INTEGER M_RESET      !Menu item no.: Reset to first pack
C     INTEGER M_INTEG      !Menu item no.: Integrate Plate
C     INTEGER M_LAST       !Menu item no.: Examine Last Integration
C     INGEGER M_NEXTPL     !Menu item no.: Select Next Plate
C     INTEGER M_AUTOPK     !Menu item no.: Auto-integrate Pack
C     INTEGER M_WRINT      !Menu item no.: Write Intensities File
C     INTEGER M_NEXTPK     !Menu item no.: Select Next Pack
C     INTEGER M_STAT       !Menu item no.: Integration Status
C     INTEGER NUMP         !No. of packs
C     INTEGER NPLATES      !No. plates/pack
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(4)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. from menu selection
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER KEYPLATE     !Key plate
C     INTEGER IPL          !Plates loop counter
C     INTEGER IFLG         !Integration status flag
C     INTEGER IXROOT       !X root position for popup notice
C     INTEGER IYROOT       !Y root position for popup notice
C     INTEGER IBUTTON      !Button selected from popup notice
C     INTEGER IRET         !Return flag from MTZ file check routines
C     INTEGER JLEN         !Length of filename up to extension
C     INTEGER ILEN         !Length of filename up to extension
C     INTEGER IFAIL        !File open failure flag
C     CHARACTER*2 ERRSTR   !Error message string (dummy)
C     CHARACTER*(MAXFLEN) FILNAM  !File name 
C     CHARACTER*(MAXFLEN) MTZ_FILE  !MTZ file name
C     CHARACTER*(MAXFLEN) GE1_FILE  !.ge1 file name
C     CHARACTER*(MAXFLEN) GE2_FILE  !.ge2 file name

C
C-------------------------------------------------------------------------------
C
C====== Check that pack input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) THEN
         CALL ERR_NOTICE (1, '**Number of packs is zero**')
         RETURN
      END IF
C
C====== Get key plate for current pack
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
C
C====== Clear profiles flags on entry in case parameters affecting LRL
C====== generation have been changed.
C
      IPRF_PK = 0
      IPRF_PL = 0
C
C====== Intitialise menu item numbers
C
      M_RESET = 1
      M_INTEG = 2
      M_LAST = 3
      M_NEXTPL = 4
      M_AUTOPK = 5
      M_WRINT = 6
      M_NEXTPK = 7
      M_STAT = 8
C
C====== Set up parameter table 3 & return current values for integration
C       control parameters
C
      CALL INT_PTAB3 (0)
C
C====== Set up 'Integrate Options' Menu
C
100   CALL SET_MENU10
C
C====== Get input from 'Integration Options' menu or Parameter tables 
C
      NVIEW = 4
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2
      IVHLIST(4) = IVH_PAR3

      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======= Quit (Return to Previous Menu) selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            RETURN
         END IF
C
C====== Reset to first pack and plate
C
         IF (ITEM.EQ.M_RESET) THEN
            IF (IPACK.EQ.1.AND.IPLATE.EQ.1) GO TO 100
            CALL SET_NEWPLATE (1, 1, IERR)
            CALL INT_PTAB3(2)
            GO TO 100
C
C====== Integrate Plate
C 
         ELSE IF (ITEM.EQ.M_INTEG) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL INTEGRATE_CALC (KEYPLATE, IERR)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Examine Last Integration
C
         ELSE IF (ITEM.EQ.M_LAST) THEN
            IF (INTEG_LASTPK.EQ.0.OR.INTEG_LASTPL.EQ.0) THEN
               CALL ERR_NOTICE (1,'**No integration to examine**')
               GO TO 100
            END IF
            CALL INTEGRATE_SHOW
            GO TO 100
C
C====== Select Next Plate
C
         ELSE IF (ITEM.EQ.M_NEXTPL) THEN
            CALL SET_NEWPLATE (IPACK, IPLATE+1, IERR)
            CALL INT_PTAB3(2)
            GO TO 100
C
C====== Auto-integrate Pack
C 
         ELSE IF (ITEM.EQ.M_AUTOPK) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            SKIP_INT = .FALSE.
            CALL LDM_GET_NPLAT (NPLATES, IFLAG)
            ANY_INT = .FALSE.
            DO 110 IPL = 1, NPLATES
               CALL INTFLAG_GET (IPACK, IPL, IFLG)
               IF (IFLG.GT.0) ANY_INT = .TRUE.
 110        CONTINUE
            IF (ANY_INT) THEN
               SKIP_INT = .TRUE.
               CALL IOW_ASKQ (IVH_IOW, 
     +           'Skip plates already integrated', SKIP_INT)
            END IF
            CALL AUTO_INTEGRATE_CTL (1, SKIP_INT, ' ', 2,
     +                               NPROF, PROMIN, PRF_ROT, 
     +                               IPRF_ALL, NOVLD, IERR)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Write Intensities File
C 
         ELSE IF (ITEM.EQ.M_WRINT) THEN
C
C====== See which plates integrated etc.
C
            CALL LDM_GET_NPLAT (NPLATES, IFLAG)
            ALL_INT = .TRUE.
            ANY_INT = .FALSE.
            DO 120 IPL = 1, NPLATES
               CALL INTFLAG_GET (IPACK, IPL, IFLG)
               IF (IFLG.EQ.0) ALL_INT = .FALSE.
               IF (IFLG.GT.0) ANY_INT = .TRUE.
 120        CONTINUE
            IF (.NOT.ANY_INT) THEN
               CALL ERR_NOTICE (1, 
     +              '**No integrated intensities for this pack**')
               GO TO 100
            END IF
            ALL_WRITTEN = .TRUE.
            DO 130 IPL = 1, NPLATES
               CALL INTFLAG_GET (IPACK, IPL, IFLG)
               IF (IFLG.EQ.1) ALL_WRITTEN = .FALSE.
 130        CONTINUE
            IF (ALL_WRITTEN) THEN
               CALL NOTICE_POSN(1, IXROOT, IYROOT)
               CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +            XDLSTR('*Intensities have already been written*'), 39,
     +                 XDLSTR(' '), -1,
     +                 XDLSTR('Cancel'), 6,
     +                 XDLSTR('Rewrite'), 7,
     +                 IFONT, 1, IBUTTON)
               IF (IBUTTON.EQ.1) GO TO 100         
            END IF
            CALL INT_FILNAM (' ', MTZ_FILE)
            IF (INT_TYP.EQ.1) THEN
               CALL MTZ_CHK1 (MTZ_FILE, IRET)
               IF (IRET.EQ.1) THEN
                  CALL ERR_NOTICE (1,
     +                 '**MTZ file exists and cannot be overwritten**') 
                  GO TO 100
               END IF
               IF (IRET.EQ.2) THEN
                  CALL NOTICE_POSN(1, IXROOT, IYROOT)
                  CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +            XDLSTR('*Overwrite existing file*'), 25,
     +                 XDLSTR(' '), -1,
     +                 XDLSTR('Yes'), 3,
     +                 XDLSTR('No'), 2,
     +                 IFONT, 1, IBUTTON)
                  IF (IBUTTON.EQ.2) GO TO 100 
               END IF        
               CALL MTZ_CHK2 (MTZ_FILE, IRET)
               IF (IRET.EQ.1) THEN
                  CALL ERR_NOTICE (1,
     +                 '**Cannot open MTZ file**') 
                  GO TO 100
               END IF
            ELSE
               CALL INT_FILNAM (' ', FILNAM)
               CALL FILEXT (FILNAM, 'xxx', GE1_FILE, ILEN)
               CALL FILEXT (FILNAM(1:ILEN), 'ge1', GE1_FILE, JLEN)
               CALL FILEXT (FILNAM(1:ILEN), 'ge2', GE2_FILE, JLEN)
               ANY_PRES = .FALSE.
               EXISTS = CCPEXS (GE1_FILE)
               IF (EXISTS) THEN
                  CALL LMESSAGE(IVH_IOW,'**.ge1 file already exists**')
                  ANY_PRES = .TRUE.
               END IF
               EXISTS = CCPEXS (GE2_FILE)
               IF (EXISTS) THEN
                  CALL LMESSAGE(IVH_IOW,'**.ge2 file already exists**')
                  ANY_PRES = .TRUE.
               END IF
               IF (ANY_PRES) THEN
                  CALL NOTICE_POSN(1, IXROOT, IYROOT)
                  CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +            XDLSTR('*Overwrite existing file(s)*'), 25,
     +                 XDLSTR(' '), -1,
     +                 XDLSTR('Yes'), 3,
     +                 XDLSTR('No'), 2,
     +                 IFONT, 1, IBUTTON)
                  IF (IBUTTON.EQ.2) GO TO 100 
               END IF
               IFAIL = 1
               CALL CCPDPN (-IUN_GE1, GE1_FILE,'UNKNOWN','DU',19,IFAIL)
               IF (IFAIL.LT.0) THEN
                  CALL ERR_NOTICE (1,
     +                 '**Error in opening the .ge1 file**') 
                  GO TO 100
               END IF
               IFAIL = 1
               CALL CCPDPN (-IUN_GE2, GE2_FILE,'UNKNOWN','DU',2,IFAIL)
               IF (IFAIL.LT.0) THEN
                  CALL ERR_NOTICE (1,
     +                 '**Error in opening the .ge2 file**') 
                  GO TO 100
               END IF
            END IF
            CALL WRITE_INTFILE (IPACK, INT_TYP, SCAL_INT,
     +                          MTZ_FILE, GE1_FILE, GE2_FILE, IERR)
            IF (IERR.EQ.1) THEN
               CALL ERR_NOTICE (1,
     +         '**Memory allocation error - could not write files**')
            END IF
            GO TO 100
C
C====== Select next pack
C
         ELSE IF (ITEM.EQ.M_NEXTPK) THEN
            CALL SET_NEWPLATE (IPACK+1, 1, IERR)
            CALL INT_PTAB3(2)
            GO TO 100
C
C====== Integration Status
C
         ELSE IF (ITEM.EQ.M_STAT) THEN
            CALL INTEG_STATUS
            GO TO 100
         END IF
         GO TO 100
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         IPRF_PK = 0
         IPRF_PL = 0
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         IPRF_PK = 0
         IPRF_PL = 0
         GO TO 100
C
C====== Parameter table 3 input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL INT_PTAB3 (1)
         IPRF_PK = 0
         IPRF_PL = 0
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SEL_REFINE       **
C**************************
C
C
      SUBROUTINE SEL_REFINE
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Handle input select refinement functions menu and parameter tables
C          1 and 2
C
C Author:  John W. Campbell, June 1991
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'lauegen_observed_spots.finc'
      INCLUDE 'spot_box.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL EXISTS
      LOGICAL ANY_PRES
      LOGICAL CONT
      LOGICAL RFCL
      LOGICAL DFLT1
      INTEGER NNOD
      INTEGER NVIEW
      INTEGER IVHLIST(3)
      INTEGER IVHLST2(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER I
      INTEGER IFAIL
      INTEGER IPLATE_SAV
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IBUTTON
      INTEGER M_RESET
      INTEGER M_DISP
      INTEGER M_MATCH
      INTEGER M_SEL_SEARCH
      INTEGER M_NODALS
      INTEGER M_AUTPL
      INTEGER M_NEXTPL
      INTEGER M_AUTPK
      INTEGER M_WRITEGE
      INTEGER M_NEXTPK
      INTEGER LISTE(2)
      INTEGER NUMSPOTS
      INTEGER NUMP
      INTEGER IFLAG
      INTEGER KEYPLATE
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) GEN_FILE
      CHARACTER*(MAXFLEN) GE1_FILE
      CHARACTER*(MAXFLEN) GE2_FILE
C
C====== Variables for .gen/.ge files... will be removed later
C
      LOGICAL WR_SPAT
      LOGICAL WR_CLOS
      LOGICAL DISTOR
      INTEGER MININT
      INTEGER PACK_ID
      INTEGER NUM_SPOTS
      INTEGER NUM_MULTIPLETS
      INTEGER NUM_SPATIALS
      INTEGER NUM_BOTH
      INTEGER NUM_NODALS

C     LOGICAL EXISTS          !File exists flag
C     LOGICAL ANY_PRES        !Any of the output files exists flag
C     LOGICAL CONT            !Continue writing files flag
C     LOGICAL RFCL            !Refine cell flag for auto-refine
C     LOGICAL DFLT1           !Default nodal index used for start cycles flag
C     INTEGER NNOD            !Nodal index/no. of nodals flag for auto-refine
C     INTEGER NVIEW           !No. of view objects for input
C     INTEGER IVHLIST(3)      !View-object handles list
C     INTEGER IVHLST2(2)      !2'nd view-object handles list
C     INTEGER IVH             !Returned view-object handle
C     INTEGER ITEM            !Returned menu item number
C     INTEGER IQUIT           !Quit flag from menu
C     INTEGER IERR            !Error flag
C     INTEGER I               !Temp/loop variable
C     INTEGER IFAIL           !Open file failure flag
C     INTEGER IPLATE_SAV       !Saved current film/plate number
C     INTEGER IXROOT          !Root x position for error notice
C     INTEGER IYROOT          !Root y position for error notice
C     INTEGER IBUTTON         !Button return from error notice
C     INTEGER M_RESET         !Menu item no.: Reset to First Pack
C     INTEGER M_DISP          !Menu item no.: Display/Measure Image
C     INTEGER M_MATCH         !Menu item no.: Match Spots and Refine
C     INTEGER M_SEL_SEARCH    !Menu item no.: Select, Search and Refine
C     INTEGER M_NODALS        !Menu item no.: Nodals Search and Refine
C     INTEGER M_AUTPL         !Menu item no.: Auto-refine Plate
C     INTEGER M_NEXTPL        !Menu item no.: Select Next Plate
C     INTEGER M_AUTPK         !Menu item no.: Auto-refine Pack
C     INTEGER M_WRITEGE       !Menu item no.: Write .ge Files
C     INTEGER M_NEXTPK        !Menu item no.: Select Next Pack
C     INTEGER LISTE(2)        !Dummy array for SET_PAR1_VALS call
C     INTEGER NUMSPOTS        !Number of Laue spots generated
C     INTEGER NUMP            !Number of packs
C     INTEGER IFLAG           !Parameter status flag
C     INTEGER KEYPLATE        !Key plate
C     CHARACTER*2 ERRSTR      !Error string
C     CHARACTER*80 STR        !Temporary string
C     CHARACTER*(MAXFLEN) FILNAM    !File name string
C     CHARACTER*(MAXFLEN) GEN_FILE  !.gen file name
C     CHARACTER*(MAXFLEN) GE1_FILE  !.ge1 file name
C     CHARACTER*(MAXFLEN) GE2_FILE  !.ge2 file name
C
C-------------------------------------------------------------------------------
C
C====== Check that pack input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) THEN
         CALL ERR_NOTICE (1, '**Number of packs is zero**')
         RETURN
      END IF
C
C====== Get key plate for current pack
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
C
C====== Zero spot box size calculation parameters
C
      SPOTD_LAST = 0.0
      SPOTL_LAST = 0.0
      USE_RADIAL = .FALSE.
C
C====== Intitialise menu item numbers
C
      M_RESET = 1
      M_DISP = 2
      M_MATCH = 3
      M_SEL_SEARCH = 4
      M_NODALS = 5
      M_AUTPL = 6
      M_NEXTPL = 7
      M_AUTPK = 8
      M_WRITEGE = 9
      M_NEXTPK = 10
C
C====== Set up 'Refinement Options' Menu
C
100   CALL SET_MENU3
C
C====== Get input from 'Refinement Options' menu or Parameter tables 1 & 2
C
      NVIEW = 3
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2

      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======= Quit (Return to Previous Menu) selected
C
         IF (IQUIT.EQ.1) RETURN
C
C====== Reset to First Pack
C
         IF (ITEM.EQ.M_RESET) THEN
            IF (IPACK.EQ.1) GO TO 100
            CALL SET_NEWPLATE (1, 0, IERR)
            CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
            GO TO 100
C
C====== Display/Measure Image
C
         ELSE IF (ITEM.EQ.M_DISP) THEN
            CALL DISPLAY_OPT
            GO TO 100
C
C====== Match Spots and Refine
C 
         ELSE IF (ITEM.EQ.M_MATCH) THEN
            CALL CHK_REFINE (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Spots**')
               GO TO 100
            END IF
            CALL MATCH_SPOTS (IERR)
            IF (IERR.GT.0) GO TO 100
            CALL MATCH_TO_OBS
            IF (NUM_OBS.EQ.0) GO TO 100
            CALL PREPARE_REFIN (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL REFINE_CALC
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Select, Search and Refine
C
         ELSE IF (ITEM.EQ.M_SEL_SEARCH) THEN
            CALL CHK_REFINE (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL CALC_LAUE (.TRUE.) 
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Spots**')
               GO TO 100
            END IF
            CALL SELECT_REFS (IERR)
            IF (IERR.GT.0) GO TO 100
            CALL SEARCH_SPOTS(IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL PREPARE_REFIN (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL REFINE_CALC
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Nodals Search and Refine
C
         ELSE IF (ITEM.EQ.M_NODALS) THEN
            CALL CHK_REFINE (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL CALC_LAUE (.TRUE.)
            CALL LRL_NUMSPOTS (NUMSPOTS)
            IF (NUMSPOTS.EQ.0) THEN
               CALL LMESSAGE(IVH_IOW,'**No Generated Spots**')
               GO TO 100
            END IF
            CALL FIND_SEL_NODS (1, 0, 1, 1, 0, 0, 0)
            CALL SEARCH_SPOTS(IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL PREPARE_REFIN (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL REFINE_CALC
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Auto-refine plate
C
         ELSE IF (ITEM.EQ.M_AUTPL) THEN
            CALL CHK_REFINE (IQUIT)
            IF (IQUIT.EQ.1) GO TO 100
            STR = 'plate'
            RFCL = .FALSE.
            IF (IPACK.EQ.1.AND.IPLATE.EQ.KEYPLATE) THEN
               RFCL = .TRUE.
               CALL IOW_ASKQ (IVH_IOW, 'Refine cell parameters', RFCL)
            END IF
            IF (RFCL) THEN
               CALL STR_ADDS (STR, 'cell', 1)
            ELSE
               CALL STR_ADDS (STR, 'nocell', 1)
            END IF
            DFLT1 = .TRUE.
            NNOD = 4
            CALL IOW_ASKI (IVH_IOW, 'Start nodal index or no. spots',
     +                     NNOD)
            IF (NNOD.NE.4) THEN
               CALL STR_ADDI (STR, NNOD, 1)
               DFLT1 = .FALSE.
            END IF
            NNOD = 6
            CALL IOW_ASKI (IVH_IOW, 'Final nodal index or no. spots',
     +                     NNOD)
            IF (NNOD.NE.6.OR..NOT.DFLT1) CALL STR_ADDI (STR, NNOD, 1)
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL AUTO_REFINE_CTL (1, STR, 2, 1, 4, 6)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Select Next Plate
C
         ELSE IF (ITEM.EQ.M_NEXTPL) THEN
            CALL SET_NEWPLATE (IPACK, IPLATE+1, IERR)
            GO TO 100
C
C====== Auto-refine pack
C
         ELSE IF (ITEM.EQ.M_AUTPK) THEN
            STR = 'pack'
            RFCL = .FALSE.
            IF (IPACK.EQ.1) THEN
               RFCL = .TRUE.
               CALL IOW_ASKQ (IVH_IOW, 'Refine cell parameters', RFCL)
            END IF
            IF (RFCL) THEN
               CALL STR_ADDS (STR, 'cell', 1)
            ELSE
               CALL STR_ADDS (STR, 'nocell', 1)
            END IF
            DFLT1 = .TRUE.
            NNOD = 4
            CALL IOW_ASKI (IVH_IOW, 'Start nodal index or no. spots',
     +                     NNOD)
            IF (NNOD.NE.4) THEN
               CALL STR_ADDI (STR, NNOD, 1)
               DFLT1 = .FALSE.
            END IF
            NNOD = 6
            CALL IOW_ASKI (IVH_IOW, 'Final nodal index or no. spots',
     +                     NNOD)
            IF (NNOD.NE.6.OR..NOT.DFLT1) CALL STR_ADDI (STR, NNOD, 1)
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL AUTO_REFINE_CTL (1, STR, 2, 1, 4, 6)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Write .ge Files
C
         ELSE IF (ITEM.EQ.M_WRITEGE) THEN
110         CALL LPROMPT 
     +        (IVH_IOW, 'Root name for .gen/.ge1/.ge2 files: ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, IERR)
            IF (FILNAM.EQ.' ') GO TO 100
            ANY_PRES = .FALSE.
            CALL FILEXT (FILNAM, 'gen', GEN_FILE, I)
            EXISTS = CCPEXS (GEN_FILE)
            IF (EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**.gen file already exists**')
               ANY_PRES = .TRUE.
            END IF
            CALL FILEXT (FILNAM, 'ge1', GE1_FILE, I)
            EXISTS = CCPEXS (GE1_FILE)
            IF (EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**.ge1 file already exists**')
               ANY_PRES = .TRUE.
            END IF
            CALL FILEXT (FILNAM, 'ge2', GE2_FILE, I)
            EXISTS = CCPEXS (GE2_FILE)
            IF (EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**.ge2 file already exists**')
               ANY_PRES = .TRUE.
            END IF
            IF (ANY_PRES) THEN
               CONT = .FALSE.
               CALL IOW_ASKQ (IVH_IOW, 'Overwrite existing files', 
     +                        CONT)
               IF (.NOT.CONT) GO TO 110
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GEN, GEN_FILE,'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,
     +              '**Error in opening the .gen file**')
               GO TO 110
            END IF
            CALL WRITE_GENFIL
            CLOSE (UNIT=IUN_GEN)
            IFAIL = 1
            CALL CCPDPN (-IUN_GE1, GE1_FILE,'UNKNOWN','DU',19,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,
     +              '**Error in opening the .ge1 file**')
               GO TO 110
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GE2, GE2_FILE,'UNKNOWN','DU',2,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,
     +              '**Error in opening the .ge2 file**')
               GO TO 110
            END IF
            WR_SPAT = .FALSE.
            CALL IOW_ASKQ(IVH_IOW,
     +        'Do you want to write spatials to the file',WR_SPAT)
            WR_CLOS = .FALSE.
            MININT = 100
            CALL IOW_ASKI(IVH_IOW,
     +      'Enter Min I to by-pass measurements on subsequent plates',
     +       MININT)
            DISTOR = .FALSE.
            CALL LDM_GET_PID (IPACK, PACK_ID, IFLAG, IERR, ERRSTR)
            CALL WRITE_GEFILE (IPACK, IUN_GE1, IUN_GE2, WR_SPAT, 
     +                         WR_CLOS,DISTOR, MININT, PACK_ID, 
     +                         KEYPLATE, NUM_SPOTS, NUM_MULTIPLETS,
     +                         NUM_SPATIALS, NUM_BOTH, NUM_NODALS)
            WRITE (STR,6060) NUM_SPOTS
            CALL LMESSAGE(IVH_IOW,STR)
            WRITE (STR,6070) NUM_MULTIPLETS
            CALL LMESSAGE(IVH_IOW,STR)
            WRITE (STR,6080) NUM_SPATIALS
            CALL LMESSAGE(IVH_IOW,STR)
            WRITE (STR,6090) NUM_BOTH
            CALL LMESSAGE(IVH_IOW,STR)
            WRITE (STR,6100) NUM_NODALS
            CALL LMESSAGE(IVH_IOW,STR)
            GO TO 100
C
C====== Select Next Pack
C
         ELSE IF (ITEM.EQ.M_NEXTPK) THEN
            IF (IPACK.EQ.NUMP) GO TO 100
            CALL SET_NEWPLATE (IPACK+1, 1, IERR)
            CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
            GO TO 100
         END IF
         GO TO 100
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         GO TO 100
      END IF
      GO TO 100

C
C====== Format statements
C
 6060 FORMAT ('Summary:',I6,' spots output, of which')
 6070 FORMAT (8X,I6,' were multiplets,')
 6080 FORMAT (8X,I6,' were spatial overlaps,')
 6090 FORMAT (8X,I6,' were both, and')
 6100 FORMAT (8X,I6,' were nodals.')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SEL_SOFT         **
C**************************
C
C
      SUBROUTINE SEL_SOFT
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Improve soft limits control routine
C
C Author:  John W. Campbell, March 1994
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER M_RESET
      INTEGER M_DMIN
      INTEGER M_LMIN
      INTEGER M_NEXT
      INTEGER IP_NPROF
      INTEGER IP_ROTAT
      INTEGER IP_PROMIN
      INTEGER IP_DNUMB
      INTEGER IP_DWIDTH
      INTEGER IP_LNUMB
      INTEGER IP_LWIDTH
      INTEGER IP_FRAC
      INTEGER IP_SIGTEST
      INTEGER IP_FRTEST
      INTEGER NUMP
      INTEGER NVIEW
      INTEGER IVHLIST(4)
      INTEGER IVH
      INTEGER ITM
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER ITYP
      INTEGER IFLAG
      INTEGER ND
      INTEGER IV
      INTEGER KEYPLATE
      INTEGER ITOG
      REAL FP
      REAL DMIN
      REAL LMIN
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL 
      CHARACTER*80 ERRSTR
      CHARACTER*80 STR

C     INTEGER M_RESET      !Menu item no.: Reset to first pack
C     INTEGER M_DMIN       !Menu item no.: Dmin soft limit determination
C     INTEGER M_LMIN       !Menu item no.: Lmin soft limit determination
C     INTEGER M_NEXT       !Menu item no.: Select next pack
C     INTEGER IP_NPROF     !Parameter table item no.: No. profile bins
C     INTEGER IP_ROTAT     !Parameter table 3 item: Rotate profiles flag
C     INTEGER IP_PROMIN    !Parameter table item no.: Min I for profiles
C     INTEGER IP_DNUMB     !Parameter table item no.: No. 'dmin' bins
C     INTEGER IP_DWIDTH    !Parameter table item no.: 'dmin' bin width
C     INTEGER IP_LNUMB     !Parameter table item no.: No. 'lmin' bins
C     INTEGER IP_LWIDTH    !Parameter table item no.: 'lmin' bin width
C     INTEGER IP_FRAC      !Parameter table item no.: Start soft limit fraction
C     INTEGER IP_SIGTEST   !Parameter table item no.: Significant intensity test
C     INTEGER IP_FRTEST    !Parameter table item no.: Soft limit criterion
C     INTEGER NUMP         !No. of packs
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(4)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITM          !Item no. modified in parameter table
C     INTEGER ITEM         !Item no. from menu selection
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER ITYP         !Return flag from INTFP or extended LDM param type
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IV           !Integer value
C     INTEGER ITOG         !Parameter table toggle flag
C     INTEGER KEYPLATE     !Key plate
C     REAL FP              !Real value
C     REAL DMIN            !'dmin' value
C     REAL LMIN            !'lambda-min' value
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !String for parameter table input value
C     CHARACTER*80 ERRSTR  !Error message string
C     CHARACTER*80 STR     !String

C
C-------------------------------------------------------------------------------
C
C====== Check that pack input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) THEN
         CALL ERR_NOTICE (1, '**Number of packs is zero**')
         RETURN
      END IF
C
C====== Reset to key plate if current plate is not key plate
C
      CALL SET_KEYPLATE
C
C====== Get key plate for current pack
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
C
C====== Intitialise menu item numbers
C
      M_RESET = 1
      M_DMIN = 2
      M_LMIN = 3
      M_NEXT = 4
C
C====== Set up parameter table 3
C
      IP_NPROF = 1
      IP_ROTAT = 2
      IP_PROMIN = 3
      IP_DNUMB = 4
      IP_DWIDTH = 5
      IP_LNUMB = 6
      IP_LWIDTH = 7
      IP_FRAC = 8
      IP_SIGTEST = 9
      IP_FRTEST = 10
C
C====== Get bin width sizes
C
      CALL SOFT_BINS (1, ISOFT_D_NUMBINS, SOFT_DMIN_WIDTH)
      CALL SOFT_BINS (2, ISOFT_L_NUMBINS, SOFT_LMIN_WIDTH)

      CALL LDM_GET ('NPROF', 1, 1, STR, 
     +              FP, ND, NPROF, IFLAG, ITYP, IERR, ERRSTR)
      WRITE (STR,'(I8)') NPROF
      CALL LJUST(STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_NPROF,
     +     XDLSTR('nprof:'), 6,
     +     XDLSTR(STR),25, 0, 1, IERR)
      PRF_ROT = .FALSE.
      CALL LDM_GET ('PROF_ROTATE', IPACK, IPLATE, STR, 
     +              FP, ND, IV, IFLAG, ITYP, IERR, ERRSTR)
      IF (STR.EQ.'yes') PRF_ROT = .TRUE.
      ITOG = 4
      IF (PRF_ROT) ITOG = 3
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_ROTAT,
     +     XDLSTR('prof_rotate:'), 12,
     +     XDLSTR(' '), 1, ITOG, 1, IERR)
      CALL LDM_GET ('PROMIN', 1, 1, STR, 
     +              PROMIN, ND, IV, IFLAG, ITYP, IERR, ERRSTR)
      WRITE (STR,'(F8.1)') PROMIN
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_PROMIN,
     +     XDLSTR('promin:'), 7,
     +     XDLSTR(STR), LENSTR(STR), 0, 1, IERR)
      WRITE (STR,'(I8)') ISOFT_D_NUMBINS
      CALL LJUST(STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_DNUMB,
     +     XDLSTR('No. ''dmin'' bins:'), 16,
     +     XDLSTR(STR),25, 0, 0, IERR)
      WRITE (STR,'(F8.2)') SOFT_DMIN_WIDTH
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_DWIDTH,
     +     XDLSTR('Bin width (dmin):'), 17,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(I8)') ISOFT_L_NUMBINS
      CALL LJUST(STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_LNUMB,
     +     XDLSTR('No. ''lmin'' bins:'), 16,
     +     XDLSTR(STR),25, 0, 0, IERR)
      WRITE (STR,'(F8.2)') SOFT_LMIN_WIDTH
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_LWIDTH,
     +     XDLSTR('Bin width (lmin):'), 17,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.2)') SOFT_FRAC
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_FRAC,
     +     XDLSTR('Start fraction:'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.1)') SOFT_SIGTEST
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_SIGTEST,
     +     XDLSTR('Sigma test:'), 11,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.2)') SOFT_FRTEST
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_FRTEST,
     +     XDLSTR('Fraction test:'), 14,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)

C
C====== Set up 'Refinement Options' Menu
C
100   CALL SET_MENU8
C
C====== Get input from 'Soft Limits Options' menu or Parameter tables 1 & 2
C
      NVIEW = 4
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2
      IVHLIST(4) = IVH_PAR3

      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======= Quit (Return to Previous Menu) selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            RETURN
         END IF
C
C====== Reset to first pack (and keyplate)
C
         IF (ITEM.EQ.M_RESET) THEN
            IF (IPACK.EQ.1.AND.IPLATE.EQ.KEYPLATE) GO TO 100
            CALL SET_NEWPLATE (1, 0, IERR)
            GO TO 100
C
C====== Determine 'dmin'
C 
         ELSE IF (ITEM.EQ.M_DMIN) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL SOFT_CALC (1, IERR)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Determine 'lmin'
C
         ELSE IF (ITEM.EQ.M_LMIN) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL SOFT_CALC (2, IERR)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Select next pack
C
         ELSE IF (ITEM.EQ.M_NEXT) THEN
            CALL SET_NEWPLATE (IPACK+1, 0, IERR)
            GO TO 100
         END IF
         GO TO 100
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         GO TO 100
C
C====== Parameter table 3 input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITM.EQ.IP_NPROF) THEN
            CALL LDM_SET ('NPROF', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR) 
               GO TO 100
            END IF 
            GO TO 100
         ELSE IF (ITM.EQ.IP_ROTAT) THEN
            CALL LDM_SET ('PROF_ROTATE', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR) 
               GO TO 100
            END IF 
            GO TO 100
         ELSE IF (ITM.EQ.IP_PROMIN) THEN
            CALL LDM_SET ('PROMIN', IPACK, IPLATE, PVAL, 
     +                     IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR(ERRSTR), LENSTR(ERRSTR), IERR) 
               GO TO 100
            END IF 
            GO TO 100
         ELSE IF (ITM.EQ.IP_DNUMB) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.NE.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Integer Format**'), 26, IERR)
               GO TO 100
            END IF
            IF (IV.LT.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Must be >= 0**'), 16, IERR)
               GO TO 100
            END IF
            IF (IV.GT.MAX_SOFT_BINS) THEN
               STR = '**Number of bins exceeds limit of'
               CALL STR_ADDI (STR,MAX_SOFT_BINS,1)
               CALL STR_ADDS (STR,'**',0)
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR(STR), LENSTR(STR), IERR)
               GO TO 100
            END IF
            ISOFT_D_NUMBINS = IV
            WRITE (STR,'(I8)') ISOFT_D_NUMBINS
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_DWIDTH) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SOFT_DMIN_WIDTH = FP
            WRITE (STR,'(F8.2)') SOFT_DMIN_WIDTH
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_LNUMB) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.NE.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Integer Format**'), 26, IERR)
               GO TO 100
            END IF
            IF (IV.LT.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Must be >= 0**'), 16, IERR)
               GO TO 100
            END IF
            IF (IV.GT.MAX_SOFT_BINS) THEN
               STR = '**Number of bins exceeds limit of'
               CALL STR_ADDI (STR,MAX_SOFT_BINS,1)
               CALL STR_ADDS (STR,'**',0)
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR(STR), LENSTR(STR), IERR)
               GO TO 100
            END IF
            ISOFT_L_NUMBINS = IV
            WRITE (STR,'(I8)') ISOFT_L_NUMBINS
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_LWIDTH) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SOFT_LMIN_WIDTH = FP
            WRITE (STR,'(F8.2)') SOFT_LMIN_WIDTH
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_FRAC) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            IF (FP.GT.1.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be <= 1.0**'), 24, IERR)
               GO TO 100
            END IF
            SOFT_FRAC = FP
            WRITE (STR,'(F8.2)') SOFT_FRAC
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_SIGTEST) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SOFT_SIGTEST = FP
            WRITE (STR,'(F8.1)') SOFT_SIGTEST
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_FRTEST) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            IF (FP.GT.1.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be <= 1.0**'), 24, IERR)
               GO TO 100
            END IF
            SOFT_FRTEST = FP
            WRITE (STR,'(F8.2)') SOFT_FRTEST
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SEL_SPOTSIZE     **
C**************************
C
C
      SUBROUTINE SEL_SPOTSIZE
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Determine Spot Size  control routine
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'spot_sizes.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER INTFP
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER M_RESET
      INTEGER M_FIND
      INTEGER M_NEXT
      INTEGER IP_NBIN
      INTEGER IP_CUT
      INTEGER IP_THR
      INTEGER IP_EXPND
      INTEGER NUMP
      INTEGER NVIEW
      INTEGER IVHLIST(4)
      INTEGER IVH
      INTEGER ITM
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER ITYP
      INTEGER IFLAG
      INTEGER ND
      INTEGER IV
      INTEGER KEYPLATE
      INTEGER IMTYP
      REAL FP
      CHARACTER*2 VALSTR
      CHARACTER*(MAX_P3SCROLL_CHARS) PVAL 
      CHARACTER*80 ERRSTR
      CHARACTER*80 STR

C     INTEGER M_RESET      !Menu item no.: Reset to first pack
C     INTEGER M_FIND       !Menu item no.: Determine spot size
C     INTEGER M_NEXT       !Menu item no.: Select next pack
C     INTEGER IP_NBIN      !Parameter table item no.: No. angle bins
C     INTEGER IP_CUT       !Parameter table item no.: Standard deviation cutoff
C     INTEGER IP_THR       !Parameter table item no.: Search threshold factor
C     INTEGER IP_EXPND     !Parameter table item no.: Expansion factor
C     INTEGER NUMP         !No. of packs
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(4)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITM          !Item no. modified in parameter table
C     INTEGER ITEM         !Item no. from menu selection
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER ITYP         !Return flag from INTFP
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IV           !Integer value
C     INTEGER KEYPLATE     !Key plate
C     INTEGER IMTYP        !Image type flag (LDM)
C     REAL FP              !Real value
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*(MAX_P3SCROLL_CHARS) PVAL !String for parameter table input value
C     CHARACTER*80 ERRSTR  !Error message string
C     CHARACTER*80 STR     !String

C
C-------------------------------------------------------------------------------
C
C====== Check that pack input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) THEN
         CALL ERR_NOTICE (1, '**Number of packs is zero**')
         RETURN
      END IF
C
C====== Reset to key plate if current plate is not key plate
C
      CALL SET_KEYPLATE
C
C====== Get key plate for current pack
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
C
C====== Intitialise menu item numbers
C
      M_RESET = 1
      M_FIND = 2
      M_NEXT = 3
C
C====== Set up parameter table 3
C
      IP_THR = 1
      IP_NBIN = 2
      IP_CUT = 3
      IP_EXPND = 4
      WRITE (STR,'(F8.2)') SPOT_THRFAC
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_THR,
     +     XDLSTR('Threshold factor:'), 17,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(I8)') ISPOT_NBIN
      CALL LJUST(STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_NBIN,
     +     XDLSTR('No. angle bins:'), 15,
     +     XDLSTR(STR),25, 0, 0, IERR)
      WRITE (STR,'(F8.2)') SPOT_SDCUT
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_CUT,
     +     XDLSTR('Std Dev cutoff:'), 15,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
      WRITE (STR,'(F8.2)') SPOT_EXPAND
      CALL LJUST (STR)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR3, IP_EXPND,
     +     XDLSTR('Expand by:'), 10,
     +     XDLSTR(STR), LENSTR(STR), 0, 0, IERR)
C
C====== Set up 'Spotsize Options' Menu
C
100   CALL SET_MENU9
C
C====== Get input from 'Soft Limits Options' menu or Parameter tables 1 & 2
C
      NVIEW = 4
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_PAR1
      IVHLIST(3) = IVH_PAR2
      IVHLIST(4) = IVH_PAR3

      CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C====== Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======= Quit (Return to Previous Menu) selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_PARAM_TABLE_CLEARITEMS (IVH_PAR3, IERR)
            RETURN
         END IF
C
C====== Reset to first pack (and keyplate)
C
         IF (ITEM.EQ.M_RESET) THEN
            IF (IPACK.EQ.1.AND.IPLATE.EQ.KEYPLATE) GO TO 100
            CALL SET_NEWPLATE (1, 0, IERR)
            GO TO 100
C
C====== Determine spot size
C 
         ELSE IF (ITEM.EQ.M_FIND) THEN
            CALL LOG_CHANGES (1)
            CALL LDM_CH_RESET (1)
            CALL SPOTSIZE_CALC (IERR)
            CALL LDM_CH_RESET (1)
            GO TO 100
C
C====== Select next pack
C
         ELSE IF (ITEM.EQ.M_NEXT) THEN
            CALL SET_NEWPLATE (IPACK+1, 0, IERR)
            GO TO 100
         END IF
         GO TO 100
C
C====== Parameter table 1 input
C
      ELSE IF (IVH.EQ.IVH_PAR1) THEN
         CALL PAR1_INPUT
         GO TO 100
C
C====== Parameter table 2 input
C
      ELSE IF (IVH.EQ.IVH_PAR2) THEN
         CALL PAR2_INPUT
         GO TO 100
C
C====== Parameter table 3 input
C
      ELSE IF (IVH.EQ.IVH_PAR3) THEN
         CALL XDLF_PARAM_TABLE_GETVALUE (IVH_PAR3, ITM,
     +        XDLSTR(PVAL), MAX_P3SCROLL_CHARS, IERR)
         IF (ITM.EQ.IP_THR) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.1.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Threshold factor must be >1.0**'), 
     +                     33, IERR)  
               GO TO 100
            END IF
            SPOT_THRFAC = FP
            WRITE (STR,'(F8.2)') SPOT_THRFAC
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_NBIN) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.NE.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Integer Format**'), 26, IERR)
               GO TO 100
            END IF
            IF (IV.LT.1) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Number of bins must be > 0**'), 30, IERR)  
               GO TO 100
            END IF
            IF (IV.GT.64) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Number of bins exceeds limit of 64**'), 
     +              38, IERR)
               GO TO 100
            END IF
            ISPOT_NBIN = IV
            WRITE (STR,'(I8)') ISPOT_NBIN
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_CUT) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than zero**'), 35, IERR)
               GO TO 100
            END IF
            SPOT_SDCUT = FP
            WRITE (STR,'(F8.2)') SPOT_SDCUT
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         ELSE IF (ITM.EQ.IP_EXPND) THEN
            ITYP = INTFP (PVAL, FP, IV)
            IF (ITYP.EQ.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +              XDLSTR('**Invalid Number Format**'), 25, IERR)
               GO TO 100
            END IF
            IF (FP.LE.1.0) THEN
               CALL XDLF_PARAM_TABLE_ERROR (IVH_PAR3, ITM,
     +         XDLSTR('**Value must be greater than 1.0**'), 34, IERR)
               GO TO 100
            END IF
            SPOT_EXPAND = FP
            WRITE (STR,'(F8.2)') SPOT_EXPAND
            CALL LJUST(STR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR3, ITM,
     +           XDLSTR(STR), LENSTR(STR), 0, IERR)
            GO TO 100
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SELECT_REFS      **
C**************************
C
C
      SUBROUTINE SELECT_REFS (IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Display image, select/edit reflections list for refinement spots
C          search
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
      INTEGER IERR
C 
C IERR    (W)   Error flag =0 OK, =1 error opening image file / displaying image
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'image.finc'
      INCLUDE 'matches.finc'
      INCLUDE 'selrefs.finc'
      INCLUDE 'symbol_types.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      INTEGER NXTTOK
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL EXISTS 
      LOGICAL CONT
      LOGICAL REPLY
      LOGICAL CLEAR
      LOGICAL SPAT
      LOGICAL NODFLG
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) REFLIST_FILE
      INTEGER I
      INTEGER J
      INTEGER KERR
      INTEGER IVHLIST(3)
      INTEGER IVHLST2(2)
      INTEGER NVIEW
      INTEGER I_ADD
      INTEGER I_DEL
      INTEGER IADDEL
      INTEGER IDISP
      INTEGER ITEM
      INTEGER IVH
      INTEGER M_ALL
      INTEGER M_NODALS
      INTEGER M_NODIDX
      INTEGER M_NODHKL
      INTEGER M_CLEAR
      INTEGER M_INPUT
      INTEGER M_DELETE
      INTEGER M_READ
      INTEGER M_WRITE
      INTEGER IQUIT
      INTEGER IDSQLIM
      INTEGER IDSQMIN
      INTEGER IXP
      INTEGER IYP
      INTEGER ISPIX
      INTEGER IFPIX
      INTEGER ID
      INTEGER ISPOT
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IFAIL
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER NADD
      INTEGER NERR
      INTEGER NVALS
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IFLAG
      INTEGER ND 
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER MULT
      INTEGER NUMSPOTS 
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL    VALUES(20)
      REAL    XFD
      REAL    YFD
      REAL    ALAM
      REAL    DTHR2

C     LOGICAL EXISTS       !File exists flag
C     LOGICAL CONT         !Continue with writing file flag
C     LOGICAL REPLY        !Yes/no reply flag (.TRUE./.FALSE.)
C     LOGICAL CLEAR        !Clear reflections list flag
C     LOGICAL SPAT         !Spatial overlap flag
C     LOGICAL NODFLG       !Nodal spot flag
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR   !Error string (dummy)
C     CHARACTER*80 STR     !Character string for messages
C     CHARACTER*(MAXFLEN) FILNAM       !File name as input
C     CHARACTER*(MAXFLEN) REFLIST_FILE    !Reflections list file name
C     INTEGER I            !Temp/loop variable
C     INTEGER J            !Temp/loop variable
C     INTEGER KERR         !Error return flag
C     INTEGER IVHLIST(3)   !List of view-object handles for getting events
C     INTEGER IVHLST2(2)   !Second list of view-objects for getting events
C     INTEGER NVIEW        !Number of view-objects for getting events
C     INTEGER I_ADD        !Add option value flag for IADDEL
C     INTEGER I_DEL        !Delete option value flag for IADDEL
C     INTEGER IADDEL       !Add/Delete spots flag (I_ADD or I_DEL)
C     INTEGER IDISP        !Display predicted spots flag =0 all, =1 nodals
C     INTEGER ITEM         !Menu item number selected
C     INTEGER IVH          !View-object handle of view object returning event
C     INTEGER M_ALL        !Menu item no.: Display all predicted reflections
C     INTEGER M_NODALS     !Menu item no.: Display nodals only
C     INTEGER M_NODIDX     !Menu item no.: Select by Nodal Index
C     INTEGER M_NODHKL     !Menu item no.: Select by Nodal h,k,l
C     INTEGER M_CLEAR      !Menu item no.: Clear spots list
C     INTEGER M_INPUT      !Menu item no.: Input (add) reflections
C     INTEGER M_DELETE     !Menu item no.: Delete reflections
C     INTEGER M_READ       !Menu item no.: Read reflections list file
C     INTEGER M_WRITE      !Menu item no.: Write reflections list file
C     INTEGER IQUIT        !Quit return flag from menu input
C     INTEGER IDSQLIM      !Distance squared tolerance for pixel selection 
C     INTEGER IDSQMIN      !Min distance squared founf in pixel selection
C     INTEGER IXP          !Returned x pixel value from film-image display
C     INTEGER IYP          !Returned y pixel value from film-image display
C     INTEGER ISPIX        !Pixel position along slow axis
C     INTEGER IFPIX        !Pixel position along fast axis
C     INTEGER ID           !Distance squared from pixel
C     INTEGER ISPOT        !Index in list of nearest spot/symbol found
C     INTEGER IXROOT       !X root position for popup notice
C     INTEGER IYROOT       !Y root position for popup notice
C     INTEGER IFAIL        !Error flag for CCPDPN routine
C     INTEGER IH           !Reflection h index
C     INTEGER IK           !Reflection k index
C     INTEGER IL           !Reflection l index
C     INTEGER M1           !Token start position
C     INTEGER M2           !Token end position
C     INTEGER NADD         !Number of reflns added from input 'reflist' file
C     INTEGER NERR         !Number of errors reading 'reflist' file
C     INTEGER NVALS        !Number of numerical values in 'reflist' file record
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER JH           !h index
C     INTEGER JK           !k index
C     INTEGER JL           !l index
C     INTEGER MULT         !Multiplicity
C     INTEGER NUMSPOTS     !No. of spots in generated spots list
C     REAL MM_RAST_X       !mm to x-rasters conversion factor
C     REAL MM_RAST_Y       !mm to y-rastrs conversion factor
C     REAL    VALUES(20)   !Numerical values from 'reflist' file record
C     REAL    XFD          !X coordinate on detector (rast) (distort. corrected)
C     REAL    YFD          !Y coordinate on detector (rast) (distort. corrected)
C     REAL    ALAM         !Wavelength
C     REAL    DTHR2        !dmin-threshold**2
C
C-------------------------------------------------------------------------------
C
C====== Get some parameters
C
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LRL_NUMSPOTS (NUMSPOTS)
C
C====== Display image
C
      CALL SHOW_IMAGE(1, IERR)
      IF (IERR.EQ.1) RETURN
C
C====== Set max limit for IDSQMIN to consider as a position match
C
      IDSQLIM = 18*NCMP*NCMP
C
C====== Determine whether to display all reflns or nodals at start
C
      IDISP = 0
      IF (NUMSPOTS.GT.MAX_DISP) THEN
         CALL FIND_SEL_NODS (1, 1, 1, 1, 0, 0, 0)
         IDISP = 1
      END IF
C
C====== Display predicted positions
C
      NUM_MATCH = 0
      CALL PLOT_SYMBS (IDISP, 2)
C
C====== Set up Reflections List Selection Options Menu
C
      M_ALL = 1
      M_NODALS = 2
      M_NODIDX = 3
      M_NODHKL = 4
      M_CLEAR = 5
      M_INPUT = 6
      M_DELETE = 7
      M_READ = 8
      M_WRITE = 9
      CALL SET_MENU5
C
C====== Service Reflections List Selection Menu and Film Image Display
C
      I_ADD = 1
      I_DEL = 2
      IADDEL = 0
      IVHLIST(1) = IVH_MENU
      IVHLIST(2) = IVH_FILM
      NVIEW = 1

100   CALL XDLF_GET_EVENTS(NVIEW,IVHLIST,IVH)

C
C====== Menu item selected
C
      IF (IVH.EQ.IVH_MENU) THEN
         CALL XDLF_MENU_AREA_GETITEM(IVH_MENU,ITEM,IQUIT)
C
C====== Quit ('End reflections input') selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, KERR)
            CALL XDLF_DELETE_VIEW_OBJECT(IVH_FILM,KERR)
            NUM_SELECT = NUM_MATCH
            IF (NUM_SELECT.GT.0) THEN
               DO 10 I = 1, NUM_SELECT
                  SEL_REFS(I) = IREF_MATCH(I)
10             CONTINUE
            END IF
            RETURN
         END IF
C
C====== Display all predicted reflections
C
         IF (ITEM.EQ.M_ALL) THEN
            IF (NUMSPOTS.GT.MAX_DISP) THEN
               CALL ERR_NOTICE (1,'**Too many spots to display**')
               GO TO 100
            END IF
            IDISP = 0
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            CALL PLOT_SYMBS (IDISP, 2)        
            GO TO 100
C
C====== Display nodals only
C
         ELSE IF (ITEM.EQ.M_NODALS) THEN
            CALL FIND_SEL_NODS (1, 1, 1, 1, 0, 0, 0)
            IDISP = 1
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            CALL PLOT_SYMBS (IDISP, 2)
            GO TO 100
C
C====== Select by nodal index
C
         ELSE IF (ITEM.EQ.M_NODIDX) THEN
            CALL FIND_SEL_NODS (1, 1, 1, 1, 0, 0, 0)
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            NUM_MATCH = 0
            DO 20 I = 1, NUM_SELECT
               NUM_MATCH = NUM_MATCH + 1
               IF (NUM_MATCH.GT.MAX_MATCH) THEN
                  IF (NUM_MATCH.EQ.MAX_MATCH+1) THEN
                     STR = '**Selected spots list truncated to'
                     CALL STR_ADDI(STR,MAX_MATCH,1)
                     CALL STR_ADDS(STR,'spots**',1)
                     CALL ERR_NOTICE(0,STR)
                  END IF
               ELSE
                  J = SEL_REFS(I)
                  IREF_MATCH(NUM_MATCH) = J
                  CALL LRL_GET (J, JH, JK, JL, XFD, YFD, ALAM, 
     +                          DTHR2, MULT, NODFLG, SPAT, KERR)
                  IXPIX_MATCH(NUM_MATCH)=NINT(XFD)
                  IYPIX_MATCH(NUM_MATCH)=NINT(YFD)
               END IF
 20         CONTINUE
            NUM_MATCH = MIN (NUM_MATCH,MAX_MATCH)
            CALL PLOT_SYMBS (IDISP, 2)
            GO TO 100
C
C====== Select by nodal h, k, l
C
         ELSE IF (ITEM.EQ.M_NODHKL) THEN
            CALL FIND_SEL_NODS (1, 1, 2, 1, 0, 0, 0)
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            NUM_MATCH = 0
            DO 30 I = 1, NUM_SELECT
               NUM_MATCH = NUM_MATCH + 1
               IF (NUM_MATCH.GT.MAX_MATCH) THEN
                  IF (NUM_MATCH.EQ.MAX_MATCH+1) THEN
                     STR = '**Selected spots list truncated to'
                     CALL STR_ADDI(STR,MAX_MATCH,1)
                     CALL STR_ADDS(STR,'spots**',1)
                     CALL ERR_NOTICE(0,STR)
                  END IF
               ELSE
                  J = SEL_REFS(I)
                  IREF_MATCH(NUM_MATCH) = J
                  CALL LRL_GET (J, JH, JK, JL, XFD, YFD, ALAM, 
     +                          DTHR2, MULT, NODFLG, SPAT, KERR)
                  IXPIX_MATCH(NUM_MATCH)=NINT(XFD)
                  IYPIX_MATCH(NUM_MATCH)=NINT(YFD)
               END IF
 30         CONTINUE
            NUM_MATCH = MIN (NUM_MATCH,MAX_MATCH)
            CALL PLOT_SYMBS (IDISP, 2)
            GO TO 100
C
C====== Clear Matches List
C
         ELSE IF (ITEM.EQ.M_CLEAR) THEN
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,KERR)
            NUM_MATCH = 0
            CALL PLOT_SYMBS (IDISP, 2)
            NVIEW = 1
            GO TO 100
C
C====== Input Reflections
C
         ELSE IF (ITEM.EQ.M_INPUT) THEN
            NVIEW = 2
            IADDEL = I_ADD
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +           XDLSTR(
     +      'Input predicted position of spot to add'),
     +                   44,KERR)
            GO TO 100
C
C====== Delete Reflections
C
         ELSE IF (ITEM.EQ.M_DELETE) THEN
            NVIEW = 2
            IADDEL = I_DEL
            CALL XDLF_IMAGE_INPUT_MESSAGE (IVH_FILM,
     +           XDLSTR(
     +      'Input predicted position of spot to delete'),
     +                   48,KERR)
            GO TO 100
C
C====== Read Reflections List File
C
         ELSE IF (ITEM.EQ.M_READ) THEN
            IF (NUMSPOTS.EQ.0) THEN
               CALL ERR_NOTICE (1,'**No spots predicted**')
               GO TO 100
            END IF
            CLEAR = .FALSE.
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, KERR)
            IF (NUM_MATCH.GT.0) THEN
               REPLY = .FALSE.
               CALL IOW_ASKQ (IVH_IOW, 
     +              'Add to existing reflections list', REPLY)
               IF (.NOT.REPLY) THEN
                  CALL IOW_ASKQ (IVH_IOW, 
     +                 'Overwrite existing reflections list',
     +            REPLY)
                  IF (.NOT.REPLY) THEN
                     CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, KERR)
                     GO TO 100
                  END IF
                  CLEAR = .TRUE.
              END IF
            END IF
            NVIEW = 1
102         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.reflist): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, KERR)
            IF (FILNAM.EQ.' ') THEN
               CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
               GO TO 100
            END IF
            CALL FILEXT (FILNAM, 'reflist', REFLIST_FILE, I)
            EXISTS = CCPEXS (REFLIST_FILE)
            IF (.NOT.EXISTS) THEN
               CALL LMESSAGE(IVH_IOW,'**File not found**')
               GO TO 102
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_REFLIST, REFLIST_FILE,
     +                    'READONLY','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 102
            END IF
            READ (IUN_REFLIST,'(A)',END=104) STR
            J = 0
            IF (NXTTOK (STR, ' ', J, M1, M2).EQ.0) THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''reflist:'' keyword**')
               CLOSE (IUN_REFLIST)
               GO TO 102
            END IF
            CALL CCPUPC(STR)
            IF (STR(M1:M2).NE.'REFLIST:') THEN
               CALL LMESSAGE (IVH_IOW, 
     +          '**File does not start with ''reflist:'' keyword**')
               CLOSE (IUN_REFLIST)
               GO TO 102
            END IF
            IF (CLEAR) NUM_MATCH = 0
            NERR = 0
            NADD = 0
103         READ (IUN_REFLIST,'(A)',END=104) STR
            IF (STR.EQ.' ') GO TO 103
            CALL STRVAL (STR, ' =', 20, VALUES, NVALS)
            IF (NVALS.NE.3) THEN
               CALL LMESSAGE(IVH_IOW,'**Invalid format in record**')
               NERR = NERR + 1
               GO TO 103
            END IF
            IF (NUM_MATCH.GE.MAX_MATCH) THEN
               CALL LMESSAGE (IVH_IOW,'**Reflections list full**')
               NERR = NERR + 1
               GO TO 104
            END IF
            IH = NINT(VALUES(1))
            IK = NINT(VALUES(2))
            IL = NINT(VALUES(3))
            DO 350 I=1,NUMSPOTS
               CALL LRL_GET (J, JH, JK, JL, XFD, YFD, ALAM, 
     +                       DTHR2, MULT, NODFLG, SPAT, KERR)
               IF (IH.EQ.JH.AND.IK.EQ.JK.AND.IL.EQ.JL) THEN
                  NUM_MATCH = NUM_MATCH + 1
                  IREF_MATCH(NUM_MATCH) = I
                  IXPIX_MATCH(NUM_MATCH)=NINT(XFD)
                  IYPIX_MATCH(NUM_MATCH)=NINT(YFD)
                  NADD = NADD + 1
                  GO TO 103
               END IF
350         CONTINUE
            STR = '**Cannot find reflection'
            CALL STR_ADDI (STR, IH, 1)
            CALL STR_ADDI (STR, IK, 1)
            CALL STR_ADDI (STR, IL, 1)
            CALL STR_ADDS (STR, 'in the predicted spots list**',
     +        1)
            CALL LMESSAGE (IVH_IOW, STR)
            NERR = NERR + 1
            GO TO 103
104         CLOSE (IUN_REFLIST)
            STR = 'Number of reflections added ='
            CALL STR_ADDI (STR, NADD, 1)
            CALL LMESSAGE (IVH_IOW, STR)
            IF (NERR.GT.0) THEN
               STR = '**Number of errors ='
               CALL STR_ADDI (STR, NERR, 1)
               CALL STR_ADDS (STR,'**',1)
               CALL LMESSAGE (IVH_IOW, STR)
            END IF
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, KERR)
            CALL PLOT_SYMBS (IDISP, 2)
            IF (NERR.EQ.0) CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
            GO TO 100
C
C====== Write Reflections List File
C
         ELSE IF (ITEM.EQ.M_WRITE) THEN
            CALL NOTICE_POSN (1,IXROOT,IYROOT)
            NVIEW = 1
            IF (NUM_MATCH.LE.0) THEN
               CALL ERR_NOTICE(1,'**No Reflections in list**')
               GO TO 100
            END IF
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, KERR)
105         CALL LPROMPT 
     +        (IVH_IOW, 'File name (default ext=.reflist): ')
            IVHLST2(1) = IVH_IOW
            CALL XDLF_GET_EVENTS (1, IVHLST2, IVH)
            CALL XDLF_IO_WINDOW_GETSTRING (IVH_IOW, XDLSTR(FILNAM),
     +           MAXFLEN, KERR)
            IF (FILNAM.EQ.' ') THEN
               CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
               GO TO 100
            END IF
            CALL FILEXT (FILNAM, 'reflist', REFLIST_FILE, I)
            CALL LGFILE_EXISTS (REFLIST_FILE, CONT)
            IF (.NOT.CONT) GO TO 105
            IFAIL = 1
            CALL CCPDPN (-IUN_REFLIST, REFLIST_FILE,
     +                   'UNKNOWN','F',0,IFAIL)
            IF (IFAIL.LT.0) THEN
               CALL LMESSAGE(IVH_IOW,'**Error in opening the file**')
               GO TO 105
            END IF
            WRITE (IUN_REFLIST,'(''reflist:'')')
            DO 106 I=1,NUM_MATCH
               J = IREF_MATCH(I)
               CALL LRL_GET (J, JH, JK, JL, XFD, YFD, ALAM, 
     +                          DTHR2, MULT, NODFLG, SPAT, KERR)
               WRITE (IUN_REFLIST,'(3I5)') JH, JK, JL
106         CONTINUE
            CLOSE (IUN_REFLIST)
            CALL XDLF_VIEW_OBJECT_RAISE(IVH_FILM, KERR)
            GO TO 100
         ELSE
            GO TO 100
         END IF
         GO TO 100
C
C====== Input from film/image-plate image display
C
      ELSE IF (IVH.EQ.IVH_FILM) THEN
         IF (IADDEL.EQ.I_ADD) THEN
            CALL XDLF_IMAGE_GETPIX_OVLY (IVH_FILM, 1,
     +         IXP, IYP, KERR)
            IF (NUM_DISP.LE.0) GO TO 100
            IDSQMIN = NXRAST*NXRAST + NYRAST*NYRAST
            ISPOT = 0
            DO 200 I=1,NUM_DISP
               ID = (IXP-IXPIX_DISP(I))**2 + (IYP-IYPIX_DISP(I))**2
               IF (ID.GT.IDSQLIM) GO TO 200
               IF (ID.LT.IDSQMIN) THEN
                  ISPOT = I
                  IDSQMIN = ID
               END IF
200         CONTINUE
            IF (ISPOT.EQ.0) GO TO 100
            IF (NUM_MATCH.GE.MAX_MATCH) THEN
               CALL ERR_NOTICE (0,'**Reflections list is full**')
               GO TO 100
            END IF
            NUM_MATCH = NUM_MATCH + 1
            IXPIX_MATCH(NUM_MATCH) = IXPIX_DISP(ISPOT)
            IYPIX_MATCH(NUM_MATCH) = IYPIX_DISP(ISPOT)
            IREF_MATCH(NUM_MATCH) = IREF_DISP(ISPOT)
            CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM,
     +           IXPIX_DISP(ISPOT), IYPIX_DISP(ISPOT),
     +           ISYMBTYP(ISYMB_DISP(ISPOT)), 
     +           ICOLRTYP(ISYMB_DISP(ISPOT)),
     +           1, KERR)
            CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +           IXPIX_MATCH(NUM_MATCH), IYPIX_MATCH(NUM_MATCH),
     +           ISYMBTYP(3), ICOLRTYP(3), 1, KERR)
         ELSE IF (IADDEL.EQ.I_DEL) THEN
            CALL XDLF_IMAGE_GETPIX_OVLY (IVH_FILM, 1,
     +            IXP, IYP, KERR)
            IF (NUM_MATCH.LE.0) GO TO 100
            IDSQMIN = NXRAST*NXRAST + NYRAST*NYRAST
            DO 180 I=1,NUM_MATCH
               ID = (IXP-IXPIX_MATCH(I))**2 + (IYP-IYPIX_MATCH(I))**2
               IF (ID.LT.IDSQMIN) THEN
                  ISPOT = I
                  IDSQMIN = ID
               END IF
180         CONTINUE
            IF (IDSQMIN.GT.IDSQLIM) GO TO 100
            CALL XDLF_IMAGE_DEL_SYMBOL (IVH_FILM,
     +           IXPIX_MATCH(ISPOT), IYPIX_MATCH(ISPOT),
     +           ISYMBTYP(3), ICOLRTYP(3), 1, KERR)
            DO 250 I=1,NUM_DISP
               IF (IREF_DISP(I).EQ.IREF_MATCH(ISPOT)) THEN
                  CALL XDLF_IMAGE_SYMBOL (IVH_FILM,
     +                 IXPIX_DISP(I), IYPIX_DISP(I),
     +                 ISYMBTYP(ISYMB_DISP(I)), ICOLRTYP(ISYMB_DISP(I)),
     +                 1, KERR)
                  GO TO 260
               END IF
250         CONTINUE
260         IF (ISPOT.EQ.NUM_MATCH) THEN
               NUM_MATCH = NUM_MATCH - 1
            ELSE
               DO 280 I = ISPOT, NUM_MATCH - 1
                  IREF_MATCH(I) = IREF_MATCH(I+1)
                  IXPIX_MATCH(I) = IXPIX_MATCH(I+1)
                  IYPIX_MATCH(I) = IYPIX_MATCH(I+1)
280            CONTINUE
               NUM_MATCH = NUM_MATCH - 1
            END IF
         END IF
         GO TO 100
      ELSE
         GO TO 100
      END IF

      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_DIRECTION    **
C**************************
C
C
      SUBROUTINE SET_DIRECTION (IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Calculate (and set) required Phi missetting angles for a simulation
C          with a requested zone along the X-ray beam
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
      INTEGER IERR

C
C IERR    (W)   Error flag =0 OK
C                          =1 error or option quit without changing setting
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL DEFN
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER IDET
      INTEGER KERR
      INTEGER NVALS
      INTEGER LISTE(10)
      INTEGER IFLAG
      INTEGER ND
      REAL VALUES(10)
      REAL XR
      REAL YR
      REAL ZR
      REAL COSANG1
      REAL SINANG1
      REAL COSANG2
      REAL SINANG2
      REAL COSANG3
      REAL SINANG3
      REAL R1
      REAL R2
      REAL R3
      REAL UBMAT(3,3)
      REAL UBINV(3,3)
      REAL RX(3,3)
      REAL RY(3,3)
      REAL RYUB(3,3)
      REAL RZ(3,3)
      REAL AM(3,3)
      REAL AMSAV(3,3)
      REAL BDUM(3,3)
      REAL ROTM(3,3)
      REAL PHIS(3)
      REAL SPINDLE
      REAL RMSD
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR

C     LOGICAL DEFN             !Second zone defined flag
C     INTEGER IH               !'h' index
C     INTEGER IK               !'k' index
C     INTEGER IL               !'l' index
C     INTEGER IDET             !Determinant flag
C     INTEGER KERR             !Error flag
C     INTEGER NVALS            !No. of values decoded from input string
C     INTEGER LISTE(10)        !List of parameter table entries to be updated
C     INTEGER IFLAG            !Parameter status flag
C     INTEGER ND               !No. of decimal places flag
C     REAL VALUES(10)          !Values decoded from input string
C     REAL XR                  !Reciprocal lattice 'x' coordinate
C     REAL YR                  !Reciprocal lattice 'y' coordinate
C     REAL ZR                  !Reciprocal lattice 'x' coordinate
C     REAL COSANG1             !Cosine of rotation angle 1
C     REAL SINANG1             !Sine of rotation angle 1
C     REAL COSANG2             !Cosine of rotation angle 2
C     REAL SINANG2             !Sine of rotation angle 2
C     REAL COSANG3             !Cosine of rotation angle 3
C     REAL SINANG3             !Sine of rotation angle 3
C     REAL R1                  !Projection of 1'st vector onto plane
C     REAL R2                  !Projection of 2'nd vector onto plane
C     REAL R3                  !Projection of 3'rd vector onto plane
C     REAL UBMAT(3,3)          !UB matrix
C     REAL UBINV(3,3)          !Inverse of UB matrix
C     REAL RX(3,3)             !Rotation matrix around 'X' 
C     REAL RY(3,3)             !Rotation matrix around 'Y'
C     REAL RYUB(3,3)           !Matrix RY*UB
C     REAL RZ(3,3)             !Rotation matrix around 'Z'
C     REAL AM(3,3)             !Combined setting matrix
C     REAL AMSAV(3,3)          !Saved AM matrix
C     REAL BDUM(3,3)           !Unsued matrix from FNDAND
C     REAL ROTM(3,3)           !Rotations part of matrix
C     REAL PHIS(3)             !Missetting angles derived from ROTM
C     REAL SPINDLE             !Spindle angle
C     REAL RMSD                !Usused RMSD value from FNDANG
C     CHARACTER*2 ERRSTR       !Error string (dummy)
C     CHARACTER*80 STR         !Input string
C
C-------------------------------------------------------------------------------
C
      IERR = 0
    
 10   CALL LPROMPT (IVH_IOW, 'Indices for zone along beam: ')
      CALL LREAD (IVH_IOW, STR)
      CALL STRVAL (STR, ' ,', 10, VALUES, NVALS)
      IF (NVALS.EQ.0) THEN
         IERR = 1
         RETURN
      END IF
      IF (NVALS.NE.3) THEN
          CALL LMESSAGE(IVH_IOW,'**Invalid indices**')
          GO TO 10
      END IF
      IH = NINT(VALUES(1))
      IK = NINT(VALUES(2))
      IL = NINT(VALUES(3))
      IF (IH.EQ.0.AND.IK.EQ.0.AND.IL.EQ.0) THEN
          CALL LMESSAGE(IVH_IOW,'**Invalid indices**')
          GO TO 10
      END IF
       

      CALL LRL_MK_ORIENT (UBMAT)
C
C====== Calculate reciprocal lattice coordinates of the reflection
C
      XR = UBMAT(1,1)*IH + UBMAT(1,2)*IK + UBMAT(1,3)*IL
      YR = UBMAT(2,1)*IH + UBMAT(2,2)*IK + UBMAT(2,3)*IL
      ZR = UBMAT(3,1)*IH + UBMAT(3,2)*IK + UBMAT(3,3)*IL
C
C====== Set R1 = length of projection of r.l. vector onto XZ r.l. plane
C
      R1 = SQRT (XR*XR + ZR*ZR)
C
C====== Find angle of rotation around Y required to put r.l. into XY plane
C
      COSANG1 = 1.0
      SINANG1 = 0.0
      IF (R1.GT.0.00001) THEN
         COSANG1 = XR/R1
         SINANG1 = ZR/R1
      END IF
C
C====== Set matrix for rotation around Y
C
      RY(1,1) = COSANG1
      RY(1,2) = 0.0
      RY(1,3) = SINANG1
      RY(2,1) = 0.0
      RY(2,2) = 1.0
      RY(2,3) = 0.0
      RY(3,1) = -SINANG1
      RY(3,2) = 0.0
      RY(3,3) = COSANG1
C
C====== Set matrix RYUB = RY*UB
C
      CALL MTX_MULT (RY, UBMAT, RYUB, 3, 3, 3)
C
C====== Find r.l. coordinates of vector rotated into XY plane
C
      XR = RYUB(1,1)*IH + RYUB(1,2)*IK + RYUB(1,3)*IL
      YR = RYUB(2,1)*IH + RYUB(2,2)*IK + RYUB(2,3)*IL
      ZR = RYUB(3,1)*IH + RYUB(3,2)*IK + RYUB(3,3)*IL
C
C====== Set R2 = length of projection of rotated r.l. vector onto XYplane
C
      R2 = SQRT (XR*XR + YR*YR)
C
C====== Find angle of rotation around Z required to put r.l. vector along beam
C
      COSANG2 = XR/R2
      SINANG2 = YR/R2
C
C====== Set matrix for -ve rotation around Z
C
      RZ(1,1) = COSANG2
      RZ(1,2) = SINANG2
      RZ(1,3) = 0.0
      RZ(2,1) = -SINANG2
      RZ(2,2) = COSANG2
      RZ(2,3) = 0.0
      RZ(3,1) = 0.0
      RZ(3,2) = 0.0 
      RZ(3,3) = 1.0
C
C====== Get new matrix AM = RZ*RYUB
C
      CALL MTX_MULT (RZ, RYUB, AM, 3, 3, 3)
C
C====== See if second direction is to be set
C
      DEFN = .FALSE.
 20   CALL IOW_ASKQ (IVH_IOW, 'Define zone to lie in XZ plane', DEFN)
      IF (DEFN) THEN
 30      CALL LPROMPT (IVH_IOW, 'Indices for zone: ')
         CALL LREAD (IVH_IOW, STR)
         CALL STRVAL (STR, ' ,', 10, VALUES, NVALS)
         IF (NVALS.EQ.0) GO TO 20
         IF (NVALS.NE.3) THEN
             CALL LMESSAGE(IVH_IOW,'**Invalid indices**')
             GO TO 30
         END IF
         IH = NINT(VALUES(1))
         IK = NINT(VALUES(2))
         IL = NINT(VALUES(3))
         IF (IH.EQ.0.AND.IK.EQ.0.AND.IL.EQ.0) THEN
             CALL LMESSAGE(IVH_IOW,'**Invalid indices**')
             GO TO 30
         END IF
C
C====== Get r.l. vector for this zone
C
         XR = AM(1,1)*IH + AM(1,2)*IK + AM(1,3)*IL
         YR = AM(2,1)*IH + AM(2,2)*IK + AM(2,3)*IL
         ZR = AM(3,1)*IH + AM(3,2)*IK + AM(3,3)*IL
C
C====== Set R3 = length of projection of r.l. vector onto YZ r.l. plane
C
         R3 = SQRT (YR*YR + ZR*ZR)
         IF (R3.LT.0.001) THEN
            CALL LMESSAGE (IVH_IOW, 
     +           '**New zone too close to beam direction**')
            GO TO 20
         END IF
C
C====== Find angle of rotation around X required to put r.l. vector into XZ 
C====== plane
C
        COSANG3 = ZR/R3
        SINANG3 = YR/R3
        RX(1,1) = 1.0
        RX(1,2) = 0.0
        RX(1,3) = 0.0
        RX(2,1) = 0.0
        RX(2,2) = COSANG3
        RX(2,3) = -SINANG3
        RX(3,1) = 0.0
        RX(3,2) = SINANG3
        RX(3,3) = COSANG3
C
C====== Get new matrix AM = RX*AM
C
        CALL MTX_PACK (AM, AMSAV, 3, 3, 3, 3)
        CALL MTX_MULT (RX, AMSAV, AM, 3, 3, 3)
      END IF 
C
C====== Extract rotations matrix
C
      CALL MTX_INV (UBMAT, UBINV, 3)
      CALL MTX_MULT (AM, UBINV, ROTM, 3, 3, 3)
C
C====== Now decode angles
C
      CALL FNDANG (ROTM, PHIS, BDUM, IDET, RMSD)
      IF (IDET.EQ.2) THEN
         CALL LMESSAGE (IVH_IOW, '**Program could not decode angles**')
         IERR = 1
         RETURN
      END IF
C
C====== Set new values for the angles
C
      CALL LDM_GET_SPIN (IPACK, SPINDLE, IFLAG, ND, KERR, ERRSTR)
      PHIS(3) = PHIS(3) - SPINDLE
      CALL LDM_SET_PHIX (IPACK, PHIS(1), KERR, ERRSTR)
      CALL LDM_SET_PHIY (IPACK, PHIS(2), KERR, ERRSTR)
      CALL LDM_SET_PHIZ (IPACK, PHIS(3), KERR, ERRSTR)

      LISTE(1) = IP_PHIX
      LISTE(2) = IP_PHIY
      LISTE(3) = IP_PHIZ
      CALL SET_PAR1_VALS (3, LISTE)

      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_KEYPLATE     **
C**************************
C
C
      SUBROUTINE SET_KEYPLATE
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Reset current plate to the key plate for the current pack
C
C Author:  John W. Campbell, January 1992
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER LISTE(2)
      INTEGER IERR
      INTEGER IFTYPE
      INTEGER IFLAG
      INTEGER NUMP
      INTEGER NPLATES
      INTEGER KEYPLATE
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     INTEGER LISTE(2)            !Dummy array for SET_PAR2_VALS
C     INTEGER IERR                !Error flag
C     INTEGER IFTYPE              !Image file type 1=byte, 2=i2
C     INTEGER IFLAG               !Parameter status flag
C     INTEGER NUMP                !Number of packs
C     INTEGER NPLATES             !Number of plates/pack
C     INTEGER KEYPLATE            !Key plate
C     CHARACTER*2 VALSTR          !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR          !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
C
C====== See if pack is input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) RETURN
C
C====== Get key plate
C
      CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
C
C====== See if film/plate needs to be changed
C
      IF (IPLATE.EQ.KEYPLATE) RETURN
C
C====== Output warning message
C
      CALL ERR_NOTICE (1,'*Key plate will be re-selected*')
C
C====== Check that key plate within valid range
C
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (KEYPLATE.LT.1.OR.KEYPLATE.GT.NPLATES) THEN
         CALL LDM_SET_KEYP (IPACK, 1, IERR, ERRSTR)
         CALL ERR_NOTICE (1, '**Out of range key plate reset to 1**')
         KEYPLATE = 1
      END IF
C
C====== Close current film /plate
C
      IF (FILM_OPEN) THEN
         CALL LDM_GET_IMDAT (VALSTR, IFTYPE, IFLAG)
         IF (IFTYPE.EQ.1) THEN
            CALL XDLF_CLOSE_FILM_FILE (IFD, IERR)
         ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
            CALL XDLF_CLOSE_I2 (IFD, IERR)
         END IF
      END IF
C
C====== Reset flags/parameters for changed film
C
      IPLATE = KEYPLATE
      LISTE(1) = IP_PLATE
      CALL SET_PAR1_VALS (1,LISTE)
      FILM_OPEN = .FALSE.
      IPACK_OPN = 0
      IPLATE_OPN = 0
      FILM_READ = .FALSE.
      CALL SET_PAR2_VALS (0, LISTE)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU1        **
C**************************
C
C
      SUBROUTINE SET_MENU1
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up MAIN MENU for 'lauegen'
C
C Author:  John W. Campbell, June 1991
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(6)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(6)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Read Parameters File',
     +            'Write Parameters File',
     +            'Laue Simulations',
     +            'Display/Measure Image',
     +            'Find Orientation',
     +            'Process'/
      DATA QUITNAM /'Quit Program'/
C
C-------------------------------------------------------------------------------
C
C====== Set up initial menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 6, XDLSTR(NAMES), 25,
     +     XDLSTR('MAIN MENU'), 9, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU10       **
C**************************
C
C
      SUBROUTINE SET_MENU10
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'Integrate Spots' menu for 'lauegen'
C
C Author:  John W. Campbell, December 1995
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(8)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(8)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Reset to First Pack',
     +            'Integrate Plate',
     +            'Examine Last Integration',
     +            'Select Next Plate',
     +            'Auto-integrate Pack',
     +            'Write Intensities File',
     +            'Select Next Pack',
     +            'Integration Status'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 8, XDLSTR(NAMES), 25,
     +     XDLSTR('Integration Options'), 19, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU2        **
C**************************
C
C
      SUBROUTINE SET_MENU2
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up initial menu for 'lauegen'
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(2)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(2)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Set Default Parameters',
     +            'Set Standard Parameters'/
      DATA QUITNAM /'Return to Main Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Set up reset/setup menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 2, XDLSTR(NAMES), 25,
     +     XDLSTR('Setup/Reset Menu'), 16, XDLSTR(QUITNAM), 25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU3        **
C**************************
C
C
      SUBROUTINE SET_MENU3
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'Refinement Options' menu for 'lauegen'
C
C Author:  John W. Campbell, June 1991
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(10)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(10)  !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Reset to First Pack',
     +            'Display/Measure Image',
     +            'Match Spots and Refine',
     +            'Select, Search and Refine',
     +            'Nodals Search and Refine',
     +            'Auto-refine Plate',
     +            'Select Next Plate',
     +            'Auto-refine Pack',
     +            'Write .ge Files',
     +            'Select Next Pack'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 10, XDLSTR(NAMES), 25,
     +     XDLSTR('Refinement Options Menu'), 23, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU4        **
C**************************
C
C
      SUBROUTINE SET_MENU4
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'Match Spots Options' menu for 'lauegen'
C
C Author:  John W. Campbell, July 1991
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(7)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(7)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Display All Predicted',
     +            'Display Nodals Only',
     +            'Clear Matches List',
     +            'Input Matches',
     +            'Delete Matches',
     +            'Read Matches File',
     +            'Write Matches File'/
      DATA QUITNAM /'End Matches Input'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 7, XDLSTR(NAMES), 25,
     +     XDLSTR('Match Spots Options Menu'), 24, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU5        **
C**************************
C
C
      SUBROUTINE SET_MENU5
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'Select Reflections' menu for 'lauegen'
C
C Author:  John W. Campbell, February 1992
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(9)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(9)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Display All Predicted',
     +            'Display Nodals Only',
     +            'Select by Nodal Index',
     +            'Select by Nodal h,k,l',
     +            'Clear Reflections List',
     +            'Input Reflections',
     +            'Delete Reflections',
     +            'Read Reflections File',
     +            'Write Reflections File'/
      DATA QUITNAM /'End Reflections Input'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 9, XDLSTR(NAMES), 25,
     +     XDLSTR('Select Reflections Menu'), 23, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU6        **
C**************************
C
C
      SUBROUTINE SET_MENU6

      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'Autoindexing Solutions' menu for 'lauegen'
C
C Author:  John W. Campbell, March 1992
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(5)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(5)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Select Solution',
     +            'Show Solution',
     +            'Refine Solution',
     +            'List Solution',
     +            'Save Solution'/
      DATA QUITNAM /'End Autoindexing'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU_AUT, 5, XDLSTR(NAMES), 25,
     +     XDLSTR('Autoindexing Solutions'), 22, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU7        **
C**************************
C
C
      SUBROUTINE SET_MENU7
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'process options' menu for 'lauegen'
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(6)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(6)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Display/Measure Image',
     +            'Determine Spot Size',
     +            'Refine Orientation',
     +            'Improve Soft Limits',
     +            'Integrate Spots',
     +            'Write Parameters File'/
      DATA QUITNAM /'End Processing'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 6, XDLSTR(NAMES), 25,
     +     XDLSTR('PROCESSING MENU'), 15, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU8        **
C**************************
C
C
      SUBROUTINE SET_MENU8
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'soft limits options' menu for 'lauegen'
C
C Author:  John W. Campbell, March 1994
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(4)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(4)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Reset to First Pack',
     +            'Determine ''dmin''',
     +            'Determine ''lambda-min''',
     +            'Select Next Pack'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 4, XDLSTR(NAMES), 25,
     +     XDLSTR('Soft Limits Options'), 19, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_MENU9        **
C**************************
C
C
      SUBROUTINE SET_MENU9
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set up 'Determine spot size' menu for 'lauegen'
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
C      None
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      CHARACTER*25 NAMES(3)
      CHARACTER*25 QUITNAM
      INTEGER IERR

C     CHARACTER*25 NAMES(3)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string
C     INTEGER IERR            !Error flag

      DATA NAMES /'Reset to First Pack',
     +            'Determine Spot Size',
     +            'Select Next Pack'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Set up menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 3, XDLSTR(NAMES), 25,
     +     XDLSTR('Spotsize Options'), 16, XDLSTR(QUITNAM), 
     +     25, 0, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_NEWPLATE     **
C**************************
C
C
      SUBROUTINE SET_NEWPLATE (IPK, IPL, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Reset current pack/plate to a specified one (interactive commands)
C
C Author:  John W. Campbell, march 1994
C
C Arguments:
C
      INTEGER IPK
      INTEGER IPL
      INTEGER IERR
C     
C  IPK     (R)  New pack number
C  IPL     (R)  New plate number (or 0 to set key plate)
C  IERR    (W)  Error flag = 0 OK, =1 requested pack/plate not defined
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER LISTE(2)
      INTEGER KERR
      INTEGER IFTYPE
      INTEGER IFLAG
      INTEGER NUMP
      INTEGER KPL
      INTEGER NPLATES
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     INTEGER LISTE(2)            !Array for reset parameters flags
C     INTEGER KERR                !Error flag
C     INTEGER IFTYPE              !Image file type 1=byte, 2=i2
C     INTEGER IFLAG               !Parameter status flag
C     INTEGER NUMP                !Number of packs
C     INTEGER KPL                 !Plate number
C     INTEGER NPLATES             !Number of plates
C     CHARACTER*2 VALSTR          !Parameter value string (dummy)
C     CHARACTER*2 ERRSTR          !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
      IERR = 0
C
C====== See if pack is input
C
      CALL LDM_GET_NUMP (NUMP, IFLAG)
      IF (NUMP.EQ.0) THEN
         IF (LG_MODE.EQ.1) CALL ERR_NOTICE 
     +                    (1, '**Number of packs is zero**')            
         IERR = 1
         RETURN
      END IF
C
C====== See if pack/plate needs to be changed
C
      IF (IPK.EQ.IPACK.AND.IPL.EQ.IPLATE) RETURN
C
C====== Check that pack/plate within range
C
      IF (IPK.LT.1.OR.IPK.GT.NUMP) THEN
         IERR = 1
         RETURN
      END IF
      KPL = IPL
      IF (KPL.LE.0) CALL LDM_GET_KEYP (IPK, KPL, IFLAG, KERR, ERRSTR)
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (KPL.LT.1.OR.KPL.GT.NPLATES) THEN
         IF (LG_MODE.EQ.1) CALL ERR_NOTICE 
     +        (1, '**Key plate out of valid range, reset to 1**')            
         CALL LDM_SET_KEYP (IPK, 1, KERR, ERRSTR)
         KPL = 1
      END IF
C
C====== Close current film /plate
C
      IF (FILM_OPEN) THEN
         CALL LDM_GET_IMDAT (VALSTR, IFTYPE, IFLAG)
         IF (IFTYPE.EQ.1) THEN
            CALL XDLF_CLOSE_FILM_FILE (IFD, KERR)
         ELSE IF (IFTYPE.EQ.2.OR.IFTYPE.EQ.3.OR.IFTYPE.EQ.4) THEN
            CALL XDLF_CLOSE_I2 (IFD, KERR)
         END IF
      END IF
C
C====== Reset flags/parameters for changed film
C
      IPACK = IPK
      IPLATE = KPL
      LISTE(1) = IP_PACK
      LISTE(2) = IP_PLATE
      CALL SET_PAR1_VALS (2,LISTE)
      FILM_OPEN = .FALSE.
      IPACK_OPN = 0
      IPLATE_OPN = 0
      FILM_READ = .FALSE.
      CALL SET_PAR2_VALS (0, LISTE)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_OMIT         **
C**************************
C
C
      SUBROUTINE SET_OMIT (IOP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set list of parameters which may not be changed in processing mode
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
      INTEGER IOP
C  
C IOP     (R)  =1 Set LDM keywords
C              =2 Set Parameter table 1 entry numbers (only after SET_PAR12_NAM
C                 called)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'process_omit.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C

C
C-------------------------------------------------------------------------------
C
      IF (IOP.EQ.1) THEN
         NOMITK = 17
         OMIT(1) = 'SYSTEM'
         OMIT(2) = 'LATTICE'
         OMIT(3) = 'SYMMETRY'
         OMIT(4) = 'BEAM_AXIS'
         OMIT(5) = 'ROTATION_AXIS'
         OMIT(6) = 'IMAGE_TYPE'
         OMIT(7) = 'IMAGE_DATA'
         OMIT(8) = 'AXORD'
         OMIT(9) = 'FIDTYPE'
         OMIT(10) = 'NXRAST'
         OMIT(11) = 'NYRAST'
         OMIT(12) = 'RASTER_SIZE'
         OMIT(13) = 'NUMPACK'
         OMIT(14) = 'NPLATES'
         OMIT(15) = 'TEMPLATE'
         OMIT(16) = 'DGEOM'
         OMIT(17) = 'DTILT'
      ELSE IF (IOP.EQ.2) THEN
         NOMITP = 17
         IP_OMIT(1) = IP_SYST
         IP_OMIT(2) = IP_LATT
         IP_OMIT(3) = IP_SYMM
         IP_OMIT(4) = IP_BEAM
         IP_OMIT(5) = IP_ROT
         IP_OMIT(6) = IP_IMTYP
         IP_OMIT(7) = IP_IMDAT
         IP_OMIT(8) = IP_AXORD
         IP_OMIT(9) = IP_FIDT
         IP_OMIT(10) = IP_NXRAST
         IP_OMIT(11) = IP_NYRAST
         IP_OMIT(12) = IP_RAST
         IP_OMIT(13) = IP_NUMP
         IP_OMIT(14) = IP_NPLAT
         IP_OMIT(15) = IP_TEMPL
         IP_OMIT(16) = IP_DGEOM
         IP_OMIT(17) = IP_DTILT
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     SET_PAR12_NAM      **
C****************************
C
C
      SUBROUTINE SET_PAR12_NAM
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set parameter names (and menus) for parameter tables 1&2 and
C          set item numbers
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
      CHARACTER*4  SYST_STR(7)
      CHARACTER*2  LATT_STR(7)
      CHARACTER*3  AX_STR(6)
      CHARACTER*3  FID_STR(2)
      CHARACTER*9  DSTYP_STR(3)
      CHARACTER*8  AXORD_STR(16)
      CHARACTER*6  IMTYP_STR(2)
      CHARACTER*6  IMDAT_STR(4)
      CHARACTER*4  DGEOM_STR(2)
      CHARACTER*20 LABEL
      CHARACTER*2  BUTSTR

C     INTEGER IERR                      !Error flag
C     CHARACTER*20 LABEL                !Label for param table 2
C     CHARACTER*4 SYST_STR(7)           !Menu for crystal systems
C     CHARACTER*2 LATT_STR(7)           !Menu for Lattice types
C     CHARACTER*3 AX_STR(6)             !Menu for Axis directions
C     CHARACTER*3 FID_STR(2)            !Menu for fiducials options
C     CHARACTER*9 DSTYP_STR(3)          !Menu for distortion type options
C     CHARACTER*8  AXORD_STR(16)        !Menu for axis order options
C     CHARACTER*6  IMTYP_STR(2)         !Image type strings
C     CHARACTER*6  IMDAT_STR(4)         !Image data type strings
C     CHARACTER*4  DGEOM_STR(2)         !Detector geometry type strings
C     CHARACTER*2  BUTSTR               !Button strings

      DATA SYST_STR /'Tri.',
     +               'Mon.',
     +               'Ort.',
     +               'Tet.',
     +               'Hex.',
     +               'Rho.',
     +               'Cub.'/
      DATA LATT_STR /'P ','A ','B ','C ','I ','F ','R '/
      DATA AX_STR /'+a*','+b*','+c*','-a*','-b*','-c*'/
      DATA FID_STR /'no','yes'/
      DATA DSTYP_STR /'standard','r/toff','spdxy'/
      DATA AXORD_STR /'+xf+yf  ',
     +                '+xf-yf  ',
     +                '-xf+yf  ',
     +                '-xf-yf  ',
     +                '+yf+xf  ',
     +                '+yf-xf  ',
     +                '-yf+xf  ',
     +                '-yf-xf  ',
     +                '+xf+yf s',
     +                '+xf-yf s',
     +                '-xf+yf s',
     +                '-xf-yf s',
     +                '+yf+xf s',
     +                '+yf-xf s',
     +                '-yf+xf s',
     +                '-yf-xf s'/
      DATA IMTYP_STR /'ip','film'/
      DATA IMDAT_STR /'byte','i2','mar','pfbyte'/
      DATA DGEOM_STR /'flat','cyl'/
      DATA BUTSTR /'+-'/
C
C-------------------------------------------------------------------------------
C
C
C====== Set up item numbers (Parameter table 1)
C
      IP_PACK = 1
      IP_PLATE = 2
      IP_SYST = 4
      IP_LATT = 5
      IP_SYMM = 6
      IP_ROT = 8
      IP_BEAM = 9
      IP_PACKID = 11
      IP_SPINDL = 12
      
      IP_A = 13
      IP_B = 14
      IP_C = 15
      IP_ALPH = 16
      IP_BETA = 17
      IP_GAMM = 18
      IP_WMIN = 19
      IP_WMAX = 20
      IP_DMIN = 21
      IP_PHIX = 22
      IP_PHIY = 23
      IP_PHIZ = 24

      IP_IMTYP = 25
      IP_IMDAT = 26
      IP_NUMP = 27
      IP_NPLAT = 28
      IP_FIDT = 29
      IP_DISTOR = 30
      IP_DGEOM = 31
      IP_DTILT = 32
      IP_EPS = 33
      IP_STHR = 34
      IP_OVPIX = 35
      IP_TEMPL = 36

      IP_NXRAST = 37
      IP_NYRAST = 38
      IP_RAST = 39
      IP_AXORD = 40
      IP_RMIN = 42
      IP_RMAX = 43
      IP_XLOW = 45
      IP_XHIGH = 46
      IP_YLOW = 47
      IP_YHIGH = 48
C
C====== Set up item numbers (Parameter table 2)
C
      IP_LABEL = 1
      IP_FNAM = 3
      IP_CTOF = 4
      IP_XCENF = 5
      IP_YCENF = 6
      IP_XC = 7
      IP_YC = 8
      IP_WC = 9
      IP_YSCAL = 10
      IP_TWIST = 11
      IP_TILT = 12
      IP_BULGE = 13
      IP_ROFF = IP_BULGE
      IP_SPDXY = IP_ROFF
      IP_TOFF = 14
      IP_SPDX = IP_TOFF
      IP_SPDY = 15
      IP_STRK_L = 16
      IP_STRK_W = 17
      IP_STRK_F = 18
      IP_STRK_BW = 19
      IP_DELTA = 20
      IP_RFL = 21
C
C====== Set up parameter item names and any menus required (Table 1)
C
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_PACK,
     +     XDLSTR('current pack:'), 13, XDLSTR(' '), 1, 0, 0, IERR)
      CALL XDLF_PARAM_TABLE_SETBUTTON (IVH_PAR1, IP_PACK,
     +                XDLSTR(BUTSTR), 1, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_PLATE,
     +     XDLSTR('current plate:'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      CALL XDLF_PARAM_TABLE_SETBUTTON (IVH_PAR1, IP_PLATE,
     +                XDLSTR(BUTSTR), 1, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_SYST,
     +     XDLSTR('system:'), 7, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_SYST, 7,
     +     XDLSTR(SYST_STR), 4, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_LATT,
     +     XDLSTR('lattice:'), 8, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_LATT, 7,
     +     XDLSTR(LATT_STR), 2, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_SYMM,
     +     XDLSTR('symmetry:'), 9, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_ROT,
     +     XDLSTR('rotation axis:'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_ROT, 6,
     +     XDLSTR(AX_STR), 3, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_BEAM,
     +     XDLSTR('beam axis:'), 10, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_BEAM, 6,
     +     XDLSTR(AX_STR), 3, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_PACKID,
     +     XDLSTR('pack id:'), 8, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_SPINDL,
     +     XDLSTR('spindle (Deg):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_A,
     +     XDLSTR('a (Angstroms):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_B,
     +     XDLSTR('b (Angstroms):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_C,
     +     XDLSTR('c (Angstroms):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_ALPH,
     +     XDLSTR('alpha (Deg):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_BETA,
     +     XDLSTR('beta  (Deg):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_GAMM,
     +     XDLSTR('gamma (Deg):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_WMIN,
     +     XDLSTR('lmin (A):'), 9, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_WMAX,
     +     XDLSTR('lmax (A):'), 9, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_DMIN,
     +     XDLSTR('dmin (A):'), 9, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_PHIX,
     +     XDLSTR('phix (Deg):'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_PHIY,
     +     XDLSTR('phiy (Deg):'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_PHIZ,
     +     XDLSTR('phiz (Deg):'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_IMTYP,
     +     XDLSTR('image type:'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_IMTYP, 2,
     +     XDLSTR(IMTYP_STR), 6, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_IMDAT,
     +     XDLSTR('image data:'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_IMDAT, 4,
     +     XDLSTR(IMDAT_STR), 6, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_NUMP,
     +     XDLSTR('numpack:'), 8, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_NPLAT,
     +     XDLSTR('nplates:'), 7, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_FIDT,
     +     XDLSTR('fiducials:'), 10, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_FIDT, 2,
     +     XDLSTR(FID_STR), 3, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_DISTOR,
     +     XDLSTR('distortion:'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_DISTOR, 3,
     +     XDLSTR(DSTYP_STR), 9, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_DGEOM,
     +     XDLSTR('detector geom:'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_DGEOM, 2,
     +     XDLSTR(DGEOM_STR), 4, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_DTILT,
     +     XDLSTR('detector tilt:'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_EPS,
     +     XDLSTR('spot eps (mm):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_STHR,
     +     XDLSTR('spot thresh:'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_OVPIX,
     +     XDLSTR('overload pix:'), 13, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_TEMPL,
     +     XDLSTR('template:'), 9, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_NXRAST,
     +     XDLSTR('nxrast:'), 7, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_NYRAST,
     +     XDLSTR('nyrast:'), 7, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_RAST,
     +     XDLSTR('raster (mu):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_AXORD,
     +     XDLSTR('axis order:'), 11, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800
      CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR1, IP_AXORD, 14,
     +     XDLSTR(AXORD_STR), 8, IERR)
      IF (IERR.NE.0) GO TO 810

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_RMIN,
     +     XDLSTR('rmin (mm):'), 10, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_RMAX,
     +     XDLSTR('rmax (mm):'), 10, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_XLOW,
     +     XDLSTR('xlow  (ras):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_XHIGH,
     +     XDLSTR('xhigh (ras):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_YLOW,
     +     XDLSTR('ylow  (ras):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR1, IP_YHIGH,
     +     XDLSTR('yhigh (ras):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

C
C====== Set up item names for parameter table 2
C
      LABEL = '         Plate'
      CALL STR_ADDI (LABEL, IPLATE, 1)
      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_LABEL,
     +     XDLSTR(LABEL), 20, XDLSTR(' '), 1, -1, 1, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_FNAM,
     +     XDLSTR('filename:'), 9, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 800

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_CTOF,
     +     XDLSTR('ctof (mm):'), 10, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_XCENF,
     +     XDLSTR('x_cen_f (ras):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_YCENF,
     +     XDLSTR('y_cen_f (ras):'), 14, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_XC,
     +     XDLSTR('x_c offset (mm):'), 16, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_YC,
     +     XDLSTR('y_c offset (mm):'), 16, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_WC,
     +     XDLSTR('w_c offset (deg):'), 17, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_YSCAL,
     +     XDLSTR('y_scale:'), 8, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_TWIST,
     +     XDLSTR('twist (.01deg):'), 15, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_TILT,
     +     XDLSTR('tilt  (.01deg):'), 15, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL SET_PAR2_DST (IERR)
      IF (IERR.EQ.2) GO TO 810
      IF (IERR.EQ.1) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_STRK_L,
     +     XDLSTR('spot length (mm):'), 17, XDLSTR(' '), 1, 0, 0, 
     +             IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_STRK_W,
     +     XDLSTR('spot width  (mm):'), 17, XDLSTR(' '), 1, 0, 0, 
     +             IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_STRK_F,
     +     XDLSTR('spot factor:'), 12, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_STRK_BW,
     +     XDLSTR('Spot border (ras):'), 18, XDLSTR(' '), 1, 0, 0, 
     +             IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_DELTA,
     +     XDLSTR('spot delta (mm):'), 16, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820

      CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_RFL,
     +     XDLSTR('refined flag:'), 13, XDLSTR(' '), 1, 0, 0, IERR)
      IF (IERR.NE.0) GO TO 820
      RETURN
C
C====== Error conditions
C
800   WRITE (6,2001)
      STOP
810   WRITE (6,2002)
      STOP
820   WRITE (6,2003)
      STOP
C
C====== Format statements
C
2001  FORMAT (/,' **Error in setting names for first parameter table**')
2002  FORMAT (/,' **Error in setting menus for first parameter table**')
2003  FORMAT (/,' **Error in setting names for 2''nd parameter table**')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     SET_PAR1_VALS      **
C****************************
C
C
      SUBROUTINE SET_PAR1_VALS (NE, LISTE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set some or all values in parameter table 1 (from values in
C          LDM data); 
C          Deal with some parameter dependencies. (Note that cell consistency
C          routine reset_cell is no longer called from here and needs to be
C          called if any cell parameter is changed)
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      INTEGER NE
      INTEGER LISTE(*)

C NE      (R)    Number of entries to be updated (0=all)
C LISTE   (R)    Array of parameter table entry numbers for the NE parameters
C                to be updated.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL CLL
      LOGICAL CBLANK(6)
      LOGICAL IPLIST(NP1_COLS*NP1_ROWS)
      INTEGER I
      INTEGER NPMAX
      INTEGER IERR
      INTEGER LST2(3)
      INTEGER IVAL
      INTEGER ISYST
      INTEGER IFLAG
      INTEGER ND
      INTEGER IORD
      INTEGER ISWAP
      REAL    VALUE
      REAL    CELLP(6)
      CHARACTER*2 ERRSTR
      CHARACTER*(MAX_PSCROLL_CHARS) VALSTR
      CHARACTER*4 SYST_STR(7)

C     LOGICAL CLL      !Flag =.TRUE. cell param(s) to update, =.FALSE. not
C     LOGICAL CBLANK(6)!Flags to o/p fixed cell params as blanks
C     LOGICAL IPLIST(NP1_COLS*NP1_ROWS) !Flags for items to be changed
C     INTEGER I        !Temp/loop variable
C     INTEGER NPMAX    !Maximum number of parameters possible in table 1
C     INTEGER IERR     !Error flag
C     INTEGER LST2(3)  !List of parameter item values to reset
C     INTEGER IVAL     !Integer parameter value
C     INTEGER ISYST    !Crystal system
C     INTEGER IFLAG    !Parameter status flag
C     INTEGER ND       !No. of decimal places flag
C     INTEGER IORD     !Data order flag
C     INTEGER ISWAP    !Byte swap flag
C     REAL    VALUE    !Real parameter value
C     REAL    CELLP(6) !Cell parameters
C     CHARACTER*2 ERRSTR  !Dummy error string
C     CHARACTER*(MAX_PSCROLL_CHARS) VALSTR !Value string for parameter table
C     CHARACTER*4 SYST_STR(7)              !Crystal system strings

      DATA SYST_STR /'Tri.',
     +               'Mon.',
     +               'Ort.',
     +               'Tet.',
     +               'Hex.',
     +               'Rho.',
     +               'Cub.'/
C
C-------------------------------------------------------------------------------
C
      IF (LG_MODE.NE.1) RETURN
C
C====== Set up flags of parameter items to be changed
C
      NPMAX = NP1_ROWS*NP1_COLS
      DO 10 I=1,NPMAX
         IF (NE.EQ.0) THEN
            IPLIST(I) = .TRUE.
         ELSE
            IPLIST(I) = .FALSE.
         END IF
10    CONTINUE
      IF (NE.GT.0) THEN
         DO 20 I=1,NE
            IF (LISTE(I).GE.1.AND.LISTE(I).LE.NPMAX)
     +         IPLIST(LISTE(I)) = .TRUE.
20       CONTINUE
      END IF
C
C====== See if cell parameter(s) included in list
C
      CLL = .FALSE.
      IF (NE.EQ.0) CLL=.TRUE.
      IF (NE.GT.0) THEN
         IF (IPLIST(IP_A)) CLL = .TRUE.
         IF (IPLIST(IP_B)) CLL = .TRUE.
         IF (IPLIST(IP_C)) CLL = .TRUE.
         IF (IPLIST(IP_ALPH)) CLL = .TRUE.
         IF (IPLIST(IP_BETA)) CLL = .TRUE.
         IF (IPLIST(IP_GAMM)) CLL = .TRUE.
         IF (IPLIST(IP_SYST)) CLL = .TRUE.
      END IF
C
C====== Update cell parameters (if required)
C
      IF (CLL) THEN
         DO 30 I=1,6
            CBLANK(I) = .FALSE.
30       CONTINUE
         CALL LDM_GET_A (CELLP(1), IFLAG, ND)
         CALL LDM_GET_B (CELLP(2), IFLAG, ND)
         CALL LDM_GET_C (CELLP(3), IFLAG, ND)
         CALL LDM_GET_ALPHA (CELLP(4), IFLAG, ND)
         CALL LDM_GET_BETA (CELLP(5), IFLAG, ND)
         CALL LDM_GET_GAMMA (CELLP(6), IFLAG, ND)
         CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
         IF (ISYST.EQ.2) THEN
            CBLANK(4) = .TRUE.
            CBLANK(6) = .TRUE.
         ELSE IF (ISYST.EQ.3) THEN
            CBLANK(4) = .TRUE.
            CBLANK(5) = .TRUE.
            CBLANK(6) = .TRUE.
         ELSE IF (ISYST.EQ.4) THEN
            CBLANK(2) = .TRUE.
            CBLANK(4) = .TRUE.
            CBLANK(5) = .TRUE.
            CBLANK(6) = .TRUE.
         ELSE IF (ISYST.EQ.5) THEN            
            CBLANK(2) = .TRUE.
            CBLANK(4) = .TRUE.
            CBLANK(5) = .TRUE.
            CBLANK(6) = .TRUE.
         ELSE IF (ISYST.EQ.6) THEN
            CBLANK(2) = .TRUE.
            CBLANK(3) = .TRUE.
            CBLANK(5) = .TRUE.
            CBLANK(6) = .TRUE.
         ELSE IF (ISYST.EQ.7) THEN
            CBLANK(2) = .TRUE.
            CBLANK(3) = .TRUE.
            CBLANK(4) = .TRUE.
            CBLANK(5) = .TRUE.
            CBLANK(6) = .TRUE.
         END IF
         WRITE (VALSTR,'(F8.2)') CELLP(1)
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_A,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         IF (CBLANK(2)) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_B,
     +           XDLSTR(' '), 1, 0, IERR)
         ELSE
            WRITE (VALSTR,'(F8.2)') CELLP(2)
            CALL LJUST(VALSTR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_B,
     +           XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         END IF
         IF (CBLANK(3)) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_C,
     +           XDLSTR(' '), 1, 0, IERR)
         ELSE
            WRITE (VALSTR,'(F8.2)') CELLP(3)
            CALL LJUST(VALSTR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_C,
     +           XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         END IF
         IF (CBLANK(4)) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_ALPH,
     +           XDLSTR(' '), 1, 0, IERR)
         ELSE
            WRITE (VALSTR,'(F8.2)') CELLP(4)
            CALL LJUST(VALSTR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_ALPH,
     +           XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         END IF
         IF (CBLANK(5)) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_BETA,
     +           XDLSTR(' '), 1, 0, IERR)
         ELSE
            WRITE (VALSTR,'(F8.2)') CELLP(5)
            CALL LJUST(VALSTR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_BETA,
     +           XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         END IF
         IF (CBLANK(6)) THEN
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_GAMM,
     +           XDLSTR(' '), 1, 0, IERR)
         ELSE
            WRITE (VALSTR,'(F8.2)') CELLP(6)
            CALL LJUST(VALSTR)
            CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_GAMM,
     +           XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         END IF
         CALL LDM_GET_SYST (VALSTR, IVAL, IFLAG)
         VALSTR = SYST_STR(IVAL)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_SYST,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF
C
C====== Update other parameters as required
C
      IF (IPLIST(IP_PACK)) THEN
         WRITE (VALSTR,'(I8)') IPACK
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_PACK,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_PLATE)) THEN
         WRITE (VALSTR,'(I8)') IPLATE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_PLATE,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_LATT)) THEN
         CALL LDM_GET_LATT (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_LATT,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_SYMM)) THEN
         CALL LDM_GET_NSYM (IVAL, IFLAG)
         IF (IVAL.EQ.0) THEN
            VALSTR = 'no'
         ELSE
            VALSTR = 'yes'
         END IF
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_SYMM,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_ROT)) THEN
         CALL LDM_GET_ROT (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_ROT,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_BEAM)) THEN
         CALL LDM_GET_BEAM (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_BEAM,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_PACKID)) THEN
         CALL LDM_GET_PID (IPACK, IVAL, IFLAG, IERR, ERRSTR)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_PACKID,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_SPINDL)) THEN
         CALL LDM_GET_SPIN (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_SPINDL,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_WMIN)) THEN
         CALL LDM_GET_LMIN (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_WMIN,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_WMAX)) THEN
         CALL LDM_GET_LMAX (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_WMAX,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_DMIN)) THEN
         CALL LDM_GET_DMIN (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_DMIN,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_PHIX)) THEN
         CALL LDM_GET_PHIX (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_PHIX,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_PHIY)) THEN
         CALL LDM_GET_PHIY (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_PHIY,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_PHIZ)) THEN
         CALL LDM_GET_PHIZ (IPACK, VALUE, IFLAG, ND, IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_PHIZ,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_IMTYP)) THEN
         CALL LDM_GET_IMTYP (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_IMTYP,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_IMDAT)) THEN
         CALL LDM_GET_IMDAT (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_IMDAT,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_NUMP)) THEN
         CALL LDM_GET_NUMP (IVAL, IFLAG)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_NUMP,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_NPLAT)) THEN
         CALL LDM_GET_NPLAT (IVAL, IFLAG)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_NPLAT,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_FIDT)) THEN
         CALL LDM_GET_FIDT (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_FIDT,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_DISTOR)) THEN
         CALL LDM_GET_DSTOR (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_DISTOR,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         CALL SET_PAR2_DST(IERR)
         IF (IVAL.EQ.1) THEN
            LST2(1) = IP_BULGE
            CALL SET_PAR2_VALS (1, LST2)
         ELSE IF (IVAL.EQ.2) THEN
            LST2(1) = IP_ROFF
            LST2(2) = IP_TOFF
            CALL SET_PAR2_VALS (2, LST2)
         ELSE IF (IVAL.EQ.3) THEN
            LST2(1) = IP_SPDXY
            LST2(2) = IP_SPDX
            LST2(3) = IP_SPDY
            CALL SET_PAR2_VALS (3, LST2)
         END IF
      END IF

      IF (IPLIST(IP_DGEOM)) THEN
         CALL LDM_GET_DGEOM (VALSTR, IVAL, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_DGEOM,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_DTILT)) THEN
         CALL LDM_GET_DTILT (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_DTILT,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_EPS)) THEN
         CALL LDM_GET_EPS (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_EPS,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_STHR)) THEN
         CALL LDM_GET_STHR (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_STHR,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_OVPIX)) THEN
         CALL LDM_GET_OVPIX (IVAL, IFLAG)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_OVPIX,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_TEMPL)) THEN
         CALL LDM_GET_TEMPL (VALSTR, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_TEMPL,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
         LST2(1) = IP_FNAM
         CALL SET_PAR2_VALS (1, LST2)
      END IF

      IF (IPLIST(IP_NXRAST)) THEN
         CALL LDM_GET_NXRAS (IVAL, IFLAG)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_NXRAST,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_NYRAST)) THEN
         CALL LDM_GET_NYRAS (IVAL, IFLAG)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_NYRAST,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_RAST)) THEN
         CALL LDM_GET_RAST (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_RAST,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_AXORD)) THEN
         CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_AXORD,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_RMIN)) THEN
         CALL LDM_GET_RMIN (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_RMIN,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_RMAX)) THEN
         CALL LDM_GET_RMAX (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_RMAX,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF


      IF (IPLIST(IP_XLOW)) THEN
         CALL LDM_GET_XLOW (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_XLOW,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_XHIGH)) THEN
         CALL LDM_GET_XHIGH (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_XHIGH,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_YLOW)) THEN
         CALL LDM_GET_YLOW (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_YLOW,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_YHIGH)) THEN
         CALL LDM_GET_YHIGH (VALUE, IFLAG, ND)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR1, IP_YHIGH,
     +        XDLSTR(VALSTR), MAX_PSCROLL_CHARS, 0, IERR)
      END IF

      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     SET_PAR2_DST       **
C****************************
C
C
      SUBROUTINE SET_PAR2_DST (IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set parameter names (and menus) for distortion correction type
C          dependent parameters
C
C Author:  John W. Campbell, September 1993
C
C Arguments:
C
      INTEGER IERR
C  
C IERR    (W)  Error flag =0 OK, =1 error
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IFLAG
      INTEGER DISTOR_TYPE
      CHARACTER*2  VALSTR
      CHARACTER*4  SPD_STR(2)

C     INTEGER IFLAG                     !Parameter status flag
C     INTEGER DISTOR_TYPE               !Distortion type
C     CHARACTER*2  VALSTR               !Dummy value string
C     CHARACTER*4  SPD_STR(2)           !Menu strings for spd items
C
      DATA SPD_STR/'edit',' '/
C
C-------------------------------------------------------------------------------
C
      IERR = 0
C
C===== Clear distortion type dependent parameter table entries
C
      CALL XDLF_PARAM_TABLE_DELITEM (IVH_PAR2, IP_BULGE, IERR)
      CALL XDLF_PARAM_TABLE_DELITEM (IVH_PAR2, IP_ROFF, IERR)
      CALL XDLF_PARAM_TABLE_DELITEM (IVH_PAR2, IP_TOFF, IERR)
      CALL XDLF_PARAM_TABLE_DELITEM (IVH_PAR2, IP_SPDXY, IERR)
      CALL XDLF_PARAM_TABLE_DELITEM (IVH_PAR2, IP_SPDX, IERR)
      CALL XDLF_PARAM_TABLE_DELITEM (IVH_PAR2, IP_SPDY, IERR)
C
C====== Now set distortion type dependent parameters for current type
C
      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, IFLAG)
      IF (DISTOR_TYPE.EQ.1) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_BULGE,
     +     XDLSTR('bulge (.01deg):'), 15, XDLSTR(' '), 1, 0, 0, IERR)
         IF (IERR.NE.0) THEN
            IERR = 1
            RETURN
         END IF

      ELSE IF (DISTOR_TYPE.EQ.2) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_ROFF,
     +     XDLSTR('roff (10mu):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
         IF (IERR.NE.0) THEN
            IERR = 1
            RETURN
         END IF

         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_TOFF,
     +     XDLSTR('toff (10mu):'), 12, XDLSTR(' '), 1, 0, 0, IERR)
         IF (IERR.NE.0) THEN
            IERR = 1
            RETURN
         END IF

      ELSE IF (DISTOR_TYPE.EQ.3) THEN
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_SPDXY,
     +     XDLSTR('spdxy:'), 6, XDLSTR(' '), 1, 0, 0, IERR)
         IF (IERR.NE.0) THEN
            IERR = 1
            RETURN
         END IF

         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_SPDX,
     +     XDLSTR('spdx_n:'), 7, XDLSTR(' '), 1, 0, 0, IERR)
         IF (IERR.NE.0) THEN
            IERR = 1
            RETURN
         END IF
         CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR2, IP_SPDX, 1,
     +     XDLSTR(SPD_STR), 8, IERR)
         IF (IERR.NE.0) THEN
             IERR = 2
             RETURN
         END IF

         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_SPDY,
     +     XDLSTR('spdy_n:'), 12, XDLSTR(' '), 1, 0, 0, IERR)
         IF (IERR.NE.0) THEN
            IERR = 1
            RETURN
         END IF
         CALL XDLF_PARAM_TABLE_SETMENU (IVH_PAR2, IP_SPDY, 1,
     +     XDLSTR(SPD_STR), 8, IERR)
         IF (IERR.NE.0) THEN
             IERR = 2
             RETURN
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     SET_PAR2_VALS      **
C****************************
C
C
      SUBROUTINE SET_PAR2_VALS (NE, LISTE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set some or all values in parameter table 2 (from values in
C          the common blocks); 
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      INTEGER NE
      INTEGER LISTE(*)

C NE      (R)    Number of entries to be updated (0=all)
C LISTE   (R)    Array of parameter table entry numbers for the NE parameters
C                to be updated.
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL IPLIST(NP2_COLS*NP2_ROWS)
      INTEGER I
      INTEGER NPMAX
      INTEGER IERR
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ND
      INTEGER DISTOR_TYPE
      REAL    VALUE
      CHARACTER*(MAX_P2SCROLL_CHARS) VALSTR
      CHARACTER*20 LABEL
      CHARACTER*2 ERRSTR

C     LOGICAL IPLIST(NP2_COLS*NP2_ROWS) !Flags for items to be changed
C     INTEGER I        !Temp/loop variable
C     INTEGER NPMAX    !Maximum number of parameters possible in table 2
C     INTEGER IERR     !Error flag
C     INTEGER IVAL     !Integer parameter value
C     INTEGER IFLAG    !Parameter status flag
C     INTEGER ND       !No. of decimal places flag
C     INTEGER DISTOR_TYPE                   !Distortion type flag
C     REAL    VALUE                         !Real parameter value
C     CHARACTER*(MAX_P2SCROLL_CHARS) VALSTR !Value string for parameter table
C     CHARACTER*20 LABEL                    !Label string for parameter table
C     CHARACTER*2 ERRSTR                    !Dummy error string
C

C
C-------------------------------------------------------------------------------
C
      IF (LG_MODE.NE.1) RETURN
C
C====== Set up flags of parameter items to be changed
C
      NPMAX = NP2_ROWS*NP2_COLS
      DO 10 I=1,NPMAX
         IF (NE.EQ.0) THEN
            IPLIST(I) = .TRUE.
         ELSE
            IPLIST(I) = .FALSE.
         END IF
10    CONTINUE
      IF (NE.GT.0) THEN
         DO 20 I=1,NE
            IF (LISTE(I).GE.1.AND.LISTE(I).LE.NPMAX)
     +         IPLIST(LISTE(I)) = .TRUE.
20       CONTINUE
      END IF
C
C====== Update parameters
C
      IF (IPLIST(IP_LABEL)) THEN
         LABEL = '         Plate'
         CALL STR_ADDI (LABEL, IPLATE, 1)
         CALL XDLF_PARAM_TABLE_SETITEM (IVH_PAR2, IP_LABEL,
     +        XDLSTR(LABEL), 20, XDLSTR(' '), 1, -1, 1, IERR)
      END IF

      IF (IPLIST(IP_FNAM)) THEN
         CALL LDM_FILENAME (IPACK, IPLATE, VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_FNAM,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_CTOF)) THEN
         CALL LDM_GET_CTOF (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_CTOF,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_XCENF)) THEN
         CALL LDM_GET_XCENF (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_XCENF,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_YCENF)) THEN
         CALL LDM_GET_YCENF (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_YCENF,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_XC)) THEN
         CALL LDM_GET_XC (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                    IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_XC,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_YC)) THEN
         CALL LDM_GET_YC (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                    IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_YC,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_WC)) THEN
         CALL LDM_GET_WC (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                    IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_WC,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_YSCAL)) THEN
         CALL LDM_GET_YSCAL (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.3)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_YSCAL,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_TWIST)) THEN
         CALL LDM_GET_TWIST (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_TWIST,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_TILT)) THEN
         CALL LDM_GET_TILT (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_TILT,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, IFLAG)

      IF (IPLIST(IP_BULGE).AND.DISTOR_TYPE.EQ.1) THEN
         CALL LDM_GET_BULGE (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                       IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_BULGE,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_ROFF).AND.DISTOR_TYPE.EQ.2) THEN
         CALL LDM_GET_ROFF (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.1)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_ROFF,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_TOFF).AND.DISTOR_TYPE.EQ.2) THEN
         CALL LDM_GET_TOFF (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.1)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_TOFF,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_SPDXY).AND.DISTOR_TYPE.EQ.3) THEN
         CALL LDM_GET_SPDXY (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(F8.4)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_SPDXY,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_SPDX).AND.DISTOR_TYPE.EQ.3) THEN
         CALL LDM_GET_SPDXN (IPACK, IPLATE, IVAL, IFLAG,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_SPDX,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_SPDY).AND.DISTOR_TYPE.EQ.3) THEN
         CALL LDM_GET_SPDYN (IPACK, IPLATE, IVAL, IFLAG,
     +                      IERR, ERRSTR)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_SPDY,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_STRK_L)) THEN
         CALL LDM_GET_SPOTL (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                       IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_STRK_L,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_STRK_W)) THEN
         CALL LDM_GET_SPOTW (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                       IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_STRK_W,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_STRK_F)) THEN
         CALL LDM_GET_SPOTF (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                       IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_STRK_F,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_STRK_BW)) THEN
         CALL LDM_GET_SPOTB (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                       IERR, ERRSTR)
         WRITE (VALSTR,'(F8.1)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_STRK_BW,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_DELTA)) THEN
         CALL LDM_GET_SPOTD (IPACK, IPLATE, VALUE, IFLAG, ND,
     +                       IERR, ERRSTR)
         WRITE (VALSTR,'(F8.2)') VALUE
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_DELTA,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      IF (IPLIST(IP_RFL)) THEN
         CALL LDM_GET_RFL (IPACK, IPLATE, IVAL, IFLAG,
     +                     IERR, ERRSTR)
         WRITE (VALSTR,'(I8)') IVAL
         CALL LJUST(VALSTR)
         CALL XDLF_PARAM_TABLE_SETVALUE (IVH_PAR2, IP_RFL,
     +        XDLSTR(VALSTR), MAX_P2SCROLL_CHARS, 0, IERR)
      END IF

      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_PROMIN       **
C**************************
C
C
      SUBROUTINE SET_PROMIN
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set PROMIN parameter value if currently the default 0.0
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL PROF_ROT
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER IERR
      INTEGER ND
      INTEGER NPROF
      REAL PROMIN
      CHARACTER*20 STR
      CHARACTER*80 ERRSTR

C     LOGICAL PROF_ROT         !Rotate profiles flag
C     INTEGER IVAL             !Integer parameter value
C     INTEGER IFLAG            !Parameter status flag
C     INTEGER ITYP             !Parameter type flag
C     INTEGER IERR             !Error flag
C     INTEGER ND               !No. of decimal places flag
C     INTEGER NPROF            !No. of profile bins
C     REAL PROMIN              !Value of PROMIN parameter
C     CHARACTER*20 STR         !Temp string
C     CHARACTER*80 ERRSTR      !Error string 
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET ('PROMIN', 1, 1, STR, 
     +              PROMIN, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (PROMIN.EQ.0.0) THEN
         CALL LFN_SAINT_DF (NPROF, PROMIN, PROF_ROT)
         WRITE (STR,'(F8.1)') PROMIN
         CALL LJUST(STR)
         CALL LDM_SET ('PROMIN', 1, 1, STR, IERR, ERRSTR) 
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_SCALINT      **
C**************************
C
C
      SUBROUTINE SET_SCALINT
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set SCALE_INT parameter value if currently the default 0.0
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IVAL
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER IERR
      INTEGER ND
      INTEGER IMTYP
      REAL SCAL_INT
      CHARACTER*20 STR
      CHARACTER*80 ERRSTR

C     INTEGER IVAL             !Integer parameter value
C     INTEGER IFLAG            !Parameter status flag
C     INTEGER ITYP             !Parameter type flag
C     INTEGER IERR             !Error flag
C     INTEGER ND               !No. of decimal places flag
C     INTEGER IMTYP            !Image type flag
C     REAL SCAL_INT            !SCALE_INT value
C     CHARACTER*20 STR         !Temp string
C     CHARACTER*80 ERRSTR      !Error string 
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET ('SCALE_INT', 1, 1, STR, 
     +              SCAL_INT, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (SCAL_INT.EQ.0.0) THEN
         CALL LDM_GET_IMTYP (STR, IMTYP, IFLAG)
         IF (IMTYP.EQ.1) THEN
            SCAL_INT = 1.0            
         ELSE
            SCAL_INT = 0.1
         END IF
         WRITE (STR,'(F8.1)') SCAL_INT
         CALL LJUST(STR)
         CALL LDM_SET ('SCALE_INT', 1, 1, STR, IERR, ERRSTR) 
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SET_UPD_FLAGS    **
C**************************
C
C
      SUBROUTINE SET_UPD_FLAGS(IUPD)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set flags for automatic update of parameter values for other
C          packs/plates
C
C Author:  John W. Campbell, June 1994
C
C Arguments:
C
      INTEGER IUPD
C 
C IUPD    (R)   Flag from LAUEGEN_UPD environment variable if set (otherwise
C               -1)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'file_units.finc'
      INCLUDE 'upd_flags.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER I
C
C-------------------------------------------------------------------------------
C
      IF (IUPD.LT.0) THEN
         UPD_LAMS = .TRUE.
         UPD_DMIN = .TRUE.
         UPD_PHIS = .TRUE.
         UPD_CTOF = .TRUE.
         UPD_CENT = .TRUE.
         UPD_XCYC = .TRUE.
         UPD_WC = .FALSE.
         UPD_YSCAL = .TRUE.
         UPD_TT = .TRUE.
         UPD_BULG = .FALSE.
         UPD_RTOFF = .TRUE.
         UPD_SPD = .TRUE.
         UPD_SPOT = .TRUE.
      ELSE
         I = IUPD
         UPD_LAMS = .FALSE.
         IF (MOD(I,2).NE.0) UPD_LAMS = .TRUE.
         I = I/2
         UPD_DMIN = .FALSE.
         IF (MOD(I,2).NE.0) UPD_DMIN = .TRUE.
         I = I/2
         UPD_PHIS = .FALSE.
         IF (MOD(I,2).NE.0) UPD_PHIS = .TRUE.
         I = I/2
         UPD_CTOF = .FALSE.
         IF (MOD(I,2).NE.0) UPD_CTOF = .TRUE.
         I = I/2
         UPD_CENT = .FALSE.
         IF (MOD(I,2).NE.0) UPD_CENT = .TRUE.
         I = I/2
         UPD_XCYC = .FALSE.
         IF (MOD(I,2).NE.0) UPD_XCYC = .TRUE.
         I = I/2
         UPD_WC = .FALSE.
         IF (MOD(I,2).NE.0) UPD_WC = .TRUE.
         I = I/2
         UPD_YSCAL = .FALSE.
         IF (MOD(I,2).NE.0) UPD_YSCAL = .TRUE.
         I = I/2
         UPD_TT = .FALSE.
         IF (MOD(I,2).NE.0) UPD_TT = .TRUE.
         I = I/2
         UPD_BULG = .FALSE.
         IF (MOD(I,2).NE.0) UPD_BULG = .TRUE.
         I = I/2
         UPD_RTOFF = .FALSE.
         IF (MOD(I,2).NE.0) UPD_RTOFF = .TRUE.
         I = I/2
         UPD_SPD = .FALSE.
         IF (MOD(I,2).NE.0) UPD_SPD = .TRUE.
         I = I/2
         UPD_SPOT = .FALSE.
         IF (MOD(I,2).NE.0) UPD_SPOT = .TRUE.
      ENDIF
      IF (IUN_LOG.LE.0) RETURN
         IF (IUPD.LE.0) THEN
            WRITE(IUN_LOG,6000)
         ELSE
            WRITE(IUN_LOG,6010)
         END IF
         IF (UPD_LAMS) THEN
            WRITE (IUN_LOG,6020) 'lambda_min, lambda_max'
         ELSE
            WRITE (IUN_LOG,6030) 'lambda_min, lambda_max'
         END IF
         IF (UPD_DMIN) THEN
            WRITE (IUN_LOG,6020) 'd_min'
         ELSE
            WRITE (IUN_LOG,6030) 'd_min'
         END IF
         IF (UPD_PHIS) THEN
            WRITE (IUN_LOG,6020) 'phix, phiy, phiz'
         ELSE
            WRITE (IUN_LOG,6030) 'phix, phiy, phiz'
         END IF
         IF (UPD_CTOF) THEN
            WRITE (IUN_LOG,6020) 'c_to_f'
         ELSE
            WRITE (IUN_LOG,6030) 'c_to_f'
         END IF
         IF (UPD_CENT) THEN
            WRITE (IUN_LOG,6020) 'x_cen_f, y_cen_f'
         ELSE
            WRITE (IUN_LOG,6030) 'x_cen_f, y_cen_f'
         END IF
         IF (UPD_XCYC) THEN
            WRITE (IUN_LOG,6020) 'x_c, y_c'
         ELSE
            WRITE (IUN_LOG,6030) 'x_c, y_c'
         END IF
         IF (UPD_WC) THEN
            WRITE (IUN_LOG,6020) 'w_c'
         ELSE
            WRITE (IUN_LOG,6030) 'w_c'
         END IF
         IF (UPD_YSCAL) THEN
            WRITE (IUN_LOG,6020) 'y_scale'
         ELSE
            WRITE (IUN_LOG,6030) 'y_scale'
         END IF
         IF (UPD_TT) THEN
            WRITE (IUN_LOG,6020) 'tilt, twist'
         ELSE
            WRITE (IUN_LOG,6030) 'tilt, twist'
         END IF
         IF (UPD_BULG) THEN
            WRITE (IUN_LOG,6020) 'bulge'
         ELSE
            WRITE (IUN_LOG,6030) 'bulge'
         END IF
         IF (UPD_RTOFF) THEN
            WRITE (IUN_LOG,6020) 'roff, toff'
         ELSE
            WRITE (IUN_LOG,6030) 'roff, toff'
         END IF
         IF (UPD_SPD) THEN
            WRITE (IUN_LOG,6020) 
     +            'spd... (polynomial spatial distortion)'       
         ELSE
            WRITE (IUN_LOG,6030) 
     +             'spd... (polynomial spatial distortion)'
         END IF
         IF (UPD_SPOT) THEN
            WRITE (IUN_LOG,6020) 'spot sizes'
         ELSE
            WRITE (IUN_LOG,6030) 'spot sizes'
         END IF
         WRITE(IUN_LOG,6040)
      RETURN
C
C Format Statements
C------------------
C
6000  FORMAT (//,'Automatic parameter update flags (default)',/)
6010  FORMAT (//,
     +  'Automatic parameter update flags (set using LAUEGEN_UPD)',/)
6020  FORMAT ('Yes: ',A)
6030  FORMAT ('No:  ',A)
6040  FORMAT (' ')
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*********************
C**     SFPIX       **
C*********************
C
C
      SUBROUTINE SFPIX (IXPIX, IYPIX, ISPIX, IFPIX)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Convert x,y pixel position to slow, fast axis pixel position
C
C Author:  John W. Campbell, October 1993
C
C Arguments:
C
      INTEGER IXPIX
      INTEGER IYPIX
      INTEGER ISPIX
      INTEGER IFPIX
C 
C IXPIX      (R)   Pixel position wrt x axis
C IYPIX      (R)   Pixel position wrt y axis
C ISPIX      (W)   Pixel position wrt slow axis in stored image
C IFPIX      (W)   Pixel position wrt fast axis in stored image
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER IORD
      INTEGER ISWAP
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IFLAG
      CHARACTER*2 VALSTR

C     INTEGER IORD            !Axis order in stored image 1-8
C     INTEGER ISWAP           !Byte swap flag
C     INTEGER NXRAST          !No. x-rasters
C     INTEGER NYRAST          !No. y-rasters
C     INTEGER IFLAG           !Parameter status flag
C     CHARACTER*2 VALSTR      !Parameter value string (dummy)
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      IF (IORD.EQ.1) THEN
         ISPIX = IXPIX
         IFPIX = IYPIX
      ELSE IF (IORD.EQ.2) THEN
         ISPIX = IXPIX
         IFPIX = NYRAST - IYPIX + 1
      ELSE IF (IORD.EQ.3) THEN
         ISPIX = NXRAST - IXPIX + 1
         IFPIX = IYPIX
      ELSE IF (IORD.EQ.4) THEN
         ISPIX = NXRAST - IXPIX + 1
         IFPIX = NYRAST - IYPIX + 1
      ELSE IF (IORD.EQ.5) THEN
         ISPIX = IYPIX
         IFPIX = IXPIX
      ELSE IF (IORD.EQ.6) THEN
         ISPIX = IYPIX
         IFPIX = NXRAST - IXPIX + 1
      ELSE IF (IORD.EQ.7) THEN
         ISPIX = NYRAST - IYPIX + 1
         IFPIX = IXPIX
      ELSE IF (IORD.EQ.8) THEN
         ISPIX = NYRAST - IYPIX + 1
         IFPIX = NXRAST - IXPIX + 1
      ELSE
         ISPIX = 0
         IFPIX = 0
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SHOW_IMAGE       **
C**************************
C
C
      SUBROUTINE SHOW_IMAGE (IPOSN, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Show film/image-plate image (check opening of file & read
C          image if needed)
C
C Author:  John W. Campbell, March 1992
C
C Arguments:
C
      INTEGER IPOSN
      INTEGER IERR
C
C IPOSN   (R)   Position of image
C               =1 Position at top left of parameter table 1
C               =2 Top left of autoindexing solutions text table
C IERR    (W)   Error flag =0 OK, =1 error
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'image.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C

      INTEGER KERR
      INTEGER IDUMMY(2)
      INTEGER KXROOT
      INTEGER KYROOT
      INTEGER IFLAG
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER IORD
      INTEGER ISWAP
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL W_F
      CHARACTER*2 VALSTR
      CHARACTER*2 ERRSTR

C     INTEGER KERR        !Error flag
C     INTEGER IDUMMY(2)   !Dummy array for film display routine
C     INTEGER KXROOT      !Root window x position for image display
C     INTEGER KYROOT      !Root window y position for image display
C     INTEGER IFLAG       !Parameter status flag
C     INTEGER NXRAST      !No. of x-rasters
C     INTEGER NYRAST      !No. of y-rasters
C     INTEGER NF_OFF      !Offset between start of slow rasters in image
C     INTEGER IORD        !Axis order flag
C     INTEGER ISWAP       !Byte swap flag
C     REAL X_CEN_F        !X centre
C     REAL Y_CEN_F        !Y centre
C     REAL W_F            !Omega
C     CHARACTER*2 VALSTR  !Value string (dummy)
C     CHARACTER*2 ERRSTR  !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
C
C====== Open film/image-plate file
C
      CALL CHK_OPN(IERR)
      IF (IERR.GT.0) THEN
         IERR = 1
         RETURN
      END IF
      IERR = 0
C
C====== Read image if not already read
C
      IF (.NOT.FILM_READ) CALL READ_IMAGE (0, IMG, MAX_IMG_WORDS, 
     +                              ITYPE, NF_OFF, IERR, ERRSTR)
      IF (.NOT.FILM_READ) THEN
         IERR = 1
         RETURN
      END IF
      CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
C
C====== Display film/image-plate image
C
      KXROOT = 0
      KYROOT = 0
      IF (IPOSN.EQ.1) THEN
         CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,0,0,KXROOT,KYROOT,KERR)
         KYROOT = KYROOT - 30
         IF (KYROOT.LT.0) KYROOT = 0
      ELSE IF (IPOSN.EQ.2) THEN
         CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_TABL_AUT,0,0,KXROOT,KYROOT,
     +                                KERR)
         KYROOT = KYROOT - 30
         IF (KYROOT.LT.0) KYROOT = 0
      END IF
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      CALL XDLF_IMAGE (IVH_FILM,0,KXROOT,KYROOT,1,IMG,ITYPE,
     +                 NSRASTS,NFRASTS,NFRASTS,
     +                 1,1,NXRAST,NYRAST,-NCMP,IORD,2,
     +                 MINVAL,MAXVAL,MINTHR,MAXTHR,0,0,
     +                 1,1,ICONTRAST,1,IERR)
      CALL XDLF_IMAGE_AXNAMES (IVH_FILM,XDLSTR('xf'),2,XDLSTR('yf'),2,
     +                         IERR)
      CALL XDLF_IMAGE_BACKGROUND(IVH_FILM,IMG_BG,NCMP,
     +                           NF_BGOFF,KERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SHOW_INTSTATS    **
C**************************
C
C
      SUBROUTINE SHOW_INTSTATS
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Show intensity statistics
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER IVH
      INTEGER IVHLIST(2)
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IERR
      INTEGER NCOLS
      INTEGER NROWS
      INTEGER ICOL
      INTEGER LL
      INTEGER IBOLD
      INTEGER NS(5)
      INTEGER NG(5)
      INTEGER NO(5)
      INTEGER NN(5)
      INTEGER NB(5)
      INTEGER N3(5)
      INTEGER N10(5)
      REAL AIM(5)
      REAL AIS(5)
      CHARACTER*20 NAMES(2)
      CHARACTER*80 STR 

C     INTEGER I             !Temp/loop variable
C     INTEGER IVH           !View-object handle returned from XDLF_GET_EVENTS
C     INTEGER IVHLIST(2)    !List of view-object handles for getting events
C     INTEGER IXROOT        !Root 'x' position for profiles text table
C     INTEGER IYROOT        !Root 'y' position for profiles text table
C     INTEGER IERR          !Error flag
C     INTEGER NCOLS         !No. of columns for text table
C     INTEGER NROWS         !No. of rows for text table
C     INTEGER ICOL          !Column no. for start of text output
C     INTEGER LL            !Length of character string
C     INTEGER IBOLD         !Bold/colour flag
C     INTEGER NS(5)   !No. of spots present for the 5 spot categories
C     INTEGER NG(5)   !No. of spots integrated & good for the 5 spot categories
C     INTEGER NO(5)   !No. of overload spots flagged for the 5 spot categories
C     INTEGER NN(5)   !No. of OK negative intensities for the 5 spot categories
C     INTEGER NB(5)   !No. of bad spots spots flagged for the 5 spot categories
C     INTEGER N3(5)   !No. OK spots with I>3*sig(I) for the 5 spot categories
C     INTEGER N10(5)  !No. OK spots wit I>10*sig(I) for the 5 spot categories
C     REAL AIM(5)     !Mean I value for the 5 spot categories (for OK positive
C                      intensities only)
C     REAL AIS(5)     !Mean I/sig(I) values for the 5 spot categories (for
C                      OK positive intensities only)
C     CHARACTER*20 NAMES(2) !Item names for menu
C     CHARACTER*80 STR      !Output string

      DATA NAMES/'Continue',' '/

C
C-------------------------------------------------------------------------------
C
C====== Get statistics
C
      CALL LFN_INT_STATS1 (KDX_LIRL, IPACK, IPLATE, NS, NG, NO, NN,  
     +                     NB, AIM, AIS, N3, N10, IERR)
      IF (IERR.NE.0) THEN
         CALL ERR_NOTICE (1,'**No intensities data found**')
         RETURN
      END IF
C
C====== Create text table and output results
C
      NCOLS = 82
      NROWS = 16
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_PAR1,0,0,IXROOT,IYROOT,IERR)
      CALL XDLF_TEXT_TABLE (IVH_PROF_TAB, 0, IXROOT, IYROOT, 0, NCOLS,
     +                      NROWS, 0, 0, IFONT, IERR)

      STR = 'Integration statistics for pack'
      CALL STR_ADDI (STR, IPACK, 1)
      CALL STR_ADDS (STR, ', plate', 0)
      CALL STR_ADDI (STR, IPLATE, 1)
      LL = LENSTR (STR)
      ICOL = (82-LL)/2+1
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           1, ICOL, 11, IERR)
      STR = 'Spot type'
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           4, 2, 11, IERR)
      STR= '  Total   Good Ovld.  Neg.   Bad'
      CALL STR_ADDS (STR, '     Mean   Mean  Number  Number', 0)
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           4, 17, 1, IERR)
      STR = '  Spots  Spots Spots Spots Spots'
      CALL STR_ADDS (STR, '        I I/sigI  >3sigI >10sigI', 0)
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           5, 17, 1, IERR)
      STR = 'All spots'
      LL = LENSTR (STR)
      IBOLD = 1
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           7, 1, IBOLD, IERR)
      STR = 'Singles'
      LL = LENSTR (STR)
      IBOLD = 3
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           8, 1, IBOLD, IERR)
      STR = '(sep)'
      LL = LENSTR (STR)
      IBOLD = 0
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           8, 9, IBOLD, IERR)
      STR = 'Multiples'
      LL = LENSTR (STR)
      IBOLD = 3
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           9, 1, IBOLD, IERR)
      STR = '(sep)'
      LL = LENSTR (STR)
      IBOLD = 0
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           9, 11, IBOLD, IERR)
      STR = 'SpOv. Singles'
      LL = LENSTR (STR)
      IBOLD = 1
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           10, 1, IBOLD, IERR)
      STR = 'SpOv. Multiples'
      LL = LENSTR (STR)
      IBOLD = 1
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           11, 1, IBOLD, IERR)
       DO 10 I = 1, 5
         WRITE (STR,'(I7)') NS(I)
         LL = LENSTR (STR)
         IBOLD = 0
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              6+I, 17, IBOLD, IERR)
         WRITE (STR,'(I7)') NG(I)
         LL = LENSTR (STR)
         IF (I.EQ.2.OR.I.EQ.3) IBOLD = 3
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              6+I, 24, IBOLD, IERR)
         IBOLD = 0
         WRITE (STR,'(3I6,F9.1)') NO(I), NN(I), NB(I), AIM(I)
         LL = LENSTR (STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              6+I, 31, IBOLD, IERR)
         IF (I.EQ.2.OR.I.EQ.3) IBOLD = 3
         WRITE (STR,'(F7.1)') AIS(I)
         LL = LENSTR (STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              6+I, 58, IBOLD, IERR)
         IBOLD = 0
         WRITE (STR,'(I8,I8)') N3(I), N10(I)
         LL = LENSTR (STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              6+I, 65, IBOLD, IERR)
 10   CONTINUE
      STR = 'Key:'
      IBOLD = 10
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           13, 1, IBOLD, IERR)
      STR = 'Good  = Good spot, measured and not bad/overload'
      IBOLD = 0
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           13, 6, IBOLD, IERR)
      STR = '     (sep) = Spatially separated'
      IBOLD = 0
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           14, 1, IBOLD, IERR)
      STR = '     Ovld. = Intensity overload'
      IBOLD = 0
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           15, 1, IBOLD, IERR)
      STR = '     SpOv. = Spatially overlapped'
      IBOLD = 0
      LL = LENSTR (STR)
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           16, 1, IBOLD, IERR)
C
C===== Get continue command from menu
C
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 1, XDLSTR(NAMES), 20,
     +     XDLSTR(' '), -1, XDLSTR(' '), -1, 0, IERR)
      IVHLIST(1) = IVH_MENU
      CALL XDLF_GET_EVENTS(1, IVHLIST, IVH)
      CALL XDLF_DELETE_VIEW_OBJECT(IVH_PROF_TAB, IERR)
      RETURN
      END
CC LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SHOW_PREDICT     **
C**************************
C
C
      SUBROUTINE SHOW_PREDICT (ITYP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Show predicted pattern on image
C
C Author:  John W. Campbell, March 1992
C
C Note: Assumes that image is already displayed
C
C Arguments:
C
      INTEGER ITYP
C
C ITYP  (R)   Flag = 1 Using main menu area / base frame
C                  = 2 Using autoindexing solutions menu area / base frame
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER KTYP
      INTEGER IERR
      INTEGER IVH_MENU_USE
      INTEGER IDISP
      INTEGER M_ALL
      INTEGER M_NODALS
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER NUMSPOTS
      CHARACTER*25 NAMES(2)
      CHARACTER*25 QUITNAM

C     INTEGER KTYP         !Flag for notices positioning
C     INTEGER IERR         !Error flag
C     INTEGER IVH_MENU_USE !View-object handle of menu area to be used
C     INTEGER IDISP        !=0 display all reflections, =1 display nodals
C     INTEGER M_ALL        !Menu item number for display all reflections
C     INTEGER M_NODALS     !Menu item number for display nodals
C     INTEGER NVIEW        !Number of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item number selected on menu
C     INTEGER IQUIT        !Quit flag from menu
C     INTEGER NUMSPOTS     !No. of predicted spots
C     CHARACTER*25 NAMES(2)   !Menu item strings
C     CHARACTER*25 QUITNAM    !Quit box string

      DATA NAMES /'Display All Predicted',
     +            'Display Nodals Only'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C
C====== Initialisations
C
      KTYP = 1
      IVH_MENU_USE = IVH_MENU
      IF (ITYP.EQ.2) THEN
         KTYP = 2
         IVH_MENU_USE = IVH_MENU_AUT
      END IF
C
C====== Predict reflections if not already done
C
      CALL CALC_LAUE (.TRUE.)
C
C====== Determine whether to display all reflns or nodals at start
C
      CALL LRL_NUMSPOTS(NUMSPOTS)
      IDISP = 0
      IF (NUMSPOTS.GT.MAX_DISP) THEN
         CALL FIND_SEL_NODS (ITYP, 1, 1, 1, 0, 0, 0)
         IDISP = 1
      END IF
C
C====== Display predicted positions
C
      CALL PLOT_SYMBS (IDISP, 3)
C
C====== Set up Selection Options Menu
C
      M_ALL = 1
      M_NODALS = 2
      CALL XDLF_MENU_AREA_SETMENU (IVH_MENU_USE, 2, 
     +     XDLSTR(NAMES), 25,
     +     XDLSTR('Prediction Menu'), 15, XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Service Menu
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU_USE

100   CALL XDLF_GET_EVENTS(NVIEW,IVHLIST,IVH)
      IF (IVH.EQ.IVH_MENU_USE) THEN
         CALL XDLF_MENU_AREA_GETITEM(IVH_MENU_USE,ITEM,IQUIT)
C
C====== Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,IERR)
            RETURN
         END IF
C
C====== Display all predicted reflections
C
         IF (ITEM.EQ.M_ALL) THEN
            IF (NUMSPOTS.GT.MAX_DISP) THEN
               CALL ERR_NOTICE (KTYP,
     +              '**Too many spots to display**')
               GO TO 100
            END IF
            IDISP = 0
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,IERR)
            CALL PLOT_SYMBS (IDISP, 3)
            GO TO 100
C
C====== Display nodals only
C
         ELSE IF (ITEM.EQ.M_NODALS) THEN
            CALL FIND_SEL_NODS (ITYP, 1, 1, 1, 0, 0, 0)
            IDISP = 1
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM,IERR)
            CALL PLOT_SYMBS (IDISP, 3)
            GO TO 100
         END IF
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SHOW_PROFILES    **
C**************************
C
C
      SUBROUTINE SHOW_PROFILES
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Show current integration profiles
C
C Author:  John W. Campbell, January 1996
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL DRAW_PROF
      LOGICAL PROF_ROT
      INTEGER M_FIRST
      INTEGER M_NEXT
      INTEGER M_PREV
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER IPK
      INTEGER IPL
      INTEGER IPROF_CUR
      INTEGER NPHALF
      INTEGER NUMPIX
      INTEGER NPROFS
      INTEGER NCOLS
      INTEGER NROWS
      INTEGER LL
      INTEGER I
      INTEGER IX
      INTEGER IY
      INTEGER KCX
      INTEGER KCY
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER ICOL
      INTEGER IROW
      INTEGER IMASK
      INTEGER IBOLD
      INTEGER INUM
      REAL PROFMAX
      REAL PRF
      REAL SC_PRF
      REAL ANG
      CHARACTER*25 NAMES(3)
      CHARACTER*25 QUITNAM
      CHARACTER*1 NUMCH(16)
      CHARACTER*25 STR
      CHARACTER*1 CH
    
C     LOGICAL DRAW_PROF     !Profile drawing required
C     LOGICAL PROF_ROT      !Rotate profiles flag
C     INTEGER M_FIRST       !Menu item no.: Show first profile
C     INTEGER M_NEXT        !Menu item no.: Show next profile
C     INTEGER M_PREV        !Menu item no.: Show previous profile
C     INTEGER NVIEW         !No. of view-objects for getting events
C     INTEGER IVHLIST(2)    !List of view-object handles for getting events
C     INTEGER IVH           !Returned view-object handle from getting events
C     INTEGER ITEM          !Item no. from menu selection
C     INTEGER IQUIT         !Quit button flage from menu
C     INTEGER IERR          !Error flag
C     INTEGER IPK           !Pack no. from latest profile calculated
C     INTEGER IPL           !Plate no. from latest profile calculated
C     INTEGER IPROF_CUR     !No. of current profile
C     INTEGER NPHALF        !Half width of profile boxes
C     INTEGER NUMPIX        !No. of pixels in profile
C     INTEGER NPROFS        !No. of profile bins
C     INTEGER NCOLS         !No. of columns for profiles text table
C     INTEGER NROWS         !No. of rows for profiles text table
C     INTEGER LL            !Length of character string
C     INTEGER I             !Temp/loop variable
C     INTEGER IX            !Loop counter through 'x' pixels of profile box
C     INTEGER IY            !Loop counter through 'y' pixels of profile box
C     INTEGER KCX           !Centre 'x' character posn in profiles text table
C     INTEGER KCY           !Centre 'y' character posn in profiles text table
C     INTEGER IXROOT        !Root 'x' position for profiles text table
C     INTEGER IYROOT        !Root 'y' position for profiles text table
C     INTEGER ICOL          !Column no. for character in profiles text table
C     INTEGER IROW          !Row no. for character in profiles text table
C     INTEGER IMASK         !Mask value for profile pixel
C     INTEGER IBOLD         !Bold print & colour flag
C     INTEGER INUM          !Character number in table (0-15)
C     REAL PROFMAX          !Maximum picel value in profile
C     REAL PRF              !Profile value of a requested pixel in the profile
C     REAL SC_PRF           !Scale factor for profile
C     REAL ANG              !Angle at start or end of profile bin
C     CHARACTER*25 NAMES(3) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string
C     CHARACTER*1 NUMCH(16) !Character table for profile print
C     CHARACTER*25 STR      !Temp string
C     CHARACTER*1 CH        !Character for profile pixel o/p

      DATA NAMES /'Show First Profile',
     +            'Show Next Profile',
     +            'Show Previous Profile'/
      DATA QUITNAM /'Return to Previous Menu'/
      DATA NUMCH/'0','1','2','3','4','5','6','7','8','9',
     +           'A','B','C','D','E','F'/

C
C-------------------------------------------------------------------------------
C
C
C====== Get details of profiles
C
      CALL LFN_GET_PROFPARS (IPK, IPL, NPHALF, NUMPIX, NPROFS, 
     +                       PROF_ROT)
C
C====== Set up Profile display window
C
      IPROF_CUR = 1
      NCOLS = 4*NPHALF + 3
      IF (NCOLS.LT.31) THEN
         NCOLS = 31
      END IF
      NROWS =2*NPHALF + 5  
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_PAR1,0,0,IXROOT,IYROOT,IERR)
      CALL XDLF_TEXT_TABLE (IVH_PROF_TAB, 0, IXROOT, IYROOT, 0, NCOLS,
     +                      NROWS, 0, 0, IFONT, IERR)
      DRAW_PROF = .TRUE.
      STR = 'Pack'
      CALL STR_ADDI (STR, IPK, 1)
      CALL STR_ADDS (STR, ', Plate', 0) 
      CALL STR_ADDI (STR, IPL, 1)
      LL = LENSTR(STR)
      I = (NCOLS-LL)/2 + 1
      CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                           NROWS, I, 10, IERR)
      KCX = (NCOLS+1)/2
      KCY = (NROWS+1)/2
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Set up & process menu
C
      M_FIRST = 1
      M_NEXT = 2
      M_PREV = 3
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 3, XDLSTR(NAMES), 25,
     +                         XDLSTR('Show Profiles Menu'), 18,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Draw requested profile if needed
C
      IF (DRAW_PROF) THEN
         CALL XDLF_TEXT_TABLE_CLEAR (IVH_PROF_TAB, IERR)
         STR = 'Profile'
         CALL STR_ADDI (STR, IPROF_CUR, 1)
         LL = LENSTR(STR)
         I = (NCOLS-LL)/2 + 1
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              1, 1, 11, IERR)
         STR = '('
         ANG = (IPROF_CUR-1)*360.0/FLOAT(NPROFS)
         CALL STR_ADDF (STR, ANG, 1, 0)
         CALL STR_ADDS (STR, '-', 0)
         ANG = IPROF_CUR*360.0/FLOAT(NPROFS)
         CALL STR_ADDF (STR, ANG, 1, 0)
         CALL STR_ADDS (STR, 'deg)', 0)
         LL = LENSTR(STR)
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              1, NCOLS-LL+1, 10, IERR)
         STR = 'Pack'
         CALL STR_ADDI (STR, IPK, 1)
         CALL STR_ADDS (STR, ', Plate', 0) 
         CALL STR_ADDI (STR, IPL, 1)
         LL = LENSTR(STR)
         I = (NCOLS-LL)/2 + 1
         CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(STR), LL, 
     +                              NROWS, I, 10, IERR)
         CALL LFN_GET_PROFMAX (IPROF_CUR, PROFMAX, IERR)
         SC_PRF = 1.0
         IF (PROFMAX.GT.0.0) SC_PRF = 15.0/PROFMAX
         DO 70 IY = -NPHALF, NPHALF
            DO 60 IX = -NPHALF, NPHALF
               ICOL = KCX + 2*IX
               IROW = KCY - IY
               CALL LFN_GET_PROFPIX (IPROF_CUR, IX, IY, IMASK, 
     +                               PRF, IERR)
               IF (IERR.EQ.2.OR.IMASK.EQ.-100) THEN
                  IBOLD = 1
                  CH = '.'
               ELSE
                  IF (IMASK.EQ.-1) THEN
                     IBOLD = 1
                     CH = '*'
                  ELSE 
                     INUM = NINT (SC_PRF*PRF)
                     IF (INUM.LT.0) INUM = 0
                     IF (INUM.GT.15) INUM = 15
                     CH = NUMCH(INUM+1)
                     IF (IMASK.LE.1) THEN
                        IBOLD = 10
                     ELSE IF (IMASK.GE.10) THEN
                        IBOLD = 3
                     ELSE
                        GO TO 60
                     END IF
                  END IF
               END IF
               CALL XDLF_TEXT_TABLE_TEXT (IVH_PROF_TAB, XDLSTR(CH), 1, 
     +                              IROW, ICOL, IBOLD, IERR)
 60         CONTINUE
 70      CONTINUE
         DRAW_PROF = .FALSE.
      END IF

C
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_PROF_TAB, IERR)
            RETURN
         END IF 
C
C====== Show First Profile
C
         IF (ITEM.EQ.M_FIRST) THEN
            IF (IPROF_CUR.NE.1) THEN
               IPROF_CUR = 1
               DRAW_PROF = .TRUE.
            END IF
            GO TO 50
C
C====== Show Next Profile 
C
         ELSE IF (ITEM.EQ.M_NEXT) THEN
            IF (IPROF_CUR.LT.NPROFS) THEN
               IPROF_CUR = IPROF_CUR + 1
               DRAW_PROF = .TRUE.
            END IF
            GO TO 50
C
C====== Show Previous Profile
C
         ELSE IF (ITEM.EQ.M_PREV) THEN
            IF (IPROF_CUR.GT.1) THEN
               IPROF_CUR = IPROF_CUR - 1
               DRAW_PROF = .TRUE.
            END IF
            GO TO 50
         END IF
         GO TO 100
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C************************
C**     SOFT_BINS      **
C************************
C
C
      SUBROUTINE SOFT_BINS (IOPT, NBINS, BINW)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Return soft limits determination default bin parameters based
C          on current soft limit value
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER IOPT
      INTEGER NBINS
      REAL BINW
C
C IOPT    (R)  Soft limit type 1=dmin, 2=lmin
C NBINS   (W)  Number of bins
C BINW    (W)  Bin width
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL IDUM_PRF_ROT
      INTEGER NPR_DUM
      REAL PRO_DUM
      REAL FRAC_DUM
      REAL SIG_DUM
      REAL FRT_DUM      

C     LOGICAL IDUM_PRF_ROT   !Dummy parameter for PROF_ROT
C     INTEGER NPR_DUM        !Dummy parameter for NPROF
C     REAL PRO_DUM           !Dummy parameter for PROMIN
C     REAL FRAC_DUM          !Dummy parameter for FRAC
C     REAL SIG_DUM           !Dummy parameter for SIGTEST
C     REAL FRT_DUM           !Dummy parameter for FRTEST
C
C-------------------------------------------------------------------------------
C
      CALL LFN_SOFT_DF (IOPT, MAX_SOFT_BINS, NPR_DUM, IDUM_PRF_ROT,
     +                  PRO_DUM, FRAC_DUM,
     +                  SIG_DUM, FRT_DUM, NBINS, BINW)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SOFT_CALC        **
C**************************
C
C
      SUBROUTINE SOFT_CALC (IOPT, KQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Improve soft limits calculation routine
C
C Author:  John W. Campbell, March 1994
C
C Arguments:
C
      INTEGER IOPT
      INTEGER KQUIT
C 
C IOPT     (R)    Flag =1, determine dmin
C                      =2, determine lambda-min
C KQUIT    (W)    Return flag  = 0, OK
C                              = 1, Cannot open image file or cannot read
C                                   image
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'image.finc'
      INCLUDE 'upd_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      EXTERNAL SOFT_INTEG_PROGRESS
      LOGICAL LFN_DUMMY_CNCL
      EXTERNAL LFN_DUMMY_CNCL
C
C====== LOCALS:
C
      LOGICAL GRAPH_DISP
      LOGICAL ACCEPT
      INTEGER I
      INTEGER M_NORM
      INTEGER M_HIST
      INTEGER M_SHOW
      INTEGER M_ACCEPT
      INTEGER M_INPUT
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER JERR
      INTEGER IWARN
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IBUTTON
      INTEGER IRFL
      INTEGER IFLAG
      INTEGER ND
      INTEGER IORDER
      INTEGER ISWAP
      INTEGER IYN
      INTEGER LISTE(2)
      INTEGER NUMBINS
      INTEGER NTOT_MEAS
      INTEGER NTOT_GTSIG
      INTEGER NMEAS(MAX_SOFT_BINS)
      INTEGER NGTSIG(MAX_SOFT_BINS)
      INTEGER IBIN_SEL
      INTEGER KPACK
      INTEGER KPLATE
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL W_F
      REAL RBIN(MAX_SOFT_BINS)
      REAL SOFT_MIN
      REAL SOFT_MAX
      REAL SOFT_SEL
      REAL BIN_WIDTH
      REAL SHOW_VAL
      REAL VAL
      REAL CUR_INT_LOW
      CHARACTER*2 VALSTR
      CHARACTER*80 ERRSTR
      CHARACTER*80 WARNSTR
      CHARACTER*120 STR
      CHARACTER*25 NAMES(5)
      CHARACTER*25 QUITNAM

C     LOGICAL GRAPH_DISP   !Graph is currently displayed flag
C     LOGICAL ACCEPT       !Limit has been accepted
C     INTEGER I            !Temp/loop variable
C     INTEGER M_NORM       !Menu item no.: Normalised Histogram
C     INTEGER M_HIST       !Menu item no.: Un-normalised Histogram
C     INTEGER M_SHOW       !Menu item no.: Show image
C     INTEGER M_ACCEPT     !Menu item no.: Accept new limit
C     INTEGER M_INPUT      !Menu item no.: Input another limit
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. from menu selection
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER JERR         !Error flag
C     INTEGER IWARN        !warning flag
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER NF_OFF       !Offset between start of slow rasters in image
C     INTEGER IXROOT       !Root window x position for popup notice
C     INTEGER IYROOT       !Root window y position for popup notice
C     INTEGER IBUTTON      !Button from popup notice
C     INTEGER IRFL         !Plate refined flag = 1 yes, = 0 no
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IORDER       !Axis order flag
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER IYN          !Yes/no flag
C     INTEGER LISTE(2)     !List of parameter table 1 entries to be updated
C     INTEGER NUMBINS      !No. of bins
C     INTEGER NTOT_MEAS    !Total no. of measured spots
C     INTEGER NTOT_GTSIG   !Total no. of significant spots
C     INTEGER NMEAS(MAX_SOFT_BINS)  !No. measured spots in each statisticss bin
C     INTEGER NGTSIG(MAX_SOFT_BINS) !No. significant spots in each bin
C     INTEGER IBIN_SEL     !Selected soft limit bin no.
C     INTEGER KPACK        !Pack number, 0 = all packs
C     INTEGER KPLATE       !Plate number, 0 = all plates
C     REAL X_CEN_F         !X centre
C     REAL Y_CEN_F         !Y centre
C     REAL W_F             !Omega
C     REAL RBIN(MAX_SOFT_BINS)      !Significant/measured ratios in each bin
C     REAL SOFT_MIN        !Lower end of soft limit range used
C     REAL SOFT_MAX        !Upper end of soft limit range used
C     REAL SOFT_SEL        !Determined soft limit value
C     REAL BIN_WIDTH       !Bin width for soft limits determination
C     REAL SHOW_VAL        !Value of soft limit for predicted pattern on image
C     REAL VAL             !Temporary value
C     CUR_INT_LOW          !Current low limit used in prediction/integration
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*80 ERRSTR  !Error message string
C     CHARACTER*80 WARNSTR !Warning message string
C     CHARACTER*120 STR    !Message string
C     CHARACTER*25 NAMES(5) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string

      DATA NAMES /'Normalised Histogram',
     +            'Un-normalised Histogram',
     +            'Show Results on Image',
     +            'Accept New Soft Limit',
     +            'Input Another Limit'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      KQUIT = 0
C
C====== Open film/image-plate file if needed
C
      CALL CHK_OPN(IERR)
      IF (IERR.GT.0) THEN
         KQUIT = 1
         RETURN
      END IF
C
C====== Read image if not already read
C
      IF (.NOT.FILM_READ) CALL READ_IMAGE (0, IMG, MAX_IMG_WORDS, 
     +                              ITYPE, NF_OFF, JERR, ERRSTR)
      IF (.NOT.FILM_READ) THEN
         KQUIT = 1
         RETURN
      END IF
      CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
C
C====== Check that plate has been refined
C
      CALL LDM_GET_RFL(IPACK, IPLATE, IRFL, IFLAG, IERR, ERRSTR)
      IF (IRFL.EQ.0) THEN
         CALL NOTICE_POSN(1, IXROOT, IYROOT)
         CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +           XDLSTR('**Plate not yet refined**'), 25,
     +           XDLSTR('Continue in spite of this?'), 26,
     +           XDLSTR('Yes'), 3,
     +           XDLSTR('No'), 2,
     +           IFONT, 1, IBUTTON)
         IF (IBUTTON.EQ.2) RETURN
      END IF
C
C====== Get some image related details
C
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORDER, ISWAP, IFLAG)
C
C====== Get progress bar position
C
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,IPROG_X,IPROG_Y,IERR)
      IPROG_PASS = 0
C
C====== Calculate the soft limit
C
      IF (IOPT.EQ.1) THEN
         NUMBINS = ISOFT_D_NUMBINS
         BIN_WIDTH = SOFT_DMIN_WIDTH
      ELSE
         NUMBINS = ISOFT_L_NUMBINS
         BIN_WIDTH = SOFT_LMIN_WIDTH
      END IF
      CALL LFN_SOFT (IPACK, IPLATE, IOPT, IMG, ITYPE, IORDER,
     +               NFRASTS, NXRAST, NYRAST, PROMIN,
     +               NPROF, PRF_ROT, 
     +               SOFT_INTEG_PROGRESS, LFN_DUMMY_CNCL,
     +               SOFT_FRAC, SOFT_SIGTEST, SOFT_FRTEST, 
     +               NUMBINS, BIN_WIDTH,
     +               NTOT_MEAS, NTOT_GTSIG, NMEAS, NGTSIG, RBIN,
     +               SOFT_MIN, SOFT_MAX, SOFT_SEL, IBIN_SEL,
     +               IERR, ERRSTR, IWARN, WARNSTR)
      IB_SEL = IBIN_SEL
      CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
      IF (IERR.NE.0) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL LMESSAGE (IVH_IOW, STR)
      END IF
      IF (IOPT.EQ.1) THEN
         STR = 'Value determined for ''dmin'' is'
      ELSE
         STR = 'Value determined for ''lambda-min'' is'
      END IF
      CALL STR_ADDF(STR,SOFT_SEL,2,1)
      CALL LMESSAGE(IVH_IOW, STR)
      IF (IWARN.GT.0) THEN
         STR = '*Warning*'
         CALL STR_ADDS(STR,WARNSTR,1)
         CALL LMESSAGE(IVH_IOW,STR)
      END IF
      SHOW_VAL = SOFT_SEL
      CUR_INT_LOW = SOFT_MIN
      IF (IUN_LOG.GT.0) WRITE(IUN_LOG,'('' '')')
      IF (IUN_LOG.GT.0) CALL LFN_SOFT_LIST (IUN_LOG, 0, IPACK, IPLATE, 
     +    IOPT, PROMIN, NPROF, PRF_ROT, 
     +    SOFT_SIGTEST, SOFT_FRTEST, NUMBINS, BIN_WIDTH,
     +    NMEAS, NGTSIG, RBIN, SOFT_MIN, SOFT_MAX, SOFT_SEL,        
     +    IBIN_SEL, IWARN, WARNSTR)
C
C====== Set some flags
C
      GRAPH_DISP = .FALSE.
      ACCEPT = .FALSE.
C
C====== Output menu to service results
C
      M_NORM = 1
      M_HIST = 2
      M_SHOW = 3
      M_ACCEPT = 4
      M_INPUT = 5
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 5, XDLSTR(NAMES), 25,
     +                         XDLSTR('Soft Limits Results Menu'), 24,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            IF (.NOT.ACCEPT) THEN
               CALL YESNO_NOTICE (1,
     +              'No new value selected - still return?', IYN)
               IF (IYN.EQ.2) GO TO 100
               IF (IUN_LOG.GT.0) WRITE(IUN_LOG,1020)
            END IF
            IF (GRAPH_DISP) THEN
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_GRAPH, IERR)
            END IF
            RETURN
         END IF
C
C====== Delete graph if present unless 'accept' or 'input option
C
         IF (ITEM.NE.M_ACCEPT.AND.ITEM.NE.M_INPUT) THEN
            IF (GRAPH_DISP) THEN
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_GRAPH, IERR)
               GRAPH_DISP = .FALSE.
            END IF
         END IF
C
C====== Output Normalised Histogram
C
         IF (ITEM.EQ.M_NORM) THEN
            CALL SOFT_HIST (IOPT, 1, NUMBINS, BIN_WIDTH, 
     +                      SOFT_MIN, SOFT_MAX, SOFT_SEL, IBIN_SEL,
     +                      NGTSIG, RBIN)
            GRAPH_DISP = .TRUE.
            GO TO 100
C
C====== Output Un-normalised Histogram
C
         ELSE IF (ITEM.EQ.M_HIST) THEN
            CALL SOFT_HIST (IOPT, 0, NUMBINS, BIN_WIDTH, 
     +                      SOFT_MIN, SOFT_MAX, SOFT_SEL, IBIN_SEL,
     +                      NGTSIG, RBIN)
            GRAPH_DISP = .TRUE.
            GO TO 100
C
C====== Show image
C
         ELSE IF (ITEM.EQ.M_SHOW) THEN
            CALL SOFT_SHOW (IOPT, SHOW_VAL, CUR_INT_LOW)
            GO TO 50
C
C====== Accept value
C
         ELSE IF (ITEM.EQ.M_ACCEPT) THEN
            IF (IOPT.EQ.1) THEN
               CALL LDM_SET_DMIN (IPACK, SOFT_SEL, IERR, ERRSTR)
               IF (IERR.NE.0) THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR,ERRSTR,1)
                  CALL ERR_NOTICE (1,STR)
               END IF
               ACCEPT = .TRUE.
               LISTE(1) = IP_DMIN
               CALL SET_PAR1_VALS (1, LISTE)
               CALL OTHERS_UPD (1, UPD_DMIN, KPACK, KPLATE)
               CALL LDM_SET_DMIN (KPACK, SOFT_SEL, IERR, ERRSTR)
            ELSE IF (IOPT.EQ.2) THEN
               CALL LDM_SET_LMIN (IPACK, SOFT_SEL, IERR, ERRSTR)
               IF (IERR.NE.0) THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR,ERRSTR,1)
                  CALL ERR_NOTICE (1,STR)
               END IF
               ACCEPT = .TRUE.
               LISTE(1) = IP_WMIN
               CALL SET_PAR1_VALS (1, LISTE)
               CALL OTHERS_UPD (1, UPD_LAMS, KPACK, KPLATE)
               CALL LDM_SET_LMIN (KPACK, SOFT_SEL, IERR, ERRSTR)
            END IF
            IF (IUN_LOG.GT.0) WRITE(IUN_LOG,1000)
            SHOW_VAL = SOFT_SEL
            GO TO 100
C
C====== Input another value
C
         ELSE IF (ITEM.EQ.M_INPUT) THEN
            IF (GRAPH_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            END IF
200         VAL = SHOW_VAL
            IF (IOPT.EQ.1) THEN
               CALL IOW_ASKF (IVH_IOW,'Input value for ''dmin''', VAL,
     +                        2)
               CALL LDM_SET_DMIN (IPACK, VAL, IERR, ERRSTR)
               IF (IERR.NE.0) THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR,ERRSTR,1)
                  CALL LMESSAGE (IVH_IOW, STR)
                  GO TO 200
               END IF
               SHOW_VAL = VAL
               ACCEPT = .TRUE.
               LISTE(1) = IP_DMIN
               CALL SET_PAR1_VALS (1, LISTE)
               CALL OTHERS_UPD (1, UPD_DMIN, KPACK, KPLATE)
               CALL LDM_SET_DMIN (KPACK, VAL, IERR, ERRSTR)
               IF (IUN_LOG.GT.0) THEN
                  STR = 'New value for dmin input as'
                  CALL STR_ADDF(STR,VAL,2,1)
                  WRITE(IUN_LOG,1010) STR
               END IF
            ELSE IF (IOPT.EQ.2) THEN
               CALL IOW_ASKF (IVH_IOW,'Input value for ''lambda-min''', 
     +                        VAL, 2)
               CALL LDM_SET_LMIN (IPACK, VAL, IERR, ERRSTR)
               IF (IERR.NE.0) THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR,ERRSTR,1)
                  CALL LMESSAGE (IVH_IOW, STR)
                  GO TO 200
               END IF
               SHOW_VAL = VAL
               ACCEPT = .TRUE.
               LISTE(1) = IP_WMIN
               CALL SET_PAR1_VALS (1, LISTE)
               CALL OTHERS_UPD (1, UPD_LAMS, KPACK, KPLATE)
               CALL LDM_SET_LMIN (KPACK, VAL, IERR, ERRSTR)
               IF (IUN_LOG.GT.0) THEN
                  STR = 'New value for lambda-min input as'
                  CALL STR_ADDF(STR,VAL,2,1)
                  WRITE(IUN_LOG,1010) STR
               END IF
            END IF
            IF (GRAPH_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_GRAPH, IERR)
            END IF
            GO TO 100
         END IF
      END IF
      GO TO 100            
C
C====== Format statements
C
1000  FORMAT('New value accepted',/)
1010  FORMAT(/,A)
1020  FORMAT('No new value accepted',/)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SOFT_HIST        **
C**************************
C
C
      SUBROUTINE SOFT_HIST (IOPT, INORM, NUMBINS, BIN_WIDTH, 
     +                      SOFT_MIN, SOFT_MAX, SOFT_SEL, ISEL, 
     +                      NGTSIG, RBIN)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Output histogram of soft limits determination results
C
C Author:  John W. Campbell, March 1994
C
C Arguments:
C
      INTEGER IOPT
      INTEGER INORM
      INTEGER NUMBINS
      REAL BIN_WIDTH
      REAL SOFT_MIN
      REAL SOFT_MAX
      REAL SOFT_SEL
      INTEGER ISEL
      INTEGER NGTSIG(*)
      REAL RBIN(*)
C
C  IOPT        (R)  Option flag =1 dmin, =2 lmin
C  INORM       (R)  Normalised histogram =1 yes, =0 un-normalised
C  NUMBINS     (R)  Number of bins
C  BIN_WIDTH   (R)  Bin width
C  SOFT_MIN    (R)  Minimum soft limits value
C  SOFT_MAX    (R)  Maximum soft limits value
C  SOFT_SEL    (R)  Selected soft limits value
C  ISEL        (R)  Selected bin number
C  NGTSIG      (R)  No. significant reflections for NUMBINS bins
C  RBIN()      (R)  Significant/Measured intensity ratios for NUMBINS bins
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'get_soft.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL MARK_OVER
      INTEGER I
      INTEGER KXROOT
      INTEGER KYROOT
      INTEGER IERR
      REAL AX1_DIV
      REAL X1
      REAL X2
      REAL Y
      REAL ARR_H
      REAL ARR_W
      REAL ARR_X(3)
      REAL ARR_Y(3)
      REAL RBINMAX
      CHARACTER*80 TITLE

C     LOGICAL MARK_OVER       !Mark value >1.0 on normalised histogram
C     INTEGER I               !Temp/loop variable
C     INTEGER KXROOT          !Root window x position for graphics window
C     INTEGER KYROOT          !Root window y position for graphics window
C     INTEGER IERR            !Error flag
C     REAL AX1_DIV            !Axis 1 divisions width
C     REAL X1                 !Start of histogram box (x axis)
C     REAL X2                 !End of histogram box (x axis)
C     REAL Y                  !Height of histogram box (y axis)
C     REAL ARR_H              !Arrow height 
C     REAL ARR_W              !Arrow half width
C     REAL ARR_X(3)           !Arrow head x coordinates
C     REAL ARR_Y(3)           !Arrow head y coordinates
C     REAL RBINMAX            !Maximum value is RBIN array
C     CHARACTER*80 TITLE      !Graph title string
C
C-------------------------------------------------------------------------------
C
C====== Get required position for graph display
C
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,0,0,KXROOT,KYROOT,IERR)
      KYROOT = KYROOT - 30
      IF (KYROOT.LT.0) KYROOT = 0
C
C====== Get maximum value in RBIN array
C
      RBINMAX = 0.0
      DO 10 I = 1, NUMBINS
         IF (RBIN(I).GT.RBINMAX.AND.NGTSIG(I).GE.10) RBINMAX = RBIN(I)
10    CONTINUE
C
C====== Create graphics window
C
      CALL XDLF_GRAPH_WIN (IVH_GRAPH, 0, KXROOT, KYROOT, 0, 0,
     +                     600, 400, 0, 0, 2, 0, IERR)
C
C====== Plot the histogram
C
      IF (INORM.EQ.1) THEN
         TITLE = 'Normalised Histogram  for'
      ELSE
         TITLE = 'Histogram for'
      END IF
      IF (IOPT.EQ.1) THEN
         CALL STR_ADDS(TITLE,'''dmin''',1)
      ELSE IF (IOPT.EQ.2) THEN
         CALL STR_ADDS(TITLE,'''lambda-dmin''',1)
      END IF
      CALL STR_ADDS (TITLE,'determination',1)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 0, 1, -1, IERR)
      CALL XDLF_GRAPH_WIN_MAP (IVH_GRAPH, 0.0, 1.0, 
     +                         0.0, 1.0, 0.0, 1.0, 0.0, 1.0,
     +                         0, IERR)
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.5, 0.95,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .042, 0, 1, 0.0, IERR)
      IF (INORM.EQ.1) THEN
         TITLE = 'I_significant/I_measured ratios (normalised)'
      ELSE 
         TITLE = 'I_significant/I_measured ratios'
      END IF
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.5, 0.89,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .033, 0, 1, 0.0, IERR)
      IF (IOPT.EQ.1) THEN
         TITLE = 'd-spacing'
      ELSE IF (IOPT.EQ.2) THEN
         TITLE = 'lambda'
      END IF
      CALL STR_ADDS (TITLE,'(Angstroms)',1)
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.5, 0.05,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .033, 0, 1, 0.0, IERR)
      CALL XDLF_GRAPH_WIN_MAP (IVH_GRAPH, SOFT_MIN, SOFT_MAX, 
     +                         0.0, 1.0, 0.1, 0.9, 0.15, 0.8,
     +                         0, IERR)
      IF (NUMBINS.LE.15) THEN
         CALL XDLF_GRAPH_WIN_AX1 (IVH_GRAPH, SOFT_MIN, 0.0, 
     +                         SOFT_MAX-SOFT_MIN, NUMBINS, 0.0, 
     +                         2, .015, .03, 0, IERR)
      ELSE
         I = (NUMBINS-1)/15 + 1
         AX1_DIV = I*BIN_WIDTH
         CALL XDLF_GRAPH_WIN_AX1 (IVH_GRAPH, SOFT_MIN, 0.0, 
     +                         SOFT_MAX-SOFT_MIN, 0, AX1_DIV, 
     +                         2, .015, .03, 0, IERR)
      END IF
      CALL XDLF_GRAPH_WIN_AX2 (IVH_GRAPH, SOFT_MIN, 0.0, 
     +                         1.0, 10, 0.0, 1, .015, .03, 
     +                         0, IERR)       
C
C====== Plot histogram boxes
C
      DO 100 I = 1, NUMBINS
         X1 = SOFT_MIN + (I-1)*BIN_WIDTH
         X2 = SOFT_MIN + I*BIN_WIDTH
         Y = RBIN(I)
         IF (INORM.EQ.1) Y = Y/RBINMAX
         MARK_OVER = .FALSE.
         IF (INORM.EQ.1.AND.Y.GT.1.0) THEN
            Y = 1.0
            MARK_OVER = .TRUE.
         END IF
         CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X1, 0.0, X1, Y, IERR)
         IF (MARK_OVER) THEN
            CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 0, 3, -1, IERR)
            CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X1, Y, X2, Y, IERR)
            CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 0, 1, -1, IERR)
         ELSE
            CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X1, Y, X2, Y, IERR)
         END IF
         CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X2, Y, X2, 0.0, IERR)
100   CONTINUE
C
C====== Arrow at selected value
C
      ARR_H = 0.1
      ARR_W = (SOFT_MAX-SOFT_MIN)/80
      Y = RBIN(ISEL)
      IF (INORM.EQ.1) Y = RBIN(ISEL)/RBINMAX
      Y = Y + 0.02
      ARR_X(1) = SOFT_SEL
      ARR_Y(1) = Y
      ARR_X(2) = SOFT_SEL - ARR_W
      ARR_Y(2) = Y + ARR_H/2.0
      ARR_X(3) = SOFT_SEL + ARR_W
      ARR_Y(3) = Y + ARR_H/2.0
      CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 2, -1, -1, IERR)
      CALL XDLF_GRAPH_WIN_POLYGON (IVH_GRAPH, ARR_X, ARR_Y, 3, 1, IERR)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, -1, 2, -1, IERR)
      CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, SOFT_SEL, Y+ARR_H/4.0,
     +                          SOFT_SEL, Y+ARR_H, IERR)
C
C====== Show line at selection criterion
C
      Y = 0.15
      IF (INORM.NE.1) Y = Y*RBINMAX
      CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 6, 1, -1, IERR)
      CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, SOFT_MIN, Y, SOFT_MAX, Y,
     +                          IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C********************************
C**     SOFT_INTEG_PROGRESS    **
C********************************
C
C
      SUBROUTINE SOFT_INTEG_PROGRESS (IPASS, NSPOT, ISPOT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Monitor progess of integration passes for soft limits determinations
C
C Author:  John W. Campbell, March 1994
C
C Arguments:
C
      INTEGER IPASS
      INTEGER NSPOT
      INTEGER ISPOT
C  
C  IPASS    (R)   Integration pass
C  NSPOT    (R)   Total no. spots to integrate
C  ISPOT    (R)   No. of last spot integrated
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
C
C    INTEGER IERR          !Error flag
C
C-------------------------------------------------------------------------------
C
      IF (IPROG_PASS.EQ.IPASS) THEN
         IF (LG_MODE.NE.1) RETURN
         IF (MOD(ISPOT,20).NE.0) RETURN
         CALL XDLF_PROGRESS_BAR_VALUE (IVH_BAR, ISPOT, IERR)
      ELSE
         IF (LG_MODE.EQ.1.AND.IPROG_PASS.GT.0) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, IERR)
         END IF
         IF (LG_MODE.EQ.1) THEN
            IF (IPASS.EQ.1) THEN
               CALL XDLF_PROGRESS_BAR (IVH_BAR, IPROG_X, IPROG_Y,
     +              XDLSTR('Forming profiles:'), 17, 150, NSPOT,
     +              2, 1)
            ELSE IF (IPASS.EQ.2) THEN
               CALL XDLF_PROGRESS_BAR (IVH_BAR, IPROG_X, IPROG_Y,
     +              XDLSTR('Integrating spots:'), 18, 150, NSPOT,
     +              2, 5)
            END IF
         ELSE IF (LG_MODE.EQ.2) THEN
            IF (IPASS.EQ.1) THEN
               CALL TWRITE ('==Forming profiles==')
            ELSE IF (IPASS.EQ.2) THEN
               CALL TWRITE ('==Integrating spots==')
            END IF
         END IF
         IPROG_PASS = IPASS
      END IF
      RETURN
      END

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***********************
C**     SOFT_LIST     **
C***********************
C
C
      SUBROUTINE SOFT_LIST (ILOG, ITERM, IPACK, IPLATE, IOPT,
     +                      PROMIN, NPROF, PRF_ROT, SIGTEST, FRTEST, 
     +                      NBINS, BINW, NMEAS, NGTSIG, RBIN,
     +                      SOFT_MIN, SOFT_MAX, SOFT_SEL,
     +                      IBIN_SEL, IWARN, WARNSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Control listing of soft limits determination results when called
C          fom command line lg_dmin or lg_lmin commands
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER ILOG
      INTEGER ITERM
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IOPT
      REAL PROMIN
      INTEGER NPROF
      LOGICAL PRF_ROT
      REAL SIGTEST
      REAL FRTEST
      INTEGER NBINS
      REAL BINW
      INTEGER NMEAS(*)
      INTEGER NGTSIG(*)
      REAL RBIN(*)
      REAL SOFT_MIN
      REAL SOFT_MAX
      REAL SOFT_SEL
      INTEGER IBIN_SEL
      INTEGER IWARN
      CHARACTER*(*) WARNSTR
C 
C Parameters are the same as for LFN_SOFT_LIST
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip1_entries.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'upd_flags.finc'
      INCLUDE 'get_soft.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      LOGICAL EOF
      LOGICAL ACCEPT
      INTEGER IB
      INTEGER IB_MIN
      INTEGER IB_MAX
      INTEGER IERR
      INTEGER IFLAG
      INTEGER ND
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER LISTE(2)
      REAL RATMAX
      REAL RATNRM
      REAL SFT_MIN
      REAL SFT_MAX
      REAL SOFT_CUR
      CHARACTER*80 STR
      CHARACTER*80 ERRSTR

C     LOGICAL EOF                !End of file flag
C     LOGICAL ACCEPT             !Accept new soft limit flag
C     INTEGER IB                 !Bin counter
C     INTEGER IB_MIN             !Minimum bin number for mini histogram
C     INTEGER IB_MAX             !Maximum bin number for mini histogram
C     INTEGER IERR               !Error flag
C     INTEGER IFLAG              !Parameter status flag
C     INTEGER ND                 !No. of decimal places flag
C     INTEGER KPACK              !Pack number, 0 = all packs
C     INTEGER KPLATE             !Plate number, 0 = all plates
C     INTEGER LISTE(2)           !List of parameters to be updated
C     REAL RATMAX                !Maximum sigificant/measured ratio found
C     REAL RATNRM                !Normalised ratio
C     REAL SFT_MIN               !Minimum soft limit for current bin
C     REAL SFT_MAX               !Maximum soft limit for current bin
C     REAL SOFT_CUR              !Current soft limit value
C     CHARACTER*80 STR           !Temp string
C     CHARACTER*80 ERRSTR        !Error string
C
C-------------------------------------------------------------------------------
C
         IF (IUN_LOG.GT.0) WRITE(IUN_LOG,'('' '')')
         IF (IUN_LOG.GT.0) CALL LFN_SOFT_LIST (IUN_LOG, 0, 
     +       IPACK, IPLATE, 
     +       IOPT, PROMIN, NPROF, PRF_ROT,
     +       SIGTEST, FRTEST, NBINS, BINW,
     +       NMEAS, NGTSIG, RBIN, SOFT_MIN, SOFT_MAX, SOFT_SEL,        
     +       IBIN_SEL, IWARN, WARNSTR)
         IF (LG_MODE.NE.3) THEN
            RATMAX = 0.0
            DO 500 IB = 1, NBINS
               IF (RBIN(IB).GT.RATMAX.AND.NGTSIG(IB).GE.10) 
     +            RATMAX = RBIN(IB)
500         CONTINUE
            IF (RATMAX.GT.0.0) THEN
               STR = 'Bin     Range     Nmeas  Nobs Ratio   Norm'
               IF (LG_MODE.EQ.1) THEN 
                  CALL LMESSAGE (IVH_IOW, STR)
               ELSE IF (LG_MODE.EQ.2) THEN
                  CALL TWRITE (STR)
               END IF
               IB_MIN = IBIN_SEL - 3
               IF (IB_MIN.LT.1) IB_MIN = 1
               IB_MAX = IB_MIN + 6
               IF (IB_MAX.GT.NBINS) IB_MAX = NBINS
               DO 510 IB = IB_MIN, IB_MAX
                  SFT_MIN = SOFT_MIN + (IB-1)*BINW
                  SFT_MAX = SFT_MIN + BINW
                  RATNRM = RBIN(IB)/RATMAX
                  WRITE(STR,1200) IB, SFT_MIN, SFT_MAX, NMEAS(IB),
     +                   NGTSIG(IB), RBIN(IB), RATNRM
                  IF (IB.EQ.IBIN_SEL) THEN
                     CALL STR_ADDS (STR, '<<<<<<', 3)
                  END IF
                  IF (LG_MODE.EQ.1) THEN
                     CALL LMESSAGE (IVH_IOW, STR)
                  ELSE IF (LG_MODE.EQ.2) THEN
                     CALL TWRITE (STR)
                  END IF
510            CONTINUE
            END IF             
         END IF
         IF (IOPT.EQ.1) THEN
            STR = 'Value determined for ''dmin'' is'
         ELSE
            STR = 'Value determined for ''lambda-min'' is'
         END IF
         CALL STR_ADDF (STR, SOFT_SEL, 2, 1)
         IF (IOPT.EQ.1) THEN
            CALL LDM_GET_DMIN (IPACK, SOFT_CUR, IFLAG, ND, IERR, 
     +                         ERRSTR)
         ELSE
            CALL LDM_GET_LMIN (IPACK, SOFT_CUR, IFLAG, ND, IERR, 
     +                         ERRSTR)
         END IF
         CALL STR_ADDS (STR, '(was',1)
         CALL STR_ADDF (STR, SOFT_CUR, 2, 1)
         CALL STR_ADDS (STR, ')',0)
         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE (IVH_IOW, STR)
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (STR)
         END IF
         ACCEPT = .TRUE. 
         IF (IWARN.GT.0) THEN
            STR = '*Warning*'
            CALL STR_ADDS(STR,WARNSTR,1)
            ACCEPT = .FALSE.
            IF (IWARN.EQ.2) ACCEPT = .TRUE.
            IF (LG_MODE.EQ.1) THEN
               CALL LMESSAGE (IVH_IOW, STR)
               CALL IOW_ASKQ(IVH_IOW, 'Accept new value', ACCEPT)
            ELSE IF (LG_MODE.EQ.2) THEN
               CALL TWRITE (STR)
               CALL TASKQ ('Accept new value', ACCEPT, EOF)
            END IF
         END IF
         IF (ACCEPT) THEN
            IF (IUN_LOG.GT.0) WRITE(IUN_LOG, 1000)
            IF (IOPT.EQ.1) THEN
               CALL LDM_SET_DMIN (IPACK, SOFT_SEL, IERR, ERRSTR)
               LISTE(1) = IP_DMIN
               CALL SET_PAR1_VALS (1, LISTE)
               CALL OTHERS_UPD (1, UPD_DMIN, KPACK, KPLATE)
               CALL LDM_SET_DMIN (KPACK, SOFT_SEL, IERR, ERRSTR)
            ELSE IF (IOPT.EQ.2) THEN
               CALL LDM_SET_LMIN (IPACK, SOFT_SEL, IERR, ERRSTR)
               LISTE(1) = IP_WMIN
               CALL SET_PAR1_VALS (1, LISTE)
               CALL OTHERS_UPD (1, UPD_LAMS, KPACK, KPLATE)
               CALL LDM_SET_LMIN (KPACK, SOFT_SEL, IERR, ERRSTR)
            END IF
         ELSE
            IF (IUN_LOG.GT.0) WRITE(IUN_LOG, 1010)
         END IF
      RETURN
C
C====== Format statements
C
1000  FORMAT('New value accepted',/)
1010  FORMAT('New value not accepted',/)
1200  FORMAT(I3,F6.2,' -',F5.2,I6,I6,F7.2,F7.2)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     SOFT_PROGRESS     **
C***************************
C
C
      SUBROUTINE SOFT_PROGRESS (IUN_LOG, IOPT, ISTAGE, IPACK, IPLATE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Monitor automatic soft limit determination progress
C
C Author:  John W. Campbell, November 1994
C
C Arguments:
C
      INTEGER IUN_LOG
      INTEGER IOPT
      INTEGER ISTAGE
      INTEGER IPACK
      INTEGER IPLATE
C
C IUN_LOG  (R)  Unit number for log file
C IOPT     (R)  1=dmin, 2=lambda-min flag
C ISTAGE   (R)  Stage = 0  Start of new pack
C                     = 1  Starting to read image
C                     = 2  Finished image reading
C                     = 3  Starting actual soft limit 
C                          determination for the pack
C                     = 4  Finished soft limit 
C                          determination for the pack
C IPACK    (R)  Pack number
C IPLATE   (R)  Plate number
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'get_soft.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER LISTE(2)
      INTEGER IERR
      CHARACTER*80 STR

C     INTEGER LISTE(2)        !List of parameters to update
C     INTEGER IERR            !Error flag
C     CHARACTER*80 STR        !Temp. string

C
C-------------------------------------------------------------------------------
C
      IF (ISTAGE.EQ.0) THEN
C
C====== Update parameter tables
C
         IF (LG_MODE.EQ.1) THEN
            CALL SET_PAR1_VALS (0, LISTE)
            CALL SET_PAR2_VALS (0, LISTE)
         END IF
C
C====== Output heading for new pack
C
         IF (IOPT.EQ.1) THEN
            STR = '==Determining dmin for pack'
         ELSE
            STR = '==Determining lambda-min for pack'
         END IF
         CALL STR_ADDI (STR, IPACK, 1)
         CALL STR_ADDS (STR, 'using plate', 1)
         CALL STR_ADDI (STR, IPLATE, 1)

         IF (LG_MODE.EQ.1) THEN
            CALL LMESSAGE (IVH_IOW, STR)
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE (STR)
         END IF

      ELSE IF (ISTAGE.EQ.3) THEN
C
C====== Get progress bar position
C
         IPROG_X = 0
         IPROG_Y = 0
         IF (LG_MODE.EQ.1) THEN
            CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_CMD, 8, 35,
     +                                    IPROG_X, IPROG_Y, IERR)
         END IF
         IPROG_PASS = 0
         IF (LG_MODE.EQ.1) CALL CMD_CNCL_BUT

      ELSE IF (ISTAGE.EQ.4) THEN
C
C====== Remove progress bar and cancel button
C
         IF (LG_MODE.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_CNCL_BUT, IERR)
         END IF

      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***********************
C**     SOFT_SHOW     **
C***********************
C
C
      SUBROUTINE SOFT_SHOW (IOPT, SHOW_VAL, CUR_INT_LOW)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Show soft limits results on image
C
C Author:  John W. Campbell, December 1993
C
C Arguments:
C
      INTEGER IOPT
      REAL SHOW_VAL
      REAL CUR_INT_LOW
C 
C IOPT        (R)    Soft limit type =1 dmin, =2 lmin
C SHOW_VAL    (R)    Determined or input soft limit value
C CUR_INT_LOW (R/W)  Current low limit used in prediction/integration
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INTEGER MAX_TEMP
      PARAMETER(MAX_TEMP=1000)
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'get_soft.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'image.finc'
      INCLUDE 'integ_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      EXTERNAL SOFT_INTEG_PROGRESS
      LOGICAL LFN_DUMMY_CNCL
      EXTERNAL LFN_DUMMY_CNCL
C
C====== LOCALS:
C
      LOGICAL SYMBOLS
      LOGICAL CHANGE
      LOGICAL NODF
      LOGICAL SPAT
      LOGICAL BAD
      LOGICAL OVL
      LOGICAL MS
      LOGICAL DISTOR
      LOGICAL INTEG
      INTEGER ISORTED
      INTEGER IOVTYP
      INTEGER INTCOD
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IORDER
      INTEGER ISWAP
      INTEGER M_PRED
      INTEGER M_LOW
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER ND
      INTEGER IFLAG
      INTEGER IERR
      INTEGER JERR
      INTEGER NUM_SPOTS
      INTEGER N
      INTEGER NOUT
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER MULT
      INTEGER ICODE
      INTEGER ICT
      INTEGER IXPIX_TEMP(MAX_TEMP)
      INTEGER IYPIX_TEMP(MAX_TEMP)
      INTEGER ISYMB_TEMP(MAX_TEMP)
      INTEGER ICOLR_TEMP(MAX_TEMP)
      INTEGER IXC
      INTEGER IYC
      REAL A
      REAL B
      REAL RAD
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL XF
      REAL YF
      REAL BLAM
      REAL DTHR
      REAL X
      REAL AI
      REAL ASIG
      REAL CUR_LOW
      REAL SOFT_LOW
      REAL SOFT_HIGH
      CHARACTER*25 NAMES(2)
      CHARACTER*25 QUITNAM
      CHARACTER*80 ERRSTR
      CHARACTER*120 STR
      CHARACTER*2 VALSTR

C     LOGICAL SYMBOLS      !Symbols plotted on image flag
C     LOGICAL CHANGE       !Limits changed flag
C     LOGICAL NODF         !OK nodal flag
C     LOGICAL SPAT         !Spatially overlapped flag
C     LOGICAL BAD          !Bad spot flag
C     LOGICAL OVL          !Overload flag
C     LOGICAL MS           !Spot measured flag
C     LOGICAL DISTOR       !Coordinates distortion corrected flag
C     LOGICAL INTEG        !Spots integrated flag
C     INTEGER ISORTED      !Sort order code for spots list
C     INTEGER IOVTYP       !Overlap type 
C     INTEGER INTCOD       !Integration code type
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER IORDER       !Axis order
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER M_PRED       !Menu item no.: Predicted pattern
C     INTEGER M_LOW        !Menu item no.: Low dmin/lmin spots
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. from menu selection
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER IERR         !Error flag
C     INTEGER JERR         !Error flag
C     INTEGER NUM_SPOTS    !No. of generated spots
C     INTEGER N            !Spot no.
C     INTEGER NOUT         !Number of symbols count flag
C     INTEGER IH           !'h' index
C     INTEGER IK           !'k' index
C     INTEGER IL           !'l' index
C     INTEGER MULT         !Multiplicity
C     INTEGER ICODE        !Integration status code
C     INTEGER ICT          !Integration code type
C     INTEGER IXPIX_TEMP(MAX_TEMP) !x pixel positions of spots
C     INTEGER IYPIX_TEMP(MAX_TEMP) !y pixel positions of spots
C     INTEGER ISYMB_TEMP(MAX_TEMP) !Symbol type
C     INTEGER ICOLR_TEMP(MAX_TEMP) !Color type
C     INTEGER IXC          !Spot centre nearest 'x' pixel
C     INTEGER IYC          !Spot centre nearest 'y' pixel
C     REAL A               !Spot ellipse major axis
C     REAL B               !Spot ellipse minor axis
C     REAL RAD             !Spot radius + 1 pixel
C     REAL MM_RAST_X       !Conversion factor mm to x-rasters
C     REAL MM_RAST_Y       !Conversion factor mm to y-rasters
C     REAL XF              !xf position of spot 
C     REAL YF              !yf position of spot
C     REAL BLAM            !Lambda value of spot
C     REAL DTHR            !Dminthresholds2 value of spot
C     REAL X               !Current d/lambda value of spot
C     REAL AI              !Integrated intensity of spot
c     REAL ASIG            !sig(I) of spot
C     REAL CUR_LOW         !Current low  soft limit value
C     REAL SOFT_LOW        !Low limit of soft parameter for spots display
C     REAL SOFT_HIGH       !High limit of soft parameter for spots display
C     CHARACTER*25 NAMES(2) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string
C     CHARACTER*80 ERRSTR   !Error string 
C     CHARACTER*120 STR     !Message string
C     CHARACTER*2 VALSTR    !Parameter value string (dummy)

      DATA NAMES /'Show Predicted Pattern',
     +            ' '/

      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Get max spot radius + 1 pixel
C
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_SPOTL (IPACK, IPLATE, A, IFLAG, ND, 
     +                       IERR, ERRSTR)
      CALL LDM_GET_SPOTW (IPACK, IPLATE, B, IFLAG, ND, 
     +                       IERR, ERRSTR)
      RAD = A
      IF (B.GT.A) RAD = B
      RAD = RAD*MM_RAST_X/2.0 + 1.0
C
C====== Show image
C
      CALL SHOW_IMAGE (1, IERR)
C
C====== Output menu to service results
C
      M_PRED = 1
      M_LOW = 2
      IF (IOPT.EQ.1) THEN
         NAMES(2) = 'Show low ''dmin'' Spots'
      ELSE IF (IOPT.EQ.2) THEN
         NAMES(2) = 'Show low ''lmin'' Spots'
      END IF
      SYMBOLS = .FALSE.
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 2, XDLSTR(NAMES), 25,
     +                         XDLSTR('Soft Limits on Image'), 20,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            CALL XDLF_IMAGE_SETTINGS (IVH_FILM, MINTHR, MAXTHR,
     +           MONO_THR, ICONTRAST, ICOLOR_OPT, IOVLY_OPT, IBG_OPT,
     +           MAG_OPT, ISHOW_INT, IERR)
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            RETURN
         END IF
         IF (SYMBOLS) THEN
            CALL XDLF_IMAGE_CLEAR_SYMBOLS (IVH_FILM, IERR)
            CALL XDLF_IMAGE_CLEAR_VECTS (IVH_FILM, IERR)
         END IF
C
C====== Output predicted pattern
C
         IF (ITEM.EQ.M_PRED) THEN
            CHANGE = .FALSE.
            IF (SHOW_VAL.LT.CUR_INT_LOW) CHANGE = .TRUE.
            IF (CHANGE) THEN
               IF (IOPT.EQ.1) THEN
                  CALL LDM_GET_DMIN (IPACK, CUR_LOW, ND, IFLAG, 
     +                               IERR, ERRSTR)
                  CALL LDM_SET_DMIN (IPACK, SHOW_VAL, IERR, ERRSTR)
               ELSE IF (IOPT.EQ.2) THEN
                  CALL LDM_GET_LMIN (IPACK, CUR_LOW, ND, IFLAG, 
     +                               IERR, ERRSTR)
                  CALL LDM_SET_LMIN (IPACK, SHOW_VAL, IERR, ERRSTR)
               END IF
               CUR_INT_LOW = SHOW_VAL
               CALL LRL_GEN (IPACK, IPLATE, .TRUE., 2, IERR, ERRSTR)
            END IF
            CALL LRL_STATUS (NUM_SPOTS, ISORTED, IOVTYP, DISTOR,
     +                       INTEG, INTCOD)
            IF (NUM_SPOTS.GT.0) THEN
               NOUT = 0
               DO 120 N = 1, NUM_SPOTS
                  CALL LRL_GET (N, IH, IK, IL, XF, YF, BLAM, DTHR, 
     +                          MULT, NODF, SPAT, JERR)
                  CALL LRL_GET_INT (N, AI, ASIG, MS, BAD, OVL, 
     +                             ICODE, ICT, JERR)
                  IF (IOPT.EQ.1) THEN
                     X = 1.0/SQRT(DTHR)
                  ELSE
                     X = BLAM
                  END IF
                  IF (X.LT.SHOW_VAL) GO TO 120
                  IF (NOUT.EQ.MAX_TEMP) THEN
                     CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NOUT,
     +                     IXPIX_TEMP, IYPIX_TEMP,
     +                     ISYMB_TEMP,ICOLR_TEMP,1,0,
     +                     IERR)
                     IF (IERR.GT.0) THEN
                        STR = '**Error code'
                        CALL STR_ADDI(STR,IERR,1)
                        CALL STR_ADDS(STR,
     +                    'from xdl_view symbol plot routine**',1)
                        CALL ERR_NOTICE(0,STR)
                        GO TO 100
                     END IF
                     NOUT = 0
                  END IF
                  NOUT = NOUT + 1
                  IXPIX_TEMP(NOUT) = NINT(XF)
                  IYPIX_TEMP(NOUT) = NINT(YF)
                  IF (NODF) THEN
                     ISYMB_TEMP(NOUT) = ISYMBTYP(2)
                     ICOLR_TEMP(NOUT) = ICOLRTYP(2)
                  ELSE
                     ISYMB_TEMP(NOUT) = ISYMBTYP(1)
                     ICOLR_TEMP(NOUT) = ICOLRTYP(1)
                  END IF
120            CONTINUE
               IF (NOUT.GT.0) THEN
                  CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NOUT,
     +                        IXPIX_TEMP, IYPIX_TEMP,
     +                        ISYMB_TEMP,ICOLR_TEMP,1,0,
     +                        IERR)
                  IF (IERR.GT.0) THEN
                     STR = '**Error code'
                     CALL STR_ADDI(STR,IERR,1)
                     CALL STR_ADDS(STR,
     +                    'from xdl_view symbol plot routine**',1)
                     CALL ERR_NOTICE(0,STR)
                     GO TO 100
                  END IF
               END IF
            END IF
            SYMBOLS = .TRUE.
            IF (CHANGE) THEN
               IF (IOPT.EQ.1) THEN
                  CALL LDM_SET_DMIN (IPACK, CUR_LOW, IERR, ERRSTR)
               ELSE IF (IOPT.EQ.2) THEN
                  CALL LDM_SET_LMIN (IPACK, CUR_LOW, IERR, ERRSTR)
               END IF
            END IF
            GO TO 100
C
C====== Output low dmin/lmin spots
C
         ELSE IF (ITEM.EQ.M_LOW) THEN
            IF (IOPT.EQ.1) THEN
               CALL LDM_GET_DMIN (IPACK, CUR_LOW, ND, IFLAG, 
     +                            IERR, ERRSTR)
            ELSE IF (IOPT.EQ.2) THEN
               CALL LDM_GET_LMIN (IPACK, CUR_LOW, ND, IFLAG, 
     +                            IERR, ERRSTR)
            END IF
200         SOFT_LOW = SHOW_VAL
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            IF (IOPT.EQ.1) THEN
               CALL IOW_ASKF (IVH_IOW,'Lower limit for d-spacing',
     +                       SOFT_LOW, 2)
            ELSE IF (IOPT.EQ.2) THEN
               CALL IOW_ASKF (IVH_IOW,'Lower limit for lambda',
     +                       SOFT_LOW, 2)
            END IF
            CHANGE = .FALSE.
            IF (SOFT_LOW.LT.CUR_INT_LOW) THEN
               CHANGE = .TRUE.
               IF (IOPT.EQ.1) THEN
                  CALL LDM_SET_DMIN (IPACK, SOFT_LOW, IERR, ERRSTR)
               ELSE IF (IOPT.EQ.2) THEN
                  CALL LDM_SET_LMIN (IPACK, SOFT_LOW, IERR, ERRSTR)
               END IF
               IF (IERR.NE.0) THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR,ERRSTR,1)
                  CALL LMESSAGE (IVH_IOW, STR)
                  GO TO 200
               END IF
            END IF
            IF (IOPT.EQ.1) THEN
               SOFT_HIGH = SOFT_LOW + SOFT_DMIN_WIDTH
            ELSE IF (IOPT.EQ.2) THEN
               SOFT_HIGH = SOFT_LOW + SOFT_LMIN_WIDTH
            END IF
            IF (IOPT.EQ.1) THEN
               CALL IOW_ASKF (IVH_IOW,'Upper limit for d-spacing',
     +                       SOFT_HIGH, 2)
            ELSE IF (IOPT.EQ.2) THEN
               CALL IOW_ASKF (IVH_IOW,'Upper limit for lambda',
     +                       SOFT_HIGH, 2)
            END IF
            CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
            IF (CHANGE) THEN
               CALL LRL_GEN (IPACK, IPLATE, .TRUE., 2, IERR, ERRSTR)
               CUR_INT_LOW = SOFT_LOW
            END IF
            CALL LRL_STATUS (NUM_SPOTS, ISORTED, IOVTYP, DISTOR,
     +                       INTEG, INTCOD)
            IF (.NOT.INTEG) THEN
C
C====== Re-integrate if needed (do not need to reform profiles)
C
               CALL LDM_GET_NXRAS (NXRAST, IFLAG)
               CALL LDM_GET_NYRAS (NYRAST, IFLAG)
               CALL LDM_GET_AXORD (VALSTR, IORDER, ISWAP, IFLAG)
               CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,
     +                                       IPROG_X,IPROG_Y,IERR)
               IF (IORDER.LE.4) THEN
                  CALL LRL_SORT (3)
               ELSE
                  CALL LRL_SORT (4)
               END IF
               IPROG_PASS = 0
               CALL LFN_SAINT (IPACK, IPLATE, 2, IMG, ITYPE, IORDER,
     +               NFRASTS, NXRAST, NYRAST, PROMIN, NPROF, PRF_ROT,
     +               0, SOFT_INTEG_PROGRESS, LFN_DUMMY_CNCL, 
     +               IERR, ERRSTR)
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, JERR)
               IF (IERR.NE.0) THEN
                  STR = '**Error**'
                  CALL STR_ADDS (STR,ERRSTR,1)
                  CALL LMESSAGE (IVH_IOW, STR)
                  GO TO 100
               END IF
            END IF
            IF (NUM_SPOTS.GT.0) THEN
               NOUT = 0
               DO 250 N = 1, NUM_SPOTS
                  CALL LRL_GET (N, IH, IK, IL, XF, YF, BLAM, DTHR, 
     +                          MULT, NODF, SPAT, JERR)
                  CALL LRL_GET_INT (N, AI, ASIG, MS, BAD, OVL, 
     +                             ICODE, ICT, JERR)
                  IF (IOPT.EQ.1) THEN
                     X = 1.0/SQRT(DTHR)
                  ELSE
                     X = BLAM
                  END IF
                  IF (X.LT.SOFT_LOW.OR.X.GT.SOFT_HIGH) GO TO 250
                  IF (MULT.GT.1) GO TO 250
                  IF (SPAT.OR.AI.LE.SOFT_SIGTEST*ASIG) THEN
                     IF (NOUT.EQ.MAX_TEMP) THEN
                        CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NOUT,
     +                        IXPIX_TEMP, IYPIX_TEMP,
     +                        ISYMB_TEMP,ICOLR_TEMP,1,0,
     +                        IERR)
                        IF (IERR.GT.0) THEN
                           STR = '**Error code'
                           CALL STR_ADDI(STR,IERR,1)
                           CALL STR_ADDS(STR,
     +                       'from xdl_view symbol plot routine**',1)
                           CALL ERR_NOTICE(0,STR)
                           GO TO 100
                        END IF
                        NOUT = 0
                     END IF
                  END IF
                  IF (SPAT) THEN
                     NOUT = NOUT + 1
                     IXPIX_TEMP(NOUT) = NINT(XF)
                     IYPIX_TEMP(NOUT) = NINT(YF)
                     ISYMB_TEMP(NOUT) = ISYMBTYP(10)
                     ICOLR_TEMP(NOUT) = ICOLRTYP(10)
                  ELSE
                     IF (AI.GT.SOFT_SIGTEST*ASIG) THEN
                        IXC = NINT(XF)
                        IYC = NINT(YF)
                        CALL DRAW_CIRC (IVH_FILM, IXC, IYC, RAD, 8,
     +                                 1000, ICOLRTYP(9), .FALSE.)
                     ELSE
                        NOUT = NOUT + 1
                        IXPIX_TEMP(NOUT) = NINT(XF)
                        IYPIX_TEMP(NOUT) = NINT(YF)
                        ISYMB_TEMP(NOUT) = ISYMBTYP(8)
                        ICOLR_TEMP(NOUT) = ICOLRTYP(8)
                     END IF
                  END IF
250            CONTINUE
               IF (NOUT.GT.0) THEN
                  CALL XDLF_IMAGE_SYMBOLS(IVH_FILM,NOUT,
     +                        IXPIX_TEMP, IYPIX_TEMP,
     +                        ISYMB_TEMP,ICOLR_TEMP,1,0,
     +                        IERR)
                  IF (IERR.GT.0) THEN
                     STR = '**Error code'
                     CALL STR_ADDI(STR,IERR,1)
                     CALL STR_ADDS(STR,
     +                    'from xdl_view symbol plot routine**',1)
                     CALL ERR_NOTICE(0,STR)
                     GO TO 100
                  END IF
               END IF
            END IF
            SYMBOLS = .TRUE.
            IF (CHANGE) THEN
               IF (IOPT.EQ.1) THEN
                  CALL LDM_SET_DMIN (IPACK, CUR_LOW, IERR, ERRSTR)
               ELSE IF (IOPT.EQ.2) THEN
                  CALL LDM_SET_LMIN (IPACK, CUR_LOW, IERR, ERRSTR)
               END IF
            END IF
            GO TO 100
         END IF
      END IF
      GO TO 100
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SPOT_C_OF_G      **
C**************************
C
      SUBROUTINE SPOT_C_OF_G (IXC, IYC, IXSIZ, IYSIZ, IDATA, IWORK,
     +                        ITHRESH, IMG, ITYPE, IORDER, NFOFF, 
     +                        NXRAST, NYRAST, NOVER, CGX, CGY, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Find the centre of gravity of intensities lying within a
C             defined box allowing for a constant intensity threshold.
C
C Author:     John W. Campbell, 
C             (Based on a routine from the Daresbury Laboratory Laue
C              suite program GENLAUE as of September 1990)
C
C Arguments:
C
      INTEGER IXC
      INTEGER IYC
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER IDATA(-IYSIZ:IYSIZ,-IXSIZ:IXSIZ)
      INTEGER IWORK(*)
      INTEGER ITHRESH
      INTEGER IMG(*)
      INTEGER ITYPE
      INTEGER IORDER
      INTEGER NFOFF
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NOVER
      REAL CGX
      REAL CGY
      INTEGER IERR
C
C  IXC     (R)   X pixel position for box centre (numbered from 1 up)
C  IYC     (R)   Y pixel position for box centre
C  IXSIZ   (R)   X box parameter (Box size will be (2*IXSIZ+1) * (2*IYSIZ+1)
C  IYSIZ   (R)   Y box parameter (See previous parameter)
C  IDATA   (W)   Array to hold read in data. Must be dimensioned to at least
C                (2*IXSIZ+1) * (2*IYSIZ+1) elements
C  IWORK   (R)   Work array (dimensioned to at least larger of
C                (2*IXSIZ+1) * (2*IYSIZ+1) elements
C  ITHRESH (R)   Intensity threshold
C  IMG     (R)   In memory image data
C  ITYPE   (R)   Data type in stored image 1=unsigned byte, 2=unsigned two-byte
C  IORDER  (R)   Image data order flag (1-8) 
C  NFOFF   (R)   Offset in pixels between lines in stored image
C  NXRAST  (R)   The number of x rasters in the image
C  NYRAST  (R)   The number of y-rasters in the image
C  NOVER   (W)   Returns the number of pixels over the threshold value
C  CGX     (W)   Returns the x coordinate (in raster units) of the c of g
C  CGY     (W)   Returns the y coordinate (in raster units) of the c of g
C  IERR    (W)   Error flag =0 OK, 
C                          =-1 flag error, =-2 byte handling not available
C                           =1 box partly out of range
C                           =2 box completely out of range of image.
C
C Declarations
C ============
C
C GLOBALS:
C

C
C LOCALS:
C
      INTEGER IX
      INTEGER IY
      INTEGER INTENS
      REAL SUMX
      REAL SUMY
      REAL SUM_INTENS   

C     INTEGER IX      !Loop counter over x points
C     INTEGER IY      !Loop counter over y points
C     INTEGER INTENS  !Pixel intensity
C     REAL SUMX       !Sum for cgx calcn.
C     REAL SUMY       !Sum for cgy calcn.
C     REAL SUM_INTENS !Sum of intensities over threshold
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      NOVER = 0
      CGX = IXC
      CGY = IYC
C
C====== Read spot
C
      CALL LFN_IMG_RECT (IMG, ITYPE, IORDER, NFOFF, 
     +                   IXC-IXSIZ, IYC-IYSIZ, 2*IXSIZ+1, 2*IYSIZ+1,
     +                   NXRAST, NYRAST, 0, IDATA, IWORK, IERR)
      IF (IERR.LT.0.OR.IERR.GT.1) RETURN
C
C====== Find Centre of Gravity
C
      SUMX = 0.0
      SUMY = 0.0
      SUM_INTENS = 0.0
      DO 200 IX = -IXSIZ, IXSIZ
         DO 100 IY = -IYSIZ, IYSIZ
            INTENS = MAX (0, IDATA(IY,IX) - ITHRESH)
            IF (INTENS.GT.0) NOVER = NOVER + 1
            SUMX = SUMX + IX * INTENS
            SUMY = SUMY + IY * INTENS
            SUM_INTENS = SUM_INTENS + INTENS
100      CONTINUE
200   CONTINUE
      IF (SUM_INTENS.EQ.0.0) RETURN
      CGX = IXC + SUMX / SUM_INTENS
      CGY = IYC + SUMY / SUM_INTENS
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SPOT HIST        **
C**************************
C
      SUBROUTINE SPOT_HIST (IOPT, NUMBINS,
     +           N_GOOD, SUM_GOOD, RAST_MM, SIZE_FAC, 
     +           SEL_SIZE, Y_SCL_MAX)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Output histogram of spots size determination results
C
C Author:  Don Nguti, September 1995
C
C Arguments:
C
      INTEGER IOPT
      INTEGER NUMBINS
      INTEGER N_GOOD(*)
      REAL SUM_GOOD(*)
      REAL RAST_MM
      REAL SIZE_FAC
      REAL SEL_SIZE
      REAL Y_SCL_MAX
C
C  IOPT        i  (R)  Option flag =1 spot length, =2 spot width
C  NUMBINS     i  (R)  Number of bins
C  N_GOOD(*)   i  (R)  Number of good spots in this bin
C  SUM_GOOD(*) r  (R)  Sum of spots sizes in this bin
C  RAST_MM     r  (R)  Raster to mm conversion factor
C  SIZE_FAC    r  (R)  Size compensation factor
C  SEL_SIZE    r  (R)  Average spot size over all bins
C  Y_SCL_MAX   r  (R)  spot size maximum axis length
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER KXROOT
      INTEGER KYROOT
      INTEGER IERR
      REAL AX1_DIV
      REAL X1
      REAL X2
      REAL Y
      CHARACTER*80 TITLE

C     INTEGER I               !Temp/loop variable
C     INTEGER KXROOT          !Root window x position for graphics window
C     INTEGER KYROOT          !Root window y position for graphics window
C     INTEGER IERR            !Error flag
C     REAL AX1_DIV            !Axis 1 divisions width
C     REAL X1                 !Start of histogram box (x axis)
C     REAL X2                 !End of histogram box (x axis)
C     REAL Y                  !Height of histogram box (y axis)
C     CHARACTER*80 TITLE      !Graph title string
C
C-------------------------------------------------------------------------------
C
C====== Get required position for graph display
C
      CALL XDLF_VIEW_OBJECT_ROOTXY(IVH_PAR1,0,0,KXROOT,KYROOT,IERR)
      KYROOT = KYROOT - 30
      IF (KYROOT.LT.0) KYROOT = 0
C
C====== Create graphics window
C
      CALL XDLF_GRAPH_WIN (IVH_GRAPH, 0, KXROOT, KYROOT, 0, 0,
     +                     600, 400, 0, 0, 2, 0, IERR)
C
C====== Plot the histogram
C
C
C====== Write title
C
      TITLE = 'Histogram for'
      IF (IOPT.EQ.1) THEN
         CALL STR_ADDS(TITLE,'''spot length''',1)
      ELSE
         CALL STR_ADDS(TITLE,'''spot width''',1)
      END IF
      CALL STR_ADDS (TITLE,'determination',1)
      CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 0, 1, -1, IERR)
      CALL XDLF_GRAPH_WIN_MAP (IVH_GRAPH, 0.0, 1.0, 
     +                         0.0, 1.0, 0.0, 1.0, 0.0, 1.0,
     +                         0, IERR)
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.5, 0.95,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .042, 0, 1, 0.0, IERR)
      TITLE = '(Average measured and proposed sizes)'
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.5, 0.89,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .033, 0, 1, 0.0, IERR)
C
C====== Write y-axis label
C
      IF (IOPT.EQ.1) THEN
         TITLE = 'Spot length (mm)'
      ELSE
         TITLE = 'Spot width (mm)'
      END IF
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.05, 0.5,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .033, 0, 1, 90.0, IERR)

C
C====== Write x-axis label
C
      TITLE = 'Bin Number'
      CALL XDLF_GRAPH_WIN_STEXT (IVH_GRAPH, 0.5, 0.05,
     +                           XDLSTR(TITLE), LENSTR(TITLE),
     +                           0.0, .033, 0, 1, 0.0, IERR)
      CALL XDLF_GRAPH_WIN_MAP (IVH_GRAPH, 0.0, REAL(NUMBINS),
     +                         0.0, Y_SCL_MAX, 0.125, 0.925, 0.15, 0.8,
     +                         0, IERR)
      IF (NUMBINS.LE.32) THEN
         CALL XDLF_GRAPH_WIN_AX1 (IVH_GRAPH, 0.0, 0.0, 
     +                         REAL(NUMBINS), NUMBINS, 0.0, 
     +                         0, .015, .03, 0, IERR)
      ELSE
         I = (NUMBINS-1)/32 + 1
         CALL XDLF_GRAPH_WIN_AX1 (IVH_GRAPH, 0.0, 0.0, 
     +                         REAL(NUMBINS), 0, FLOAT(I), 
     +                         0, .015, .03, 0, IERR)
      END IF 

      CALL XDLF_GRAPH_WIN_AX2 (IVH_GRAPH, 0.0, 0.0, 
     +                         Y_SCL_MAX, 10, 0.0, 1, .015, .03, 
     +                         0, IERR)       
C
C====== Plot histogram boxes
C
      DO 100 I = 1, NUMBINS
         X1 =  I - 1.0
         X2 = I
         Y = SUM_GOOD(I) / N_GOOD(I)
         Y = Y * RAST_MM *SIZE_FAC
         CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X1, 0.0, X1, Y, IERR)
         CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X1, Y/SIZE_FAC, 
     +                                        X2, Y/SIZE_FAC, IERR)
         CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 0, 3, -1, IERR)
         CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X1, Y, X2, Y, IERR)
         CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 0, 1, -1, IERR)
         CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, X2, Y, X2, 0.0, IERR)
100   CONTINUE

C 
C====== Show line at selected size
C
      Y = SEL_SIZE * SIZE_FAC * RAST_MM
      CALL XDLF_GRAPH_WIN_STYLE (IVH_GRAPH, 6, 1, -1, IERR)
      CALL XDLF_GRAPH_WIN_LINE (IVH_GRAPH, 0.0, Y, 
     +                     REAL(NUMBINS), Y, IERR)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SPOT_PROGRESS    **
C**************************
C
C
      SUBROUTINE SPOT_PROGRESS (IFLAG, NSTRIP, ISTRIP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Monitor progess of spot find routine
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
      INTEGER IFLAG
      INTEGER NSTRIP
      INTEGER ISTRIP
C  
C  IFLAG    (R)   = 0 start, =1 in progress, =2 done
C  NSTRIP   (R)   Total no. of strips of image to process
C  ISTRIP   (R)   Current strip (1 to NSTRIP)
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'spot_sizes.finc'
      INCLUDE 'prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
C
C====== LOCALS:
C
      INTEGER IERR
C
C    INTEGER IERR          !Error flag
C
C-------------------------------------------------------------------------------
C
      IF (IFLAG.EQ.0) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL XDLF_PROGRESS_BAR (IVH_BAR, ISP_PROGX, ISP_PROGY,
     +           XDLSTR('Finding spots:'), 14, 150, NSTRIP,
     +           2, 1)
            PROG_BAR = .TRUE.
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE ('==Finding spots==')
         END IF
      ELSE IF (IFLAG.EQ.1) THEN
         IF (LG_MODE.NE.1) RETURN
         IF (MOD(ISTRIP,10).NE.0) RETURN
         CALL XDLF_PROGRESS_BAR_VALUE (IVH_BAR, ISTRIP, IERR)
      ELSE IF (IFLAG.EQ.2) THEN
         IF (LG_MODE.EQ.1) THEN
            CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, IERR)
            PROG_BAR = .FALSE.
         ELSE IF (LG_MODE.EQ.2) THEN
            CALL TWRITE ('==Spot search complete==')
         END IF
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     SPOT_RADIAL      **
C**************************
C
      SUBROUTINE SPOT_RADIAL (IXC, IYC, IXSIZ, IYSIZ, IDATA, 
     +            IWORK, ITHRESH, IMG, ITYPE, IORD, NFOFF, 
     +            NXRAST, NYRAST,
     +            X_CEN, Y_CEN, NOVER, 
     +            CGX, CGY, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Find the centre of gravity of intensities lying within a
C             radially masked ellipse allowing for a constant intensity 
C             threshold.
C
C Author:     Based on code from GENLAUE including radial masking code
C             of T.J. Greengough and A.K. Shrive (Univ. of Keele)
C
C Arguments:
C
      INTEGER IXC
      INTEGER IYC
      INTEGER IXSIZ
      INTEGER IYSIZ
      INTEGER IDATA(-IYSIZ:IYSIZ,-IXSIZ:IXSIZ)
      INTEGER IWORK(*)
      INTEGER ITHRESH
      INTEGER IMG(*)
      INTEGER ITYPE
      INTEGER IORD
      INTEGER NFOFF
      INTEGER NXRAST
      INTEGER NYRAST
      REAL X_CEN
      REAL Y_CEN
      INTEGER NOVER
      REAL CGX
      REAL CGY
      INTEGER IERR
C
C  IXC     (R)   X pixel position for box centre (numbered from 1 up)
C  IYC     (R)   Y pixel position for box centre
C  IXSIZ   (R)   X box parameter (Box size will be (2*IXSIZ+1) * (2*IYSIZ+1)
C  IYSIZ   (R)   Y box parameter (See previous parameter)
C  IDATA   (W)   Array to hold read in data. Must be dimensioned to at least
C                (2*IXSIZ+1) * (2*IYSIZ+1) elements
C  IWORK   (R)   Work array (dimensioned to at least larger of
C                (2*IXSIZ+1) * (2*IYSIZ+1) elements
C  ITHRESH (R)   Intensity threshold
C  IMG     (R)   In memory image data
C  ITYPE   (R)   Data type in stored image 1=unsigned byte, 2=unsigned two-byte
C  IORD    (R)   Image data order flag (1-8) 
C  NFOFF   (R)   Offset in pixels between lines in stored image
C  NXRAST  (R)   No. of x-rasters
C  NYRAST  (R)   No. y-rasters
C  X_CEN   (R)   Corrected 'x' centre position (rasters)
C  Y_CEN   (R)   Corrected 'y' centre position (rasters)
C  NOVER   (W)   Returns the number of pixels over the threshold value
C  CGX     (W)   Returns the x coordinate (in raster units) of the c of g
C  CGY     (W)   Returns the y coordinate (in raster units) of the c of g
C  IERR    (W)   Error flag =0 OK, 
C                          =-1 flag error, =-2 byte handling not available
C                           =1 box partly out of range
C                           =2 box completely out of range of image.
C
C Declarations
C ============
C
C
C parameter statements
C
      INCLUDE 'lauegen_limits.finc'
C
C GLOBALS:
C
      INCLUDE 'film_pack.finc'
C
C LOCALS:
C
      INTEGER IXM
      INTEGER IYM
      INTEGER XPN
      INTEGER YPN
      INTEGER IMARK
      INTEGER IX
      INTEGER IY
      INTEGER INTENS
      INTEGER IFLAG
      INTEGER KERR
      INTEGER ND
      REAL SPOTFAC
      REAL SPOTL
      REAL SPOTW
      REAL CTOF
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL SUMX
      REAL SUMY
      REAL SUM_INTENS   
      REAL PI
      REAL CMASK
      REAL RADIUS
      REAL AMAJOR
      REAL BMINOR
      REAL THETA
      REAL XPRIME
      REAL YPRIME
      REAL ELLIP
      CHARACTER*2 ERRSTR

C     INTEGER IX      !Loop counter over x points
C     INTEGER IY      !Loop counter over y points
C     INTEGER INTENS  !Pixel intensity
C     INTEGER IXM     !x offset of ellipse centre from film centre in rasters
C     INTEGER IYM     !y offset of ellipse centre from film centre in rasters
C     INTEGER XPN     !x offset of current pixel from film centre in rasters
C     INTEGER YPN     !y offset of current pixel from film centre in rasters
C     INTEGER IMARK   !Flag =1 include pixel as part of spot, =0 do not
C     INTEGER IFLAG   !Parameter status flag
C     INTEGER KERR    !Error flag
C     INTEGER ND      !No. of decimal places flag
C     REAL SPOTFAC    !Spot expansion factor
C     REAL SPOTL      !Spot length
C     REAL SPOTW      !Spot width
C     REAL CTOF       !Crystral-film distance
C     REAL MM_RAST_X  !Conversion factor mm to x-rasters
C     REAL MM_RAST_Y  !Conversion factor mm to y-rasters
C     REAL SUMX       !Sum for cgx calcn.
C     REAL SUMY       !Sum for cgy calcn.
C     REAL SUM_INTENS !Sum of intensities over threshold
C     REAL PI         !Pi
C     REAL CMASK      !1/2 streak length (uncorrected) in rasters
C     REAL RADIUS     !Distance of ellipse centre from film centre (rasters)
C     REAL AMAJOR     !Ellipse major axis (corrected) in rasters
C     REAL BMINOR     !Ellipse minor axis in rasters
C     REAL THETA      !Angle of ellipse major axis wrt. xf (radians)
C     REAL XPRIME     !x' coordinate of current point wrt ellipse axes (rasters)
C     REAL YPRIME     !y' coordinate of current point wrt ellipse axes (rasters)
C     REAL ELLIP      !Value of ellipse function x**2/a**+y**2/b**2
C     CHARACTER*2 ERRSTR !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      NOVER = 0
      CGX = IXC
      CGY = IYC
      CALL LDM_GET_SPOTF (IPACK, IPLATE, SPOTFAC, IFLAG, ND, 
     +                    KERR, ERRSTR)
      CALL LDM_GET_CTOF (IPACK, IPLATE, CTOF, IFLAG, ND,
     +                   KERR, ERRSTR)
      CALL LDM_GET_SPOTL (IPACK, IPLATE, SPOTL, IFLAG, ND,
     +                    KERR, ERRSTR)
      CALL LDM_GET_SPOTW (IPACK, IPLATE, SPOTW, IFLAG, ND,
     +                    KERR, ERRSTR)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
C
C====== Read spot
C
      CALL LFN_IMG_RECT (IMG, ITYPE, IORD, NFOFF, 
     +                   IXC-IXSIZ, IYC-IYSIZ, 2*IXSIZ+1, 2*IYSIZ+1,
     +                   NXRAST, NYRAST, 0, IDATA, IWORK, IERR)
      IF (IERR.LT.0.OR.IERR.GT.1) RETURN
C
C====== Find Centre of Gravity
C
      SUMX = 0.0
      SUMY = 0.0
      SUM_INTENS = 0.0
C
C====== Get offsets in pixels of box centre from pattern centre
C
      IXM = NINT(FLOAT(IXC)-X_CEN)
      IYM = NINT(FLOAT(IYC)-Y_CEN)
C
C====== Set up parameters for radial masking calculation
C
      PI = 4.0*ATAN(1.0)
      CMASK = SPOTL*MM_RAST_X/2.0
      RADIUS = SQRT(FLOAT(IXM**2)+FLOAT(IYM**2))
      AMAJOR = CMASK*(1.0+SPOTFAC*RADIUS/
     +         (CTOF*MM_RAST_X))
      BMINOR = SPOTW*MM_RAST_X/2.0
      IF (IXM.EQ.0) THEN
         THETA = PI/2.0
         IF (IYM.LT.0) THEN
            THETA = 1.5*PI
         END IF
         GO TO 50
      END IF

      THETA = ATAN(FLOAT(IYM)/FLOAT(IXM))
      IF (IXM.LT.0) THEN
         THETA = THETA + PI
      ELSE IF (IYM.LT.0) THEN
         THETA = THETA + 2.0*PI
      END IF

50    CONTINUE
C
C====== Loop through pixels within box and see if each is within ellipse
C
      DO 200 IX = -IXSIZ, IXSIZ
         DO 100 IY = -IYSIZ, IYSIZ
C
C====== Get offsets in pixels of current point from pattern centre
C
            XPN = NINT(FLOAT(IXC+IX)-X_CEN)
            YPN = NINT(FLOAT(IYC+IY)-Y_CEN)

            IMARK = 0
            XPRIME = (FLOAT(XPN)-IXM)*COS(THETA)
            XPRIME = XPRIME + (FLOAT(YPN)-IYM)*SIN(THETA)
            YPRIME = (FLOAT(YPN)-IYM)*COS(THETA)
            YPRIME = YPRIME - (FLOAT(XPN)-IXM)*SIN(THETA)
            ELLIP = (XPRIME**2/AMAJOR**2) + (YPRIME**2/BMINOR**2)
            IF (ELLIP.LE.1.0) IMARK = 1
C
C====== Include pixel intensity if within ellipse
C
            IF (IMARK.EQ.1) THEN
               INTENS = MAX (0, IDATA(IY,IX) - ITHRESH)
               IF (INTENS.GT.0) NOVER = NOVER + 1
               SUMX = SUMX + IX * INTENS
               SUMY = SUMY + IY * INTENS
               SUM_INTENS = SUM_INTENS + INTENS
            END IF
100      CONTINUE
200   CONTINUE
      IF (SUM_INTENS.EQ.0.0) RETURN
      CGX = IXC + SUMX / SUM_INTENS
      CGY = IYC + SUMY / SUM_INTENS
      RETURN
      END
C
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C******************************
C**     SPOTSIZE_CALC        **
C******************************
C
C
      SUBROUTINE SPOTSIZE_CALC (KQUIT)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Determine spot sizes calculation routine
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
      INTEGER KQUIT
C 
C KQUIT    (W)    Return flag  = 0, OK
C                              = 1, Error                                
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'ip2_entries.finc'
      INCLUDE 'spot_sizes.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'prog_flags.finc'
      INCLUDE 'image.finc'
      INCLUDE 'symbol_types.finc'
      INCLUDE 'upd_flags.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'bg_progress.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      EXTERNAL SPOT_PROGRESS
      LOGICAL LFN_DUMMY_CNCL
      EXTERNAL LFN_DUMMY_CNCL
      EXTERNAL BG_PROGRESS
      EXTERNAL BG_DUMMY_CNCL
C
C====== LOCALS:
C
      LOGICAL GRAPH_DISP
      LOGICAL IMAGE_DISP
      LOGICAL ACCEPT
      INTEGER I
      INTEGER M_SHOW
      INTEGER M_HIST_L
      INTEGER M_HIST_W
      INTEGER M_ACCEPT
      INTEGER M_INPUT
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER IERR
      INTEGER JERR
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NF_OFF
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IFLAG
      INTEGER ND
      INTEGER IORDER
      INTEGER ISWAP
      INTEGER IYN
      INTEGER LISTE(2)
      INTEGER KPACK
      INTEGER KPLATE
      INTEGER MINDX_SPOT
      INTEGER NPBOX
      INTEGER IPCNT
      INTEGER NUMB_L(64)
      INTEGER NREJ_L(64)
      INTEGER NGOOD_L(64)
      INTEGER NUMB_W(64)
      INTEGER NREJ_W(64)
      INTEGER NGOOD_W(64)
      INTEGER NSPOT
      INTEGER IBUF(7)
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL W_F
      REAL MM_RAST_X
      REAL MM_RAST_Y
      REAL SPOTL
      REAL SPOTW
      REAL X_C
      REAL Y_C
      REAL XCEN
      REAL YCEN
      REAL RMIN
      REAL RMAX
      REAL XLOW
      REAL XHIGH
      REAL YLOW
      REAL YHIGH
      REAL REXCLUDE
      REAL SEL_LEN
      REAL SEL_WID
      REAL SPT_LEN
      REAL SPT_WID
      REAL VAL
      REAL BIN_S_L(64)
      REAL BIN_E_L(64)
      REAL SUM_L (64)
      REAL VAR_L(64)
      REAL SDEV_L(64)
      REAL AVE_L(64)
      REAL SGOOD_L(64)
      REAL BIN_S_W(64)
      REAL BIN_E_W(64)
      REAL SUM_W (64)
      REAL VAR_W(64)
      REAL SDEV_W(64)
      REAL AVE_W(64)
      REAL SGOOD_W(64)
      REAL SX
      REAL SY
      REAL SIZ
      REAL Y_SCL_MAX
      CHARACTER*2 VALSTR
      CHARACTER*80 ERRSTR
      CHARACTER*120 STR
      CHARACTER*25 NAMES(5)
      CHARACTER*25 QUITNAM

C     LOGICAL GRAPH_DISP   !Graph is currently displayed flag
C     LOGICAL IMAGE_DISP   !Image is currently displayed flag
C     LOGICAL ACCEPT       !Limit has been accepted
C     INTEGER I            !Temp/loop variable
C     INTEGER M_SHOW       !Menu item no.: Show spots on image
C     INTEGER M_HIST_L     !Menu item no.: Spot length histogram
C     INTEGER M_HIST_W     !Menu item no.: Spot width histogram
C     INTEGER M_ACCEPT     !Menu item no.: Accept new limit
C     INTEGER M_INPUT      !Menu item no.: Input another limit
C     INTEGER NVIEW        !No. of view-objects for getting events
C     INTEGER IVHLIST(2)   !List of view-object handles for getting events
C     INTEGER IVH          !Returned view-object handle from getting events
C     INTEGER ITEM         !Item no. from menu selection
C     INTEGER IQUIT        !Quit button flage from menu
C     INTEGER IERR         !Error flag
C     INTEGER JERR         !Error flag
C     INTEGER NXRAST       !No. x-rasters
C     INTEGER NYRAST       !No. y-rasters
C     INTEGER NF_OFF       !Offset between start of slow rasters in image
C     INTEGER IXROOT       !Root window x position for popup notice
C     INTEGER IYROOT       !Root window y position for popup notice
C     INTEGER IFLAG        !Parameter status flag
C     INTEGER ND           !No. of decimal places flag
C     INTEGER IORDER       !Axis order flag
C     INTEGER ISWAP        !Byte swap flag
C     INTEGER IYN          !Yes/no flag
C     INTEGER LISTE(2)     !List of parameter table 1 entries to be updated
C     INTEGER KPACK        !Pack number, 0 = all packs
C     INTEGER KPLATE       !Plate number, 0 = all plates
C     INTEGER MINDX_SPOT   !Index for spots list in memory records
C     INTEGER NPBOX        !Box size for background searches
C     INTEGER IPCNT        !Percent threshold for background points
C     INTEGER NUMB_L(64)   !Spot length analysis parameters
C     INTEGER NREJ_L(64)   !"
C     INTEGER NGOOD_L(64)  !"
C     INTEGER NUMB_W(64)   !Spot width analysis parameters
C     INTEGER NREJ_W(64)   !"
c     INTEGER NGOOD_W(64)  !"
C     INTEGER NSPOT        !No. of spots found
C     INTEGER IBUF(7)      !Buffer for spot list record
C     REAL X_CEN_F         !X centre
C     REAL Y_CEN_F         !Y centre
C     REAL W_F             !Omega
C     REAL MM_RAST_X       !Conversion mm to x-rasters
C     REAL MM_RAST_Y       !Conversion mm to y-rasters
C     REAL SPOTL           !Spot length
C     REAL SPOTW           !Spot width
C     REAL X_C             !x_c in mm
C     REAL Y_C             !y_c in mm
C     REAL XCEN            !X centre (corrected) in rasters
C     REAL YCEN            !Y centre (corrected) in rasters
C     REAL RMIN            !RMIN parameter converted to rasters
C     REAL RMAX            !RMAX parameter converted to rasters
C     REAL XLOW            !Low x limit in rasters
C     REAL XHIGH           !High x limit in rasters
C     REAL YLOW            !Low y limit in raster
C     REAL YHIGH           !High y limit in rasters
C     REAL REXCLUDE        !Exclusion adjustment to RMIN, RMAX (rasters)
C     REAL SEL_LEN         !Determined spot length (rasters)
C     REAL SEL_WID         !Determined spot width (rasters)
C     REAL SPT_LEN         !Spot length (proposed) in mm
C     REAL SPT_WID         !Spot width (proposed) in mm
C     REAL VAL             !Real value
C     REAL BIN_S_L(64)     !Spot length analysis parameters
C     REAL BIN_E_L(64)     !"
C     REAL SUM_L (64)      !"
C     REAL VAR_L(64)       !"
C     REAL SDEV_L(64)      !"
C     REAL AVE_L(64)       !"
C     REAL SGOOD_L(64)     !"
C     REAL BIN_S_W(64)     !Spot width analysis parameters
C     REAL BIN_E_W(64)     !"
C     REAL SUM_W (64)      !"
C     REAL VAR_W(64)       !"
C     REAL SDEV_W(64)      !"
C     REAL AVE_W(64)       !"
C     REAL SGOOD_W(64)     !"
C     REAL SX              !Spot 'x' position in rasters
C     REAL SY              !Spot 'y' position in rasters
C     REAL SIZ             !Temporary spot size
C     REAL Y_SCL_MAX       !Spot size maximum for o/p histograms
C     CHARACTER*2 VALSTR   !Parameter value string (dummy)
C     CHARACTER*80 ERRSTR  !Error message string
C     CHARACTER*120 STR    !Message string
C     CHARACTER*25 NAMES(5) !Menu item names
C     CHARACTER*25 QUITNAM  !Quit button string

      EQUIVALENCE (SX,IBUF(1)), (SY,IBUF(2))

      DATA NAMES /'Show Spots on Image',
     +            'Spot Length Histogram',
     +            'Spot Width Histogram',
     +            'Accept New Spot Size',
     +            'Input Another Size'/
      DATA QUITNAM /'Return to Previous Menu'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      KQUIT = 0
      MINDX_SPOT = -1
C
C====== Open film/image-plate file if needed
C
      CALL CHK_OPN(IERR)
      IF (IERR.GT.0) THEN
         KQUIT = 1
         RETURN
      END IF
C
C====== Read image if not already read
C
      IF (.NOT.FILM_READ) CALL READ_IMAGE (0, IMG, MAX_IMG_WORDS, 
     +                              ITYPE, NF_OFF, JERR, ERRSTR)
      IF (.NOT.FILM_READ) THEN
         KQUIT = 1
         RETURN
      END IF
C
C====== Get progress bar position
C
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,
     +                              IBG_PROGX,IBG_PROGY,IERR)
      PROG_BG_ON = .FALSE.
      NPBOX = 2 * ((NFRASTS/NCMP)/50) + 1
      IPCNT = 50
      CALL XDLF_BG_CALC_PROG (IMG, ITYPE, NSRASTS, NFRASTS, NFRASTS,
     +                   NCMP, NPBOX, -IPCNT, IMG_BG, NF_BGOFF,
     +                   BG_PROGRESS, BG_DUMMY_CNCL, IERR)
      IF (PROG_BG_ON) CALL XDLF_DELETE_VIEW_OBJECT (IVH_BAR, IERR)
      IF (IERR.EQ.2) THEN
         CALL LMESSAGE (IVH_IOW, '**Search box too big for image**')
         KQUIT = 1
         RETURN
      END IF
      CALL FILM_CENTRE (X_CEN_F, Y_CEN_F, W_F)
      CALL LDM_GET_XC (IPACK, IPLATE, X_C, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, IPLATE, Y_C, IFLAG, ND, IERR, ERRSTR)
C
C====== Get some image related details
C
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORDER, ISWAP, IFLAG)
      CALL LDM_MMRAST (IPACK, IPLATE, MM_RAST_X, MM_RAST_Y)
      CALL LDM_GET_RMIN (RMIN, IFLAG, ND)
      RMIN = RMIN*MM_RAST_X
      CALL LDM_GET_RMAX (RMAX, IFLAG, ND)
      RMAX = RMAX*MM_RAST_X
      CALL LDM_GET_XLOW (XLOW, IFLAG, ND)
      CALL LDM_GET_XHIGH (XHIGH, IFLAG, ND)
      CALL LDM_GET_YLOW (YLOW, IFLAG, ND)
      CALL LDM_GET_YHIGH (YHIGH, IFLAG, ND)

      XCEN = X_CEN_F + X_C*MM_RAST_X
      YCEN = Y_CEN_F + Y_C*MM_RAST_Y
C
C====== Get progress bar position
C
      CALL XDLF_VIEW_OBJECT_ROOTXY (IVH_IOW,20,20,
     +                              ISP_PROGX,ISP_PROGY,IERR)
      PROG_BAR = .FALSE.
C
C====== Check that not too many rasters
C
      IF (NXRAST.GT.MAX_RASTS.OR.NYRAST.GT.MAX_RASTS) THEN
         CALL ERR_NOTICE (1,
     +     '**Too many rasters in image for spot search**')
         KQUIT = 1
         RETURN
      END IF

C
C====== Determine the spot sizes
C
      NF_OFF = NFRASTS
      REXCLUDE = FLOAT(NPBOX*NCMP)/SQRT(2.0)
      CALL LFN_FINDSPOTS (IMG, ITYPE, IORDER, NF_OFF, 
     +                        NXRAST, NYRAST, IMG_BG, NF_BGOFF,
     +                        NCMP, ISP_DATA, ISP_WORK, XCEN, YCEN,
     +                        RMIN, RMAX, 
     +                        XLOW, XHIGH, YLOW, YHIGH, REXCLUDE, 
     +                        SPOT_THRFAC, 
     +                        SPOT_PROGRESS, LFN_DUMMY_CNCL,
     +                        MINDX_SPOT, NSPOT, IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         STR = '**Error**'
         CALL STR_ADDS (STR, ERRSTR, 1)
         CALL LMESSAGE (IVH_IOW, STR)
         KQUIT = 1
         RETURN
      END IF 
      IF (NSPOT.EQ.0) THEN
         CALL ERR_NOTICE(1,'**No spots found**')
         KQUIT = 1
         RETURN
      END IF
      STR = 'Number of spots found ='
      CALL STR_ADDI (STR, NSPOT, 1)
      CALL LMESSAGE (IVH_IOW, STR)
      CALL LFN_SPOTS_ANALYSE (MINDX_SPOT, 1, SPOT_SDCUT, ISPOT_NBIN,
     +                        BIN_S_L, BIN_E_L, SUM_L, NUMB_L,
     +                        VAR_L, SDEV_L, AVE_L, NREJ_L, SGOOD_L,
     +                        NGOOD_L, SEL_LEN, IERR, ERRSTR)
      CALL LFN_SPOTS_ANALYSE (MINDX_SPOT, 2, SPOT_SDCUT, ISPOT_NBIN,
     +                        BIN_S_W, BIN_E_W, SUM_W, NUMB_W,
     +                        VAR_W, SDEV_W, AVE_W, NREJ_W, SGOOD_W,
     +                        NGOOD_W, SEL_WID, IERR, ERRSTR)
      SPT_LEN = SPOT_EXPAND*SEL_LEN/MM_RAST_X
      SPT_WID = SPOT_EXPAND*SEL_WID/MM_RAST_X
      STR = 'Proposed spot dimensions are'
      CALL STR_ADDF(STR, SPOT_EXPAND, 2, 1)
      CALL STR_ADDS(STR, '*average determined dimensions',0)
      CALL LMESSAGE(IVH_IOW, STR)
      STR = 'Value proposed for spot length ='
      CALL STR_ADDF (STR, SPT_LEN, 2, 1)
      CALL STR_ADDS (STR, 'mm.', 1)
      CALL LMESSAGE(IVH_IOW, STR)
      STR = 'Value proposed for spot width ='
      CALL STR_ADDF (STR, SPT_WID, 2, 1)
      CALL STR_ADDS (STR, 'mm.', 1)
      CALL LMESSAGE(IVH_IOW, STR)
      IF (IUN_LOG.GT.0) WRITE(IUN_LOG,'('' '')')
      IF (IUN_LOG.GT.0) CALL LFN_SPOTS_ANA_LIS (IUN_LOG, 0, 1,
     +                    ISPOT_NBIN, BIN_S_L, BIN_E_L, SGOOD_L,
     +                    NGOOD_L, NREJ_L,  SEL_LEN, 1.0/MM_RAST_X,
     +                    SPOT_THRFAC, SPOT_SDCUT, SPOT_EXPAND,
     +                    IPACK, IPLATE) 
      IF (IUN_LOG.GT.0) CALL LFN_SPOTS_ANA_LIS (IUN_LOG, 0,  2,
     +                    ISPOT_NBIN, BIN_S_W, BIN_E_W, SGOOD_W,
     +                    NGOOD_W, NREJ_W, SEL_WID, 1.0/MM_RAST_X,
     +                    SPOT_THRFAC, SPOT_SDCUT, SPOT_EXPAND,
     +                    IPACK, IPLATE) 
C
C====== Get maximum spot size for histograms rounded up to next mm.
C
      Y_SCL_MAX = 0.0
      DO 10 I = 1, ISPOT_NBIN
         IF (NGOOD_L(I).GT.0) THEN
            SIZ = SPOT_EXPAND*SGOOD_L(I)/NGOOD_L(I)
            SIZ = SIZ/MM_RAST_X
            IF (SIZ.GT.Y_SCL_MAX) Y_SCL_MAX = SIZ
         END IF
         IF (NGOOD_W(I).GT.0) THEN
            SIZ = SPOT_EXPAND*SGOOD_W(I)/NGOOD_W(I)
            SIZ = SIZ/MM_RAST_X
            IF (SIZ.GT.Y_SCL_MAX) Y_SCL_MAX = SIZ
         END IF
 10   CONTINUE
      Y_SCL_MAX = FLOAT(INT(1000*Y_SCL_MAX)/1000+1)
C
C====== Set some flags
C
      GRAPH_DISP = .FALSE.
      IMAGE_DISP = .FALSE.
      ACCEPT = .FALSE.
C
C====== Output menu to service results
C
      M_SHOW = 1
      M_HIST_L = 2
      M_HIST_W = 3
      M_ACCEPT = 4
      M_INPUT = 5
50    CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 5, XDLSTR(NAMES), 25,
     +                         XDLSTR('Spot Size Results Menu'), 22,
     +                         XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
      NVIEW = 1
      IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
100   CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
      IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
         CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
         IF (IQUIT.EQ.1) THEN
            IF (.NOT.ACCEPT) THEN
               CALL YESNO_NOTICE (1,
     +              'No new value selected - still return?', IYN)
               IF (IYN.EQ.2) GO TO 100
               IF (IUN_LOG.GT.0) WRITE(IUN_LOG,1020)
            END IF
            IF (GRAPH_DISP) THEN
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_GRAPH, IERR)
            END IF
            IF (IMAGE_DISP) THEN
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
            END IF
            CALL DMLF_FREE (MINDX_SPOT, IERR)
            RETURN
         END IF
C
C====== Delete graph/image if present unless 'accept' or 'input option
C
         IF (ITEM.NE.M_ACCEPT.AND.ITEM.NE.M_INPUT) THEN
            IF (GRAPH_DISP) THEN
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_GRAPH, IERR)
               GRAPH_DISP = .FALSE.
            END IF
            IF (IMAGE_DISP) THEN
               CALL XDLF_DELETE_VIEW_OBJECT (IVH_FILM, IERR)
               IMAGE_DISP = .FALSE.
            END IF
         END IF
C
C====== Show spots on image
C
         IF (ITEM.EQ.M_SHOW) THEN
            CALL SHOW_IMAGE (1, IERR)
            IF (IERR.NE.0) GO TO 100
            IF (NSPOT.GT.0) THEN
               DO 120 I = 1, NSPOT
                  CALL DMLF_GETREC(MINDX_SPOT,I,IBUF,IERR)
                  CALL XDLF_IMAGE_SYMBOL (IVH_FILM, NINT(SX), NINT(SY),
     +                 ISYMBTYP(6), ICOLRTYP(6), 1, IERR)
 120           CONTINUE
            END IF
            write(6,*)'******show spots here'
            IMAGE_DISP = .TRUE.
            GO TO 100
C
C====== Output spot length histogram
C
         ELSE IF (ITEM.EQ.M_HIST_L) THEN
            CALL SPOT_HIST (1, ISPOT_NBIN,
     +           NGOOD_L, SGOOD_L, 1.0/MM_RAST_X, SPOT_EXPAND,
     +           SEL_LEN, Y_SCL_MAX)
            GRAPH_DISP = .TRUE.
            GO TO 100
C
C====== Output spot width histogram
C
         ELSE IF (ITEM.EQ.M_HIST_W) THEN
            CALL SPOT_HIST (2, ISPOT_NBIN,
     +           NGOOD_W, SGOOD_W, 1.0/MM_RAST_X, SPOT_EXPAND,
     +           SEL_WID, Y_SCL_MAX)
            GRAPH_DISP = .TRUE.
            GO TO 100
C
C====== Accept value
C
         ELSE IF (ITEM.EQ.M_ACCEPT) THEN
            CALL LDM_SET_SPOTL (IPACK, IPLATE, SPT_LEN, IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               STR = '**Error**'
               CALL STR_ADDS (STR,ERRSTR,1)
               CALL ERR_NOTICE (1,STR)
               GO TO 100
            END IF
            CALL LDM_SET_SPOTW (IPACK, IPLATE, SPT_WID, IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               STR = '**Error**'
               CALL STR_ADDS (STR,ERRSTR,1)
               CALL ERR_NOTICE (1,STR)
               GO TO 100
            END IF
            ACCEPT = .TRUE.
            LISTE(1) = IP_STRK_L
            LISTE(2) = IP_STRK_W
            CALL SET_PAR2_VALS (2, LISTE)
            CALL OTHERS_UPD (1, UPD_SPOT, KPACK, KPLATE)
            CALL LDM_SET_SPOTL (KPACK, KPLATE, SPT_LEN, IERR, ERRSTR)
            CALL LDM_SET_SPOTW (KPACK, KPLATE, SPT_WID, IERR, ERRSTR)
            IF (IUN_LOG.GT.0) WRITE(IUN_LOG,1000)
            GO TO 100
C
C====== Input other values 
C
         ELSE IF (ITEM.EQ.M_INPUT) THEN
            IF (GRAPH_DISP.OR.IMAGE_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_BASE, IERR)
            END IF
200         VAL = SPT_LEN
            CALL IOW_ASKF (IVH_IOW,'Input value for spot length (mm)', 
     +                     VAL, 2)
            CALL LDM_SET_SPOTL (IPACK, IPLATE, VAL, IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               STR = '**Error**'
               CALL STR_ADDS (STR,ERRSTR,1)
               CALL LMESSAGE (IVH_IOW, STR)
               GO TO 200
            END IF
            SPOTL = VAL
210         VAL = SPT_WID
            CALL IOW_ASKF (IVH_IOW,'Input value for spot width (mm)', 
     +                     VAL, 2)
            CALL LDM_SET_SPOTW (IPACK, IPLATE, VAL, IERR, ERRSTR)
            IF (IERR.NE.0) THEN
               STR = '**Error**'
               CALL STR_ADDS (STR,ERRSTR,1)
               CALL LMESSAGE (IVH_IOW, STR)
               GO TO 210
            END IF
            SPOTW = VAL
            ACCEPT = .TRUE.
            LISTE(1) = IP_STRK_L
            LISTE(2) = IP_STRK_W
            CALL SET_PAR2_VALS (2, LISTE)
            CALL OTHERS_UPD (1, UPD_SPOT, KPACK, KPLATE)
            CALL LDM_SET_SPOTL (KPACK, KPLATE, SPOTL, IERR, ERRSTR)
            CALL LDM_SET_SPOTW (KPACK, KPLATE, SPOTW, IERR, ERRSTR)
            IF (IUN_LOG.GT.0) THEN
               STR = 'New value for spot length input as'
               CALL STR_ADDF(STR,SPOTL,2,1)
               WRITE(IUN_LOG,1010) STR
               STR = 'New value for spot width input as'
               CALL STR_ADDF(STR,SPOTW,2,1)
               WRITE(IUN_LOG,1010) STR
            END IF
            IF (GRAPH_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_GRAPH, IERR)
            END IF
            IF (IMAGE_DISP) THEN
               CALL XDLF_VIEW_OBJECT_RAISE (IVH_FILM, IERR)
            END IF
            GO TO 100
         END IF
      END IF
      GO TO 100            
C
C====== Format statements
C
1000  FORMAT('New values of spot length and spot width accepted',/)
1010  FORMAT(/,A)
1020  FORMAT('No new values of spot length and width accepted',/)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     SPOTSIZE_DFLTS    **
C***************************
C
C
      SUBROUTINE SPOTSIZE_DFLTS (NBIN, SDCUT, THRFAC, EXPAND)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Default parameters for spot sizes calculation routine
C
C Author:  John W. Campbell, September 1995
C
C Arguments:
C
      INTEGER NBIN
      REAL SDCUT
      REAL THRFAC
      REAL EXPAND
C 
C NBIN      (W)   No. of bins for analysis
C SDCUT     (W)   Standard deviation cutoff level for 'good' spots
C THRFAC    (W)   Spot threshold above background factor
C EXPAND    (W)   Expand factor from average measured to proposed spot size
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C

C
C-------------------------------------------------------------------------------
C
      NBIN = 12
      SDCUT = 3.5
      THRFAC = 2.0
      EXPAND = 1.5
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     WRITE_GEFILE     **
C**************************
C
C
      SUBROUTINE WRITE_GEFILE (IPACK, IUN_GE1, IUN_GE2, WR_SPAT, 
     +                         WR_CLOS, DISTOR, MININT, PACK_ID, 
     +                         KEYPLATE, NUM_SPOTS, NUM_MULTIPLETS,
     +                         NUM_SPATIALS, NUM_BOTH, NUM_NODALS)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Write .ge1/.ge2 files
C
C Author:  John W. Campbell, February 1992
C
C Note:    Output .ge1/.ge2 files must be opened before calling this
C          routine. They will be closed within this routine.
C
C Arguments:
C
      INTEGER IPACK
      INTEGER IUN_GE1
      INTEGER IUN_GE2
      LOGICAL WR_SPAT
      LOGICAL WR_CLOS
      LOGICAL DISTOR
      INTEGER MININT
      INTEGER PACK_ID
      INTEGER KEYPLATE
      INTEGER NUM_SPOTS
      INTEGER NUM_MULTIPLETS
      INTEGER NUM_SPATIALS
      INTEGER NUM_NODALS
      INTEGER NUM_BOTH
C
C IPACK          (R)    Pack number
C IUN_GE1        (R)    Unit no. for .ge1 file (already opened)
C IUN_GE2        (R)    Unit no. for .ge2 file (already opened)
C WR_SPAT        (R)    Write spatials flag
C WR_CLOS        (R)    Write too close spots flag
C DISTOR         (R)    Apply distortion corrections to coordinates flag
C MININT         (R)    Minimum intensity for subsequent films integration
C PACK_ID        (R)    Pack identifier
C KEYPLATE       (R)    Key plate no.
C NUM_SPOTS      (W)    No. of spots written
C NUM_MULTIPLETS (W)    No. of multiplets
C NUM_SPATIALS   (W)    No. of spatials
C NUM_NODALS     (W)    No. nodals
C NUM_BOTH       (W)    No. both spatial & multiple
C
C====== Parameter statements
C 
C
C====== LOCALS:
C
      LOGICAL    SPAT, CLOS, NODFLG
      INTEGER    NODAL_INDEX
      INTEGER    CURRENT_REFLEX, I, J
      INTEGER    II, JJ, KK
      INTEGER    IERR, KERR, IFLAG, ND
      INTEGER    ISPOT, NUMSPOTS
      INTEGER    IBEAM, IROT, DISTOR_TYPE
      INTEGER    LINK_REC
      INTEGER    BINTENS(6), BSIGS(6), PINTENS(6), PSIGS(6)
      INTEGER    M_FLAG, H, K, L, NODIDX, H2, K2, L2
      INTEGER    IREAL
      INTEGER    IH,IK,IL
      INTEGER    GE1_REC, GE2_REC
      INTEGER    MULTIPLICITY, IX, IY, HKLPAK
      INTEGER    JPACK, NFILM
      INTEGER    MULTI_BINS(21)
      INTEGER    BUFFER(19), BUFFER2(2), MM
      INTEGER    MHKL(4), HKL2(4)
      INTEGER    NODAL_BINS(12)
      INTEGER    BOX(5)
      INTEGER    LAMBDA_BINS(16)
      INTEGER    ISYLAT(2), ISL
      INTEGER    IFAIL, NSING, NSINGOV
      INTEGER    ISYST, LATT
      INTEGER    H_N, K_N, L_N, MINH, MAXH, INCH
      REAL       ALNOD, DTHRNOD
      REAL       CTOF_RATS(6), CTOF
      REAL       PHIS(3), SPINDLE, CTOF_KEYPLATE, DELTA, EPSILON
      REAL       X_C(6), Y_C(6), W_C(6), Y_SCALE(6)
      REAL       TWIST(6), TILT(6), BULGE(6)
      REAL       WMIN, WMAX, DMIN, FILMR
      REAL       RINT
      REAL       BX, BY, BDMIN2
      REAL       LAMBDA1, LAMBDA2
      REAL       X_CEN_FS(6)
      REAL       Y_CEN_FS(6)
      REAL       W_FS(6)
      REAL       RCELL(6), CELLC(6), CELL(6)
      REAL       MM_RAST_X, MM_RAST_Y
      CHARACTER*80 STR, COMPOUND
      CHARACTER*6 CRYST
      CHARACTER*2 VALSTR, ERRSTR

      EQUIVALENCE (IREAL, RINT)
      EQUIVALENCE (BUFFER(1),BX)
      EQUIVALENCE (BUFFER(2),BY)
      EQUIVALENCE (BUFFER(16),LAMBDA1)
      EQUIVALENCE (BUFFER(18),LAMBDA2)
      EQUIVALENCE (BUFFER(19),BDMIN2)

      EQUIVALENCE (MHKL(1),M_FLAG)
      EQUIVALENCE (MHKL(2),H)
      EQUIVALENCE (MHKL(3),K)
      EQUIVALENCE (MHKL(4),L)

      EQUIVALENCE (HKL2(1),NODIDX)
      EQUIVALENCE (HKL2(2),H2)
      EQUIVALENCE (HKL2(3),K2)
      EQUIVALENCE (HKL2(4),L2)

      EQUIVALENCE (BUFFER2(2),LAMBDA1)

      DATA  BINTENS, BSIGS, PINTENS, PSIGS /6*-9999, 6*-9999,
     +                6*-9999, 6*-9999/
C
C------------------------------------------------------------------------------
C
C
C====== Put initialised intensity/sigma values in reflection record buffer
C
      CALL CCPII2(BUFFER(3),BINTENS,6,.TRUE.,.FALSE.)
      CALL CCPII2(BUFFER(6),BSIGS,6,.TRUE.,.FALSE.)
      CALL CCPII2(BUFFER(9),PINTENS,6,.TRUE.,.FALSE.)
      CALL CCPII2(BUFFER(12),PSIGS,6,.TRUE.,.FALSE.)
C
C====== Zero histograms
C
      NUM_SPOTS = 0
      NUM_SPATIALS = 0
      NUM_MULTIPLETS = 0
      NUM_BOTH = 0
      NUM_NODALS = 0
      DO 20 I = 1 , 21
         MULTI_BINS(I) = 0
 20   CONTINUE
      NSING = 0
      NSINGOV = 0
      DO 30 I = 1 , 12
         NODAL_BINS(I) = 0
 30   CONTINUE
C
C====== Now write .ge1/.ge2 files 
C
      GE1_REC = 10
      GE2_REC = 0

      CALL LRL_GEN (IPACK, 1, DISTOR, 2, IERR, ERRSTR)
      CALL LRL_NUMSPOTS (NUMSPOTS)

      DO 40 ISPOT = 1 , NUMSPOTS

         CALL LRL_GET (ISPOT, H, K, L, BX, BY, LAMBDA1, BDMIN2,
     +                 MULTIPLICITY, NODFLG, SPAT, KERR)
         CALL LRL_GET_XFYFD (ISPOT, BX, BY, KERR)
         CALL LRL_GET_OVLP (ISPOT, SPAT, CLOS, KERR)
         M_FLAG = 0
         H2 = 0
         K2 = 0
         L2 = 0
         CALL STBITS (M_FLAG,0,5,MULTIPLICITY)
         IF (SPAT.OR.CLOS) CALL STBITS (M_FLAG,6,1,1)
         IF (CLOS) CALL STBITS (M_FLAG,7,1,1)
         IF (NODFLG) CALL STBITS (M_FLAG,5,1,1)
         IF ((.NOT.SPAT .OR. WR_SPAT) .AND. 
     +       (.NOT.CLOS .OR. WR_CLOS)) THEN
            IF (MULTIPLICITY.EQ.1) THEN
C
C====== Now write out .ge1 record for the single
C
               GE1_REC = GE1_REC + 1
               IF (NODFLG) THEN
                  NUM_NODALS = NUM_NODALS + 1
                  IH = H
                  IK = K
                  IL = L
                  NODIDX = NODAL_INDEX(IH,IK,IL)
                  NODAL_BINS(NODIDX) = NODAL_BINS(NODIDX) + 1
               ELSE
                  NODIDX = 0
               END IF
               LAMBDA2 = 0.0
               CALL CCPIBY(BUFFER(15),MHKL,-4)
               CALL CCPIBY(BUFFER(17),HKL2,-4)
               WRITE (IUN_GE1,REC=GE1_REC) BUFFER

               MULTI_BINS(1) = MULTI_BINS(1) + 1
               NSING = NSING + 1
               IF (SPAT) NUM_SPATIALS = NUM_SPATIALS + 1
            ELSE
C
C====== Multiple
C
               CALL LRL_GET_HARM (ISPOT, H, K, L, H_N, K_N, L_N,
     +                            MULTIPLICITY, MINH, MAXH, INCH,
     +                            ALNOD, DTHRNOD, IERR)
               H2 = (MINH+INCH)*H_N
               K2 = (MINH+INCH)*K_N
               L2 = (MINH+INCH)*L_N

               LAMBDA2 = ALNOD/(MINH+INCH)
               BDMIN2 = DTHRNOD/(MINH)
C
C====== Update histogram
C
               I = MIN(MULTIPLICITY,21)
               MULTI_BINS(I) = MULTI_BINS(I) + 1
               NUM_MULTIPLETS = NUM_MULTIPLETS + 1
               IF (NODFLG) THEN
                  NUM_NODALS = NUM_NODALS + 1
                  IH = H
                  IK = K
                  IL = L
                  NODIDX = NODAL_INDEX(IH,IK,IL)
                  NODAL_BINS(NODIDX) = NODAL_BINS(NODIDX) + 1
               ELSE
                  NODIDX = 0
               END IF
               IF (SPAT) THEN
                  NUM_SPATIALS = NUM_SPATIALS + 1
                  IF (MULTIPLICITY.GT.1) NUM_BOTH = NUM_BOTH + 1
               END IF
C
C====== Now write out .ge1 record for the multiplet
C
               GE1_REC = GE1_REC + 1
               CALL CCPIBY(BUFFER(15),MHKL,-4)
               CALL CCPIBY(BUFFER(17),HKL2,-4)
               IF (MULTIPLICITY.LE.2) THEN
                  WRITE (IUN_GE1,REC=GE1_REC) BUFFER
               ELSE
                  LINK_REC = GE2_REC + 1
                  IREAL = LINK_REC
                  LAMBDA2 = RINT
                  WRITE (IUN_GE1,REC=GE1_REC) BUFFER
C
C====== Write out consecutive records to .ge2 file
C
                  DO 80 I = 2 , MULTIPLICITY
                     H = (MINH+(I-1)*INCH)*H_N
                     K = (MINH+(I-1)*INCH)*K_N
                     L = (MINH+(I-1)*INCH)*L_N
                     LAMBDA1 = ALNOD/(MINH+(I-1)*INCH)
                     GE2_REC = GE2_REC + 1
                     CALL CCPIBY(BUFFER2(1),MHKL,-4)
                     WRITE (IUN_GE2,REC=GE2_REC) BUFFER2
 80               CONTINUE
              END IF
            ENDIF
         END IF

 40   CONTINUE
C
C====== Finally write out header info, number of spots output
C
 90   JPACK = 0
      NFILM = 0
      NUM_SPOTS = GE1_REC - 10
      WRITE (IUN_GE1,REC=9) JPACK , NFILM , NUM_SPOTS
C
C====== Calc cumulative totals
C
      DO 110 I = 1 , 11
         NODAL_BINS(I+1) = NODAL_BINS(I+1) + NODAL_BINS(I)
 110  CONTINUE
C
C====== Now write out header
C
      CALL LDM_MMRAST (IPACK, 1, MM_RAST_X, MM_RAST_Y)

      DO 660 II=1,19
         BUFFER(I) = 0
660   CONTINUE

      DO 666 II=1,6
         CALL LDM_GET_XCENF (IPACK, II, X_CEN_FS(II), IFLAG, ND,
     +                       IERR, ERRSTR)
         CALL LDM_GET_YCENF (IPACK, II, Y_CEN_FS(II), IFLAG, ND,
     +                       IERR, ERRSTR)
         W_FS(II) = 0.0
666   CONTINUE
      CALL LDM_GET_TITLE(COMPOUND, IFLAG)
      WRITE (IUN_GE1,REC=1) COMPOUND(1:76)
      CALL LDM_GET_CRYST (CRYST, IFLAG)
      WRITE (IUN_GE1,REC=2) CRYST , 
     +                      (X_CEN_FS(II)/MM_RAST_X,II=1,6),
     +                      (Y_CEN_FS(JJ)/MM_RAST_Y,JJ=1,6),
     +                      (W_FS(I),I=1,5)

      CALL LDM_GET_SYST (VALSTR, ISYST, IFLAG)
      CALL LDM_GET_LATT (VALSTR, LATT, IFLAG)
      ISYLAT(1) = ISYST
      ISYLAT(2) = LATT
      CALL CCPII2(ISL,ISYLAT,2,.TRUE.,.FALSE.)
      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 RECCEL(RCELL,CELL,1.0)
      CALL CELLCX(ISYST,CELLC,RCELL,2,2)
      CALL LDM_GET_BEAM (VALSTR, IBEAM, IFLAG)
      CALL LDM_GET_ROT (VALSTR, IROT, IFLAG)
      WRITE (IUN_GE1,REC=3) W_FS(6) , (BUFFER(I),I=1,9) , CELLC , 
     +                      ISL, IBEAM, IROT
C
C====== Initialise integration box parameters
C
      CALL LDM_GET_SPOTD (IPACK, KEYPLATE, DELTA, IFLAG, ND, IERR, 
     +                    ERRSTR)
      BOX(1) = DELTA*MM_RAST_X + 1
C
C====== Force box size to be odd.
C
      IF (MOD(BOX(1),2).EQ.0) BOX(1) = BOX(1) + 1
      BOX(2) = BOX(1)
C
C====== Cut off a corner 1/4 way along.
C
      BOX(3) = BOX(1)/4
      BOX(4) = 1
      BOX(5) = BOX(4)
      CALL LDM_GET_PHIX (IPACK, PHIS(1), IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_PHIY (IPACK, PHIS(2), IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_PHIZ (IPACK, PHIS(3), IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_LMIN (IPACK, WMIN, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_LMAX (IPACK, WMAX, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_DMIN (IPACK, DMIN, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_SPIN (IPACK, SPINDLE, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_RMAX (FILMR, IFLAG, ND)
      WRITE (IUN_GE1,REC=4) 1.0/MM_RAST_X, BOX , 
     +                      (BUFFER(I),I=1,4) , PHIS , 
     +                      1.0 , WMIN , WMAX , DMIN , 
     +                      FILMR , SPINDLE
      DO 777 II = 1, 6
         CALL LDM_GET_XC (IPACK, II, X_C(II), IFLAG, ND,
     +                       IERR, ERRSTR)
         CALL LDM_GET_YC (IPACK, II, Y_C(II), IFLAG, ND,
     +                       IERR, ERRSTR)
         CALL LDM_GET_WC (IPACK, II, W_C(II), IFLAG, ND,
     +                       IERR, ERRSTR)
777   CONTINUE
      WRITE (IUN_GE1,REC=5) (X_C(II),II=1,6), 
     +                      (Y_C(JJ),JJ=1,6),
     +                      (W_C(KK),KK=1,6),
     +                      DELTA
C
C====== Calculate cryst-film ratios
C
      CTOF_RATS(KEYPLATE) = 1.0
      CALL LDM_GET_CTOF (IPACK, KEYPLATE, CTOF_KEYPLATE, IFLAG, ND, 
     +                   IERR, ERRSTR)
      DO 330 I = 1 , 6
         CALL LDM_GET_CTOF (IPACK, I, CTOF, IFLAG, ND, IERR, ERRSTR)
         CTOF_RATS(I) = CTOF/CTOF_KEYPLATE
330   CONTINUE
      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, IFLAG)
      DO 333 I = 1, 6
         CALL LDM_GET_TWIST (IPACK, I, TWIST(I), IFLAG, ND, IERR,
     +                        ERRSTR)
         CALL LDM_GET_TILT (IPACK, I, TILT(I), IFLAG, ND, IERR, ERRSTR)
         IF (DISTOR_TYPE.EQ.1) THEN
            CALL LDM_GET_BULGE (IPACK, I, BULGE(I), IFLAG, ND, 
     +                          IERR, ERRSTR)
         ELSE
            BULGE(I) = 0.0
         END IF
333   CONTINUE
      WRITE (IUN_GE1,REC=6) (TWIST(II),II=1,6),
     +                      (TILT(JJ),JJ=1,6),
     +                      (BULGE(KK),KK=1,6),
     +                      CTOF_KEYPLATE
      DO 334 I = 1, 6
         CALL LDM_GET_YSCAL (IPACK, I, Y_SCALE(I), IFLAG, ND, IERR, 
     +                       ERRSTR)
334   CONTINUE
      CALL LDM_GET_EPS (EPSILON, IFLAG, ND)
      WRITE (IUN_GE1,REC=7) (Y_SCALE(II),II=1,6), 
     +                      CTOF_RATS , MININT , EPSILON
      WRITE (IUN_GE1,REC=8) (MULTI_BINS(I),I=1,19)
      CALL LAM_HIST(LAMBDA_BINS)
      WRITE (IUN_GE1,REC=9) (MULTI_BINS(I),I=20,21) , 
     +                       (LAMBDA_BINS(I),I=1,16) , 2
      WRITE (IUN_GE1,REC=10) PACK_ID , NUM_SPOTS , NUM_MULTIPLETS , 
     +                       NUM_SPATIALS, NUM_BOTH , NUM_NODALS,
     +                       NODAL_BINS
C
C====== Close .ge1/.ge2 files
C
      CLOSE (UNIT=IUN_GE1)
      CLOSE (UNIT=IUN_GE2)
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     WRITE_GENFIL     **
C**************************
C
C
      SUBROUTINE WRITE_GENFIL
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Write a .gen file 
C
C Author:  John W. Campbell, February 1992
C
C Note: File must be opened and closed outside this routine
C
C Arguments:
C
C      None
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'film_pack.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I
      INTEGER NCP(7)
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      INTEGER ISYST
      INTEGER LATT
      INTEGER IBEAM
      INTEGER IROT
      INTEGER DISTOR_TYPE
      INTEGER NFID
      INTEGER N1OD
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER IFLIP
      INTEGER NSPDX
      INTEGER NSPDY
      REAL SPDXY
      REAL SPDX_MIN
      REAL SPDX_MAX
      REAL SPDY_MIN
      REAL SPDY_MAX
      REAL SPDX(100)
      REAL SPDY(100)
      REAL CELL(6)
      REAL RCELL(6)
      REAL CELLC(6)
      REAL PHIS(3)
      REAL SPINDLE
      REAL WMIN
      REAL WMAX
      REAL CTOF
      REAL DMIN
      REAL FILMR
      REAL X_C
      REAL Y_C
      REAL W_C
      REAL TWIST
      REAL TILT
      REAL BULGE
      REAL ROFF
      REAL TOFF
      REAL Y_SCALE
      REAL RMIN
      REAL FIDX1
      REAL FIDY1
      REAL FIDX2
      REAL FIDY2
      REAL FIDX3
      REAL FIDY3
      REAL FIDBOX
      REAL G1OD
      REAL BASEOD
      REAL CURV
      REAL XCENF
      REAL YCENF
      REAL RASTER
      REAL XLOW
      REAL XHIGH
      REAL YLOW
      REAL YHIGH
      CHARACTER*80 CELINF
      CHARACTER*12 FLIP(3)
      CHARACTER*5 SYSTYP(7)
      CHARACTER*4 AXTYP(7)
      CHARACTER*1 LATT_STR(7)
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR

C     INTEGER I                     !Temp/loop variable
C     INTEGER NCP(7)                !No. of unique cell parameters
C     INTEGER IFLAG                 !Parameter status flag
C     INTEGER ND                    !No. of decimal places flag
C     INTEGER IERR                  !Error flag
C     INTEGER ISYST                 !Crystal system
C     INTEGER LATT                  !Lattice type
C     INTEGER IBEAM                 !Beam axis
C     INTEGER IROT                  !Rotation axis
C     INTEGER DISTOR_TYPE           !Distortion type
C     INTEGER NFID                  !No. of fiducials
C     INTEGER N1OD                  !Film n1od
C     INTEGER NXRAST                !No. x-rasters
C     INTEGER NYRAST                !No. y-rasters
C     INTEGER IFLIP                 !Film/image-plate flag
C     INTEGER NSPDX                 !Polynomial order spd correction
C     INTEGER NSPDY                 !Polynomial order spd correction
C     REAL SPDXY                    !xy spd correction
C     REAL SPDX_MIN                 !Bound spd correction
C     REAL SPDX_MAX                 !Bound spd correction
C     REAL SPDY_MIN                 !Bound spd correction
C     REAL SPDY_MAX                 !Bound spd correction
C     REAL SPDX(100)                !Polynomial spd correction
C     REAL SPDY(100)                !Polynomial spd correction
C     REAL CELL(6)                  !Real cell
C     REAL RCELL(6)                 !Reciprocal cell
C     REAL CELLC(6)                 !Compressed cell
C     REAL PHIS(3)                  !Missetting angles
C     REAL SPINDLE                  !Spindle angle
C     REAL WMIN                     !Lambda-min
C     REAL WMAX                     !Lambda-max
C     REAL CTOF                     !Crystal-film distance
C     REAL DMIN                     !'dmin'
C     REAL FILMR                    !Film radius
C     REAL X_C                      !Camera constant x_c
C     REAL Y_C                      !Camera constant y_c
C     REAL W_C                      !Camera constant w_c
C     REAL TWIST                    !Twist
C     REAL TILT                     !Tilt
C     REAL BULGE                    !Bulge
C     REAL ROFF                     !MAR Roff
C     REAL TOFF                     !MAR Toff
C     REAL Y_SCALE                  !'y_scale'
C     REAL RMIN                     !'rmin'
C     REAL FIDX1                    !Fiducials
C     REAL FIDY1                    ! "
C     REAL FIDX2                    ! "
C     REAL FIDY2                    ! "
C     REAL FIDX3                    ! "
C     REAL FIDY3                    ! "
C     REAL FIDBOX                   !Fiducials box search size
C     REAL G1OD                     !Film g1od
C     REAL BASEOD                   !Film baseod
C     REAL CURV                     !Film non-linearity
C     REAL XCENF                    !Image x-centre
C     REAL YCENF                    !Image y-centre
C     REAL RASTER                   !Raster size
C     REAL XLOW                     !Area limit xlow
C     REAL XHIGH                    !Area limit xhigh
C     REAL YLOW                     !Area limit ylow
C     REAL YHIGH                    !Area limit yhigh
C     CHARACTER*80 CELINF           !Cell information string
C     CHARACTER*12 FLIP(3)          !Film/image-plate flags
C     CHARACTER*5 SYSTYP(7)         !Crystal system strings
C     CHARACTER*4 AXTYP(7)          !Axis strings
C     CHARACTER*1 LATT_STR(7)       !Lattice type strings
C     CHARACTER*2 ERRSTR            !Error string (dummy)
C     CHARACTER*80 STR              !Temp string

      DATA NCP/6,4,3,2,2,2,1/
      DATA FLIP /'film','image-plate',' '/
      DATA SYSTYP/'TRICL','MONOC','ORTHO','TETRA','HEXAG','RHOMB',
     +            'CUBIC'/
      DATA AXTYP/'-cst','-bst','-ast',' ','+ast','+bst','+cst'/
      DATA LATT_STR /'P','A','B','C','I','F','R'/
C
C-------------------------------------------------------------------------------
C
      CALL LDM_GET_TITLE (STR, IFLAG)
      WRITE (IUN_GEN,'(A)') STR(1:LENSTR(STR))
      CALL LDM_GET_CRYST (STR, IFLAG)
      WRITE (IUN_GEN,'(A)') STR(1:LENSTR(STR))
      CALL LDM_GET_SYST (STR, ISYST, IFLAG)
      CALL LDM_GET_LATT (STR, LATT, IFLAG)
      CALL LDM_GET_ROT (STR, IROT, IFLAG)
      CALL LDM_GET_BEAM (STR, IBEAM, IFLAG)
      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)
      CELINF = ' '
      CALL RECCEL(RCELL,CELL,1.0)
      CALL CELLCX(ISYST,CELLC,RCELL,2,2)
      IF (ISYST.EQ.1) THEN
         WRITE (CELINF(1:60),'(3F10.7,3F10.5)')
     +         (CELLC(I),I=1,NCP(ISYST))
      ELSE IF (ISYST.EQ.2) THEN
         WRITE (CELINF(1:60),'(3F10.7,F10.5)')
     +         (CELLC(I),I=1,NCP(ISYST))
      ELSE IF (ISYST.EQ.3) THEN
         WRITE (CELINF(1:60),'(3F10.7)') (CELLC(I),I=1,NCP(ISYST))
      ELSE IF (ISYST.EQ.4) THEN
         WRITE (CELINF(1:60),'(2F10.7)') (CELLC(I),I=1,NCP(ISYST))
      ELSE IF (ISYST.EQ.5) THEN
         WRITE (CELINF(1:60),'(2F10.7)') (CELLC(I),I=1,NCP(ISYST))
      ELSE IF (ISYST.EQ.6) THEN
         WRITE (CELINF(1:60),'(F10.5,F10.5)')
     +         (CELLC(I),I=1,NCP(ISYST))
      ELSE IF (ISYST.EQ.7) THEN
         WRITE (CELINF(1:60),'(F10.7)') (CELLC(I),I=1,NCP(ISYST))
      END IF
      CELINF = CELINF(1:60)//' '//SYSTYP(ISYST)
     +         //' '//LATT_STR(LATT)
     +         //' '//AXTYP(IROT+4)//' '//AXTYP(IBEAM+4)
      WRITE (IUN_GEN,'(A)') CELINF
      CALL LDM_GET_PHIX (IPACK, PHIS(1), IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_PHIY (IPACK, PHIS(2), IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_PHIZ (IPACK, PHIS(3), IFLAG, ND, IERR, ERRSTR)
      WRITE (IUN_GEN,*) PHIS
      CALL LDM_GET_LMIN (IPACK, WMIN, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_LMAX (IPACK, WMAX, IFLAG, ND, IERR, ERRSTR)
      WRITE (IUN_GEN,*) 1.0, WMIN , WMAX
      CALL LDM_GET_CTOF (IPACK, 1, CTOF, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_DMIN (IPACK, DMIN, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_RMAX (FILMR, IFLAG, ND)
      WRITE (IUN_GEN,*) CTOF , DMIN , FILMR
      CALL LDM_GET_SPIN (IPACK, SPINDLE, IFLAG, ND, IERR, ERRSTR)
      WRITE (IUN_GEN,*) SPINDLE
      CALL LDM_GET_XC (IPACK, 1, X_C, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_YC (IPACK, 1, Y_C, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_WC (IPACK, 1, W_C, IFLAG, ND, IERR, ERRSTR)
      WRITE (IUN_GEN,*) X_C, Y_C, W_C
      CALL LDM_GET_DSTOR(STR, DISTOR_TYPE, IFLAG)
      CALL LDM_GET_TWIST (IPACK, 1, TWIST, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_TILT (IPACK, 1, TILT, IFLAG, ND, IERR, ERRSTR)
      IF (DISTOR_TYPE.EQ.1) THEN
         CALL LDM_GET_BULGE (IPACK, 1, BULGE, IFLAG, ND, IERR, ERRSTR)
         WRITE (IUN_GEN,*) TWIST, TILT, BULGE
      ELSE IF (DISTOR_TYPE.EQ.2) THEN
         CALL LDM_GET_ROFF (IPACK, 1, ROFF, IFLAG, ND, IERR, ERRSTR)
         CALL LDM_GET_TOFF (IPACK, 1, TOFF, IFLAG, ND, IERR, ERRSTR)
         WRITE (IUN_GEN,*) TWIST, TILT, ROFF, TOFF
      ELSE
         WRITE (IUN_GEN,*) TWIST, TILT, 0.0
      END IF
      CALL LDM_GET_YSCAL (IPACK, 1, Y_SCALE, IFLAG, ND, IERR, ERRSTR)
      WRITE (IUN_GEN,*) Y_SCALE
      CALL LDM_GET_RMIN (RMIN, IFLAG, ND)
      WRITE (IUN_GEN,*) RMIN, 0.0
C
C====== Convert fid posns to original units, uncentred.
C
      CALL LDM_GET_FIDT (STR, NFID, IFLAG)
      IF (NFID.EQ.1) NFID = 3
      IF (NFID.EQ.3) THEN
         CALL LDM_GET_FIDX1 (FIDX1, IFLAG, ND)
         CALL LDM_GET_FIDY1 (FIDY1, IFLAG, ND)
         CALL LDM_GET_FIDX2 (FIDX2, IFLAG, ND)
         CALL LDM_GET_FIDY2 (FIDY2, IFLAG, ND)
         CALL LDM_GET_FIDX3 (FIDX3, IFLAG, ND)
         CALL LDM_GET_FIDY3 (FIDY3, IFLAG, ND)
         WRITE (IUN_GEN,'(I2,3(2F8.1))') NFID, FIDX1, FIDY1,
     +                     FIDX2, FIDY2, FIDX3, FIDY3
      ELSE
         WRITE (IUN_GEN,'(I2,3(2F8.1))') NFID, 0.0, 0.0, 0.0, 0.0, 
     +                                   0.0, 0.0
      END IF
      CALL LDM_GET_FBOX (FIDBOX, IFLAG, ND)
      CALL LDM_GET_N1OD (N1OD, IFLAG)
      CALL LDM_GET_G1OD (G1OD, IFLAG, ND)
      CALL LDM_GET_BASE (BASEOD, IFLAG, ND)
      CALL LDM_GET_NONL (CURV, IFLAG, ND)
      WRITE (IUN_GEN,'(F6.1,F4.1,I4,3E10.3)') 0.0, FIDBOX, N1OD, 
     +       BASEOD, G1OD, CURV
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      CALL LDM_GET_XCENF (IPACK, 1, XCENF, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_YCENF (IPACK, 1, YCENF, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_RAST (RASTER, IFLAG, ND)
      CALL LDM_GET_XLOW (XLOW, IFLAG, ND)
      CALL LDM_GET_XHIGH (XHIGH, IFLAG, ND)
      CALL LDM_GET_YLOW (YLOW, IFLAG, ND)
      CALL LDM_GET_YHIGH (YHIGH, IFLAG, ND)
      CALL LDM_GET_IMTYP (STR, IFLIP, IFLAG)
      IF (IFLIP.GT.2) IFLIP = 3
      WRITE (IUN_GEN,'(2I5,F4.1,2F8.2,F7.2,4F7.1,X,A)') NXRAST, NYRAST, 
     +       2.0, XCENF, YCENF, RASTER,
     +       XLOW, XHIGH, YLOW, YHIGH, FLIP(IFLIP)
      IF (DISTOR_TYPE.EQ.3) THEN
         CALL LDM_SPDXY (IPACK, 1, SPDXY,
     +                   NSPDX, SPDX_MIN, SPDX_MAX, SPDX,
     +                   NSPDY, SPDY_MIN, SPDY_MAX, SPDY,
     +                   100, IERR, ERRSTR)
         WRITE (IUN_GEN, '(2F10.2,I3,/(4G14.5)))') SPDX_MIN, SPDX_MAX,
     +          NSPDX, (SPDX(I),I=1,MIN(NSPDX,100))
         WRITE (IUN_GEN, '(2F10.2,I3,/(4G14.5)))') SPDY_MIN, SPDY_MAX,
     +          NSPDY, (SPDY(I),I=1,MIN(NSPDY,100))
         WRITE (IUN_GEN, '(G14.5)') SPDXY
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     WRITE_INTFILE    **
C**************************
C
C
      SUBROUTINE WRITE_INTFILE (KPACK, INT_TYPE, SCALE_INT,
     +                          MTZ_FILE, GE1_FILE, GE2_FILE, IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Write intensities file
C
C Author:  John W. Campbell, December 1995
C
C    Note: For .ge1/.ge2 files, they must be opened on units IUN_GE1 and
C          IUN_GE2 prior to calling this routine; they will be closed
C          within this routine. If MTZ then check that file can be opened
C          prior to calling this routine though the open & close will be done
C          within this routine.
C
C Arguments:
C
      INTEGER KPACK
      INTEGER INT_TYPE
      REAL SCALE_INT
      CHARACTER*(*) MTZ_FILE
      CHARACTER*(*) GE1_FILE
      CHARACTER*(*) GE2_FILE
      INTEGER IERR
C
C KPACK     (R)  Pack no. for data to be written
C INT_TYPE  (R)  Intensities file type flag =1 mtz,  =2 .ge1/.ge2
C SCALE_INT (R)  Scale factor for output intensities
C MTZ_FILE  (R)  Name of MTZ file if integration file type = 1
C GE1_FILE  (R)  Name of .ge1 file if integration file type = 2
C GE2_FILE  (R)  Name of .ge2 file if integration file type = 2
C IERR      (W)  Error flag  =0 OK
C                           =1 Could not write .ge1/.ge2 files - memory 
C                              allocation error
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'film_pack.finc'
      INCLUDE 'file_units.finc'
      INCLUDE 'lirl_pars.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      LOGICAL SORT_OK
      LOGICAL RESCALE
      INTEGER KERR
      INTEGER NPLATES
      INTEGER NUM_SPOTS
      INTEGER NUM_MULTIPLETS
      INTEGER NUM_SPATIALS
      INTEGER NUM_BOTH
      INTEGER NUM_NODALS
      INTEGER LAMBDA_BINS(16)
      INTEGER ISORT(5)
      INTEGER IFLAG
      INTEGER ND
      INTEGER NUMSPOTS
      INTEGER ISPOT 
      INTEGER IH
      INTEGER IK
      INTEGER IL 
      INTEGER IPK
      INTEGER IPL
      INTEGER KSYM
      INTEGER MULT
      INTEGER MINHARM
      INTEGER MAXHARM
      INTEGER INCHARM
      INTEGER ISPAT
      INTEGER ICLOS
      INTEGER IMEAS
      INTEGER IBAD
      INTEGER IOVLD
      INTEGER IPACK_ID
      INTEGER ICODE
      INTEGER IFLG
      INTEGER NOVLD
      REAL CELL(6)
      REAL ADATA(15)
      REAL XF
      REAL YF
      REAL ALAM
      REAL AI
      REAL SIGI
      REAL FP
      REAL SCALOUT
      CHARACTER*80 TITL
      CHARACTER*80 HSTRNG(2)
      CHARACTER*30 LABLS(15)
      CHARACTER*1 CTYPS(15)
      CHARACTER*2 ERRSTR
      CHARACTER*80 STR

C     LOGICAL SORT_OK              !Sort was OK flag
C     LOGICAL RESCALE              !Output intensities rescaled flag
C     INTEGER KERR                 !Error flag
C     INTEGER NPLATES              !No. plates/pacl
C     INTEGER NUM_SPOTS            !No. spot written to .ge1/.ge2 files
C     INTEGER NUM_MULTIPLETS       !No. multiples written to .ge1/.ge2 files
C     INTEGER NUM_SPATIALS         !No. spatials written to .ge1/.ge2 files
C     INTEGER NUM_BOTH             !No. both spatial & multiple
C     INTEGER NUM_NODALS           !No. nodals written to .ge1/.ge2 files
C     INTEGER LAMBDA_BINS(16)      !Lambda bins histogram
C     INTEGER ISORT(5)             !MTZ column sort flags
C     INTEGER IFLAG                !Parameter status flag
C     INTEGER ND                   !No. of decimal places flag
C     INTEGER NUMSPOTS             !No. of spots
C     INTEGER ISPOT                !Spot number
C     INTEGER IH                   !'h' index
C     INTEGER IK                   !'k' index
C     INTEGER IL                   !'l' index
C     INTEGER IPK                  !Pack number
C     INTEGER IPL                  !Plate number
C     INTEGER KSYM                 !Symmetry number/flag
C     INTEGER MULT                 !Multiplicity
C     INTEGER MINHARM              !Minimum harmonic
C     INTEGER MAXHARM              !Maximum harmonic
C     INTEGER INCHARM              !Harmonic increment
C     INTEGER ISPAT                !Spatial overlap flag
C     INTEGER ICLOS                !Spots 'too close to integrate' flag
C     INTEGER IMEAS                !Intensity measured flag
C     INTEGER IBAD                 !Bad spot flag
C     INTEGER IOVLD                !Overload spot flag
C     INTEGER IPACK_ID             !Pack id
C     INTEGER ICODE                !Integration routine flags code
C     INTEGER IFLG                 !Integration flag
C     INTEGER NOVLD                !No. of overload pixels in spot
C     REAL CELL(6)                 !Real cell dimensions
C     REAL ADATA(15)               !Reflection data buffer for MTZ file
C     REAL XF                      !'x' spot position mm from pattern centre
C     REAL YF                      !'y' spot position mm from pattern centre
C     REAL ALAM                    !Lambda value
C     REAL AI                      !Integrated intensity
C     REAL SIGI                    !sig(AI)
C     REAL FP                      !Real value 
C     REAL SCALOUT                 !Used o/p scale factor (.ge1/.ge2 files)
C     CHARACTER*80 TITL            !LDM title
C     CHARACTER*80 HSTRNG(2)       !History string
C     CHARACTER*30 LABLS(15)       !MTZ file labels strings
C     CHARACTER*1 CTYPS(15)        !MTZ file column types flags
C     CHARACTER*2 ERRSTR           !Error string (dummy)
C     CHARACTER*80 STR             !Message string

      DATA LABLS/'H','K','L','PACK_ID','PLATE','XF','YF','LAMBDA',
     +            'I','SIGI','MULT','MINHARM','MAXHARM','NOVPIX',
     +            'FLAGS'/
      DATA CTYPS/'H','H','H','B','I','R','R','R','J','Q','I',
     +           'I','I','R','I'/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      IERR = 0
C
C====== Write intensities file(s)
C
      IF (INT_TYPE.EQ.1) THEN
         CALL LDM_GET_PID (KPACK, IPACK_ID, IFLAG, KERR, ERRSTR)
         SORT_OK = .TRUE.
         CALL LIRLF_SORT (KDX_LIRL, 4, KERR)
         IF (KERR.NE.0) SORT_OK = .FALSE. 
         CALL LIRLF_SORT (KDX_LIRL, 1, KERR)
         IF (KERR.NE.0) SORT_OK = .FALSE. 
         IF (SORT_OK) THEN
            ISORT(1) = 1
            ISORT(2) = 2
            ISORT(3) = 3
            ISORT(4) = 6
            ISORT(5) = 0
         ELSE
            ISORT(1) = 0
            ISORT(2) = 0
            ISORT(3) = 0
            ISORT(4) = 0
            ISORT(5) = 0
         END IF
         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 LWOPEN (1, MTZ_FILE)
         CALL LWTITL (1, TITL, 0)
         CALL LWCLAB (1, LABLS, 15, CTYPS, 0)
         CALL LWCELL (1, CELL)
         HSTRNG(1) = 'Integration by program LAUEGEN'
         CALL STR_ADDS (HSTRNG(1),'for pack id =', 1)
         CALL STR_ADDI (HSTRNG(1), IPACK_ID, 1)
         CALL LWHIST (1, HSTRNG, 1)
         CALL LDM_LWSYMM (1)
         CALL LWSORT (1,ISORT)
         CALL LIRLF_NUMREFS (KDX_LIRL, NUMSPOTS)
         IF (NUMSPOTS.GT.0) THEN
            DO 100 ISPOT = 1, NUMSPOTS
               CALL LIRLF_GETREF (KDX_LIRL, ISPOT, IH, IK, IL, 
     +            IPK, IPL, KSYM, XF, YF, ALAM, 
     +            MULT, MINHARM, MAXHARM, INCHARM,
     +            AI, SIGI, ISPAT, ICLOS, IMEAS, IBAD, IOVLD,
     +            ICODE, KERR)
                CALL LIRLF_GET_OVPIX (KDX_LIRL, ISPOT, NOVLD, KERR)
                IF (KPACK.NE.IPK) GO TO 100
                ADATA(1) = IH
                ADATA(2) = IK
                ADATA(3) = IL
                ADATA(4) = IPACK_ID
                ADATA(5) = IPL
                ADATA(6) = XF
                ADATA(7) = YF
                ADATA(8) = ALAM
                ADATA(9) = SCALE_INT*AI
                ADATA(10) = SCALE_INT*SIGI
                ADATA(11) = MULT
                ADATA(12) = MINHARM
                ADATA(13) = MAXHARM
                ADATA(14) = NOVLD
                ADATA(15) = ISPAT + 2*ICLOS + 4*IOVLD + 8*IBAD
                CALL LWREFL (1, ADATA)
 100         CONTINUE
         END IF
         CALL LWCLOS (1, 0)
         IF (IUN_LOG.GT.0) THEN 
            WRITE (IUN_LOG,6010) MTZ_FILE(1:LENSTR(MTZ_FILE))
            STR = 'Output scale factor for intensities ='
            CALL STR_ADDF (STR, SCALE_INT, 4, 1)
            WRITE (IUN_LOG,6030) STR
         END IF
      ELSE
         CALL LRL_GEN (KPACK, 1, .FALSE., 2, KERR, ERRSTR)
         CALL LAM_HIST (LAMBDA_BINS)
         CALL LFN_LIRLGE (KDX_LIRL, IUN_GE1, IUN_GE2, KPACK, SCALE_INT,
     +                  LAMBDA_BINS, NUM_SPOTS, NUM_MULTIPLETS,
     +                  NUM_SPATIALS, NUM_BOTH, NUM_NODALS,
     +                  RESCALE, SCALOUT, IERR) 
         IF (RESCALE) THEN
            STR = '*Warning* Output scale factor reset to'
            CALL STR_ADDF (STR, SCALOUT, 4, 1)
            CALL LOG_MSG (IVH_IOW, STR, 1)
         END IF
         IF (IERR.EQ.1) THEN
            IF (IUN_LOG.GT.0) WRITE (IUN_LOG,6000)
            RETURN
         END IF
         IF (IUN_LOG.GT.0) THEN
            WRITE (IUN_LOG,6020) GE1_FILE(1:LENSTR(GE1_FILE)),
     +                      GE2_FILE(1:LENSTR(GE2_FILE))      
            STR = 'Output scale factor for intensities ='
            CALL STR_ADDF (STR, SCALOUT, 4, 1)
            WRITE (IUN_LOG,6030) STR
         END IF
      END IF
C
C====== Update integration flags
C
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      DO 30 IPL = 1, NPLATES
         IF (INT_TYPE.EQ.2.AND.IPL.GT.6) GO TO 30
         CALL INTFLAG_GET (KPACK, IPL, IFLG)
         IF (IFLG.EQ.1) CALL INTFLAG_SET (KPACK, IPL, 2)
 30   CONTINUE
      RETURN
C
C====== Format statements
C
 6000 FORMAT (/,'**Error** Could not write files',
     +        ' - memory allocation error')
 6010 FORMAT (/,'MTZ intensities file written',/,
     +        /,'Name of file: ',A)
 6020 FORMAT (/,'Intensities .ge1/.ge2 files written',/,
     +        /,'Name of .ge1 file: ',A,
     +        /,'Name of .ge2 file: ',A)
 6030 FORMAT (/,A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     WRITE_PARFIL     **
C**************************
C
C
      SUBROUTINE WRITE_PARFIL (PAR_FILE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Write parameters file 
C
C Author:  John W. Campbell, February 1992
C
C Note: File must be opened and closed outside this routine
C
C Arguments:
C
      CHARACTER*(*) PAR_FILE
C
C PAR_FILE  (R)  Name of output parameters file  
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
      INCLUDE 'file_units.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR      
C
C====== LOCALS:
C

C
C-------------------------------------------------------------------------------
C
C
C====== Log name of parameters file
C
      IF (IUN_LOG.GT.0) THEN
         WRITE (IUN_LOG, 1010) PAR_FILE(1:LENSTR(PAR_FILE))
      END IF
C
C====== Write parameters data
C
      CALL LDM_WRITE (IUN_GEN, 2)
      RETURN
C
C====== Format statements
C
C
C====== Format statements
C
1010  FORMAT(/,'Writing New LDM Parameters File',/,
     +         '===============================',//,
     +         'Name of file: ',A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     YESNO_NOTICE       **
C****************************
C
C
      SUBROUTINE YESNO_NOTICE (ITYP, MESSAGE, IBUTTON)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Output a popup notice message for 'lauegen' with a
C          'Yes' box and a 'No' box
C
C Author:  John W. Campbell, August 1991
C
C Arguments:
C
      INTEGER ITYP
      CHARACTER*(*) MESSAGE
      INTEGER IBUTTON
C
C ITYP    (R)  = 0, Position notice at default position (no arrow on notice)
C              = 1, Position notice at last selected menu item position (arrow
C                   on notice in this case)
C              = 2, Position at menu item on autoindexing solutions menu
C                   area
C MESSAGE (R)  The error message
C IBUTTON (W)  Returns button selected flag 1=yes, 2=no
C
C====== Parameter statements
C 
      INCLUDE 'lauegen_limits.finc'
      INCLUDE 'screen_params.finc'
C
C====== GLOBALS:
C
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER IXROOT
      INTEGER IYROOT
      INTEGER IARROW

C     INTEGER IXROOT      !X root position for popup notice
C     INTEGER IYROOT      !Y root position for popup notice
C     INTEGER IARROW      !Arrow required flag 0=no, 1=yes
C
C-------------------------------------------------------------------------------
C
C====== Get the required position
C
      CALL NOTICE_POSN (ITYP, IXROOT, IYROOT)
C
C====== Output the popup notice
C
      IARROW = 0
      IF (ITYP.EQ.1) IARROW = 1
      CALL XDLF_POPUP_NOTICE (IXROOT, IYROOT, 
     +          XDLSTR(MESSAGE), LENSTR(MESSAGE),
     +          XDLSTR(' '), -1,
     +          XDLSTR('Yes'), 3,
     +          XDLSTR('No'), 2,
     +          IFONT, IARROW, IBUTTON)
      RETURN
      END
