
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C******************************
C**     LSC_FILE_OUTPUT      **
C******************************
C
C
C
CD-Routine: Outputs mtz- and/or shelx-files - LSC_FILE_OUTPUT
C This routine gets various data output options and criteria and 
C writes scaled reflections merged or unmerged to mtz- and/or shelx-files.
C It refines the reference scale and temperature factor if a reference data 
C set is present and if they have not been refined so far. If reference
C intensities are present they will be stored in the mtz.-output files.
C If multiples reflections have been deconvoluted they will be added to
C the output files.  
CD-end
CD-Fortran:
C
      SUBROUTINE LSC_FILE_OUTPUT (KDX, MTZ_IDX, MINDX,
     +                            IUNOUT, IUNLOG, REFSET)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Output of mtz- and/or shelx files
C
C Author:  S. Arzt, December 1997
C
C Arguments:
C
      INTEGER KDX, MTZ_IDX, MINDX, IUNOUT, IUNLOG
      REAL CELL(6)
      LOGICAL REFSET

CD-Parameters:
C
C KDX     i    (R)     The index of the keyword set to which the LSM
C                      keyworded scaling parameters are to be added)
C MTZ_IDX i    (R)     indicates which MTZ file - one index points to 
C                      both input and output files 
C MINDX   i    (R)     The index of the Laue Integrated Reflections List     
C IUNOUT  i    (R)     output unit number for shelx-file
C IUNLOG  i    (R)     output unit number for log-file
C REFSET  l    (R)    .true. = Reference data set exist
C                     .false. = no reference data present
CD-end
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'use_reflns.finc'
      INCLUDE 'ref_ctrl.finc'
      INCLUDE 'lsm_flags.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'scps_counters.finc'
      INCLUDE 'other_scale.finc'

C
C====== FUNCTION TYPES:
C
      INTEGER KDMSTR
      INTEGER LENSTR
      INTEGER LSM_NEXT_REFLN
      INTEGER LSM_INDX
      INTEGER CCPNUN
      EXTERNAL CCPNUN
      REAL LSM_SCFAC
      REAL STHLSQ
      
