
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************************
C**    LSC_REFSET_ANALYSES  **
C*******************************
C
C **** LSC SERVICE ROUTINE ONLY ****
C
C Routine: Outputs statistics of reference set scaling - LSC_REFSET_ANALYSES
C The routine LSC_REFSET_ANALYSES gathers data for statistics about
C the reference set scaling and outputs tables into the log file or
C prepares data for window output (called by LSC_MENU2, LSC_MENU2ABS,
C LSC_MENU3, LSC_MENU3ABS)
C 
      SUBROUTINE LSC_REFSET_ANALYSES(MINDX, BATCH_FL, IUN)
C
C
      IMPLICIT NONE
C
C Purpose: Calculate and output R-factor between scaled Laue- and
C          reference data
C Author:  
C
C Arguments:
C
      INTEGER MINDX
      INTEGER IUN
      LOGICAL BATCH_FL
C     
C Parameters:
C MINDX      i (R)    The index of the Laue Integrated Reflections List     
C BATCH_FL   l (R)    Graphics output flag
C                     = .true. output statistics only in log-file
C                     = .false. output statistics in log-file and 
C                               graphics windows 
C IUN        i (R)    Output unit number of log-file

C
C====== PARAMETERS:
C 
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'scp.finc'
      INCLUDE 'other_scale.finc'
      INCLUDE 'rout_arrays.finc'
      INCLUDE 'use_reflns.finc'
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LSC_IRANGE
      INTEGER XDLSTR
      REAL LSM_SCFAC 
C
C====== LOCALS:
C
      INTEGER K, I, J
      INTEGER IH, IK, IL, IPACK, IPLATE, KSYM
      INTEGER NREFS
      INTEGER MULT, MINHARM, MAXHARM, INCHARM
      INTEGER ISPAT, IOVLD, IBAD, IMEAS
      INTEGER ICODE, ICLOS, IERR, KERR
      INTEGER IUSE
      INTEGER KNORM, KPLSC
      INTEGER KBINLAMBDA
      INTEGER KBINTHETA
      INTEGER KBINSTOL
      INTEGER KBININT
      INTEGER NREFTHETA(10)
      INTEGER NREFLAMBDA(MAXRANGE,MAXBIN)
      INTEGER NREFLAM(MAXBIN)
      INTEGER NREFINT(10)
      INTEGER NREFSTOL(10)
      INTEGER M_LAMBDA
      INTEGER M_STOL 
      INTEGER M_INT 
      INTEGER M_THETA 
      INTEGER NVIEW, IVHLIST(2), IVH, ITEM, IQUIT
      REAL REFINT, SIGREF
      REAL XFD, YFD, ALAM 
      REAL AI, SIGI, RSCALE
      REAL AINT, SIGINT
      REAL RNS, RDS, SC
      REAL ABSCOR_NU, PSI_LOCAL, PSI_GLOBAL
      REAL ABSCOR_LAMFN
      REAL STOL2, AL3C2T
      REAL OB_LPFAC
      REAL THETA
      REAL AVERLAMBDA(MAXRANGE,MAXBIN)
      REAL MEANLAMBDAL(MAXRANGE,MAXBIN)
      REAL MEANLAMBDAS(MAXRANGE,MAXBIN)
      REAL RFACLAMBDA1(MAXRANGE,MAXBIN)
      REAL RFACLAMBDA2(MAXRANGE,MAXBIN)
      REAL RFACLAMBDA(MAXRANGE,MAXBIN)
      REAL RFACHIS(MAXBIN)
      REAL MEANL(MAXBIN)
      REAL MEANS(MAXBIN)
      REAL RFACTMAX
      REAL AVERTHETA(10)
      REAL MEANTHETA(10)
      REAL RFACTHETA(10)
      REAL RFACTHETA1(10)
      REAL RFACTHETA2(10)
      REAL AVERSTOL(10)
      REAL MEANSTOL(10)
      REAL IOVSIGI(10)
      REAL RFACTSTOL(10)
      REAL RFACTSTOL1(10)
      REAL RFACTSTOL2(10)
      REAL LOGSTOL(10)
      REAL AVERINT(10)
      REAL MEANINT(10)
      REAL RFACINT(10)
      REAL RFACINT1(10)       
      REAL RFACINT2(10)    
      LOGICAL GRAPH_DISP
      CHARACTER*17 NAMES(4)
      CHARACTER*25 QUITNAM

      DATA NAMES /'versus lambda',
     +            'versus resolution',
     +            'versus intensity',
     +            'versus theta'/
      DATA QUITNAM /'Return to Previous Menu'/

