C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**   LFN_AUTO_REFN      **
C**************************
C
C
CD-Routine: Automatic Orientation Refinement - LFN_AUTO_REFN
C This routine is used to carry out an automatic orientation refinement
C for a single plate, a pack or all packs and plates. The refinement
C procedure is split into three phases after an initial spot search.
C Spots with a fixed nodal index (program set default e.g. 4 or a 
C user specified nodal index or minimum number of spots) are used throughout 
C the procedure until the final refinement phase is reached. The first phase 
C will attempt to get the refinement started even if the initial rms is poor 
C (> 0.25 mm or less than half the spots found). This phase will 
C continue to try and get a reasonable rms (up to a maximum of 8 cycles) 
C provided that, either the number of spots found is increasing or the rms 
C is falling and the number of spots does not decrease by more than one
C quarter in a cycle. The main refinement phase is entered when the rms 
C is <= 0.25 mm provided that at least half the spots have been found. It 
C carries out a standard refinement 
C protocol of 4 cycles (7 if the polynomial based spatial distortion 
C correction is being used). The final refinement phase uses a nodal index 
C with a program set default e.g. 6 (or a user specified nodal index or 
C minimum number of spots) and carries out a final two cycles of refinement 
C (4 if the polynomial based spatial distortion correction is being used). 
C If a plate has already been refined the final refinement phase will be 
C entered immediately provided that the rms is <= .075 mm. When a pack is being
C refined, the key plate will be refined first. The user specifies 
C whether or not cell parameters are to be refined (applies to key plate of 
C key pack only); the default is defined by the program e.g. refine cell. 
C Spot positions are found using the LFN_GET_SPOTS routine.
CD-end
CD-Fortran:
      SUBROUTINE LFN_AUTO_REFN (IPACK, IPLATE, OPTSTR, 
     +                          IPKPL_DF, ICLL_DF, NODS_DF, NODF_DF,
     +                          IMG_PK, IMG_PL, RD_IMG, 
     +                          IMG, MAXIMG, ITYPE, NF_OFF,
     +                          IUN_LOG, LOG_RESULTS, LOG_ERR, 
     +                          MAXHALF, IDATA, IWORK, 
     +                          CANCEL, RMS, UPD, IERR, ERRSTR, 
     +                          ERRSTR2)
CD-end
      INCLUDE 'implicit_none.finc'
C
C Purpose: Automatic orientation refinement procedure
C
C Author:  John W. Campbell, October 1994
C
C Arguments:
C
      INTEGER IPACK
      INTEGER IPLATE
      CHARACTER*(*) OPTSTR
      INTEGER IPKPL_DF
      INTEGER ICLL_DF
      INTEGER NODS_DF
      INTEGER NODF_DF
      INTEGER IMG_PK
      INTEGER IMG_PL
      EXTERNAL RD_IMG
      INTEGER IMG(*)
      INTEGER MAXIMG
      INTEGER ITYPE
      INTEGER NF_OFF
      INTEGER IUN_LOG
      EXTERNAL LOG_RESULTS
      EXTERNAL LOG_ERR
      INTEGER MAXHALF
      INTEGER IDATA(*)
      INTEGER IWORK(*)
      LOGICAL CANCEL
      EXTERNAL CANCEL
      REAL RMS
      LOGICAL UPD(*)
      INTEGER IERR
      CHARACTER*(*) ERRSTR
      CHARACTER*(*) ERRSTR2