C
C====== LOCALS:
C
      INTEGER DATTYPE, FTYPE
      INTEGER I, J, KK
      INTEGER IREF, NSPOT, NR, NUMREF, NMULT
      INTEGER IERR, JERR, KERR
      INTEGER MAXE
      INTEGER MAXSTR
      INTEGER ISTAT 
      INTEGER ITYP                
      INTEGER NSYMM,NSYMMP
      INTEGER NUM_OVPIX, NOVLDPIX
      INTEGER ICODE, ICLOS
      INTEGER IRFTYP
      INTEGER ISORT(5)
      INTEGER IFLAG, IFAIL
      INTEGER IBAD, IOVLD, IMEAS, NOUTLIER
      INTEGER IPACK, IPLATE
      INTEGER IH, IK, IL, NSPG, KSYM
      INTEGER MULT, MINHARM, MAXHARM
      INTEGER NEGINT, OVLD_OUT, SPAT_OUT, INCHARM, ISPAT
      INTEGER LREC
      INTEGER KN(3), JF, ICENT, IDATA(3), KS
      REAL SIGOUT
      REAL RSM(4,4,192), RSMT(4,4,192)
      REAL ADATA(10)
      REAL AI, SIGI, SIGREF, REFINT, F, SIGF, FF, SS, W
      REAL SC
      REAL FF1, FF2, SS1, SS2, DF, SDF, SDF1, SDF2
      REAL ALAM, XFD, YFD, STOL2
      REAL SIGW(3), SIGWI(3)
      REAL VAL_MAGIC
      LOGICAL REFSCALE
      LOGICAL CSYMM
      LOGICAL SPOV, OVLD
      LOGICAL SETVAL
      LOGICAL PACKFLAG(MAXPACK)
      CHARACTER*50 STR   
      CHARACTER*70 VALSTR
      CHARACTER*80 ERRSTR  
      CHARACTER*60 FILNAM_OUT
      CHARACTER*60 FILNAM_MTZ
      CHARACTER*60 FILNAM_SHLX
      CHARACTER*30 PRGLAB_M(7)
      CHARACTER*1 CTYP_M(7)
      CHARACTER*30 PRGLAB_MR(9)
      CHARACTER*1 CTYP_MR(9)
      CHARACTER*30 PRGLAB_UM(8)
      CHARACTER*1 CTYP_UM(8)
      CHARACTER*30 PRGLAB_UMR(10)
      CHARACTER*1 CTYP_UMR(10)
      CHARACTER*80 HSTR(2)
      CHARACTER*10 PGNAME, SPGNAME  
      CHARACTER*1 LATT
      CHARACTER*12 SYST
      CHARACTER*8 FILEOPT
      CHARACTER*1 BTITLE

      DATA PRGLAB_M/'H','K','L','FP','SIGFP','DP','SIGDP'/
      DATA CTYP_M/'H','H','H','F','Q','D','Q'/
      DATA PRGLAB_MR/'H','K','L','FS','SIGF','FP','SIGFP','DP','SIGDP'/
      DATA CTYP_MR/'H','H','H','F','Q','F','Q','D','Q'/

      DATA PRGLAB_UM/'H','K','L','M/ISYM','BATCH','I','SIGI','LAM'/
      DATA CTYP_UM/'H','H','H','Y','B','J','Q','R'/
      DATA PRGLAB_UMR/'H','K','L','M/ISYM','BATCH','I','SIGI','LAM',
     +                'IS','SIGIS'/
      DATA CTYP_UMR/'H','H','H','Y','B','J','Q','R','J','Q'/

      DATA HSTR/'Created by the program LSCALE',' '/

      KDX = KINDX
   
      IF(MTZ_IDX.EQ.1) MTZ_IDX = MTZ_IDX + 1

      MAXE = 80
      MAXSTR = 50

      REFSCALE = .FALSE.
      VALSTR = ' '
      BTITLE = ' '
      KK = 0
      NMULT = 0
      NUMREF = 0
      IRFTYP = 2
      NOUTLIER = 0
      DO 20 I = 1, 10
         ADATA(I) = 0.0
 20   CONTINUE

      DO 21 I = 1, MAXPACK
         PACKFLAG(I) = .FALSE.
 21   CONTINUE
C
C ====== get output file names and options from keywords
C
      STR = 'FILENAME_OUTPUT'
      CALL KDMF_GETVALSTR (KDX, KDMSTR(STR), LENSTR(STR),  
     +         1, 1, 50, KDMSTR(VALSTR), ISTAT,
     +         ITYP, KDMSTR(ERRSTR), MAXE, IERR)
      IF (IERR.NE.0) GOTO 810  
      FILNAM_OUT = VALSTR 
      IF (FILNAM_OUT.EQ.' ') RETURN
      IF (INDEX(FILNAM_OUT,'.data').EQ.0.AND.
     +    INDEX(FILNAM_OUT,'.mtz').EQ.0) THEN
         FTYPE = 2
      ELSE IF (INDEX(FILNAM_OUT,'data').NE.0) THEN
         FTYPE = -1
      ELSE IF (INDEX(FILNAM_OUT,'mtz').NE.0) THEN
         FTYPE = 1
      END IF
 
      VALSTR = ' '
      STR = 'OUTPUT_DATAOPT'
      CALL KDMF_GETVALSTR (KDX, KDMSTR(STR), LENSTR(STR),  
     +         1, 1, 8, KDMSTR(VALSTR), ISTAT,
     +         ITYP, KDMSTR(ERRSTR), MAXE, IERR)
      IF (IERR.NE.0) GOTO 810 
      FILEOPT = VALSTR
      IF (INDEX(FILEOPT,'UNMERGED').NE.0) THEN
         DATTYPE = 1
      ELSE 
         DATTYPE = 2
      END IF
 
