
C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     LSC_ANALYSES      **
C***************************
C
CD-Routine: Calculates and outputs statistical data - LSC_ANALYSES
C This routine calculates and prepares various statistical graphs and
C marks reflections as outliers according to the input cutoff criteria.
CD-end
CD-Fortran:
C
      SUBROUTINE LSC_ANALYSES (LINDX, REFERENCE, IFL1, IFL2, 
     +                        EXOUT, CUTOFF)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C
C Purpose : Carries out data diagnostics
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER LINDX
      INTEGER IFL1
      INTEGER IFL2
      REAL CUTOFF
      LOGICAL EXOUT
      LOGICAL REFERENCE

CD-Parameters:
C
C   LINDX     i  (R)    The index of the Laue Integrated Reflections List
C   REFERENCE l  (R)    If .true. then only reflections which have a
C                       reference intensity stored will be returned;
C                       if .false., reflections will be returned whether
C                       or not a reference intensity is present.
C   IFL1,IFL2 i  (R)    Output flags
C                       IFL1 = 0, IFL2 = 0
C                       no winows output
C                       IFL1 = 1, IFL2 = 1
C                       internal refinement, no refset
C                       IFL1 = -1, IFL2 = 1
C                       external refinement, refset
C                       IFL1 = 1, IFL2 = -1
C                       internal refinement, refset scaling
C   CUTOFF    r  (R)    Outlier cutoff
C   EXOUT     l  (R)    Outlier exclusion flag (if .true. then exclude outliers)
CD-end

C 
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'scale_presets.finc'
      INCLUDE 'use_reflns.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'ref_flags.finc'
      INCLUDE 'other_scale.finc'
      INCLUDE 'view_handles.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LSM_NEXT_REFLN
      INTEGER LSM_INDX
      INTEGER XDLSTR
      INTEGER LSM_NORM_RANGE
      DOUBLE PRECISION LSM_ANORM
C
C====== LOCALS:
C

      INTEGER I, K1, K2, KN, NR
      INTEGER KERR, IERR
      INTEGER KSYM
      INTEGER IPACK, IPLATE
      INTEGER KPLS
      INTEGER IUSE
      INTEGER IH, IK, IL
      INTEGER M_SCAT1 
      INTEGER M_SCAT2
      INTEGER M_IOSLAM
      INTEGER M_RESLAM 
      INTEGER M_IOSRES 
      INTEGER M_NORM 
      INTEGER M_ILOIR
      INTEGER NVIEW
      INTEGER IVHLIST(2)
      INTEGER IVH
      INTEGER ITEM
      INTEGER IQUIT
      INTEGER KNORM
      INTEGER SPAT_OUT, OVLD_OUT, NEGINT

      REAL ANR
      REAL REFINT
      REAL ALAM
      REAL AI, SIGMA
      REAL SC
      REAL ABSCOR_NU, PSI_LOC, PSI_GLO
      REAL STOL2, AL3C2T, ABSCOR_LAMFN
      REAL OB_LPFAC
      REAL SCALINT(MAX_SYMEQ),SCALSIG(MAX_SYMEQ)
      REAL ALAMS(MAX_SYMEQ)
      REAL AINT(MAX_SYMEQ)
      REAL AREFMEAN(MAX_SYMEQ)
      REAL AIMEAN, ASIGMEAN, AMEAN
      REAL AIMEAN1, ASIGMEAN1, AMEAN1
      REAL ERROR(MXR)
      REAL ERROR1(MXR)
      REAL ALBDA(MXR)
      REAL ALAMBDA(MXR)
      REAL STOL(MAX_SYMEQ)
      REAL RES(MXR)
      REAL IOSIG(MXR)
      REAL WLNORM(MXR)
      REAL RFINT(MXR), SCINT(MXR)
      REAL SIGOUT
      LOGICAL SPOV, OVLD
      LOGICAL GRAPH_DISP 
      CHARACTER*23 NAMES(7)
      CHARACTER*19 NAMESEX(2)
      CHARACTER*25 QUITNAM

      DATA NAMES /'Error before refinement',
     +            'Error after refinement',
     +            'I/sig(I) vs. lambda',
     +            'resolution vs. lambda',
     +            'I/sig(I) vs. resolution',
     +            'Normalisation curve',
     +            'ILaue vs IRef'/
      DATA NAMESEX /'Error after Scaling',
     +              'ILaue vs IRef'/
      DATA QUITNAM /'Return to Previous Menu'/

      K1 = 0
      K2 = 0
      GRAPH_DISP = .FALSE.

      DO 40 I = 1, MXR
         ERROR(I) = 0.0
         ERROR1(I) = 0.0
         ALBDA(I) = 0.0
         ALAMBDA(I) = 0.0
         RES(I) = 0.0
         IOSIG(I) = 0.0
         WLNORM(I) = 0.0
         RFINT(I) = 0.0
         SCINT(I) = 0.0
 40   CONTINUE

      DO 50 I = 1, MAX_SYMEQ
         SCALINT(I) = 0.0
         SCALSIG(I) = 0.0
         ALAMS(I) = 0.0
         AINT(I) = 0.0
         AREFMEAN(I) = 0.0
         STOL(I) = 0.0
 50   CONTINUE

      CALL LSM_SEL_SAVE

      CALL LSM_SELECT_PKPL (0, 0) 

