
CD-Section: Re-assign Spatial Overlaps and Multiplicities
C A set of routines have been written to enable an alternative assignment
C of spatially overlapped and multiple spots using revised values of the
C Laue soft limits. This effectively enables some re-processing of the
C data without having to re-integrate spot intensities provided that
C conservative values have been used for the soft limits when the reflection
C list was generated. The re-assigned flags are held separately from the
C original flags and are accessed via the routines described in this section.
CD-end

C LAST UPDATE:
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**      LRL_REASSIGN      **
C****************************
C
CD-Routine: Reassigning spatial overlaps - LRL_REASSIGN
C This routine enables the spatial overlap/multiplicity flags to be 
C re-assigned for different values of the Laue soft limits (lambda-min, 
C lambda-max, dmin) without regenerating the Laue Reflection List. The 
C re-assigned flags are saved separately from the original flags and
C may be accessed via the LRL_GET_REASS routine. The
C LDM values for the soft limits are not reset.
CD-end
CD-Fortran:
      SUBROUTINE  LRL_REASSIGN (IOVTYP, WMIN, WMAX, DMIN,
     +                          IERR, ERRSTR)
CD-end
      INCLUDE 'implicit_none.finc'
C
C Purpose: Sort reflexions in LRL to find and mark spatial overlaps with
C          re-assigned soft limits
C
C
C Author:  John W. Campbell, October 1993 (see also LRL_OVLP)
C
C Arguments:
C
      INTEGER IOVTYP
      REAL WMIN
      REAL WMAX
      REAL DMIN
      INTEGER IERR
      CHARACTER*(*) ERRSTR
CD-Parameters:
C IOVTYP    i (R)   Flag for calculation of spatial overlaps
C                        = 1, analytical calculation (spot + unused
C                             pixel + border) v spot
C                        = 2, analytical calculation (spot + border) v spot
C                        = 3, analytical calculation spot v spot
C                        = 4, mask method (spot + unused pixel + border) 
C                             v spot
C                        = 5, mask method (spot + border) v spot
C                        = 6, mask method spot v spot
C
C WMIN      r (R)   New value for lambda-min
C WMAX      r (R)   New value for lambda-max
C DMIN      r (R)   New value for 'dmin'
C
C                   Note: New lambda soft limits must be within range
C                         of those used in generating the reflection list 
C                         and new 'dmin' must not be lower than that used
C                         generating the reflection list; otherwise the
C                         limits will be reset to meet these conditions
C                         and IERR will be returned with a value of -1
C
C IERR      i (W)  Error flag = 0, OK
C                             =-1, New limits reset to be within range
C                             = 1, Invalid overlaps type flag
C                             = 2, Too many spots in a strip for overlaps 
C                                  check
C ERRSTR    c (W)  Error message string (max 80 characters)
CD-end
C====== Parameter statements:
C
      INCLUDE 'lrl_maxss.finc'
C
C====== GLOBALS:
C
      INCLUDE 'lrl_nodmax.finc'
      INCLUDE 'lrl_data.finc'
C
C====== FUNCTION TYPES:
C 
      LOGICAL LRL_OVQ
      LOGICAL LRL_OVM
      INTEGER NBITST
      LOGICAL LRL_STILLOK
      EXTERNAL LRL_BDAT
C
C====== LOCALS:
C
      LOGICAL    RAD_MASK
      LOGICAL    OVLP
      INTEGER    IFLAG
      INTEGER    ND
      INTEGER    I
      INTEGER    J
      INTEGER    II
      INTEGER    ISPOT
      INTEGER    ISPOT1
      INTEGER    ISPOT2
      INTEGER    N
      INTEGER    NUM_STRIPS
      INTEGER    STRIP
      REAL       XMIN
      REAL       XMAX
      REAL       X_STEP
      REAL       XFD
      REAL       YFD
      REAL       X1
      REAL       Y1
      REAL       X2
      REAL       Y2
      REAL       SPOT_L
      REAL       SPOT_W
      REAL       SPOT_B
      REAL       SPOTFAC
      REAL       MM_RAST_X
      REAL       MM_RAST_Y
      REAL       RASTOMM
      REAL       CTOF
      REAL       RMAX
      REAL       EPSILON
      REAL       DELTAM
      REAL       DELTA2
      REAL       EPSILON2
      REAL       D2
      REAL       X_DIFF
      REAL       Y_DIFF
C
C------------------------------------------------------------------------------
C
      IERR = 0
      ERRSTR = ' '
      IF (NUM_SPOTS.LT.2) RETURN
      DO 10 I = 1, NUM_SPOTS
         CALL STBITS(FLAGS(I),2,2,0)
