C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LFN_SOFT         **
C**************************
C
CD-Routine: Find Improved Soft Limit - LFN_SOFT
C This routine determines an improved value for the 'dmin' or 'lambda-min'
C soft limits used in the processing of Laue data. The method involves
C over predicting the data, measuring integrated intensities and examining
C the statistics of the integrated intensities as a function of resolution
C or wavelength respectively. A preferred value is returned by the routine
C as well as the statistical data which may be further examined.
CD-end
CD-Fortran:
      SUBROUTINE LFN_SOFT (IPACK, IPLATE, IOPT, IMG, ITYPE, IORDER,
     +                     NF_OFF, NAX1_RASTS, NAX2_RASTS, PROMIN,
     +                     NTHE, PROF_ROT, PROGRESS, CANCEL, 
     +                     FRAC, SIGTEST, FRTEST, NUMBINS, BIN_WIDTH,
     +                     NTOT_MEAS, NTOT_GTSIG, NMEAS, NGTSIG, RBIN,
     +                     SOFT_MIN, SOFT_MAX, SOFT_SEL, IBIN_SEL,
     +                     IERR, ERRSTR, IWARN, WARNSTR)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Determine soft limit
C
C Author:  Q. Hao, J. W. Campbell, March 1994
C
C Arguments:
C
      INTEGER IPACK
      INTEGER IPLATE 
      INTEGER IOPT
      INTEGER IMG(*)
      INTEGER ITYPE
      INTEGER IORDER
      INTEGER NF_OFF
      INTEGER NAX1_RASTS
      INTEGER NAX2_RASTS
      REAL PROMIN
      INTEGER NTHE
      LOGICAL PROF_ROT
      EXTERNAL PROGRESS
      LOGICAL CANCEL
      EXTERNAL CANCEL
      REAL FRAC
      REAL SIGTEST
      REAL FRTEST
      INTEGER NUMBINS
      REAL BIN_WIDTH
      INTEGER NTOT_MEAS
      INTEGER NTOT_GTSIG
      INTEGER NMEAS(NUMBINS)
      INTEGER NGTSIG(NUMBINS)
      REAL RBIN(NUMBINS)
      REAL SOFT_MIN
      REAL SOFT_MAX
      REAL SOFT_SEL
      INTEGER IBIN_SEL
      INTEGER IERR
      CHARACTER*(*) ERRSTR
      INTEGER IWARN
      CHARACTER*(*) WARNSTR