C>>>>

      CALL LSC_GET_OUTPUTFLAGS (LINDX, OVLD_OUT, SPAT_OUT,  
     +                          NEGINT, SIGOUT)      

C>>>>>
      IF (SPAT_OUT.EQ.1) SPOV = .TRUE.
      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., REFERENCE, SIGOUT,  
     +                        SPOV, OVLD) 
    
      CALL LSM_TOP_LIRL(LINDX, KERR)

      IF (KERR.NE.0) RETURN 

      CALL LSM_CALC_PRESETS 

 10   NR = LSM_NEXT_REFLN(KERR)

      IF (NR.LE.-1) THEN
         CALL LSM_SEL_RESTORE

         IF (IFL1.NE.0.AND.IFL2.NE.0) THEN

            IF (REFERENCE.AND.IFL1.LT.0) THEN
               CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 7,  
     +           XDLSTR(NAMES),23, 
     +           XDLSTR('Refinement against refset'), 25,
     +           XDLSTR(QUITNAM), 25, 0, IERR)
            ELSE IF (IFL1.GT.0.AND.IFL2.LT.0) THEN
               CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 7,  
     +              XDLSTR(NAMES),23, 
     +              XDLSTR('Internal refinement'), 19,
     +              XDLSTR(QUITNAM), 25, 0, IERR)
            ELSE 
               CALL XDLF_MENU_AREA_SETMENU (IVH_MENU, 6,  
     +              XDLSTR(NAMES),23, 
     +              XDLSTR('Internal refinement'), 19,
     +              XDLSTR(QUITNAM), 25, 0, IERR)
            END IF
               M_SCAT1 = 1
               M_SCAT2 = 2
               M_IOSLAM = 3
               M_RESLAM = 4
               M_IOSRES = 5
               M_NORM = 6
               M_ILOIR = 7
C
C====== Set up list of view-object handles
C
            NVIEW = 1
            IVHLIST(1) = IVH_MENU