C
CD-Parameters:
C IPACK       i  (M)  Current pack number (On o/p last pack accessed)
C IPLATE      i  (M)  Current plate number (On o/p last pack accessed)
C OPTSTR      c  (R)  Options string (max. 80 characters long)
C                     'plate' or 'pack' or 'all'
C                     'cell' or 'nocell'
C                     nnods nnodf (nodal indices  for start/main and final 
C                                  refinement phases if <=20 or minimum
C                                  no. of predicted nodals to use for 
C                                  refinement if >20. The default values 
C                                  are nodal indices defined via parameters
C                                  NODS_DF and NODF_DF below.
C                                  If a single value is given, it is 
C                                  assumed to refer to nnodf for the final 
C                                  refinements. For the nodal index 
C                                  options, values are adjusted, if 
C                                  necessary, to be in the range 4-12. 
C IPKPL_DF    i  (R)  Default value for plate/pack/all (1,2,3)
C ICLL_DF     i  (R)  Default refine cell flag 1=yes, 2=no
C NODS_DF     i  (R)  Default nodal index for initial refinements (4-12) e.g. 4
C NODF_DF     i  (R)  Default nodal index for final refinements (4-12) e.g. 6
C IMG_PK      i  (M)  Pack number for current image in IMG; 0 if none.
C                     On output will be for the last image read or 0 if 
C                     there was an error reading the image.
C IMG_PL      i  (M)  Plate number for current image in IMG; 0 if none.
C                     On output will be for the last image read or 0 if 
C                     there was an error reading the image.
C RD_IMG      s  (R)  Subroutine to open the image file and read an image. 
C                     The call is as follows:
C  
C                         CALL RD_IMG (IPK, IPL, ITYPE, NF_OFF, IMG, 
C                        +             MAXIMG, KERR, KERRSTR)
C
C                        where
C
C                         IPK     i  (R)  Pack number
C                         IPL     i  (R)  Plate number
C                         ITYPE   i  (M)  See below 
C                         NF_OFF  i  (M)  See below
C                         IMG(*)  i  (W)  See below
C                         MAXIMG  i  (R)  See below
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 reading the
C                                         image.
C
C                     Note: In some instances it may be appropriate
C                     for the routine to set x_cen_f, y_cen_f values e.g 
C                     derived from fiducial positions if it finds that
C                     these parameters have not already been set as
C                     the refinement procedure needs these in order to
C                     continue
C IMG(*)      i  (R)  Array containing the (possibly packed) image data
C                     for the current plate.
C MAXIMG      i  (R)  Maximum no. of words in IMG array
C ITYPE       i  (M)  Image data type in IMG =1 unsigned byte
C                                            =2 unsigned two byte
C                                            =3 signed (full) integer
C                                            =4 squashed i2 data
C                     Note: May be reset by RD_IMG subroutine but must
C                     be given an input value if a previously read  image 
C                     is passed to the routine.
C NF_OFF      i  (M)  Fast offset between (slow) rasters of image (e.g. 
C                     1'st dimension of the the image data if the data
C                     are held in a two dimensional array). This value is
C                     the number of elements for the image data type
C                     as indicated by ITYPE.
C                     Note: May be reset by RD_IMG subroutine but must be
C                     given an input value if a previously read  image
C                     is passed to the routine.
C IUN_LOG     i  (R)  Unit number for output passed to LOG_RESULTS and
C                     LOG_ERR routines as one of their parameters when 
C                     called.
C LOG_RESULTS s  (R)  User defined subroutine to output results of the
C                     refinement. For output to a log file only, this
C                     may be the routine LFN_REFN_LOG. Note that the
C                     routine must be declared as EXTERNAL in the calling
C                     program. The call is as follows:
C
C                         CALL LOG_RESULTS (IUN_LOG, ISTAGE, IPACK, IPLATE, 
C                        +                  IGEN, NSEARCH, NOBS, 
C                        +                  OLD_RMS, RMS, RFMSG,
C                        +                  IFLAG, JFLAG, KFLAG)
C
C                        where
C
C                        IUN_LOG     i  (R)  Unit number for log file 
C                                            as passed to LFN_AUTO_REFN
C                        ISTAGE      i  (R)  Refinement stage to be logged
C                                            (ipack, iplate are always 
C                                            passed unless ISTAGE is 0 or 
C                                            20; other parameters which need
C                                            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
C                                                 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 
C                                            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 
C                                            refinement
C                        OLD_RMS     i  (R)  Rms from spot search prior 
C                                            to refinement
C                        RMS         i  (R)  Rms from spot search or 
C                                            refinement
C                        RFMSG       c  (R)  Message string from 
C                                            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 LOG_ERR     s  (R)  User defined subroutine called when an error
C                     condition is encountered. For certain conditions
C                     the routine may allow the refinement to continue
C                     for the next plate etc. For output only the
C                     subroutine LFN_REFN_ERR may be used. This
C                     outputs the error message to IUN_LOG and terminates
C                     the refinement after any error is found. Note that
C                     the routine must be declared as EXTERNAL in the
C                     calling program. The call is as follows:
C
C                         CALL LOG_ERR (IUN_LOG, ICONT, ERRSTR,
C                        +              ERRSTR2, NEXT)
C   
C                        where
C
C                        IUN_LOG     i  (R)  Unit number for log file. 
C                        ICONT       i  (R)  = 0 terminate refinement
C                                            = 1 may continue with next
C                                                plate if desired.
C                                            = 2 may continue with next
C                                                pack if required
C                                            =-1 Interrupted
C                        ERRSTR      c  (R)  Error string (max 80 chars)
C                        ERRSTR2     c  (R)  Subsidiary error string -
C                                            may be blank (max 80 chars)
C                        NEXT        l  (W)  Set by the routine. If
C                                            .true. then refinement will
C                                            be continued with next pack
C                                            or plate. If .false. then
C                                            refinement will be 
C                                            terminated. Note: the routine
C                                            must set it to .false. if
C                                            ICONT is 0 or -1.
C
C MAXHALF     i  (R)  Maximum half size in rasters allowed for background
C                     determining box which will be three times the spot 
C                     search box (each dimension) in size.
C IDATA       i  (*)  Work array to hold the spot data returned from the
C                     image. Must be dimensioned to at least
C                     (2*MAXHALF+1)*(2*MAXHALF+1)
C IWORK       i  (*)  Work array dimensioned to at least (2*MAXHALF+1)
C CANCEL      f  (R)  Logical function used to interrupt procedure
C                     It has one dummy argument and must return a
C                     logical value of .TRUE. to cancel the procedure
C                     or .FALSE. to let it proceed.
C                     The actual function passed must be declared as
C                     both LOGICAL and EXTERNAL in the calling program.
C                     (The dummy function LFN_DUMMY_CNCL may be used)
C RMS         f  (W)  Returns the final RMS value in mm.
C UPD(9)      l  (R)  Automatic update flags .true. yes, .false. no.
C                     The automatic updates, if done, will be as follows:
C
C                         For a pack based parameter, update parameter
C                         for subsequent packs if pack just refined is
C                         the first pack.
C
C                         For a plate based parameter, update the
C                         parameter for other plates if the plate just
C                         refined is the key plate for the pack. If, in
C                         addition, the pack is the first pack, then
C                         update the parameter for all packa and plates.
C
C                     UPD(1) Phis
C                     UPD(2) ctof
C                     UPD(3) x_c, y_c
C                     UPD(4) w_c
C                     UPD(5) y_scale
C                     UPD(6) twist, tilt
C                     UPD(7) bulge
C                     UPD(8) roff/toff
C                     UPD(9) spd parameters
C
C IERR        i  (W)  Error flag for last error found
C                                =  0 OK (no errors)
C                                = -1 Invalid current pack number.
C                                = -2 Invalid current plate number.
C                                = -3 Invalid/ambiguous option requested 
C                                     options string
C                                =  1 Required Key plate not yet refined
C                                =  2 Error reading image
C                                =  3 Centre not defined for plate
C                                =  4 Error generating reflection list
C                                =  5 Error in spots search
C                                =  6 Cannot home in on solution
C                                =  7 Less than 5 spots found
C                                =  8 Least squares refinement error
C                                =100 REfinement interrupted
C ERRSTR      c  (W)  Error message string (max 80 chars) if IERR is
C                     non-zero
C ERRSTR2     c  (W)  Additional error information (max 80 chars) if
C                     IERR is non-zero (blank for some error conditions)
CD-end
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
      INTEGER NXTTOK
      INTEGER LDM_INTFP
C
C====== LOCALS:
C
      LOGICAL RFCL
      LOGICAL NEXT
      INTEGER I
      INTEGER IPK_MIN
      INTEGER IPK_MAX
      INTEGER IPL_MIN
      INTEGER IPL_MAX
      INTEGER IPK
      INTEGER IPL
      INTEGER IPP
      INTEGER ICONT_PK
      INTEGER ICONT_PL
      INTEGER DISTOR_TYPE
      INTEGER IRFL
      INTEGER KEYPLATE
      INTEGER LFLAG
      INTEGER ND
      INTEGER IPKPL
      INTEGER ICLL
      INTEGER MINSPOTS_START
      INTEGER MINSPOTS_FINAL
      INTEGER NPL
      INTEGER IFLAG(7)
      INTEGER JFLAG(6)
      INTEGER KFLAG(6)
      INTEGER KERR
      INTEGER NNUMS
      INTEGER NSP(2)
      INTEGER NIDX
      INTEGER NIDX_START
      INTEGER NIDX_FINAL
      INTEGER NCYC
      INTEGER ICYC
      INTEGER IPLC
      INTEGER KTYP
      INTEGER NPACKS
      INTEGER NPLATES
      INTEGER NSEARCH
      INTEGER NOBS
      INTEGER NOBS_LAST
      INTEGER NNODS(12)
      INTEGER NODMAX
      INTEGER N4
      INTEGER MAIN_CYC(4)
      INTEGER MAIN_CYC_D3(7)
      INTEGER FINAL_CYC(2)
      INTEGER FINAL_CYC_D3(4)
      INTEGER IGEN(6)
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER IV
      INTEGER NOPT
      INTEGER IOPT
      REAL FP
      REAL X_CEN_F
      REAL Y_CEN_F
      REAL TUNE(3)
      REAL SPOT_L
      REAL SBOX
      REAL RMS_LAST
      REAL OLD_RMS
      CHARACTER*80 KERRSTR
      CHARACTER*2 VALSTR
      CHARACTER*80 STR
      CHARACTER*6 OPTS(5)

C     LOGICAL RFCL              !Refine cell flag
C     LOGICAL NEXT              !Continue with next pack/plate flag
C     INTEGER I                 !Temp/loop variable
C     INTEGER IPK_MIN           !Minimum pack number for refinement
C     INTEGER IPK_MAX           !Maximum pack number for refinemen
C     INTEGER IPL_MIN           !Minimum plate number for refinemen
C     INTEGER IPL_MAX           !Maximum plate number for refinemen
C     INTEGER IPK               !Pack number
C     INTEGER IPL               !Plate number
C     INTEGER IPP               !Plate sections loop (1 for key plate,
C                                2 for others)
C     INTEGER ICONT_PK          !Continue to next pack flag
C     INTEGER ICONT_PL          !Continue to next plate flag
C     INTEGER DISTOR_TYPE       !Distortion type flag
C     INTEGER IRFL              !Plate refined flag
C     INTEGER KEYPLATE          !Key plate number
C     INTEGER LFLAG             !Parameter status flag
C     INTEGER ND                !No. of decimal places flag
C     INTEGER IPKPL             !Pack/plate requested flag
C     INTEGER ICLL              !Cell/nocell requested flag
C     INTEGER MINSPOTS_START    !Min no. of spots for initial/main refinements
C     INTEGER MINSPOTS_FINAL    !Min no. of spots for final refinement
C     INTEGER NPL               !No. of plates/pack to refine
C     INTEGER IFLAG(7)          !Refinement flags (see LFN_RFN routine)
C     INTEGER JFLAG(6)          !Refinement flags (see LFN_RFN routine)
C     INTEGER KFLAG(6)          !Refinement flags (see LFN_RFN routine)
C     INTEGER KERR              !Error flag
C     INTEGER NNUMS             !No. of numbers input in options string
C     INTEGER NSP(2)            !Nodal index / no. of spots flags
C     INTEGER NIDX              !Nodal index
C     INTEGER NIDX_START        !Nodal index for initial/main refinements
C     INTEGER NIDX_FINAL        !Nodal index for final refinement
C     INTEGER NCYC              !Number of cycles
C     INTEGER ICYC              !Cycle counter
C     INTEGER IPLC              !Plate counter
C     INTEGER KTYP              !Cycle type flag for LFN_RFN_FLGS
C     INTEGER NPACKS            !No. of packs
C     INTEGER NPLATES           !No. of plates
C     INTEGER NSEARCH           !No. of spots for search
C     INTEGER NOBS              !No. of spots found
C     INTEGER NOBS_LAST         !Previous no. of spots found
C     INTEGER NNODS(12)         !Histogram of no. spots as a function of
C                                nodal index
C     INTEGER NODMAX            !Maximum nodal index
C     INTEGER N4                !No. spots for a nodal index of 4
C     INTEGER MAIN_CYC(4)       !Main refinement phase cycle type flags
C     INTEGER MAIN_CYC_D3(7)    !As above if distortion type is 3
C     INTEGER FINAL_CYC(2)      !Final refinement phase cycle type flags
C     INTEGER FINAL_CYC_D3(4)   !As above if distortion type is 3
C     INTEGER IGEN(6)           !Counts from spots list generation
C     INTEGER IL                !Index into text string
C     INTEGER M1                !Index to start of text field
C     INTEGER M2                !Index to end of text field
C     INTEGER IV                !Integer value
C     INTEGER NOPT              !No. of options
C     INTEGER IOPT              !Option number
C     REAL FP                   !Floating point value
C     REAL X_CEN_F              !X plate centre position
C     REAL Y_CEN_F              !Y plate centre position
C     REAL TUNE(3)              !Refinement routine 'tuning' parameters
C     REAL SPOT_L               !Spot length
C     REAL SBOX                 !Spot box size
C     REAL RMS_LAST             !Previous rms value
C     REAL OLD_RMS              !Old rms value
C     CHARACTER*80 KERRSTR      !Error string
C     CHARACTER*2 VALSTR        !Value string (dummy)
C     CHARACTER*80 STR          !Temp string
C     CHARACTER*6 OPTS(5)       !Options strings


      DATA MAIN_CYC /1,2,3,3/
      DATA MAIN_CYC_D3 /1,2,3,4,4,3,4/
      DATA FINAL_CYC /3,3/
      DATA FINAL_CYC_D3 /3,4,3,4/
      DATA OPTS/'PLATE','PACK','ALL','CELL','NOCELL'/
C
C-------------------------------------------------------------------------------
C
C====== Initialise and interpret options string
C
      IERR = 0
      ERRSTR = ' '
      ERRSTR2 = ' '
      OLD_RMS = 0.0
      RMS = 0.0
      CALL LOG_RESULTS (IUN_LOG, 0, 0, 0, IGEN,
     +                  0, 0, 0.0, 0.0, ' ',
     +                  IFLAG, JFLAG, KFLAG)
      CALL LDM_GET_NUMP (NPACKS, LFLAG)
      CALL LDM_GET_NPLAT (NPLATES, LFLAG)
      IF (IPACK.LT.1.OR.IPACK.GT.NPACKS) THEN
         IERR = -1
         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 LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         RETURN
      END IF
      IF (IPLATE.LT.1.OR.IPLATE.GT.NPLATES) THEN
         IERR = -2
         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 LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         RETURN
      END IF

      IPKPL = 0
      ICLL = 0
      MINSPOTS_START = 0
      NIDX_START = NODS_DF
      MINSPOTS_FINAL = 0
      NIDX_FINAL = NODF_DF
      NNUMS = 0
      NSP(1) = 0
      NSP(2) = 0
      STR = OPTSTR
      CALL CCPUPC(STR)
      IL = 0
 10   I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.LT.0) GO TO 20
      IF (I.EQ.0) GO TO 10
      I = LDM_INTFP (STR(M1:M2), FP, IV, ND)
      IF (I.EQ.2) THEN
         IERR = -3
         ERRSTR = 'Invalid option requested'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
         CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         RETURN
      END IF
      IF (I.EQ.1) THEN
         IF (NNUMS.GE.2) THEN
            IERR = -3
            ERRSTR = 'Inconsistent/duplicate option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            RETURN
         END IF
         IF (IV.LE.0) THEN
            IERR = -3
            ERRSTR = 'Nodal index or number of spots must be positive'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            RETURN
         END IF
         NNUMS = NNUMS + 1
         NSP(NNUMS) = IV
         GO TO 10
      END IF
      NOPT = 5
      CALL GETOPT (OPTS, NOPT, STR(M1:M2), IOPT, KERR)
      IF (KERR.NE.0) THEN
         IERR = -3
         IF (KERR.EQ.1) ERRSTR = 'Ambiguous option'
         IF (KERR.EQ.2) ERRSTR = 'Invalid option'
         ERRSTR2 = 'Option string:'
         CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
         CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
         RETURN
      END IF
      IF (IOPT.EQ.1) THEN
         IF (IPKPL.GT.0) THEN
            IERR = -3
            ERRSTR = 'Inconsistent/duplicate option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            RETURN
         END IF
         IPKPL = 1
      ELSE IF (IOPT.EQ.2) THEN
         IF (IPKPL.GT.0) THEN
            IERR = -3
            ERRSTR = 'Inconsistent/duplicate option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            RETURN
         END IF
         IPKPL = 2
      ELSE IF (IOPT.EQ.3) THEN
         IF (IPKPL.GT.0) THEN
            IERR = -3
            ERRSTR = 'Inconsistent/duplicate option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            RETURN
         END IF
         IPKPL = 3
      ELSE IF (IOPT.EQ.4) THEN
         IF (ICLL.GT.0) THEN
            IERR = -3
            ERRSTR = 'Inconsistent/duplicate option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            RETURN
         END IF
         ICLL = 1
      ELSE IF (IOPT.EQ.5) THEN
         IF (ICLL.GT.0) THEN
            IERR = -3
            ERRSTR = 'Inconsistent/duplicate option'
            ERRSTR2 = 'Option string:'
            CALL STR_ADDS (ERRSTR2, STR(M1:M2),1)
            CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
            RETURN
         END IF
         ICLL = 2
      END IF
      GO TO 10

 20   IF (IPKPL.EQ.0) IPKPL = IPKPL_DF
      IF (IPKPL.LT.1.OR.IPKPL.GT.3) IPKPL = 2
      IF (IPKPL.EQ.1) THEN
         IPK_MIN = IPACK
         IPK_MAX = IPACK
         IPL_MIN = IPLATE
         IPL_MAX = IPLATE
      ELSE IF (IPKPL.EQ.2) THEN
         IPK_MIN = IPACK
         IPK_MAX = IPACK
         IPL_MIN = 1
         IPL_MAX = NPLATES
      ELSE
         IPK_MIN = 1
         IPK_MAX = NPACKS
         IPL_MIN = 1
         IPL_MAX = NPLATES
      END IF

      IF (NNUMS.EQ.1) THEN
         IF (NSP(1).GT.20) THEN
            MINSPOTS_FINAL = NSP(1)
         ELSE
            NIDX_FINAL = NSP(1)
            IF (NIDX_FINAL.LT.4) NIDX_FINAL = 4
            IF (NIDX_FINAL.GT.12) NIDX_FINAL = 12
         END IF
      ELSE IF (NNUMS.EQ.2) THEN
         IF (NSP(1).GT.20) THEN
            MINSPOTS_START = NSP(1)
         ELSE
            NIDX_START = NSP(1)
            IF (NIDX_START.LT.4) NIDX_START = 4
            IF (NIDX_START.GT.12) NIDX_START = 12
         END IF
         IF (NSP(2).GT.20) THEN
            MINSPOTS_FINAL = NSP(2)
         ELSE
            NIDX_FINAL = NSP(2)
            IF (NIDX_FINAL.LT.4) NIDX_FINAL = 4
            IF (NIDX_FINAL.GT.12) NIDX_FINAL = 12
         END IF
      END IF
    
      IF (ICLL.EQ.0) ICLL = ICLL_DF
      IF (ICLL.NE.1.AND.ICLL.NE.2) ICLL = 1
      RFCL = .TRUE.
      IF (ICLL.EQ.2) RFCL = .FALSE.

      CALL LDM_GET_DSTOR (VALSTR, DISTOR_TYPE, LFLAG)

      NPL = IPL_MAX - IPL_MIN + 1
C
C====== Loop through packs and plates required (do plates loop in 2 passes
C====== because of key plate which needs to be refined first)
C
      DO 2020 IPK = IPK_MIN, IPK_MAX
         ICONT_PK = 2
         IF (IPK.EQ.IPK_MAX) ICONT_PK = 0
         IF (IPK.NE.1) THEN
            CALL LDM_GET_KEYP (1, KEYPLATE, LFLAG, KERR, KERRSTR)
            CALL LDM_GET_RFL (1, KEYPLATE, IRFL, LFLAG, KERR, KERRSTR)
            IF (IRFL.NE.1) THEN
               IERR = 1
               ERRSTR = 'Key plate not refined for key pack'
               ERRSTR2 = ' '
               CALL LOG_ERR (IUN_LOG, 0, ERRSTR, ERRSTR2, NEXT)
               RETURN
            END IF
         END IF   
         CALL LDM_GET_KEYP (IPK, KEYPLATE, LFLAG, KERR, KERRSTR)
         IPLC = 0
         DO 2010 IPP = 1, 2
            DO 2000 IPL = IPL_MIN, IPL_MAX
               IPLC = IPLC + 1
               ICONT_PL = 1
               IF (IPLC.EQ.NPL) THEN
                  IF (IPK.EQ.IPK_MAX) THEN
                     ICONT_PL = 0
                  ELSE
                     ICONT_PL = 2
                  END IF
               END IF
               IF (IPP.EQ.1.AND.IPL.NE.KEYPLATE) GO TO 2000
               IF (IPP.EQ.2.AND.IPL.EQ.KEYPLATE) GO TO 2000
               IPACK = IPK
               IPLATE = IPL
               CALL LOG_RESULTS (IUN_LOG, 1, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LOG_RESULTS (IUN_LOG, 2, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LDM_GET_RFL (IPK, KEYPLATE, IRFL, LFLAG, 
     +                           KERR, KERRSTR)
               IF (IPL.NE.KEYPLATE.AND.IRFL.NE.1) THEN
                  IERR = 1
                  ERRSTR = 'Key plate not refined for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  ERRSTR2 = ' '
                  CALL LOG_ERR (IUN_LOG, ICONT_PK, ERRSTR, ERRSTR2, 
     +                          NEXT)
                  IF (.NOT.NEXT) RETURN

                  GO TO 2020
               END IF   
               CALL LDM_SAVERP (IPK, IPL)
               IF (IPK.NE.IMG_PK.OR.IPL.NE.IMG_PL) THEN

                  CALL LOG_RESULTS (IUN_LOG, 3, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)

                  CALL RD_IMG (IPK, IPL, ITYPE, NF_OFF, IMG, 
     +                         MAXIMG, KERR, KERRSTR)

                  CALL LOG_RESULTS (IUN_LOG, 4, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)

                  IF (KERR.NE.0) THEN
                     IERR = 2
                     ERRSTR = 'Error reading image for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     IMG_PK = 0
                     IMG_PL = 0
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IMG_PK = IPK
                  IMG_PL = IPL
               END IF
               IF (CANCEL(0)) GO TO 900
               CALL LDM_GET_XCENF (IPK, IPL, X_CEN_F, LFLAG, ND, 
     +                             KERR, KERRSTR)
               CALL LDM_GET_YCENF (IPK, IPL, Y_CEN_F, LFLAG, ND, 
     +                             KERR, KERRSTR)
               IF (X_CEN_F.LE.0.0.OR.Y_CEN_F.LE.0.0) THEN
                  IERR = 3
                  ERRSTR = 'Centre not defined for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = ' '
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               IF (CANCEL(0)) GO TO 900
               CALL LDM_GET_SPOTL (IPK, IPL, SPOT_L, LFLAG, ND, 
     +                             KERR, KERRSTR)

C
C====== Initial checks
C====== ==============
C
               NIDX = NIDX_START
               CALL LOG_RESULTS (IUN_LOG, 5, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LRL_GEN (IPK, IPL, .TRUE., 2, KERR, KERRSTR)
               IF (KERR.NE.0) THEN
                  IERR = 4
                  ERRSTR = 'Error generating spots list for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = KERRSTR
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               IF (MINSPOTS_START.GT.0) THEN
                  CALL LFN_NODHIST (NNODS, 12, NODMAX)
                  DO 110 I = 1, 12
                     NIDX = I
                     IF (NNODS(NIDX).GE.MINSPOTS_START) GO TO 120
 110              CONTINUE
               END IF     
 120           CALL LOG_RESULTS (IUN_LOG, 6, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LRL_COUNTS (IGEN(1), IGEN(2), IGEN(3), IGEN(4),
     +                          IGEN(5), IGEN(6))
               CALL LOG_RESULTS (IUN_LOG, 7, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LOG_RESULTS (IUN_LOG, 8, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LFN_GET_SPOTS (NIDX, NIDX, NIDX, 0.0, .TRUE., 
     +                             CANCEL, IMG, ITYPE, NF_OFF, 
     +                             MAXHALF, IDATA, IWORK, 
     +                             NSEARCH, NOBS, RMS, KERR, KERRSTR)
               CALL LOG_RESULTS (IUN_LOG, 9, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               OLD_RMS = RMS
               IF (KERR.NE.0) THEN
                  IF (KERR.EQ.-100) GO TO 900
                  IERR = 5
                  ERRSTR = 'Error in spots search for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = KERRSTR
                  CALL LDM_RESTRP (IPK,IPL)
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               CALL LOG_RESULTS (IUN_LOG, 10, IPK, IPL, IGEN,
     +                           NSEARCH, NOBS , 0.0, RMS, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               IF (CANCEL(0)) GO TO 900
               CALL LDM_GET_RFL (IPK, IPL, IRFL, LFLAG, 
     +                           KERR, KERRSTR)
               IF (IRFL.EQ.1.AND.RMS.LE.0.075) GO TO 500
               CALL LFN_NODHIST (NNODS, 12, NODMAX)
               N4 = NNODS(4)
               IF (CANCEL(0)) GO TO 900

               IF (NOBS.GE.N4/2.AND.RMS.LE.0.25) GO TO 400
C
C====== Home in from poor start (if possible)
C====== =====================================
C
               CALL LOG_RESULTS (IUN_LOG,12, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               ICYC = 1
               NOBS_LAST = NOBS
               RMS_LAST = RMS
               TUNE(1) = 0.001
               TUNE(2) = 1.0E-06
               TUNE(3) = 0.5
               GO TO 220

 200           ICYC = ICYC + 1
               IF (CANCEL(0)) GO TO 900
               IF (ICYC.GT.8) THEN
                  IERR = 6
                  ERRSTR = 'Cannot home in on solution for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = ' '
                  CALL LDM_RESTRP (IPK,IPL)
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               CALL LOG_RESULTS (IUN_LOG, 5, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LRL_GEN (IPK, IPL, .TRUE., 2, KERR, KERRSTR)
               IF (KERR.NE.0) THEN
                  IERR = 4
                  ERRSTR = 'Error generating spots list for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = KERRSTR
                  CALL LDM_RESTRP (IPK, IPL)
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               CALL LOG_RESULTS (IUN_LOG, 6, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               IF (CANCEL(0)) GO TO 900
               CALL LRL_COUNTS (IGEN(1), IGEN(2), IGEN(3), IGEN(4),
     +                          IGEN(5), IGEN(6))
               CALL LOG_RESULTS (IUN_LOG, 7, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
 220           SBOX = 2.0*RMS
               IF (SBOX.LT.SPOT_L) SBOX = SPOT_L
               IF (SBOX.GT.1.5) SBOX = -1.5
               CALL LOG_RESULTS (IUN_LOG, 8, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               CALL LFN_GET_SPOTS (NIDX, NIDX, NIDX, SBOX, .TRUE., 
     +                             CANCEL, IMG, ITYPE, NF_OFF, 
     +                             MAXHALF, IDATA, IWORK, 
     +                             NSEARCH, NOBS, RMS, KERR, KERRSTR)
               CALL LOG_RESULTS (IUN_LOG, 9, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               OLD_RMS = RMS
               IF (KERR.NE.0) THEN
                  IF (KERR.EQ.-100) GO TO 900
                  IERR = 5
                  ERRSTR = 'Error in spots search for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = KERRSTR
                  CALL LDM_RESTRP (IPK,IPL)
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               IF (NOBS.LT.5) THEN
                  IERR = 7
                  ERRSTR = 'Less than 5 spots found for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = ' '
                  CALL LDM_RESTRP (IPK,IPL)
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF
               CALL LOG_RESULTS (IUN_LOG, 11, IPK, IPL, IGEN,
     +                           NSEARCH, NOBS , 0.0, RMS, ' ',
     +                           IFLAG, JFLAG, KFLAG)
               KTYP = 1
               IF (NOBS.GE.N4/3) THEN
                  IF (NOBS.GE.N4/2.AND.RMS.LE.0.4) KTYP = 2
                  CALL LFN_RFN_FLGS (IPK, IPL, KTYP, RFCL, 
     +                               IFLAG, JFLAG, KFLAG)              
                  CALL LOG_RESULTS (IUN_LOG, 13, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)


                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 14, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LFN_RFN (IPK, IPL, IFLAG, JFLAG, KFLAG,
     +                          X_CEN_F, Y_CEN_F, 1, TUNE, RMS, 
     +                          KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 15, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)
                  IF (KERR.NE.0.AND.KERR.NE.1) THEN
                     IERR = 8
                     ERRSTR = 'Least squares refinement error for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK,IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 16, IPK, IPL, IGEN,
     +                              NSEARCH, NOBS , OLD_RMS, RMS,
     +                              KERRSTR, IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900                  
               ELSE
                  CALL LFN_RFN_FLGS (IPK, IPL, 1, RFCL, 
     +                               IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  IFLAG(1) = 0
                  IFLAG(2) = 0
                  IFLAG(3) = 0
                  CALL LOG_RESULTS (IUN_LOG, 13, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LOG_RESULTS (IUN_LOG, 14, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LFN_RFN (IPK, IPL, IFLAG, JFLAG, KFLAG, 
     +                          X_CEN_F, Y_CEN_F, 1, TUNE, RMS, 
     +                          KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 15, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (KERR.NE.0.AND.KERR.NE.1) THEN
                     IERR = 8
                     ERRSTR = 'Least squares refinement error for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK,IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 16, IPK, IPL, IGEN,
     +                              NSEARCH, NOBS , OLD_RMS, RMS,
     +                              KERRSTR, IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  IF (IPL.EQ.KEYPLATE) THEN
                     IFLAG(1) = 1
                     IFLAG(2) = 1
                     IFLAG(3) = 1
                     IFLAG(4) = 0
                     IFLAG(5) = 0
                     IFLAG(6) = 0
                     IFLAG(7) = 0
                     CALL LOG_RESULTS (IUN_LOG, 13, IPK, IPL, IGEN,
     +                                 0, 0, 0.0, 0.0, ' ',
     +                                 IFLAG, JFLAG, KFLAG)
                     CALL LOG_RESULTS (IUN_LOG, 14, IPK, IPL, IGEN,
     +                                 0, 0, 0.0, 0.0, ' ',
     +                                 IFLAG, JFLAG, KFLAG)
                     CALL LFN_RFN (IPK, IPL, IFLAG, JFLAG, KFLAG, 
     +                             X_CEN_F, Y_CEN_F, 1, TUNE, RMS, 
     +                             KERR, KERRSTR)
                     CALL LOG_RESULTS (IUN_LOG, 15, IPK, IPL, IGEN,
     +                                 0, 0, 0.0, 0.0, ' ',
     +                                 IFLAG, JFLAG, KFLAG)
                     IF (CANCEL(0)) GO TO 900
                     CALL LOG_RESULTS (IUN_LOG, 16, IPK, IPL, IGEN,
     +                                 NSEARCH, NOBS , OLD_RMS, RMS,
     +                                 KERRSTR, IFLAG, JFLAG, KFLAG)
                     IF (CANCEL(0)) GO TO 900
                  END IF
               END IF
               IF (NOBS.GE.N4/2.AND.RMS.LE.0.25) GO TO 400
               IF (NOBS.GT.NOBS_LAST.OR.
     +            (NOBS.GE.3*NOBS_LAST/4.AND.RMS.LT.RMS_LAST)) THEN
                  NOBS_LAST = NOBS
                  RMS_LAST = RMS
                  GO TO 200
               ELSE
                  IERR = 6
                  ERRSTR = 'Cannot home in on solution for pack'
                  CALL STR_ADDI (ERRSTR, IPK, 1)
                  CALL STR_ADDS (ERRSTR, ', plate',0)
                  CALL STR_ADDI (ERRSTR, IPL, 1)
                  ERRSTR2 = ' '
                  CALL LDM_RESTRP (IPK,IPL)
                  CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                          ERRSTR2, NEXT)
                  IF (.NOT.NEXT) RETURN
                  GO TO 2000
               END IF

C
C====== Main refinement stage
C====== =====================
C
 400           TUNE(1) = 0.001
               TUNE(2) = 1.0E-06
               TUNE(3) = 0.5
               NCYC = 4
               IF (DISTOR_TYPE.EQ.3) NCYC = 7
               CALL LOG_RESULTS (IUN_LOG, 18, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)

               DO 420 ICYC = 1, NCYC
                  IF (CANCEL(0)) GO TO 900
                  IF (DISTOR_TYPE.EQ.3) THEN
                     KTYP = MAIN_CYC_D3(ICYC)
                  ELSE
                     KTYP = MAIN_CYC(ICYC)
                  END IF
                  CALL LOG_RESULTS (IUN_LOG, 5, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LRL_GEN (IPK, IPL, .TRUE., 2, KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 6, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (KERR.NE.0) THEN
                     IERR = 4
                     ERRSTR = 'Error generating spots list for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK, IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  CALL LRL_COUNTS (IGEN(1), IGEN(2), IGEN(3), IGEN(4),
     +                             IGEN(5), IGEN(6))
                  CALL LOG_RESULTS (IUN_LOG, 7, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 8, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LFN_GET_SPOTS (NIDX, NIDX, NIDX, 0.0, .TRUE., 
     +                                CANCEL, IMG, ITYPE, NF_OFF, 
     +                                MAXHALF, IDATA, IWORK, 
     +                                NSEARCH, NOBS, RMS, 
     +                                KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 9, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  OLD_RMS = RMS
                  IF (KERR.NE.0) THEN
                     IF (KERR.EQ.-100) GO TO 900
                     IERR = 5
                     ERRSTR = 'Error in spots search for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK, IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 11, IPK, IPL, IGEN,
     +                              NSEARCH, NOBS , 0.0, RMS, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  CALL LFN_RFN_FLGS (IPK, IPL, KTYP, RFCL, 
     +                               IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 13, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LOG_RESULTS (IUN_LOG, 14, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LFN_RFN (IPK, IPL, IFLAG, JFLAG, KFLAG, 
     +                          X_CEN_F, Y_CEN_F, 1, TUNE, RMS, 
     +                          KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 15, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (KERR.NE.0.AND.KERR.NE.1) THEN
                     IERR = 8
                     ERRSTR = 'Least squares refinement error for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK,IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 16, IPK, IPL, IGEN,
     +                              NSEARCH, NOBS , OLD_RMS, RMS,
     +                              KERRSTR, IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
 420           CONTINUE
C
C====== Final Refinement Stage
C====== ======================
C
 500           NIDX = NIDX_FINAL
               TUNE(1) = 0.001
               TUNE(2) = 1.0E-06
               TUNE(3) = 0.5
               NCYC = 2
               IF (DISTOR_TYPE.EQ.3) NCYC = 4
               CALL LOG_RESULTS (IUN_LOG, 19, IPK, IPL, IGEN,
     +                           0, 0, 0.0, 0.0, ' ',
     +                           IFLAG, JFLAG, KFLAG)

               DO 550 ICYC = 1, NCYC
                  IF (CANCEL(0)) GO TO 900
                  IF (DISTOR_TYPE.EQ.3) THEN
                     KTYP = FINAL_CYC_D3(ICYC)
                  ELSE
                     KTYP = FINAL_CYC(ICYC)
                  END IF
                  CALL LOG_RESULTS (IUN_LOG, 5, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LRL_GEN (IPK, IPL, .TRUE., 2, KERR, KERRSTR)
                  IF (KERR.NE.0) THEN
                     IERR = 4
                     ERRSTR = 'Error generating spots list for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK, IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  CALL LOG_RESULTS (IUN_LOG, 6, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LRL_COUNTS (IGEN(1), IGEN(2), IGEN(3), IGEN(4),
     +                             IGEN(5), IGEN(6))
                  CALL LOG_RESULTS (IUN_LOG, 7, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  IF (MINSPOTS_FINAL.GT.0) THEN
                     CALL LFN_NODHIST (NNODS, 12, NODMAX)
                     DO 510 I = 1, 12
                        NIDX = I
                        IF (NNODS(NIDX).GE.MINSPOTS_FINAL) GO TO 520
 510                 CONTINUE
                  END IF     
 520              CALL LOG_RESULTS (IUN_LOG, 8, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LFN_GET_SPOTS (NIDX, NIDX, NIDX, 0.0, .TRUE., 
     +                                CANCEL, IMG, ITYPE, NF_OFF, 
     +                                MAXHALF, IDATA, IWORK, 
     +                                NSEARCH, NOBS, RMS, 
     +                                KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 9, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  OLD_RMS = RMS
                  IF (KERR.NE.0) THEN
                     IF (KERR.EQ.-100) GO TO 900
                     IERR = 5
                     ERRSTR = 'Error in spots search for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK, IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 11, IPK, IPL, IGEN,
     +                              NSEARCH, NOBS , 0.0, RMS, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  CALL LFN_RFN_FLGS (IPK, IPL, KTYP, RFCL, 
     +                               IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900
                  CALL LOG_RESULTS (IUN_LOG, 13, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LOG_RESULTS (IUN_LOG, 14, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  CALL LFN_RFN (IPK, IPL, IFLAG, JFLAG, KFLAG, 
     +                          X_CEN_F, Y_CEN_F, 1, TUNE, RMS, 
     +                          KERR, KERRSTR)
                  CALL LOG_RESULTS (IUN_LOG, 15, IPK, IPL, IGEN,
     +                              0, 0, 0.0, 0.0, ' ',
     +                              IFLAG, JFLAG, KFLAG)
                  IF (KERR.NE.0.AND.KERR.NE.1) THEN
                     IERR = 8
                     ERRSTR = 'Least squares refinement error for pack'
                     CALL STR_ADDI (ERRSTR, IPK, 1)
                     CALL STR_ADDS (ERRSTR, ', plate',0)
                     CALL STR_ADDI (ERRSTR, IPL, 1)
                     ERRSTR2 = KERRSTR
                     CALL LDM_RESTRP (IPK,IPL)
                     CALL LOG_ERR (IUN_LOG, ICONT_PL, ERRSTR, 
     +                             ERRSTR2, NEXT)
                     IF (.NOT.NEXT) RETURN
                     GO TO 2000
                  END IF
                  IF (CANCEL(0)) GO TO 900
                  I = 16
                  IF (ICYC.EQ.NCYC) I = 17
                  CALL LOG_RESULTS (IUN_LOG, I, IPK, IPL, IGEN,
     +                              NSEARCH, NOBS , OLD_RMS, RMS,
     +                              KERRSTR, IFLAG, JFLAG, KFLAG)
                  IF (CANCEL(0)) GO TO 900

 550           CONTINUE

            CALL LDM_SET_RFL (IPK, IPL, 1, KERR, KERRSTR)

            CALL LFN_AUTO_UPDT (IPK, IPL, IFLAG, KFLAG, UPD)

2000        CONTINUE
2010     CONTINUE
2020  CONTINUE

      CALL LOG_RESULTS (IUN_LOG, 20, 0, 0, IGEN,
     +                  0, 0, 0.0, 0.0, ' ',
     +                  IFLAG, JFLAG, KFLAG)

      RETURN
C
C====== Cancel requested
C
 900  CALL LDM_RESTRP (IPACK, IPLATE)
      CALL LOG_ERR (IUN_LOG, -1, '==Refinement interrupted==', 
     +              ' ', NEXT)
      IERR = 100
      RETURN
      END
