
CD-Section: Read Data into LIRL
C These routines are for reading reflections data (with intensities) from 
C .ge1/.ge2 files or an MTZ file as output by LAUEGEN into a Laue Integrated 
C Reflection List (LIRL).
CD-end

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*************************
C**     LFN_GELIRL      **
C*************************
C
CD-Routine: Read Data from .ge1/.ge2 Files to LIRL - LFN_GELIRL
C This routine is used to read data from a pair of .ge1/.ge2 files 
C into a Laue Integrated Reflection List (LIRL). The input files must be 
C opened prior to calling the routine and will remain open after the
C routine has been called. Data are only copied for plates for which
C at least one measured intensity is recorded. Certain irems have flags
C stored instead of intensity/sigma values. Such reflections will normally
C be excluded from calulations but the following values will be assigned
C for the following cases: not-measured II=0, SIGI=0; overload II=32767,
C SIGI=1000; bad spot II as stored, SIGI=1000.
CD-end

CD-Fortran:
      SUBROUTINE LFN_GELIRL (MINDX, IUN_GE1, IUN_GE2, IPLATE, KPACK, 
     +                       NSPOT, IERR)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Read  .ge1/.ge2 files and store data in LIRL 
C                 
C
C Author:  John W. Campbell, July 1997
C
C Note:    Input .ge1/.ge2 files must be opened before calling this
C          routine. They will remain open.
C
C Arguments:
C
      INTEGER MINDX
      INTEGER IUN_GE1
      INTEGER IUN_GE2
      INTEGER IPLATE
      INTEGER KPACK
      INTEGER NSPOT
      INTEGER IERR
C
CD-Parameters:
C MINDX          i (R)   Index for LIRL
C IUN_GE1        i (R)   Unit no. for .ge1 file (already opened)
C IUN_GE2        i (R)   Unit no. for .ge2 file (already opened)
C IPLATE         i (R)   Copy data for this plate. 0=all plates
C                        for which any measured intensities recorded
C KPACK          i (R)   Pack number (>0) (or index to pack list)
C                        to be stored in the LIRL for this set
C                        of data.
C NSPOT          i (W)   No. of spots added to LIRL
C IERR           i (W)   Error flag = 0 OK
C                                   = 1 Error reading .ge1 file
C                                   = 2 Error reading .ge2 file
C                                   = 3 Error adding record to LIRL
CD-end
C
C====== Parameter statements
C

C
C====== Function types
C
      INTEGER NBITST
      INTEGER LRL_HCF
C
C====== LOCALS:
C
      LOGICAL MEAS(6)
      INTEGER KSYM
      INTEGER NSP
      INTEGER IDUM
      INTEGER JDUM
      INTEGER NREC
      INTEGER IREC
      INTEGER IBUFF(12)
      INTEGER IMULT
      INTEGER NDXHKL
      INTEGER IPOINT
      INTEGER MULTF(1)
      INTEGER MHKL(4)
      INTEGER INTP(6)
      INTEGER ISIGP(6)
      INTEGER IFILM
      INTEGER II
      INTEGER ISIG
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER H1
      INTEGER K1
      INTEGER L1
      INTEGER HCF1
      INTEGER HCF2
      INTEGER NH
      INTEGER NK
      INTEGER NL
      INTEGER MULT
      INTEGER ISPAT
      INTEGER ICLOS
      INTEGER IMEAS
      INTEGER IBAD
      INTEGER IOVLD
      INTEGER KERR
      INTEGER MINHARM
      INTEGER MAXHARM
      INTEGER INCHARM
      INTEGER JREC
      INTEGER MLTHKL
      INTEGER HKL2(4)
      INTEGER NMFLAG
      INTEGER JH
      INTEGER JK
      INTEGER JL
      REAL XFD
      REAL YFD
      REAL ALBDA
      REAL RINT
      REAL AI
      REAL SIGI