C
C ====== prepare output files
C
      ISORT(1) = 1
      ISORT(2) = 2
      ISORT(3) = 3
      ISORT(4) = 0
      ISORT(5) = 0
      
      IF (FTYPE.GE.1) THEN
C
C ====== prepare mtz-file
C
         FILNAM_MTZ = FILNAM_OUT
         IF (FTYPE.EQ.2) THEN
            FILNAM_MTZ = FILNAM_OUT(1:(INDEX(FILNAM_OUT,' '))-1)
     +           //'.mtz'
         END IF
         CALL LWOPEN (MTZ_IDX,FILNAM_MTZ)
         CALL LWTITL (MTZ_IDX,TITLE_STR,0)
         CALL LWHIST (MTZ_IDX,HSTR,2)

         IF (DATTYPE.EQ.1) THEN

C ====== prepare unmerged data mtz-file

            IF (.NOT.REFSET) THEN
               CALL LWCLAB (MTZ_IDX,PRGLAB_UM,8,CTYP_UM,0)
             ELSE 
               CALL LWCLAB (MTZ_IDX,PRGLAB_UMR,10,CTYP_UMR,0)
            END IF

         ELSE IF (DATTYPE.EQ.2) THEN

C ====== prepare merged data  mtz-file

            IF (.NOT.REFSET) THEN
               CALL LWCLAB (MTZ_IDX,PRGLAB_M,7,CTYP_M,0)
            ELSE 
               CALL LWCLAB (MTZ_IDX,PRGLAB_MR,9,CTYP_MR,0)
            END IF
         END IF

         SETVAL = .FALSE.
         CALL SET_MAGIC(MTZ_IDX,VAL_MAGIC,SETVAL)

         CELL(1) = A
         CELL(2) = B
         CELL(3) = C
         CELL(4) = ALPHA
         CELL(5) = BETA
         CELL(6) = GAMMA

         CALL LWCELL (MTZ_IDX,CELL)
         CALL KSM_GET_SYMM (NSPG, SPGNAME, PGNAME, NSYMMP, NSYMM,
     +                         RSM, RSMT, IFLAG)
         CALL KSM_GET_SYLAT (SYST, LATT)
         CALL LWSYMM (MTZ_IDX,NSYMM,NSYMMP,RSM,LATT,NSPG,SPGNAME,PGNAME)
      END IF

      IF (FTYPE.EQ.-1.OR.FTYPE.EQ.2) THEN
C
C ====== prepare shelx-file
C
         IFAIL = 0
         FILNAM_SHLX = FILNAM_OUT
         IF (FTYPE.EQ.2) THEN
            FILNAM_SHLX = FILNAM_OUT(1:(INDEX(FILNAM_OUT,' '))-1)
     +           //'.data'

         END IF
         CALL CCPDPN(IUNOUT,FILNAM_SHLX,'NEW','F',LREC,IFAIL)
      END IF

      CALL LIRLF_NUMREFS (MINDX, NSPOT)
      CALL LIRLF_SORT  (MINDX, 10, IERR)


C
C ====== prepare data for output
C

      OVLD_OUT = -1
      SPAT_OUT = 0
      NEGINT = 1
      SIGOUT = 0.0
      NOVLDPIX = 100

      CALL LSC_GET_OUTPUTFLAGS (KDX, OVLD_OUT, SPAT_OUT, NEGINT, SIGOUT)
 
      IF(SPAT_OUT.EQ.0) SPOV = .FALSE.
      IF(OVLD_OUT.NE.0) THEN
         OVLD = .TRUE.
      ELSE
         OVLD = .FALSE.
      END IF      

      CALL LSM_SELECT_SCREFS (.FALSE.,.FALSE.,SIGOUT,SPOV,OVLD)         

      
      CALL LSM_TOP_LIRL (MINDX, KERR)

      IF (DATTYPE.EQ.1) THEN