C
C===== initialize
C

      K = 0
      RNS = 0.0
      RDS = 0.0
      RFACTMAX = 0.0

      DO 30 I = 1, MAXRANGE
         DO 40 J = 1, NBINR(I)
            AVERLAMBDA(I,J) = 0.0
            NREFLAMBDA(I,J) = 0
            MEANLAMBDAL(I,J) = 0.0
            MEANLAMBDAS(I,J) = 0.0
            RFACLAMBDA1(I,J) = 0.0
            RFACLAMBDA2(I,J) = 0.0
            NREFLAM(J) = 0.0
            RFACHIS(J) = 0.0
            MEANL(J) = 0.0
            MEANS(J) = 0.0
 40      CONTINUE
 30   CONTINUE

      GRAPH_DISP = .FALSE.

      DO 50 I = 1, 10

         AVERTHETA(I) = 0.0
         NREFTHETA(I) = 0
         MEANTHETA(I) = 0.0
         RFACTHETA1(I) = 0.0
         RFACTHETA2(I) = 0.0

         AVERSTOL(I) = 0.0
         NREFSTOL(I) = 0
         MEANSTOL(I) = 0.0
         IOVSIGI(I) = 0.0
         RFACTSTOL1(I) = 0.0
         RFACTSTOL2(I) = 0.0
         LOGSTOL(I) = 0.0

         AVERINT(I) = 0.0
         NREFINT(I) = 0
         MEANINT(I) = 0.0
         RFACINT1(I) = 0.0
         RFACINT2(I) = 0.0

 50   CONTINUE

      THETAMIN = 10.0E20
      THETAMAX = 0.0
      STOL2MIN = 10.0E20
      STOL2MAX = 0.0
      AINTMIN = 0.0
      AINTMAX = 0.0

      CALL LSM_SELECT_SCREFS (.FALSE., .TRUE., SIGCUT_USE,  
     +                        .FALSE., .FALSE.) 
  
      CALL LSM_TOP_LIRL (MINDX, IERR)

      CALL LIRLF_NUMREFS (MINDX, NREFS)
C
C====== Get theta and sin**2/lamda**2 mins and maxs per range
C                
      DO 130 I = 1, NREFS
         CALL LIRLF_LSM_SCALOBS  (MINDX, I, IPACK, IPLATE,
     +                      AINT, SIGINT, ALAM, REFINT,
     +                      ABSCOR_NU, PSI_LOCAL, PSI_GLOBAL,
     +                      STOL2, AL3C2T, ABSCOR_LAMFN, OB_LPFAC,
     +                      KNORM, KPLSC, IUSE, IERR)

         IF (IUSE.EQ.1) THEN
            SC = LSM_SCFAC (I, IERR)
            THETA = ASIN(SQRT(STOL2)*ALAM)*180.0/PI
            IF (THETA.GT.THETAMAX) 
     +          THETAMAX = THETA
            IF (THETA.LT.THETAMIN) 
     +          THETAMIN = THETA
            IF (STOL2.GT.STOL2MAX) 
     +          STOL2MAX = STOL2
            IF (STOL2.LT.STOL2MIN) 
     +          STOL2MIN = STOL2
            IF (SC*AINT.GT.AINTMAX) AINTMAX = SC*AINT
            IF (SC*AINT.LT.AINTMIN) AINTMIN = SC*AI
         END IF
 130  CONTINUE

      DO 10 I = 1, NREFS
         CALL LIRLF_GET_REFINT (MINDX, I, REFINT, SIGREF, KERR)
         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, IERR)

         CALL LIRLF_LSM_SCALOBS  (MINDX, I, IPACK, IPLATE,
     +                         AINT, SIGINT, ALAM, REFINT,
     +                         ABSCOR_NU, PSI_LOCAL, PSI_GLOBAL,
     +                         STOL2, AL3C2T, ABSCOR_LAMFN, OB_LPFAC,
     +                         KNORM, KPLSC, IUSE, IERR)

         SC = LSM_SCFAC (I, IERR)

         IF (IUSE.EQ.1) THEN