C     LOGICAL MEAS(6)        !Film/plate measured flags
C     INTEGER KSYM           !Symmetry flag (dummy)
C     INTEGER NSP            !No. of spots in .ge1 file
C     INTEGER IDUM           !Dummy integer
C     INTEGER JDUM           !Dummy integer
C     INTEGER NREC           !No. of records in .ge1 file
C     INTEGER IREC           !Record counter through .ge1 file
C     INTEGER IBUFF(12)      !Buffer for reading part of .ge1 file record
C     INTEGER IMULT          !Multiplicity/indices flag
C     INTEGER NDXHKL         !Nodal indices/flag
C     INTEGER IPOINT         !Pointer to .ge2 file record (equiv. RINT)
C     INTEGER MULTF(1)       !Array to return multiplicity from packed flag
C     INTEGER MHKL(4)        !Array to return indices from packed flag 
C     INTEGER INTP(6)        !Profile fitted intensity values
C     INTEGER ISIGP(6)       !Profile fitted sig(intensity) values
C     INTEGER IFILM          !Film (Plate) loop counter
C     INTEGER II             !Intensity
C     INTEGER ISIG           !Sig(Intensity)
C     INTEGER IH             !'h' index
C     INTEGER IK             !'k' index
C     INTEGER IL             !'l' index
C     INTEGER H1             !Temp copy of 'h' index
C     INTEGER K1             !Temp copy of 'k' index
C     INTEGER L1             !Temp copy of 'l' index
C     INTEGER HCF1           !Temp highest common factor
C     INTEGER HCF2           !Temp highest common factor
C     INTEGER NH             !Nodal 'h' index
C     INTEGER NK             !Nodal 'k' index
C     INTEGER NL             !Nodal 'l' index
C     INTEGER MULT           !Multiplicity
C     INTEGER ISPAT          !Spatial overlap flag
C     INTEGER ICLOS          !Spot too close to integrate flag
C     INTEGER IMEAS          !Intensity measured flag
C     INTEGER IBAD           !Bad spot flag
C     INTEGER IOVLD          !Overload flag
C     INTEGER KERR           !Error flag
C     INTEGER MINHARM        !Minimum harmonic no.
C     INTEGER MAXHARM        !Maximum harmonic no.
C     INTEGER INCHARM        !Harmonic increment
C     INTEGER JREC           !Pointer to record in .ge2 file
C     INTEGER MLTHKL         !Indices etc flag from .ge2 record
C     INTEGER HKL2(4)        !Indices unpacked from .ge2 file flag
C     INTEGER NMFLAG         !Nodal/multiplicity flag
C     INTEGER JH             !'h' index of harmonic
C     INTEGER JK             !'k' index of harmonic
C     INTEGER JL             !'l' index of harmonic
C     REAL XFD               !Detector 'x' coordinate
C     REAL YFD               !Detector 'y' coordinate
C     REAL ALBDA             !Wavelength
C     REAL RINT              !Real wavelength or equiv. integer record pointer
C     REAL AI                !Intensity
C     REAL SIGI              !sig(Intensity)

      EQUIVALENCE (HKL2(1),NMFLAG)
      EQUIVALENCE (HKL2(2),JH)
      EQUIVALENCE (HKL2(3),JK)
      EQUIVALENCE (HKL2(4),JL)
      EQUIVALENCE (IPOINT, RINT)
C
C------------------------------------------------------------------------------
C
      NSPOT = 0
      KSYM = 0
      READ (IUN_GE1, REC=10, ERR=800) IDUM, NSP
      IF (NSP.LE.0) READ (IUN_GE1, REC=9, ERR=800) IDUM, JDUM, NSP
      NREC = NSP + 10
C
C====== Find which plates have data present
C
      IREC = 10
      DO 10 IFILM = 1, 6
         MEAS(IFILM) = .FALSE.
 10   CONTINUE
 20   IREC = IREC + 1
      IF (IREC.GT.NREC) GO TO 40
      READ (IUN_GE1, REC=IREC, ERR=800) XFD, YFD, IBUFF, IMULT, 
     +                                  ALBDA, NDXHKL, RINT
      CALL CCPI2I(INTP, IBUFF(7), 6, .TRUE., .FALSE.)
      CALL CCPI2I(ISIGP, IBUFF(10), 6, .TRUE., .FALSE.)
      DO 30 IFILM = 1, 6
         II = INTP(IFILM)
         ISIG = ISIGP(IFILM)
         IMEAS = 1
         IF (II.EQ.-9999.AND.ISIG.EQ.-9999) IMEAS = 0
         IF (IMEAS.EQ.1) MEAS(IFILM) = .TRUE.
 30   CONTINUE
      GO TO 20