C
C ====== write unmerged data to mtz and/or shelx-file
C
         DO 10 IREF = 1, NSPOT
            CALL LIRLF_GETREF (MINDX, IREF, IH, IK, IL,  
     +              IPACK, IPLATE, KSYM, XFD, YFD, ALAM,
     +              MULT, MINHARM, MAXHARM, INCHARM, AI, SIGI,
     +              ISPAT, ICLOS, IMEAS, IBAD, IOVLD, 
     +              ICODE, JERR)      
            IF (ABS(AI).LT.SIGOUT*SIGI) GO TO 10 
            IF (IOVLD.EQ.1.AND.OVLD_OUT.EQ.0) GO TO 10
            IF (FTYP_IN.EQ.'GE '.AND.IOVLD.EQ.1) GO TO 10
            IF(OVLD_OUT.GT.0) THEN
               CALL LIRLF_GET_OVPIX (MINDX, IREF, NUM_OVPIX, IERR)
               IF (NUM_OVPIX.GT.OVLD_OUT) GO TO 10 
            END IF
            IF (ISPAT.EQ.1.AND.SPAT_OUT.EQ.0) GO TO 10
            IF (AI.LT.0.0.AND.NEGINT.EQ.0) GO TO 10
            CALL LIRLF_GET_OUTLIER (MINDX, IREF, ICODE, IERR)
            IF (ICODE.GT.0) NOUTLIER = NOUTLIER + 1
            IF (ICLOS.EQ.1.OR.IMEAS.EQ.0.OR.IBAD.EQ.1.OR.ICODE.GT.0) 
     +         GO TO 10
            CALL LIRLF_HKLUNQ  (MINDX, IREF, IH, IK, IL, IERR)
            ADATA(1) = IH
            ADATA(2) = IK
            ADATA(3) = IL
            ADATA(4) = KSYM
            IF (MULT.EQ.1) THEN
               SC = LSM_SCFAC (IREF, IERR)
               IF(SC.NE.0.0) NUMREF = NUMREF + 1
               ADATA(6) = AI*SC*100.0
               ADATA(7) = SIGI*SC*100.0
               ADATA(8) = ALAM
            ELSE IF (MULT.EQ.0) THEN
               NMULT = NMULT + 1

C======= set pack number for deconvoluted multiple to 1

               IPACK = 1
               ADATA(6) = AI*100.0
               ADATA(7) = SIGI*100.0
               ADATA(8) = VAL_MAGIC
            ELSE
               GO TO 10
            END IF
            IF(SC.EQ.0.0.AND.MULT.NE.0) GO TO 10
            KK = KK + 1
            ADATA(5) = IPACK
            IF (FTYPE.GE.1) THEN
               IF (.NOT.PACKFLAG(IPACK)) THEN
                  CALL LWBTIT(MTZ_IDX, IPACK, BTITLE)
                  PACKFLAG(IPACK) = .TRUE.
               END IF
               IF (.NOT.REFSET) THEN 
                  CALL LWREFL(MTZ_IDX,ADATA)
               ELSE 
                  REFINT = VAL_MAGIC
                  SIGREF = VAL_MAGIC
                  CALL LIRLF_GET_REFINT (MINDX, IREF, REFINT, 
     +                    SIGREF, KERR)
                  ADATA(9) = REFINT*100.0
                  ADATA(10) = SIGREF*100.0
                  CALL LWREFL(MTZ_IDX,ADATA)     
               END IF
            END IF
            IF (FTYPE.EQ.-1.OR.FTYPE.EQ.2) THEN
               WRITE (IUNOUT,6030) IH, IK, IL, ADATA(6), ADATA(7),
     +                           IPACK, ALAM
            END IF            
 10      CONTINUE
         IF (FTYPE.EQ.-1.OR.FTYPE.EQ.2) THEN
