C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*************************
C**     LFN_MTZLIRL     **
C*************************
C
CD-Routine: Read Data from MTZ File to LIRL - LFN_MTZLIRL
C This routine is used to read data from an MTZ integrated reflections
C data file as output by the LAUEGEN or INTLDM programs
C into a Laue Integrated Reflection List (LIRL). The input file must be 
C opened prior to calling the routine and will remain open after the
C routine has been called unless an error is encountered.
CD-end

CD-Fortran:
      SUBROUTINE LFN_MTZLIRL (MINDX, MTZ_INDX, NUMP, IPACK_ID,
     +                        KPACK, IPLATE, NSPOT, IERR)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Read MTZ file and store data in LIRL 
C                 
C
C Author:  John W. Campbell, July 1997
C
C Note:    Input MTZ file must be opened before calling this
C          routine. It will remain open.
C
C Arguments:
C
      INTEGER MINDX
      INTEGER MTZ_INDX
      INTEGER NUMP
      INTEGER IPACK_ID(*)
      INTEGER KPACK(*)
      INTEGER IPLATE
      INTEGER NSPOT
      INTEGER IERR
C
CD-Parameters:
C MINDX          i (R)   Index for LIRL
C MTZ_INDX       i (R)   Index for MTZ file (already opened)
C NUMP           i (R)   Number of packs for which data are to be read
C IPACK_ID()     i (R/W) The pack id's for the NUMP packs - must all
C                        be given (>=0) unless NUMP=1.
C                        IF NUMP=1 and IPACK_ID(1)<0 then the data will
C                        be read for the first pack in the file. The
C                        pack id of the pack will be returned in
C                        IPACK_ID(1). 
C KPACK()        i (R)   The pack numbers (>0) (or indices to pack list)
C                        for the NUMP packs to be stored in the LIRL.
C IPLATE         i (R)   The number of the plate for which the data
C                        are to be stored.
C NSPOT          i (W)   No. of spots added to LIRL
C IERR           i (W)   Error flag = 0 OK
C                                   =-1 Invalid index for LIRL
C                                   = 1 NUMP<=0
C                                   = 2 All required MTZ columns not found
C                                   = 3 Error adding record to LIRL
CD-end
C
C====== Parameter statements
C

C
C====== Function types
C
      INTEGER NBITST
C
C====== LOCALS:
C
      LOGICAL OK
      LOGICAL EOF
      INTEGER I
      INTEGER KSYM
      INTEGER NUMSPOTS
      INTEGER LOOKUP(15)
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER IPK
      INTEGER IPL
      INTEGER KP
      INTEGER MULT
      INTEGER MINHARM
      INTEGER MAXHARM
      INTEGER INCHARM
      INTEGER NOVPIX
      INTEGER IFLAGS
      INTEGER ISPAT
      INTEGER ICLOS
      INTEGER IOVLD
      INTEGER IBAD
      INTEGER IMEAS
      INTEGER KERR
      REAL ADATA(15)
      REAL S
      CHARACTER*30 LABLS(15)
      CHARACTER*1 CTYPS(15)

C     LOGICAL OK             !Columns OK flag
C     LOGICAL EOF            !End of file flag
C     INTEGER I              !Temp/loop variable
C     INTEGER KSYM           !Symmetry flag (dummy)
C     INTEGER NUMSPOTS       !Number of spots in LIRL at start of routine
C     INTEGER LOOKUP(15)     !MTZ lookup flags
C     INTEGER IH             !'h' index
C     INTEGER IK             !'k' index
C     INTEGER IL             !Nodal 'l' index
C     INTEGER IPK            !Pack number
C     INTEGER IPL            !Plate number
C     INTEGER KP             !Pack no./index to put in LIRL
C     INTEGER MULT           !Multiplicity
C     INTEGER MINHARM        !Minimum harmonic no.
C     INTEGER MAXHARM        !Maximum harmonic no.
C     INTEGER INCHARM        !Harmonic increment
C     INTEGER NOVPIX         !No. of overload pixels
C     INTEGER IFLAGS         !Packed flags
C     INTEGER ISPAT          !Spatial overlap flag
C     INTEGER ICLOS          !Spot too close to integrate flag
C     INTEGER IOVLD          !Overload flag
C     INTEGER IBAD           !Bad spot flag
C     INTEGER IMEAS          !Intensity measured flag
C     INTEGER KERR           !Error flag
C     REAL ADATA(15)         !MTZ record buffer
C     REAL S                 !Resolution
C     CHARACTER*30 LABLS(15) !MTZ labels
C     CHARACTER*1 CTYPS(15)  !MTZ column type flags


      DATA LABLS/'H','K','L','PACK_ID','PLATE','XF','YF','LAMBDA',
     +            'I','SIGI','MULT','MINHARM','MAXHARM','NOVPIX',
     +            'FLAGS'/
      DATA CTYPS/'H','H','H','B','I','R','R','R','J','Q','I',
     +           'I','I','R','I'/
