C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     LSM_ABSCOR_RFN    **
C***************************
C
C
CD-Routine: Refine local absorption correction - LSM_ABSCOR_RFN
C This routine allows for the refinement of the local absorption
C correction parameters for a pack. The classes of data to be used
C must be set up prior to calling LSM_ABSCOR_RFN by calls to
C LSM_SELECT_PKPL and LSM_SELECT_SCREFS.
CD-end
CD-Fortran:
      SUBROUTINE  LSM_ABSCOR_RFN (LINDX, IPACK, REFERENCE, IRFTYP, TUNE,
     +                            FMIN, IERR, MESSAGE)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Refine Local Absorption Correction
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER LINDX, IPACK
      INTEGER IRFTYP
      INTEGER IERR
      REAL TUNE(3)
      REAL FMIN
      LOGICAL REFERENCE
      LOGICAL RETRY
      CHARACTER*(*) MESSAGE
C
CD-Parameters:
C  LINDX       i (R)   The index of the Laue Integrated Reflections List
C  IPACK       i (R)   The pack number of the pack for which the local
C                      absorption correction parameters are to be refined.
C  REFERENCE   l (R)   Flag = .true.  Refine against reference data -
C                                     cf LAUESCALE.
C                                     (Must have called LSM_SELECT_SCREFS
C                                      with REFERENCE = .true.)
C              l            = .false. Refine against current scaled mean
C                                     intensities (internal scaling - cf
C                                     LAUENORM.
C  IRFTYP      i (R)   Refinement routine type =1 Use LSQMIN
C                                              =2 Use LSQMQL
C  TUNE()      r (R)   Tuning parameters specific to the refinement type
C                      If IRFTYP=1 TUNE(1) = shift limit e.g.0.001
C                                  TUNE(2) = step parameter e.g. 1.0E-10
C                                  TUNE(3) = damping factor e.g. 0.5
C                      If IRFTYP=2 TUNE(1) = tolerance (ACC)
C                                  TUNE(2) = step size (H)
C  FMIN        r (W)   The refined function value (sum of squares)
C  IERR        i (W)   Error flag = 0 OK
C                                 =-1 Too little work spce for LSQMIN - 
C                                     try LSQMQL instead
C                                 = 1 Too little work space for LSQMQL
C  MESSAGE     c (W)   Message string from refinement (up to 80 chars)
CD-end
C
C Implementation Notes: Remember to use double precision copies of
C                       TUNE parameters where needed; also FMIN here
C                       returned as a real.
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== FUNCTION TYPES:
C
      EXTERNAL LSM_CALFUN_ABSLOC
      INTEGER LSM_NUM_REFOBS
C
C====== GLOBALS:
C
      INCLUDE 'x_array.finc'
      INCLUDE 'ref_flags.finc'
      INCLUDE 'refine_lsm.finc'      
      INCLUDE 'scp.finc'
C
C====== LOCALS:
C
      INTEGER NREF
      INTEGER KERR
      DOUBLE PRECISION FMINDP
      DOUBLE PRECISION FVECC(MXR)
      DOUBLE PRECISION W(NW) 
      DOUBLE PRECISION X(MAXPACK*MAXCOEFFS)
      DOUBLE PRECISION DTUNE(3)  
C          
C--------------------------------------------------------------------------
C
C
C====== start refinement:
C
      CALL LSM_TOP_LIRL (LINDX, KERR)
 
      NREF = LSM_NUM_REFOBS (LINDX, REFERENCE)
C
C====== Clear refinement flags which use data not found to be present
C
      CALL LSM_MISSING_RFLAGS

      REFSETFLAG = REFERENCE

      CALL LSM_SCP_X (1,X)

      RETRY = .FALSE.
      IF (IRFTYP.EQ.1) THEN
         IF (NW.LT.(NREF+2*NXELE+3)*NXELE + 2*NREF) THEN
            IERR = -1
            MESSAGE = 
     +        'Too little work space for LSQMIN - trying LSQMQL'
            RETRY = .TRUE.
            GO TO 10
         END IF
         DTUNE(1) = TUNE(1)
         DTUNE(2) = TUNE(2)
         DTUNE(3) = TUNE(3)
          CALL LSQMIN(NREF,NXELE,X,DTUNE(1),MAXITR,
     +        DTUNE(2),DTUNE(3),LSM_CALFUN_ABSLOC,FMINDP,FVECC,KERR,W)
         FMIN = FMINDP
      END IF

 10   IF (IRFTYP.EQ.2.OR.RETRY) THEN
         IF (NW.LT.(NREF+2*NXELE+3)*NXELE + 2*NREF) THEN
            IERR = 1
            MESSAGE = 'Too little work space for LSQMQL'
            RETURN
         END IF
         DTUNE(1) = TUNE(1)
         DTUNE(2) = TUNE(2)
         CALL LSQMQL(NREF,NXELE,X,DTUNE(1),DTUNE(2),LSM_CALFUN_ABSLOC,
     +              FMINDP,FVECC,KERR,W)  
         FMIN = FMINDP
      END IF

      CALL LSM_SCP_X (2,X)

      RETURN

      END