C            CLOSE(IUNOUT,'KEEP')
         CLOSE(IUNOUT)
         END IF
         IF (FTYPE.GE.1) CALL LWCLOS(MTZ_IDX,3)

         WRITE (IUNLOG,6050) NOUTLIER
         WRITE(IUNLOG,1000) 
         WRITE(IUNLOG,1010) 
         WRITE(IUNLOG,1020) KK

      ELSE
C
C ====== write merged data to mtz and/or shelx-file
C

         CALL KSM_CENTRIC 

 40      NR = LSM_NEXT_REFLN(KERR)

         IF (NR.LE.-1.OR.KERR.EQ.1) THEN

C ====== add deconvoluted multiples data to mtz and/or shelx-file

            DO 60 I = 1, NSPOT
               CALL LIRLF_GETREF (MINDX, I, 
     +              IH, IK, IL,
     +              IPACK, IPLATE, KSYM, XFD, YFD, ALAM,
     +              MULT, MINHARM, MAXHARM, INCHARM, AI, SIGI,
     +              ISPAT, ICLOS, IMEAS, IBAD, IOVLD, 
     +              ICODE, JERR)   
               IF (MULT.EQ.0) THEN
                  CALL LIRLF_HKLUNQ  (MINDX, I, IH, IK, IL, IERR)
                  DO 70 J = 1, 9
                     ADATA(J) = VAL_MAGIC
 70               CONTINUE
                  ADATA(1) = IH
                  ADATA(2) = IK
                  ADATA(3) = IL
                  IF(SCP(NCSCP(4)+1).NE.1.0) THEN
                     STOL2 = STHLSQ(IH,IK,IL)
                     SC = SCP(NCSCP(4)+1)
                     SC = SC * EXP(-SCP(NCSCP(5)+1)*STOL2)
                     AI = AI * SC * 100.0                   
                     SIGI = SIGI * SC * 100.0
                  END IF
                  ADATA(4) = SQRT(AI)
                  ADATA(5) = SQRT(AI+SIGI)-ADATA(4)
                  KK = KK + 1
                  NMULT = NMULT + 1
                  IF (FTYPE.GE.1) THEN
                     IF (.NOT.REFSET) THEN
                        CALL LWREFL(MTZ_IDX,ADATA)
                     ELSE 
                        REFINT = 0.0
                        SIGREF = 0.0
                        CALL LIRLF_GET_REFINT (MINDX, I, 
     +                       REFINT, SIGREF, KERR)
                        ADATA(6) = ADATA(4)
                        ADATA(7) = ADATA(5)
                        ADATA(4) = VAL_MAGIC
                        ADATA(5) = VAL_MAGIC
                        IF (SIGREF.GT.0.0.AND.REFINT.GT.0.0) THEN
                           ADATA(4) = SQRT(REFINT*100.0)
                           ADATA(5) = SIGREF/(2.0*ADATA(4))
                        END IF
                        CALL LWREFL(MTZ_IDX,ADATA)  
                     END IF
                  END IF
                  IF (FTYPE.EQ.-1.OR.FTYPE.EQ.2) THEN
                     WRITE(IUNOUT,6040) IH, IK, IL,
     +                    SQRT(AI), SQRT(AI+SIGI)-SQRT(AI)
                  END IF
               END IF

 60         CONTINUE
     
            IF (FTYPE.EQ.-1.OR.FTYPE.EQ.2) THEN