C====== collect for RSCALE

            RNS = RNS + ABS(SC*AINT-REFINT)
            RDS = RDS + (SC*AINT+REFINT)
            K = K + 1

C====== collection over lambda

            KBINLAMBDA = LSC_IRANGE(ALAM,NORMLAMMIN(KNORM), 
     +                  NORMLAMMAX(KNORM),NBINR(KNORM)) 
            AVERLAMBDA(KNORM,KBINLAMBDA) = 
     +      AVERLAMBDA(KNORM,KBINLAMBDA) + ALAM
            NREFLAMBDA(KNORM,KBINLAMBDA) =
     +      NREFLAMBDA(KNORM,KBINLAMBDA) + 1
            MEANLAMBDAL(KNORM,KBINLAMBDA) = 
     +      MEANLAMBDAL(KNORM,KBINLAMBDA) + SC*AINT
            MEANLAMBDAS(KNORM,KBINLAMBDA) = 
     +      MEANLAMBDAS(KNORM,KBINLAMBDA) + REFINT
            RFACLAMBDA1(KNORM,KBINLAMBDA) = 
     +      RFACLAMBDA1(KNORM,KBINLAMBDA) + ABS(SC*AINT-REFINT)
            RFACLAMBDA2(KNORM,KBINLAMBDA) = 
     +      RFACLAMBDA2(KNORM,KBINLAMBDA) + (SC*AINT+REFINT)           

C====== collection over theta

            THETA = ASIN(SQRT(STOL2)*ALAM)*180.0/PI
            KBINTHETA = LSC_IRANGE(THETA,THETAMIN,THETAMAX,10)  
            AVERTHETA(KBINTHETA) = AVERTHETA(KBINTHETA) + THETA
            NREFTHETA(KBINTHETA) = NREFTHETA(KBINTHETA) + 1
            MEANTHETA(KBINTHETA) = MEANTHETA(KBINTHETA) + 
     +                             SC*AINT/REFINT
            RFACTHETA1(KBINTHETA) = RFACTHETA1(KBINTHETA) +
     +                             ABS(SC*AINT-REFINT)
            RFACTHETA2(KBINTHETA) = RFACTHETA2(KBINTHETA) +
     +                             (SC*AINT+REFINT)
      

C====== collection over resolution (sin**(theta)/lambda**2)

            KBINSTOL = LSC_IRANGE(STOL2,STOL2MIN,STOL2MAX,10)  
            AVERSTOL(KBINSTOL) = AVERSTOL(KBINSTOL) + STOL2
            NREFSTOL(KBINSTOL) = NREFSTOL(KBINSTOL) + 1
            MEANSTOL(KBINSTOL) = MEANSTOL(KBINSTOL) + 
     +                           SC*AINT/REFINT
            IOVSIGI(KBINSTOL) = IOVSIGI(KBINSTOL) +  
     +                            AINT/SIGINT
            RFACTSTOL1(KBINSTOL) = RFACTSTOL1(KBINSTOL) +  
     +                            ABS(SC*AINT-REFINT)
            RFACTSTOL2(KBINSTOL) = RFACTSTOL2(KBINSTOL) +  
     +                            (SC*AINT+REFINT)
            IF (SC*AINT.GT.0.0) THEN
               LOGSTOL(KBINSTOL) = LOGSTOL(KBINSTOL) + 
     +                         LOG(SC*AINT/REFINT)
            END IF