C
C====== Copy data to LIRL for measured plates
C
 40   IREC = 10
 100  IREC = IREC + 1
      IF (IREC.GT.NREC) RETURN
      READ (IUN_GE1, REC=IREC, ERR=800) XFD, YFD, IBUFF, IMULT, 
     +                                  ALBDA, NDXHKL, RINT
      CALL CCPBYI(MULTF, IMULT, 1)
      CALL CCPBYI(MHKL, IMULT, -4)
      MULT = NBITST(MULTF(1), 0, 5)
      CALL CCPI2I(INTP, IBUFF(7), 6, .TRUE., .FALSE.)
      CALL CCPI2I(ISIGP, IBUFF(10), 6, .TRUE., .FALSE.)
      DO 150 IFILM = 1, 6
         IF (.NOT.MEAS(IFILM)) GO TO 150
         IF (IPLATE.NE.0.AND.IFILM.NE.IPLATE) GO TO 150
         II = INTP(IFILM)
         ISIG = ISIGP(IFILM)
C
C====== Check for not-measured
C
         IMEAS = 1
         IF (II.EQ.-9999.AND.ISIG.EQ.-9999) IMEAS = 0
C
C====== Get indices, lambda and multiplicity
C
         IH = MHKL(2)
         IK = MHKL(3)
         IL = MHKL(4)
         MULT = NBITST(MULTF(1),0,5)
C
C====== Check for spatial overlap
C
         ISPAT = 0
         IF (NBITST(MULTF(1),6,1).NE.0) ISPAT = 1
         ICLOS = 0
         IF (NBITST(MULTF(1),7,1).NE.0) ICLOS = 1
C
C====== Check for bad spot
C
         IBAD = 0
         IF (ISIG.EQ.-9999.AND.II.NE.9999) IBAD = 1
C
C====== Check for overload
C
         IOVLD = 0
         IF (ISIG.EQ.-9999.AND.II.EQ.9999) IOVLD = 1
C
C====== Reset (arbitrary) values for some flagged items
C
         IF (IMEAS.EQ.0) THEN
            II = 0
            ISIG = 0
         END IF
         IF (IOVLD.EQ.1) THEN
            II = 32767
            ISIG = 1000
         END IF
         IF (IBAD.EQ.1) THEN
            ISIG = 1000
         END IF 
C
C====== Store reflection data
C
         AI = FLOAT(II)
         SIGI = FLOAT(ISIG)

         IF (MULT.EQ.1) THEN

            CALL LIRLF_ADDREF (MINDX, IH, IK, IL, KPACK, IFILM, KSYM, 
     +                         XFD, YFD, ALBDA, MULT, 0, 0, 
     +                         0, AI, SIGI, ISPAT, ICLOS, IMEAS, 
     +                         IBAD, IOVLD, 0, KERR)
            IF (KERR.NE.0) THEN
               IERR = 3
               RETURN
            END IF
            NSPOT = NSPOT + 1
         ELSE
            H1 = IH
            K1 = IK
            L1 = IL
            HCF1 = LRL_HCF(H1,K1)
            HCF2 = LRL_HCF(HCF1,L1)
            NH = ISIGN(H1/HCF2,H1)
            NK = ISIGN(K1/HCF2,K1)
            NL = ISIGN(L1/HCF2,L1)
            MINHARM = 0
            MAXHARM = 0
            IF (NH.NE.0) THEN
               MINHARM = IH/NH
            ELSE IF (NK.NE.0) THEN
               MINHARM = IK/NK
            ELSE IF (NL.NE.0) THEN
               MINHARM = IL/NL
            ENDIF
            IF (MULT.EQ.2) THEN
                CALL CCPBYI(HKL2, NDXHKL, -4)
            ELSE
                JREC = IPOINT + MULT - 2
                READ (IUN_GE2, REC=JREC, ERR=810) MLTHKL
                CALL CCPBYI(HKL2, MLTHKL, -4)
            END IF
            IF (NH.NE.0) THEN
               MAXHARM = JH/NH
            ELSE IF (NK.NE.0) THEN
               MAXHARM = JK/NK
            ELSE IF (NL.NE.0) THEN
               MAXHARM = JL/NL
            ENDIF
            INCHARM = (MAXHARM-MINHARM)/(MULT-1)

            CALL LIRLF_ADDREF (MINDX, IH, IK, IL, KPACK, IFILM, KSYM, 
     +                         XFD, YFD, ALBDA, MULT, MINHARM, MAXHARM, 
     +                         INCHARM, AI, SIGI, ISPAT, ICLOS, 1, 
     +                         IBAD, IOVLD, 0, KERR)
            IF (KERR.NE.0) THEN
               IERR = 3
               RETURN
            END IF
            NSPOT = NSPOT + 1
         END IF
 150  CONTINUE
      GO TO 100
C
C====== Error conditions
C
 800  IERR = 1
      RETURN
 810  IERR = 2
      RETURN
      END
