
C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***********************
C**     LSC_ROUT      **
C***********************
C
C
C **** LSC SERVICE ROUTINE ONLY ****
C
      SUBROUTINE LSC_ROUT(IUN,NOUT,RFAC,NREF,NBMIN,NBMAX,NRAN,PLM)
C 
      INCLUDE 'implicit_none.finc'
C
C Purpose:  Output a table of inter bin/filmpack R-factors
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C
C====== PARAMETERS:
C  
      INCLUDE 'limits.finc'
C
C Arguments:
C
      INTEGER IUN
      INTEGER NOUT, NBMIN, NBMAX, NRAN
      INTEGER NREF(MAXPACK,MAXRFR)
      REAL RFAC(MAXPACK,MAXRFR)
      LOGICAL PLM
C
C Parameters:
C         IUN (R)   UNIT NO. FOR OUTPUT  
C        NOUT (R)   OUTPUT OPTION FLAG
C                   =1 ALL PAIRS OF MEASUREMENTS 
C                   =2 PAIRS OF MEASUREMENTS OF THE SAME SIGN (I+ OR I-)
C                   =3 PAIRS OF MEASUREMENTS OF THE SAME SIGN AND WITH
C                      WAVELENGTHS WITHIN 0.1 ANGSTROM
C                   =4 ALL PAIRS OF MEASUREMENTS FOR INTERPACK 
C                      MERGING R-FACTORS
C        RFAC (R)   ARRAY HOLDING R-FACTORS
C        NREF (R)   ARRAY HOLDING NUMBERS OF REFLECTIONS
C       NBMIN (R)   NUMBER OF BINS/FILMPACKS CALCULATED FOR ONE RANGE
C       NBMAX (R)   NUMBER OF BINS/FILMPACKS CALCULATED FOR ONE RANGE
C       NRAN  (R)   NUMBER OF NORMALISATION RANGE
C       PLM   (R)  .true. = merged plate data
C                  .false. = plate data seperate
C 
C
C====== GLOBALS:
C
      INCLUDE 'rout_arrays.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'scps_counters.finc'
C
C====== LOCALS:
C
      INTEGER NLINE, N, I, K, K1, K2
C
C     INTEGER NLINE, N, I, K, K1, K2       ! Temp/loop variables
C
C
C-------------------------------------------------------------------------------
C
C
C====== Output table
C
      IF (NOUT.LT.4) WRITE(IUN, 7000) 
      IF (NOUT.LT.4.AND.PLM) WRITE(IUN, 6000) 
      IF (NOUT.LT.4) WRITE(IUN, 7040) NRAN, NORMLAMMIN(NRAN),
     +                     NORMLAMMAX(NRAN)
      IF (NOUT.EQ.1) WRITE(IUN, 7010)
      IF (NOUT.EQ.2) WRITE(IUN, 7020)
      IF (NOUT.EQ.3) WRITE(IUN, 7030)
      IF (NOUT.EQ.4) THEN
         WRITE (IUN,7100)
         IF(PLM) WRITE(IUN, 6000) 
         WRITE (IUN,7010)
      END IF
      
      WRITE (IUN,6010) (N,N=NBMIN,NBMAX)
      NLINE = ((NBMAX-NBMIN+1)-1)/16 + 1
      DO 30 I = NBMIN , NBMAX
         K1 = -15
         DO 20 N = 1 , NLINE
            K1 = K1 + 16
            K2 = K1 + 15
            IF (K2.GT.NBMAX-NBMIN+1) K2 = NBMAX-NBMIN+1
            IF (N.EQ.1) THEN
               WRITE (IUN,6020) I , (RFAC(I,K),K=K1,K2)
            ELSE
               WRITE (IUN,6030) (RFAC(I,K),K=K1,K2)
            END IF
            WRITE (IUN,6040) (NREF(I,K),K=K1,K2)
 20      CONTINUE
 30   CONTINUE
      RETURN
C
C====== Format statements
C

 6000 FORMAT (/,' (Plate data merged)')
 7000 FORMAT (//,' LAUE INTER-BIN MERGING R-FACTORS = ',
     +        'SUM(ABS(I(I)-I(J)))/SUM((I(I)+I(J))')
 7010 FORMAT (/,' ALL PAIRS OF MEASUREMENTS')
 7020 FORMAT (/,' PAIRS OF MEASUREMENTS OF THE SAME SIGN (I+ OR I-)')
 7030 FORMAT (/,' PAIRS OF MEASUREMENTS OF THE SAME SIGN AND WITH',
     +        ' WAVELENGTHS WITHIN 0.1 ANGSTROM')
 7040 FORMAT (/,' NORMALISATION RANGE NUMBER ', I2,' (LAMBDA FROM ',
     +           F6.3,'A TO ',F6.3,'A)')
 7100 FORMAT (//,' LAUE INTER-FILMPACK MERGING R-FACTORS = ',
     +        'SUM(ABS(I(I)-I(J)))/SUM((I(I)+I(J))')
 6010 FORMAT (/,10X,20I6)
 6020 FORMAT (/,' ',I5,4X,20F6.3)
 6030 FORMAT (10X,20F6.3)
 6040 FORMAT (10X,20I6)
      END