C====== collection over intensities

            KBININT = LSC_IRANGE(SC*AINT,AINTMIN,AINTMAX,10)    
            AVERINT(KBININT) = AVERINT(KBININT) + SC*AINT
            NREFINT(KBININT) = NREFINT(KBININT) + 1
            MEANINT(KBININT) = MEANINT(KBININT) +
     +                          SC*AINT/REFINT
            RFACINT1(KBININT) = RFACINT1(KBININT) + 
     +                            ABS(SC*AINT-REFINT)
            RFACINT2(KBININT) = RFACINT2(KBININT) + 
     +                            (SC*AINT+REFINT)

         END IF   
 10   CONTINUE

      RSCALE = RNS/RDS

      DO 90 I = 1, NRAN
         DO 100 J = 1, NBINR(I)
            AVERLAMBDA(I,J) = AVERLAMBDA(I,J)/NREFLAMBDA(I,J) 
            MEANLAMBDAL(I,J) = MEANLAMBDAL(I,J)/NREFLAMBDA(I,J) 
            MEANLAMBDAS(I,J) = MEANLAMBDAS(I,J)/NREFLAMBDA(I,J)
            RFACLAMBDA(I,J) = RFACLAMBDA1(I,J)/RFACLAMBDA2(I,J)
 100     CONTINUE
 90   CONTINUE
            
      DO 60 I = 1, 10
         IF (NREFTHETA(I).GT.0)THEN
            AVERTHETA(I) = AVERTHETA(I)/NREFTHETA(I) 
            MEANTHETA(I) = MEANTHETA(I)/NREFTHETA(I)
            RFACTHETA(I) = RFACTHETA1(I)/RFACTHETA2(I)
         END IF
         IF (NREFSTOL(I).GT.0)THEN         
            AVERSTOL(I) = AVERSTOL(I)/NREFSTOL(I) 
            MEANSTOL(I) = MEANSTOL(I)/NREFSTOL(I) 
            IOVSIGI(I) = IOVSIGI(I)/NREFSTOL(I) 
            RFACTSTOL(I) = RFACTSTOL1(I)/RFACTSTOL2(I)
            LOGSTOL(I) = LOGSTOL(I)/NREFSTOL(I)
         END IF
         IF (NREFINT(I).GT.0)THEN
            AVERINT(I) = AVERINT(I)/NREFINT(I) 
            MEANINT(I) = MEANINT(I)/NREFINT(I)
            RFACINT(I) = RFACINT1(I)/RFACINT2(I) 
         END IF
 60   CONTINUE

C
C PRINT TABLES AND HISTOGRAMS 
C ===========================
C

      IF(BATCH_FL) THEN

C
C PRINT RSCALE
C ------------

         WRITE (IUN,6050)
         WRITE (IUN,6060) RSCALE
         WRITE (IUN,6040) K

C
C PRINT INTENSITY ANALYSIS VERSUS LAMBDA
C --------------------------------------

         WRITE (IUN,6000)
         WRITE (IUN,6005)

         DO 70 I = 1, NRAN
            WRITE (IUN,6070) I, NORMLAMMIN(I), NORMLAMMAX(I)
            WRITE (IUN,6010)
            DO 80 J = 1 , NBINR(I)
               WRITE (IUN,6020) J, AVERLAMBDA(I,J),  
     +                NREFLAMBDA(I,J) , MEANLAMBDAS(I,J), 
     +                MEANLAMBDAL(I,J), RFACLAMBDA(I,J)        
 80         CONTINUE
 70      CONTINUE      

C
C PRINT INTENSITY ANALYSIS VERSUS RESOLUTION
C ------------------------------------------
C
         WRITE (IUN,6080) 
         WRITE (IUN,6085) STOL2MIN, STOL2MAX
         WRITE (IUN,6090) 

         DO 110 I = 1, 10
            WRITE (IUN,6100) I, AVERSTOL(I),NREFSTOL(I),
     +                 MEANSTOL(I), IOVSIGI(I), RFACTSTOL(I),LOGSTOL(I)
 110     CONTINUE