C
C====== Start event loop
C
 500        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

               IF(ITEM.EQ.M_SCAT2) THEN
                  CALL LSC_SCATTER (1, 1, ALBDA, ERROR, K2, 1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500
               ELSE IF (ITEM.EQ.M_SCAT1) THEN
                  CALL LSC_SCATTER(1, 1, ALBDA, ERROR1, K2, -1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500
               ELSE IF (ITEM.EQ.M_IOSLAM) THEN
                  CALL LSC_SCATTER (1, 2, ALAMBDA, IOSIG, K1, 1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500
               ELSE IF (ITEM.EQ.M_RESLAM) THEN
                  CALL LSC_SCATTER (1, 3, ALAMBDA, RES, K1, 1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500
               ELSE IF (ITEM.EQ.M_IOSRES) THEN
                  CALL LSC_SCATTER (2, 2, RES, IOSIG, K1, 1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500
               ELSE IF (ITEM.EQ.M_NORM) THEN
                  CALL LSC_SCATTER (1, 4, ALAMBDA, WLNORM, K1, 1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500
               ELSE IF (ITEM.EQ.M_ILOIR) THEN
                  CALL LSC_SCATTER (3, 5, RFINT, SCINT, K1, 1)
                  GRAPH_DISP = .TRUE.
                  GO TO 500                  
               END IF
            END IF
            GO TO 500

         ELSE

            RETURN

         END IF
      END IF

      AIMEAN = 0.0
      AMEAN = 0.0
      ASIGMEAN = 0.0
      AIMEAN1 = 0.0
      AMEAN1 = 0.0
      ASIGMEAN1 = 0.0

      DO 240 I = 1, NR
         CALL LIRLF_LSM_SCALOBS (LINDX,LSM_INDX(I), 
     +             IPACK, IPLATE, AI, SIGMA, ALAM, REFINT,
     +             ABSCOR_NU, PSI_LOC, PSI_GLO, STOL2,
     +             AL3C2T, ABSCOR_LAMFN, OB_LPFAC,
     +             KNORM, KPLS, IUSE, KERR)
         CALL LSM_CALCSCFAC (SC, IPACK, IPLATE, KPLS, KNORM,
     +             ABSCOR_NU, PSI_LOC, PSI_GLO, ABSCOR_LAMFN,  
     +             STOL2, ALAM, AL3C2T, OB_LPFAC,  .TRUE.,
     +             PQ00_GLOB_STORE, P00_LOC_STORE, AKNORM_STORE,
     +             ANORMREF_STORE, KERR)
         SCALINT(I) = SC*AI
         SCALSIG(I) = SC*SIGMA
         AINT(I) = AI
         ALAMS(I) = ALAM
         STOL(I) = STOL2
         IF (REFINT_USE) THEN
            AREFMEAN(I) = REFINT
         ELSE 
            IF (NR.GT.1) THEN
               AIMEAN = AIMEAN + SCALINT(I)/SCALSIG(I)**2
               ASIGMEAN = ASIGMEAN + 1/SCALSIG(I)**2
            END IF
         END IF
         IF (NR.GT.1) THEN
            AIMEAN1 = AIMEAN1 + AI/SIGMA**2
            ASIGMEAN1 = ASIGMEAN1 + 1/SIGMA**2
         END IF
         CALL LIRLF_GETHKL (LINDX, LSM_INDX(I), IH, IK, IL, KSYM, KERR)
         K1 = K1 + 1
         KN = LSM_NORM_RANGE (REFNORMLAM)
         ANR = 1.0/LSM_ANORM(KN, REFNORMLAM, KERR)
         WLNORM(K1) = 1.0/(LSM_ANORM(KNORM, ALAM, KERR) * ANR)
         IF (KERR.NE.0) THEN
            IERR = 2
         END IF
         IF (REFINT_USE.OR.IFL2.LT.0) THEN
            RFINT(K1) = REFINT
            SCINT(K1) = SCALINT(I)
         END IF         
         RES(K1) = STOL(I)
         IOSIG(K1) =  SCALINT(I)/SCALSIG(I) 
         ALAMBDA(K1) = ALAMS(I)
 240  CONTINUE

      IF (NR.EQ.1) GO TO 10

      IF (.NOT.REFINT_USE) THEN
         AMEAN = AIMEAN/ASIGMEAN
         DO 30 I = 1, NR
            AREFMEAN(I) = AMEAN
 30      CONTINUE
      END IF
      AMEAN1 = AIMEAN1/ASIGMEAN1
      DO 440 I = 1, NR       
         K2 = K2 + 1
         ERROR(K2) = (SCALINT(I)-AREFMEAN(I))/AREFMEAN(I)
         ERROR1(K2) = (AINT(I)-AMEAN1)/AMEAN1
         ALBDA(K2) = ALAMS(I)
         IF(EXOUT.AND.ABS(ERROR(K2)).GT.CUTOFF) THEN
            CALL LIRLF_SET_OUTLIER(LINDX,LSM_INDX(I),1,KERR)
            K2 = K2 - 1
         END IF
 440  CONTINUE
      GO TO 10
      
 6200 FORMAT (4F11.3,4I6,2F11.3)
 6300 FORMAT (4F12.3,3I8,F11.3)
 6400 FORMAT (5F12.3)
 6500 FORMAT (40I3)
 6600 FORMAT (25I4)

      END
