C
C**********************
C Program COMBINE    **
C**********************
C
C Purpose: to combine singles and deconvoluted multiples
C
	DIMENSION ADATA1(100),IDATA1(3),ADATA2(100),IDATA2(3)
	INTEGER IPOINT(5)
	CHARACTER*30 LAB1(5)
	CHARACTER*1 CTYP(5) 
	LOGICAL EOF
	DATA LAB1/'H','K','L','F','SIGF'/
	DATA CTYP/'H','H','H','F','Q'/
        WRITE(6,*)  
        WRITE(6,*)' Program:     COMBINE' 
        WRITE(6,*)' Last update: 01/07/93'
        WRITE(6,*)' Author:     Q.Hao'
        WRITE(6,*)
        NTOTAL = 0  
	DO 75  I =1,5
	IPOINT(I)=-1
75	CONTINUE
        DO 76 I = 1, 100
           ADATA1(I) = 0.0
           ADATA2(I) = 0.0
76      CONTINUE
	CALL LROPEN (1,'HKLIN1',1,IFAIL)
	IF (IFAIL.EQ.1) STOP
	CALL LROPEN (2,'HKLIN2',1,IFAIL)
	IF (IFAIL.EQ.1) STOP
	CALL LRASSN (1,LAB1,5,IPOINT,CTYP)
	CALL LRASSN (2,LAB1,5,IPOINT,CTYP)
        CALL LWOPEN (2,'HKLOUT')
20	CALL LRREFF(1,RESOL,ADATA1,EOF)
        IDATA1(1) = NINT(ADATA1(1))
        IDATA1(2) = NINT(ADATA1(2))
        IDATA1(3) = NINT(ADATA1(3))
	IF (EOF) CALL ENDMARK(IDATA1)   
	CALL LRREFF(2,RESOL,ADATA2,EOF)
        IDATA2(1) = NINT(ADATA2(1))
        IDATA2(2) = NINT(ADATA2(2))
        IDATA2(3) = NINT(ADATA2(3))
	IF (EOF) CALL ENDMARK(IDATA2)   
30	IF (ICMPR(IDATA1,IDATA2).LT.0) THEN
	CALL LWREFL (2,ADATA1)
        NTOTAL = NTOTAL + 1
	CALL LRREFF(1,RESOL,ADATA1,EOF)
        IDATA1(1) = NINT(ADATA1(1))
        IDATA1(2) = NINT(ADATA1(2))
        IDATA1(3) = NINT(ADATA1(3))
	IF (EOF) CALL ENDMARK(IDATA1)   
        GOTO 30
	ELSE 	
	IF (ICMPR(IDATA1,IDATA2).EQ.0) THEN
C MATCHING REFLECTION FOUND
        IF (IDATA1(1).EQ.999) GOTO 50
	CALL LWREFL (2,ADATA2)
        NTOTAL = NTOTAL + 1
        ELSE
	CALL LWREFL (2,ADATA2)
        NTOTAL = NTOTAL + 1
	CALL LRREFF(2,RESOL,ADATA2,EOF)
        IDATA2(1) = NINT(ADATA2(1))
        IDATA2(2) = NINT(ADATA2(2))
        IDATA2(3) = NINT(ADATA2(3))
	IF (EOF) CALL ENDMARK(IDATA2)   
    	GOTO 30
	ENDIF
        ENDIF
	GOTO 	20
50      CALL LWCLOS(2,1)
        WRITE (6,60)NTOTAL
60      FORMAT(' TOTAL NUMBER OF REFLECTIONS =', I8)
        STOP
        END
**==icmpr.f  
C
C FUNCTION 'ICMPR'
C ================
C
C THIS FUNCTION COMPARES THE INDICES OF A LAUE REFLECTION WITH THE
C INDICES OF A STANDARD REFLECTION
C
      FUNCTION ICMPR(IHKL1,IHKL2)
C
C PARAMETERS
C
C       IHKL1 (I)   3 WORD ARRAY HOLDING LAUE REFLN INDICES
C       IHKL2 (I)   3 WORD ARRAY HOLDING STANDARD REFLN INDICES
C
C RETURNS  -1  LAUE < STANDARD
C           0  LAUE = STANDARD
C           1  LAUE > STANDARD
C
C SPECIFICATION STATEMENTS
C ------------------------
C
      DIMENSION IHKL1(3),IHKL2(3)
C
C COMPARE INDICES
C ---------------
C
      ICMPR = 0
      DO 20 I = 1 , 3
         IF (IHKL1(I).LT.IHKL2(I)) GO TO 30
         IF (IHKL1(I).NE.IHKL2(I)) GO TO 40
 20   CONTINUE
      RETURN
C
C LAUE < STANDARD
C
 30   ICMPR = -1
      RETURN
C
C LAUE > STANDARD
C
 40   ICMPR = 1
      RETURN
      END
**==endmark.f
      SUBROUTINE ENDMARK(IHKL)
      DIMENSION IHKL(3)
      IHKL(1)=999
      IHKL(2)=999
      IHKL(3)=999
      RETURN
      END