C
C------------------------------------------------------------------------------
C

      IERR = 0
      KSYM = 0
      IF (NUMP.LE.0) THEN
         IERR = 1
         CALL LRCLOS(MTZ_INDX)
         RETURN
      END IF
      CALL LIRLF_NUMREFS (MINDX, NUMSPOTS)
      IF (NUMSPOTS.EQ.-1) THEN
         IERR = -1
         CALL LRCLOS(MTZ_INDX)
         RETURN
      END IF
      DO 10 I = 1, 15
         LOOKUP(I) = 1
 10   CONTINUE
      CALL LRASSN(MTZ_INDX, LABLS, 15, LOOKUP, CTYPS)
      OK = .TRUE.
      DO 20 I = 1, 15
         IF (LOOKUP(I).EQ.0) OK = .FALSE.
 20   CONTINUE
      IF (.NOT.OK) THEN
         IERR = 2
         CALL LRCLOS(MTZ_INDX)
         RETURN
      END IF
      CALL LRREWD (MTZ_INDX) 
 100  CALL LRREFF (MTZ_INDX, S, ADATA, EOF)
      IF (EOF) RETURN
      IH = NINT(ADATA(1))
      IK = NINT(ADATA(2))
      IL = NINT(ADATA(3))
      IPK = NINT(ADATA(4))
      IF (NUMP.GT.1.OR.IPACK_ID(1).GE.0) THEN
         DO 120 I = 1, NUMP
            IF (IPK.EQ.IPACK_ID(I)) THEN
               KP = KPACK(I)
               GO TO 130
            END IF
 120     CONTINUE
      ELSE
         IF (IPACK_ID(1).LT.0) THEN
            IPACK_ID(1) = IPK
            KP = KPACK(1)
            GO TO 130
         ELSE
            IF (IPK.EQ.IPACK_ID(1)) THEN
               KP = KPACK(1)
               GO TO 130
            END IF
         END IF
      END IF
      GO TO 100
 130  IPL = NINT(ADATA(5))
      IF (IPLATE.GT.0) THEN
         IF (IPL.NE.IPLATE) GO TO 100
      END IF
      MULT = NINT(ADATA(11))
      MINHARM = NINT(ADATA(12))
      MAXHARM = NINT(ADATA(13))
      NOVPIX = NINT(ADATA(14))
      IFLAGS = NINT(ADATA(15))
      INCHARM = 1
      IF (MULT.GT.1) INCHARM = (MAXHARM-MINHARM)/(MULT-1)
      ISPAT = NBITST(IFLAGS,0,1)
      ICLOS = NBITST(IFLAGS,1,1)
      IOVLD = NBITST(IFLAGS,2,1)
      IBAD = NBITST(IFLAGS,3,1)
      IMEAS = 1
      IF (ADATA(10).EQ.0.0) IMEAS = 0
      CALL LIRLF_ADDREF (MINDX, IH, IK, IL, KP, IPL, KSYM, 
     +                   ADATA(6), ADATA(7), ADATA(8), 
     +                   MULT, MINHARM, MAXHARM, INCHARM, 
     +                   ADATA(9), ADATA(10), ISPAT, ICLOS, IMEAS, 
     +                   IBAD, IOVLD, 0, KERR)
      IF (KERR.NE.0) THEN
         IERR = 3
         CALL LRCLOS(MTZ_INDX)
         RETURN
      END IF
      NSPOT = NSPOT + 1
      CALL LIRLF_SET_OVPIX (MINDX, NUMSPOTS+NSPOT, NOVPIX, KERR)
      GO TO 100
      END