C               CLOSE(IUNOUT,'KEEP')
               CLOSE(IUNOUT)
            END IF
            IF (FTYPE.GE.1) CALL LWCLOS(MTZ_IDX,3)

            WRITE(IUNLOG,6050) NOUTLIER
            WRITE(IUNLOG,1000) 
            WRITE(IUNLOG,1030) 
            WRITE(IUNLOG,1020) KK

            RETURN

         ELSE
            DO 50 J = 1, 3
               SIGW(J) = 0.0
               SIGWI(J) = 0.0
               KN(J) = 0
               ADATA(J) = VAL_MAGIC
               ADATA(J+3) = VAL_MAGIC
               ADATA(J+6) = VAL_MAGIC
 50         CONTINUE

            CALL LIRLF_HKLUNQ  (MINDX, LSM_INDX(1), IH, IK, IL, IERR)
            ADATA(1) = IH
            ADATA(2) = IK
            ADATA(3) = IL
            IDATA(1) = IH
            IDATA(2) = IK
            IDATA(3) = IL
            CSYMM = .FALSE.
            CALL CENTR(IDATA, ICENT)
            IF (ICENT.EQ.1) CSYMM = .TRUE.
            DO 30 I = 1, NR
               CALL LIRLF_GETREF (MINDX, LSM_INDX(I), 
     +              IH, IK, IL,
     +              IPACK, IPLATE, KSYM, XFD, YFD, ALAM,
     +              MULT, MINHARM, MAXHARM, INCHARM, AI, SIGI,
     +              ISPAT, ICLOS, IMEAS, IBAD, IOVLD, 
     +              ICODE, JERR)     
               IF(NR.EQ.1) THEN
                  IF (ABS(AI).LT.SIGOUT*SIGI) GO TO 40 
                  IF (IOVLD.EQ.1.AND.OVLD_OUT.EQ.0) GO TO 40
                  IF (FTYP_IN.EQ.'GE '.AND.IOVLD.EQ.1) GO TO 40
                  IF(OVLD_OUT.GT.0) THEN
                     CALL LIRLF_GET_OVPIX(MINDX,LSM_INDX(I),
     +                    NUM_OVPIX,IERR)
                     IF (NUM_OVPIX.GT.OVLD_OUT) GO TO 40 
                  END IF
                  IF (ISPAT.EQ.1.AND.SPAT_OUT.EQ.0) GO TO 40
                  IF (AI.LT.0.0.AND.NEGINT.EQ.0) GO TO 40
                  CALL LIRLF_GET_OUTLIER (MINDX, LSM_INDX(I),
     +                 ICODE, IERR)
                  IF (ICODE.GT.0) NOUTLIER = NOUTLIER + 1
                  IF (ICLOS.EQ.1.OR.IMEAS.EQ.0.OR.IBAD.EQ.1.OR. 
     +               ICODE.GT.0)  GO TO 40
               ELSE 
                  IF (ABS(AI).LT.SIGOUT*SIGI) GO TO 30 
                  IF (IOVLD.EQ.1.AND.OVLD_OUT.EQ.0) GO TO 30
                  IF (FTYP_IN.EQ.'GE '.AND.IOVLD.EQ.1) GO TO 30
                  IF(OVLD_OUT.GT.0) THEN
                     CALL LIRLF_GET_OVPIX(MINDX,LSM_INDX(I),
     +                    NUM_OVPIX,IERR)
                     IF (NUM_OVPIX.GT.OVLD_OUT) GO TO 30 
                  END IF
                  IF (ISPAT.EQ.1.AND.SPAT_OUT.EQ.0) GO TO 30
                  IF (AI.LT.0.0.AND.NEGINT.EQ.0) GO TO 30
                  CALL LIRLF_GET_OUTLIER (MINDX, LSM_INDX(I),
     +                 ICODE, IERR)
                  IF (ICODE.GT.0) NOUTLIER = NOUTLIER + 1
                  IF (ICLOS.EQ.1.OR.IMEAS.EQ.0.OR.IBAD.EQ.1.OR.
     +               ICODE.GT.0)  GO TO 30
               END IF
               IF (MULT.EQ.1) THEN
                  SC = LSM_SCFAC (LSM_INDX(I), IERR)
                  AI = AI * SC * 100.0
                  SIGI = SIGI * SC * 100.0
               ELSE
                  GO TO 30
               END IF    
               IF(SC.EQ.0.0) GO TO 30
               NUMREF = NUMREF + 1
               W = 1.0/(SIGI*SIGI)
               SIGWI(1) = SIGWI(1) + (W*AI)
               SIGW(1) = SIGW(1) + W
               IF (.NOT.CSYMM) THEN
                  KS = 3 - MOD(KSYM,2)
                  SIGWI(KS) = SIGWI(KS) + (W*AI)
                  SIGW(KS) = SIGW(KS) + W
                  KN(KS) = KN(KS) + 1
               END IF               
 30         CONTINUE 
            FF = SIGWI(1)/SIGW(1)
            IF(FF.LT.0.0) GO TO 40
            F = SQRT(FF)
            SS = SQRT(1.0/SIGW(1))
            SIGF = SQRT(FF+SS) - SQRT(FF)
            ADATA(4) = F
            ADATA(5) = SIGF
            JF = KN(2)*KN(3)
            IF(JF.GT.0) THEN
               FF1 = SIGWI(2)/SIGW(2)
               IF (FF1.LT.0.0) GO TO 40
               SS1 = SQRT(1.0/SIGW(2))
               FF2 = SIGWI(3)/SIGW(3)
               IF (FF2.LT.0.0) GO TO 40
               SS2 = SQRT(1.0/SIGW(3))
               SDF1 = SQRT(FF1+SS1) - SQRT(FF1)
               SDF2 = SQRT(FF2+SS2) - SQRT(FF2)
               DF = SQRT(FF1) - SQRT(FF2)
               SDF = SQRT(SDF1*SDF1+SDF2*SDF2)
               IF (.NOT.REFSET) THEN
                  ADATA(6) = DF
                  ADATA(7) = SDF
               ELSE
                  ADATA(8) = DF
                  ADATA(9) = SDF
               END IF
            END IF
           
              
            IF (FTYPE.GE.1) THEN
               IF (.NOT.REFSET) THEN
                  CALL LWREFL(MTZ_IDX,ADATA)
               ELSE 
                  REFINT = 0.0
                  SIGREF = 0.0
                  CALL LIRLF_GET_REFINT (MINDX, LSM_INDX(1), REFINT, 
     +                 SIGREF, KERR)
                  ADATA(6) = ADATA(4)
                  ADATA(7) = ADATA(5)
                  ADATA(4) = VAL_MAGIC
                  ADATA(5) = VAL_MAGIC
                  IF (SIGREF.GT.0.0.AND.REFINT.GT.0.0) THEN
                           ADATA(4) = SQRT(REFINT*100.0)
                           ADATA(5) = (SIGREF*100.0)/(2.0*ADATA(4))
                  END IF
                  CALL LWREFL(MTZ_IDX,ADATA)  
               END IF
            END IF
            IF (FTYPE.EQ.-1.OR.FTYPE.EQ.2) THEN
               WRITE(IUNOUT,6040) IDATA(1),IDATA(2),IDATA(3),F,SIGF
            END IF           
            KK = KK + 1
            GO TO 40
         END IF
      END IF
      
      RETURN

 810  WRITE(IUNLOG,2002) IERR, STR(1:LENSTR(STR))
      WRITE(IUNLOG,2000)
      STOP

 1000 FORMAT (//,' D A T A   O U T P U T')
 1010 FORMAT (//,' UNMERGED DATA WRITTEN TO MTZ- AND/OR SHELX-FILE')
 1020 FORMAT (/,' NUMBER OF REFLECTIONS ADDED TO OUTPUT DATA FILE= ', 
     +            I10,/)
 1030 FORMAT (//,' MERGED DATA WRITTEN TO MTZ- AND/OR SHELX-FILE')
 2000 FORMAT (//,' ******** PROCESSING STOPPED *******')
 2002 FORMAT (/,'**Error code', I2, ' defining keyword parameter ',
     +        A, '**')
 6020 FORMAT (3I4,2F8.2)
 6030 FORMAT (3I4,2F8.2,I4,F8.4)
 6031 FORMAT (3I4,2F8.2,I4,2F8.4)
 6040 FORMAT (3I4,2F8.2)
 6050 FORMAT (//,'NUMBER OF REJECTED OUTLIERS: ',I10,//)

      END