10    CONTINUE
      IF (IOVTYP.LT.0.OR.IOVTYP.GT.6) THEN
         IERR = 1
         ERRSTR = 'Invalid overlaps calculation flag'
         RETURN
      END IF
      LMIN_NEW = WMIN
      IF (LMIN_NEW.LT.GLMIN) THEN
         IERR = -1
         LMIN_NEW = GLMIN
      END IF
      IF (LMIN_NEW.GT.GLMAX) THEN
         IERR = -1
         LMIN_NEW = GLMAX
      END IF
      LMAX_NEW = WMAX
      IF (LMAX_NEW.GT.GLMAX) THEN
         IERR = -1
         LMAX_NEW = GLMAX
      END IF
      IF (LMAX_NEW.LT.GLMIN) THEN
         IERR = -1
         LMAX_NEW = GLMIN
      END IF
      DMIN_NEW = WMIN
      IF (DMIN_NEW.LT.GDMIN) THEN
         IERR = -1
         DMIN_NEW = GDMIN
      END IF
      DTHR2_NEW = 1.0/ ((DMIN_NEW)**2)

      OVLAP_STATUS = IOVTYP
C
C====== Get delta value or ellipse max. dimension if radial masking
C
      RAD_MASK = .FALSE.
      CALL LDM_GET_SPOTW (IPK, IPL, SPOT_W, IFLAG, ND, 
     +                    IERR, ERRSTR)
      IF (SPOT_W.GT.0.0) RAD_MASK = .TRUE.
      CALL LDM_GET_SPOTL (IPK, IPL, SPOT_L, IFLAG, ND, 
     +                    IERR, ERRSTR)
      IF (RAD_MASK) THEN
         DELTAM = SPOT_L
         CALL LDM_GET_SPOTF (IPK, IPL, SPOTFAC, IFLAG, ND, 
     +                       IERR, ERRSTR)
         CALL LDM_GET_RMAX (RMAX, IFLAG, ND)
         CALL LDM_GET_CTOF (IPK, IPL, CTOF, IFLAG, ND,
     +                         IERR, ERRSTR)
         IF (SPOTFAC.GT.0.0) THEN
            DELTAM = DELTAM*(1.0+SPOTFAC*RMAX/CTOF)       
         END IF
         IF (SPOT_W.GT.DELTAM) DELTAM = SPOT_W
         CALL LDM_GET_SPOTB (IPK, IPL, SPOT_B, IFLAG, ND,
     +                       IERR, ERRSTR)
         DELTAM = DELTAM + (1.0+SPOT_B)*RASTOMM
      ELSE
         CALL LDM_GET_SPOTD (IPK, IPL, DELTAM, IFLAG, ND,
     +                       IERR, ERRSTR)
      END IF
C
C====== Adjust delta to a minimum of 10 micron
C
      DELTAM = MAX(DELTAM,0.01)
      DELTA2 = DELTAM**2
      CALL LDM_GET_EPS (EPSILON, IFLAG, ND)
      EPSILON2 = EPSILON**2

      CALL LDM_MMRAST (IPK, IPL, MM_RAST_X, MM_RAST_Y)
      RASTOMM = 1.0/MM_RAST_X

      NUM_SPAT = 0
      NUM_CLOS = 0

C
C====== Sort spot list on 'yfd' 
C
      CALL LRL_SORT (4)
C
C====== To allow for fact that some strips will contain more spots
C====== than others, fill strips half full on average.
C====== Besides this, it seems to be necessary to take a few extra strips.
C====== (Currently 2 extra)
C====== Changed again for Janos  28 Feb 87 (/3 rather than /2)
C
      NUM_STRIPS = NUM_SPOTS/(MAX_SPOTS_IN_STRIP/3.0) + 1 + 1
C
C====== Loop through the strips
C
      X_STEP = (XEND-XSTART)/NUM_STRIPS
      XMIN = XSTART - DELTAM - X_STEP
      XMAX = XMIN + X_STEP + 2.0*DELTAM
      DO 70 STRIP = 1 , NUM_STRIPS
         N = 0
         XMIN = XMIN + X_STEP
         XMAX = XMAX + X_STEP
         ISPOT = 0
C
C====== Read through & sort reflexions
C
 30      ISPOT = ISPOT + 1
         IF (ISPOT.GT.NUM_SPOTS) THEN
C
C======  O.K. now we have finished reading...
C======  ...so sort the spots within the strip
C
            IF (N.EQ.0) GO TO 70
