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