C
C PRINT INTENSITY ANALYSIS 
C ------------------------
C
         WRITE (IUN,6200) 
         WRITE (IUN,6205) AINTMIN ,AINTMAX
         WRITE (IUN,6210) 
         DO 120 I = 1, 10
            WRITE (IUN,6220) I, AVERINT(I), NREFINT(I), MEANINT(I),
     +                     RFACINT(I)
 120     CONTINUE

C
C PRINT INTENSITY ANALYSIS VERSUS THETA
C -------------------------------------
C
         WRITE (IUN,6230) 
         WRITE (IUN,6240) THETAMIN, THETAMAX
         WRITE (IUN,6250) 
         DO 160 I = 1, 10
            WRITE (IUN,6260) I, AVERTHETA(I), NREFTHETA(I), 
     +                       MEANTHETA(I), RFACTHETA(I)
 160     CONTINUE

      END IF

      IF(.NOT.BATCH_FL) THEN
C
C PREPARE MENUES FOR PLOTS
C ------------------------
C
         M_LAMBDA = 1
         M_STOL = 2
         M_INT = 3
         M_THETA = 4

 500     CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 4, XDLSTR(NAMES), 
     +                 17, XDLSTR('Reference Set Scaling'), 21,
     +                 XDLSTR(QUITNAM), 25, 0, IERR)
C
C====== Set up list of view-object handles
C
         NVIEW = 1
         IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
         CALL XDLF_GET_EVENTS (NVIEW, IVHLIST, IVH)
         IF (IVH.EQ.IVH_MENU) THEN
C
C======  Menu item selected
C
            CALL XDLF_MENU_AREA_GETITEM (IVH_MENU, ITEM, IQUIT)
C
C======  Quit selected
C
            IF (IQUIT.EQ.1) THEN
               IF (GRAPH_DISP) THEN
                  CALL XDLF_GRAPH_WIN_DELETE (IVH_GRAPH, 0, IERR)
               END IF
               RETURN
            END IF
C
C PLOT INTENSITY ANALYSIS VERSUS LAMBDA
C -------------------------------------

C            IF (ITEM.EQ.M_LAMBDA) THEN
C              DO 150 I = 1, NRAN
C                  I = 1
C                  DO 140 J = 1, MAXBIN
C                     RFACHIS(J) = RFACLAMBDA(I,J)
C                     MEANL(J) = MEANLAMBDAL(I,J)
C                     MEANS(J) = MEANLAMBDAS(I,J)
C                     NREFLAM(J) = NREFLAMBDA(I,J)
C 140              CONTINUE
C
C                  CALL LSC_HIST_LAMBDA (NBINR(I),  
C     +                 (NORMLAMMAX(I)-NORMLAMMIN(I))/(1.0*NBINR(I)), 
C     +                 NORMLAMMIN(I), NORMLAMMAX(I), NREFLAM,
C     +                 MEANL, MEANS, RFACHIS)
C                  GRAPH_DISP = .TRUE.
C                  GO TO 500
C     150       CONTINUE

            IF (ITEM.EQ.M_LAMBDA) THEN
               I = 1
               DO 140 J = 1, MAXBIN
                  RFACHIS(J) = RFACLAMBDA(I,J)
                  MEANL(J) = MEANLAMBDAL(I,J)
                  MEANS(J) = MEANLAMBDAS(I,J)
                  NREFLAM(J) = NREFLAMBDA(I,J)
 140           CONTINUE

               CALL LSC_HIST_LAMBDA (MAXBIN,  
     +                 (NORMLAMMAX(1)-NORMLAMMIN(1))/(1.0*MAXBIN), 
     +                 NORMLAMMIN(1), NORMLAMMAX(1), NREFLAM,
     +                 MEANL, MEANS, RFACHIS)
               GRAPH_DISP = .TRUE.
               GO TO 500