CD-Parameters:
C   IPACK      i (R) Pack number
C   IPLATE     i (R) Plate number
C   IOPT       i (R) Option =1 Dmin soft limit determination
C                          =2 Lambda-min soft limit determination
C   IMG (*)    i (R) Image data array (may hold signed integer data or
C                    unsigned byte data packed into an integer array or
C                    unsigned two byte data packed into an integer array
C                    or squashed i2 data packed into an integer array
C   ITYPE      i (R) Image data type =1 unsigned byte
C                                    =2 unsigned two byte
C                                    =3 signed (full) integer
C                                    =4 squashed i2 data
C   IORDER     i (R) Order of data in image wrt. the two local axes
C                    =1 +ax1 +ax2
C                    =2 +ax1 -ax2
C                    =3 -ax1 +ax2
C                    =4 -ax1 -ax2
C                    =5 +ax2 +ax1
C                    =6 +ax2 -ax1
C                    =7 -ax2 +ax1
C                    =8 -ax2 -ax1
C   NF_OFF     i (R) Fast offset between (slow) rasters of image (e.g. 1'st
C                    dimension of the image data if the data are held in
C                    a two dimensional array). This value is the number
C                    of elements for the image data type (bytes, 2-bytes
C                    or integers as set by ITYPE)
C   NAX1_RASTS i (R) No. of rasters in the image along the first 
C                    local axis 
C   NAX2_RASTS i (R) No. of rasters in the image along the second 
C                    local axis
C   PROMIN     r (R) Minimum intensity to include in profile determination
C                    e.g. 100 for film, 600 for image plate
C   NTHE       i (R) Number of theta bins for profile fitting (e.g. 8,
C                    max=17 unless program limit was reset)
C   PROF_ROT   l (R) Rotate profiles for elliptical spots integrattion
C                    flag
C   PROGRESS     ( ) Subroutine which will be called at intervals during
C                    the integration which may be used to display its 
C                    progress if required (See below for its arguments).
C                    If not required, the dummy routine LFN_SOFT_PROG
C                    may be passed. Note that the routine must be
C                    declared as EXTERNAL in the calling program.
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   FRAC       r (R) Fraction of current soft limit for use in reflection
C                    generation (suggested value = 0.8)
C   SIGTEST    r (R) No. of sigmas to be used for determining significant
C                    intensities for statistics (suggested value = 5.0)
C   FRTEST     r (R) Fraction for population of significant reflections
C                    just above soft limit (suggested value = 0.15)
C   NUMBINS    i (R) Number of bins to use (suggested value = 20)
C   BIN_WIDTH  r (R) Width of soft limit bins (suggest 0.02 if current
C                    value <=0.5, 0.05 if >0.5 and <= 1.0 and 0.1 if > 1.0
C   NTOT_MEAS  i (W) Total number of measured spots
C   NTOT_GTSIG i (W) Total number of significant spots
C   NMEAS(*)   i (W) Number of measured spots in each bin (dimensioned 
C                    to at least NUMBINS)
C   NGTSIG(*)  i (W) Number of significant spots in each bin (dimensioned 
C                    to at least NUMBINS)
C   RBIN(*)    r (W) Ratios of significant to measured spots in each bin
C                    (dimensioned to at least NUMBINS)
C   SOFT_MIN   r (W) Soft limit minimum used (rounded down to nearest
C                    bin_width multiple value)
C   SOFT_MAX   r (W) Soft limit maximum used
C   SOFT_SEL   r (W) Selected value for the soft limit
C   IBIN_SEL   i (W) Selected bin number (just above selected soft limit)
C   IERR       i (W) Error flag =  0, OK
C                               = -1, Invalid pack number
C                               = -2, Invalid plate number
C                               = -3, Invalid image type or order flag
C                               = -4, Byte handling not available
C                               =  1, Box size required based on spot size
C                                     exceeds current program limits
C                               =  2, Too many bins requested for profile 
C                                     fitting
C                               =  3, Less than 2 bins requested for
C                                     statistics
C                               = 100 Procedure interrupted
C   ERRSTR     c (W) Error message string (max 80 chars) set if IERR is 
C                    non-zero
C   IWARN      i (W) Warning flag = 0 OK (provided IERR = 0)
C                                 = 1 No bin has 10 or more significant 
C                                     reflections
C                                 = 2 First bin selected; soft limit needs
C                                     to be determined with a lower start
C                                     value
C                                 = 3 Less than five significant reflection
C                                     in selected 'above soft limit' bin
C   WARNSTR    c (W) Warning message string if IWARN is non-zero
C
C 
C                    Subroutine PROGRESS (IPASS, NSPOT, ISPOT)
C
C                    This routine is passed on to the integration routine
C                    LFN_SAINT which will call it with the following
C                    parameters:-
C
C                        IPASS i (R) Integration pass = 0 box integration,
C                                                     = 1 get profiles,
C                                                     = 2 profile fitted
C                                                         integration
C                        NSPOT i (R) No. of spots to be integrated
C                        ISPOT i (W) Last spot integrated
CD-end
C====== Parameter statements
C 

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

C
C====== LOCALS:
C
      LOGICAL NODF
      LOGICAL SPAT
      LOGICAL BAD
      LOGICAL OVL
      LOGICAL MS
      INTEGER I
      INTEGER N
      INTEGER IFLAG
      INTEGER ND
      INTEGER NTOT_SPOTS
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER MULT
      INTEGER JERR
      INTEGER ICODE
      INTEGER ICT
      INTEGER IBIN
      REAL DMIN_SAV
      REAL LMIN_SAV
      REAL XF
      REAL YF
      REAL AI
      REAL ASIG
      REAL BLAM
      REAL DTHR
      REAL X
      REAL RBINMAX
      CHARACTER*2 ERR2

C      LOGICAL NODF           !OK nodal flag
C      LOGICAL SPAT           !Spatial overlap flag
C      LOGICAL BAD            !Bad spot flag
C      LOGICAL OVL            !Overload spot flag
C      LOGICAL MS             !Spot measured flag
C      INTEGER I              !Temp/loop variable
C      INTEGER N              !Temp/loop variable
C      INTEGER IFLAG          !Flag from LDM routines
C      INTEGER ND             !No. of decimal places from LDM routines
C      INTEGER NTOT_SPOTS     !Total no. of spots generated
C      INTEGER IH             !'h' index
C      INTEGER IK             !'k' index
C      INTEGER IL             !'l' index
C      INTEGER MULT           !Multiplicity
C      INTEGER JERR           !Error flag
C      INTEGER ICODE          !Integration code
C      INTEGER ICT            !Integration code type flag
C      INTEGER IBIN           !Bin number
C      REAL DMIN_SAV          !Saves original dmin
C      REAL LMIN_SAV          !Saves original lambda-min
C      REAL XF                !Spot xf position
C      REAL YF                !Spot yf position
C      REAL AI                !Spot intensity
C      REAL ASIG              !Spot sigma(Intensity)
C      REAL BLAM              !Spot lambda
C      REAL DTHR              !Spot dmin threshold sq.
C      REAL X                 !Soft limit parameter value of current spot
C      REAL RBINMAX           !Maximum bin significant/measured ratio
C      CHARACTER*2 ERR2       !Dummy error string
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      IERR = 0
      ERRSTR = ' '
      IWARN = 0
      WARNSTR = ' '
      SOFT_SEL = 0.0
      SOFT_MIN = 0.0
      SOFT_MAX = 0.0
      IBIN_SEL = 0
      NTOT_MEAS = 0
      NTOT_GTSIG = 0
      IF (NUMBINS.LT.2) THEN
         IERR = 3
         ERRSTR = 'Less than 2 bins specified'
         RETURN
      END IF
      DO 10 I = 1, NUMBINS
         NMEAS(I) = 0
         NGTSIG(I) = 0
         RBIN(I) = 0.0
10    CONTINUE
C
C====== Get low soft limit value
C
      IF (IOPT.EQ.1) THEN
         CALL LDM_GET_DMIN (IPACK, DMIN_SAV, IFLAG, ND, IERR, ERRSTR)
         IF (IERR.NE.0) RETURN
         SOFT_MIN = FRAC*DMIN_SAV
      ELSE
         CALL LDM_GET_LMIN (IPACK, LMIN_SAV, IFLAG, ND, IERR, ERRSTR)
         IF (IERR.NE.0) RETURN
         SOFT_MIN = FRAC*LMIN_SAV
      END IF
      SOFT_MIN = INT(SOFT_MIN/BIN_WIDTH)*BIN_WIDTH
      SOFT_MAX = SOFT_MIN + NUMBINS*BIN_WIDTH
      IF (IOPT.EQ.1) THEN
         CALL LDM_SET_DMIN (IPACK, SOFT_MIN, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
      ELSE
         CALL LDM_SET_LMIN (IPACK, SOFT_MIN, IERR, ERRSTR)
         IF (IERR.NE.0) GO TO 800
      END IF
C
C====== Generate reflections & store
C
      CALL LRL_GEN (IPACK, IPLATE, .TRUE., 2, IERR, ERRSTR)
      IF (IERR.NE.0) GO TO 800
C
C====== Sort on slowest moving index in image array
C
      IF (IORDER.LE.4) THEN
         CALL LRL_SORT (3)
      ELSE
         CALL LRL_SORT (4)
      END IF
C
C====== Integrate
C
      CALL LFN_SAINT (IPACK, IPLATE, 1, IMG, ITYPE, IORDER, 
     +                NF_OFF, NAX1_RASTS, NAX2_RASTS, PROMIN,
     +                NTHE, PROF_ROT, 0, PROGRESS, CANCEL, 
     +                IERR, ERRSTR)
      IF (IERR.NE.0) GO TO 800
      CALL LFN_SAINT (IPACK, IPLATE, 2, IMG, ITYPE, IORDER,
     +                NF_OFF, NAX1_RASTS, NAX2_RASTS, PROMIN,
     +                NTHE, PROF_ROT, 0, PROGRESS, CANCEL, 
     +                IERR, ERRSTR)
      IF (IERR.NE.0) GO TO 800
C
C====== Accumulate Statistics
C
      CALL LRL_NUMSPOTS(NTOT_SPOTS)
      IF (NTOT_SPOTS.LT.1) GO TO 800
      DO 200 N = 1, NTOT_SPOTS
         CALL LRL_GET (N, IH, IK, IL, XF, YF, BLAM, DTHR, MULT,
     +                 NODF, SPAT, JERR)
         IF (MULT.EQ.1.AND..NOT.SPAT) THEN
            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_MIN.OR.X.GT.SOFT_MAX) GO TO 200
            IBIN = NUMBINS*(X-SOFT_MIN)/(SOFT_MAX-SOFT_MIN) + 1
            IF (IBIN.LT.1) IBIN = 1
            IF (IBIN.GT.NUMBINS) IBIN = NUMBINS
            NMEAS(IBIN) = NMEAS(IBIN) + 1
            NTOT_MEAS = NTOT_MEAS + 1
            IF (AI.GT.SIGTEST*ASIG) THEN
               NGTSIG(IBIN) = NGTSIG(IBIN) + 1
               NTOT_GTSIG = NTOT_GTSIG + 1
            END IF
         END IF
         IF (CANCEL(0)) THEN
            IERR = 100
            ERRSTR = 'Procedure interrupted'
            RETURN
         END IF
200   CONTINUE
C
C====== Get ratios
C
      RBINMAX = 0.0
      DO 220 I = 1, NUMBINS
         IF (NMEAS(I).GT.0) THEN
            RBIN(I) = FLOAT(NGTSIG(I))/FLOAT(NMEAS(I))
         ELSE
            RBIN(I) = 0.0
         END IF
         IF (RBIN(I).GT.RBINMAX.AND.NGTSIG(I).GE.10) RBINMAX = RBIN(I)
220   CONTINUE
      IF (RBINMAX.EQ.0.0) THEN
         IWARN = 1
         WARNSTR = 'No bin has 10 or more significant spots'
         GO TO 800
      END IF
      IF (CANCEL(0)) THEN
         IERR = 100
         ERRSTR = 'Procedure interrupted'
         RETURN
      END IF
C
C====== Find soft limit value
C
      DO 250 I = 1, NUMBINS
         IBIN = I
         IF (RBIN(I)/RBINMAX.GE.FRTEST) GO TO 280
250   CONTINUE
280   SOFT_SEL = SOFT_MIN + (IBIN-1)*(SOFT_MAX-SOFT_MIN)/NUMBINS
      IBIN_SEL = IBIN
      IF (IBIN_SEL.EQ.1) THEN
         IWARN = 2
         WARNSTR = 'Need to retry with lower start limit'
      END IF
      IF (NGTSIG(IBIN).LT.5) THEN
         IWARN = 3
         WARNSTR = 'Selected bin has < 5 significant spots'
         GO TO 800
      END IF
      IF (CANCEL(0)) THEN
         IERR = 100
         ERRSTR = 'Procedure interrupted'
         RETURN
      END IF
C
C====== Reset limits
C
800   IF (IOPT.EQ.1) THEN
         CALL LDM_SET_DMIN (IPACK, DMIN_SAV, JERR, ERR2)
      ELSE
         CALL LDM_SET_LMIN (IPACK, LMIN_SAV, JERR, ERR2)
      END IF
      RETURN
      END
