C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**   LSM_MERGE_PLATES    **
C***************************
C
C **** LSM SERVICE ROUTINE ONLY ****
C 
      SUBROUTINE LSM_MERGE_PLATES (NR, KPACK, KPLATE, KSM, MODSYM,
     +                             SCAL_INT, SCAL_SIG, ALAMS)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:  Merge data for plates within a pack (will leave data unchanged
C           if all plate nos. are 1)
C
C Author:  Steffi Arzt, John Campbell, Septenber 1997
C
C Arguments:
C
      INTEGER NR
      INTEGER KPACK(*)
      INTEGER KPLATE(*)
      INTEGER KSM(*)
      INTEGER MODSYM(*)
      REAL SCAL_INT(*)
      REAL SCAL_SIG(*)
      REAL ALAMS(*) 
C
C Parameters:
C
C NR          (R/W)   No input/output spots (output are merged)
C KPACK(*)    (R/W)   Pack no., input & output
C KPLATE(*)   (R/W)   Plate no., input & output (output all returned as 1)
C KSM(*)      (R/W)   Symmetry nos., input & output
C MODSYM(*)   (R/W)   MOD(KSYM,2) values, input & output
C SCAL_INT(*) (R/W)   Scale intensities, input & output
C SCAL_SIG(*) (R/W)   Scale sig(I)s, input & output
C ALAMS(*)    (R/W)   Scaled lambdas,  input & output
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C

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

C
C====== LOCALS:
C
      LOGICAL ALL_ONE
      LOGICAL EOL
      INTEGER I
      INTEGER MR
      INTEGER IR
      INTEGER M, M1, M2
      INTEGER KSYMPK_LAST
      INTEGER KSYMPK(MAX_SYMEQ)
      INTEGER INDX(MAX_SYMEQ)
      INTEGER ITEMP(MAX_SYMEQ)
      REAL RTEMP(MAX_SYMEQ)
      REAL SIGMA, SUMINT, SUMSIG, WSUMSIG
      
      EQUIVALENCE (ITEMP(1),RTEMP(1))
C
C-------------------------------------------------------------------------------
C
      ALL_ONE = .TRUE.
      DO 5 I = 1, NR
         IF (KPLATE(I).NE.1) ALL_ONE = .FALSE.
 5    CONTINUE
      IF (ALL_ONE) RETURN
C
C====== Sort input arrays on pack and reflection
C
      DO 10 I = 1, NR
         KSYMPK(I) = 16*KPACK(I)+KSM(I)
 10   CONTINUE
      CALL INDXIV(KSYMPK, NR, INDX)
      DO 20 I = 1, NR
         ITEMP(I) = KPACK(I)
 20   CONTINUE
      DO 25 I = 1, NR
         KPACK(I) = ITEMP(INDX(I))
 25   CONTINUE
      DO 30 I = 1, NR
         ITEMP(I) = KPLATE(I)
 30   CONTINUE
      DO 35 I = 1, NR
         KPLATE(I) = ITEMP(INDX(I))
 35   CONTINUE
      DO 40 I = 1, NR
         ITEMP(I) = KSM(I)
 40   CONTINUE
      DO 45 I = 1, NR
         KSM(I) = ITEMP(INDX(I))
 45   CONTINUE
      DO 50 I = 1, NR
         ITEMP(I) = MODSYM(I)
 50   CONTINUE
      DO 55 I = 1, NR
         MODSYM(I) = ITEMP(INDX(I))
 55   CONTINUE
      DO 60 I = 1, NR
         RTEMP(I) = SCAL_INT(I)
 60   CONTINUE
      DO 65 I = 1, NR
         SCAL_INT(I) = RTEMP(INDX(I))
 65   CONTINUE
      DO 70 I = 1, NR
         RTEMP(I) = SCAL_SIG(I)
 70   CONTINUE
      DO 75 I = 1, NR
         SCAL_SIG(I) = RTEMP(INDX(I))
 75   CONTINUE
      DO 80 I = 1, NR
         RTEMP(I) = ALAMS(I)
 80   CONTINUE
      DO 85 I = 1, NR
         ALAMS(I) = RTEMP(INDX(I))
 85   CONTINUE
C
C====== Now merge plates data
C
      MR = 0
      IR = 1
      EOL = .FALSE.
      KSYMPK_LAST = KSYMPK(1)
      M1 = 1
      M2 = 1
 100  IR = IR + 1
      IF (IR.GT.NR) THEN
         EOL = .TRUE.
         GO TO 120
      END IF
      IF (KSYMPK(IR).EQ.KSYMPK_LAST) GO TO 100

 120  M2 = IR - 1

      SUMINT = 0.0
      SUMSIG = 0.0
      SIGMA = 0.0
      WSUMSIG = 0.0
      DO 130 M = M1, M2
         SUMINT = SUMINT + SCAL_INT(M)/SCAL_SIG(M)**2
         WSUMSIG = WSUMSIG + 1.0/SCAL_SIG(M)**2
         SUMSIG = SUMSIG + SCAL_SIG(M)
 130  CONTINUE
      SUMINT = SUMINT/WSUMSIG
      SUMSIG = SUMSIG/M2
      DO 140 M = M1, M2
         SIGMA = SIGMA + (SCAL_INT(M)-SUMINT)**2
 140  CONTINUE
      SIGMA = SQRT(SIGMA/(M2-1))

      MR = MR + 1
      KPACK(MR) = KPACK(M1)
      KPLATE(MR) = 1
      KSM(MR) = KSM(M1)
      MODSYM(MR) = MODSYM(M1)
      SCAL_INT(MR) = SUMINT
      IF(SIGMA.GT.SUMSIG) THEN
         SCAL_SIG(MR) = SIGMA
      ELSE
         SCAL_SIG(MR) = SUMSIG
      END IF
      ALAMS(MR) = ALAMS(M1)

      IF (.NOT.EOL) THEN
         M1 = IR
         KSYMPK_LAST = KSYMPK(IR)
         GO TO 100
      END IF
C
C====== Return with new NR value
C
      NR = MR

      RETURN

      END