C
C====== Loop over each spot within the strip
C
            IF (N.GT.1) THEN
               DO 60 I = 1 , N - 1
                  DO 50 J = I + 1 , N
                     ISPOT1 = IWORK1(I)
                     ISPOT2 = IWORK1(J)
                     X1 = XF_D(ISPOT1)
                     Y1 = YF_D(ISPOT1)
                     X2 = XF_D(ISPOT2)
                     Y2 = YF_D(ISPOT2)
C
C====== If y difference exceeds delta then finish spot i.
C
                     Y_DIFF = ABS(Y1-Y2)
                     IF (Y_DIFF.GT.DELTAM) GO TO 60
C
C====== If y difference is possible then check x difference.
C
                     X_DIFF = ABS(X1-X2)
                     IF (X_DIFF.LE.DELTAM) THEN
C
C====== If both are possible then check precise difference.
C====== (Further approximation just if radial masking in use)
C
                        D2 = X_DIFF**2 + Y_DIFF**2
                        IF (D2.LE.DELTA2) THEN
C
C====== An overlap of some sort ... set both non-measurable and count.
C
                           IF (D2.LE.EPSILON2) THEN
C
C====== Some spot with spatial overlap, but too close to separate.
C====== Do not count twice! (set spatial overlap & too-close flags)
C
                              IF (NBITST(FLAGS(ISPOT1),3,1).EQ.0) THEN
                                 CALL STBITS (FLAGS(ISPOT1),2,2,3)
                                 NUM_CLOS = NUM_CLOS + 1
                              END IF

                              IF (NBITST(FLAGS(ISPOT2),3,1).EQ.0) THEN
                                 CALL STBITS (FLAGS(ISPOT2),2,2,3)
                                 NUM_CLOS = NUM_CLOS + 1
                              END IF

                           ELSE
C
C====== Some spot with spatial overlap, suitable for separation.
C====== (Further check needed if radial masking in use)
C
C====== Radial masking code makes approximation that overlapping
C====== Spots have the same size of ellipse and are in the same
C====== orientation
C
                              OVLP = .TRUE.
                              IF (RAD_MASK) THEN
                                 IF (IOVTYP.LE.3) THEN
                                    OVLP = LRL_OVQ (SPOT_L, SPOT_W,
     +                                     SPOTFAC, SPOT_B, CTOF,
     +                                     RASTOMM, X1, Y1, X2, Y2,
     +                                     IOVTYP)
                                 ELSE
                                    OVLP = LRL_OVM (SPOT_L, SPOT_W,
     +                                     SPOTFAC, SPOT_B, CTOF,
     +                                     MM_RAST_X, MM_RAST_Y, 
     +                                     X1, Y1, X2, Y2, IOVTYP-3)
                                 END IF
                              END IF

                              IF (OVLP) THEN
                                 IF (NBITST(FLAGS(ISPOT1),2,1).EQ.0) 
     +                              THEN
                                    CALL STBITS (FLAGS(ISPOT1),2,1,1)
                                    NUM_SPAT = NUM_SPAT + 1
                                 END IF
   
                                 IF (NBITST(FLAGS(ISPOT2),2,1).EQ.0) 
     +                              THEN
                                    CALL STBITS (FLAGS(ISPOT2),2,1,1)
                                    NUM_SPAT = NUM_SPAT + 1
                                 END IF
                              END IF
                           END IF
                        END IF
                     END IF

 50               CONTINUE
C
C====== End of loop through the strip of spots
C
 60            CONTINUE
            END IF
         ELSE
 65         II = INDX(ISPOT)
            IF (.NOT.LRL_STILLOK(II)) THEN
               ISPOT = ISPOT + 1
               IF (ISPOT.LE.NUM_SPOTS) GO TO 65
               ISPOT = NUM_SPOTS
               GO TO 30
            END IF
            XFD = XF_D(II)
            YFD = YF_D(II)
            IF (XFD.GE.XMIN .AND. XFD.LE.XMAX) THEN
C
C====== Add spot to strip, whilst checking for too many spots in strip
C
               N = N + 1
               IF (N.GT.MAX_SPOTS_IN_STRIP) THEN
                  IERR = 2
                  ERRSTR = 'Too many spots in a strip for overlaps -'
                  CALL STR_ADDS (ERRSTR,'program limit of',1)
                  CALL STR_ADDI (ERRSTR,MAX_SPOTS_IN_STRIP,1)
                  CALL STR_ADDS (ERRSTR,'exceeded',1)
                  RETURN
               END IF

               IWORK1(N) = II
            END IF
C
C====== Loop for more reflexions
C
            GO TO 30
         END IF
C
C====== End of loop over the strips
C
 70   CONTINUE
      RETURN
      END