C
C PLOT INTENSITY ANALYSIS VERSUS RESOLUTION
C ------------------------------------------
C
            ELSE IF (ITEM.EQ.M_STOL) THEN
               CALL LSC_HIST_RES (MAXBIN,
     +              (STOL2MAX-STOL2MIN)/(1.0*MAXBIN), 
     +              STOL2MIN, STOL2MAX, NREFSTOL,
     +                 MEANSTOL, RFACTSTOL, LOGSTOL)
               GRAPH_DISP = .TRUE.
               GO TO 500
C
C PLOT INTENSITY ANALYSIS 
C -----------------------
C
            ELSE IF (ITEM.EQ.M_INT) THEN
               CALL LSC_HIST_INT (MAXBIN,
     +              (AINTMAX-AINTMIN)/(1.0*MAXBIN), 
     +              AINTMIN, AINTMAX, NREFINT,
     +              MEANINT, RFACINT)
               GRAPH_DISP = .TRUE.
               GO TO 500
C
C PLOT INTENSITY ANALYSIS VERSUS THETA
C -------------------------------------
C
            ELSE IF (ITEM.EQ.M_THETA) THEN
               CALL LSC_HIST_THETA (MAXBIN,
     +             (THETAMAX-THETAMIN)/(1.0*MAXBIN), 
     +              THETAMIN, THETAMAX, NREFTHETA,
     +              MEANINT, RFACTHETA)
               GRAPH_DISP = .TRUE.
               GO TO 500
            END IF
         END IF
      ELSE 
         RETURN
      END IF



 6000 FORMAT (//'   ANALYSIS OF SCALED LAUE INTENSITIES')
 6005 FORMAT ('   ===================================')
 6010 FORMAT (/,'   BIN  AVERAGE   NO. LAUE    MEAN        MEAN',
     +        '   R-FACTOR',/,
     +        '   NO.  LAMBDA    REFLNS      IS          IL',/)
 6020 FORMAT (' ',I4,F8.3,I8,F13.1,F12.1,F8.3)
 6040 FORMAT (/,'   N =',I6)
 6050 FORMAT (///,'   SCALING R-FACTOR = SUM(ABS(IL-IS)/SUM(IL+IS)',//,
     +        '                    (SUM FOR EACH MERGED REFLECTION',/,
     +        '                     PRESENT IN BOTH DATA SETS)')
 6060 FORMAT (/,'   RSCALE =',F6.3)
 6070 FORMAT (//,'   LAMBDA RANGE NO.',I3,' (FROM ',F6.3,'A TO ',
     +             F6.3,'A)'/) 
 6080 FORMAT (///,'   ANALYSIS OF DATA IN 10 EQUAL BINS OF ',
     +        'SIN**(THETA)/LAMBDA**2')
 6085 FORMAT (/,'   (FROM',F7.4,' TO',F7.4,')')
 6090 FORMAT (//,
     +       '   BIN  AVERAGE  NO. LAUE  MEAN    I/SIG(I)  R-FACTOR',
     +       '   ','LOG(IL/IS)'
     +        ,/,'   NO.  STL2     REFLNS    IL/IS',/)
 6100 FORMAT (' ',I4,F8.3,I7,F12.3,2F8.3,F11.3)
 6200 FORMAT (///,'   ANALYSIS OF DATA IN 10 EQUAL BINS OF INTENSITY ')
 6205 FORMAT (/,'   (FROM',F12.1,'   TO',F12.1,' (UNSCALED))')
 6210 FORMAT (//,'   BIN    AVERAGE     NO. LAUE   MEAN    R-FACTOR',/,
     +        '   NO.    INTENSITY   REFLNS     IL/IS',/)
 6220 FORMAT (' ',I4,F14.1,I7,F12.3,F8.3)
 6230 FORMAT (///,'   ANALYSIS OF DATA IN 10 EQUAL BINS OF THETA ')
 6240 FORMAT (/,'   (THETA FROM',F12.1,'   TO',F12.1,')')
 6250 FORMAT (//,'   BIN    AVERAGE     NO. LAUE   MEAN    R-FACTOR',/,
     +        '   NO.    THETA       REFLNS     IL/IS',/)
 6260 FORMAT (' ',I4,F9.1,I12,F12.3,F8.3)
      END
