
C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     LSM_NEXT_REFOBS   **
C***************************
C
C **** LSM SERVICE ROUTINE ONLY ****
C
      INTEGER FUNCTION LSM_NEXT_REFOBS (REFERENCE)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Gets the next singles reflections observation set from the 
C          LIRL for currently selected reflection types (see 
C          LSM_SELECT_SCREFS) and packs/plates (see LSM_SELECT_PKPL).
C
C          Returns in a set of internal variables and arrays for use in
C          LSM_REFINE the following:
C
C          The no. of reflections (>1).
C
C          Array of LIRL indices for the reflections.
C
C          Array of scaled intensities (using scaling parameters in the
C          SCP arrays).
C
C          Array of scaled sigma(I) based weights
C
C          Array of reference intensity or weighted mean scaled intensity
C          values.
C
C     Note: Assumes that LSM_CALC_PRESETS has been called
C
C     Note: Assumes all checkin done so that a valid scaling factor
C           will be found
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      LOGICAL REFERENCE
C
C  Parameters:
C
C  REFERENCE   l (R)   Flag = .true.  return reference intensities
C                           = .false. return weighted mean scaled intensities
C
C         Returns >=2   the number of reflections in the set
C                  -1   when the end of the list is reached
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== FUNCTIONS:
C

C
C====== GLOBALS:
C
      INCLUDE 'lsm_flags.finc'
      INCLUDE 'use_reflns.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'next_refobs.finc'
      INCLUDE 'scale_presets.finc'
C
C====== LOCALS:

      INTEGER IFLAG
      INTEGER IR
      INTEGER IUSE
      INTEGER IERR
      INTEGER IPACK, IPLATE
      INTEGER KPLS, KNORM
      INTEGER IDX_ARR(MAX_SYMEQ)      
      REAL OB_LPFAC
      REAL SC
      REAL WMEAN, WIMEAN, WSIGMEAN
      REAL REFINT
      REAL ABSCOR_NU, PSI_LOC, PSI_GLO
      REAL STOL2
      REAL ABSCOR_LAMFN
      REAL ALAM3COS2TH 
      REAL AINT, SIGINT, ALAM

C     INTEGER IFLAG                 ! Return flag
C     INTEGER IR                    ! Temp./loop variables 
C     INTEGER IREF                  ! Reflection number (from 1 upwards) 
C     INTEGER IUSE                  ! Returns use reflection flag =1 yes, =0 no
C     INTEGER IERR                  ! Error flag
C     INTEGER IPACK, IPLATE         ! Pack number, plate number
C     INTEGER KPLS                  ! Returns plate to plate scaling range flag
C     INTEGER KNORM                 ! Returns normalisation curve range no. flag
C     INTEGER KSYM, IH, IK, IL      ! Symmetry no., h, k, l
C     INTEGER IDX_ARR(MAX_SYMEQ)    ! Array of reflection indices (from 1 
C                                     upwards) for the reflections in the set
C     REAL OB_LPFAC                 ! Lorenz-polarisation/obliquity factor
C     REAL SC                       ! Scale factor 
C     REAL WMEAN                    ! weighted mean
C     REAL WIMEAN, WSIGMEAN         ! Temp./loop variables
C     REAL REFINT                   ! reference intensity 
C     REAL ABSCOR_NU,PSI_LOC,PSI_GLO! nu- and psi-angle
C     REAL STOL2                    ! sin**theta/lambda**2 
C     REAL ABSCOR_LAMFN             ! lambda dependent function for absorption 
C     REAL ALAM3COS2TH              ! lambda**3/cos2theta
C     REAL AINT, SIGINT, ALAM       ! intensity I, sig(I), wavelength   
C                                     correction (W) 
C          
C-------------------------------------------------------------------------------
C
 10   CALL LIRLF_LSM_NEXT (IDX_ARR, MAX_SYMEQ, NREFOBS, 0, IFLAG)
      IF (IFLAG.GE.0) THEN
         IF (.NOT.REFERENCE.AND.NREFOBS.EQ.1) GO TO 10
         WIMEAN = 0.0
         WSIGMEAN = 0.0
         DO 20 IR = 1, NREFOBS
            CALL LIRLF_LSM_SCALOBS (LINDX_USE,IDX_ARR(IR), 
     +                IPACK, IPLATE, AINT, SIGINT, ALAM, REFINT,
     +                ABSCOR_NU, PSI_LOC, PSI_GLO, STOL2,
     +                ALAM3COS2TH, ABSCOR_LAMFN, OB_LPFAC,
     +                KNORM, KPLS, IUSE, IERR)
            CALL LSM_CALCSCFAC (SC, IPACK, IPLATE, KPLS, KNORM,
     +               ABSCOR_NU, PSI_LOC, PSI_GLO, ABSCOR_LAMFN,  
     +               STOL2, ALAM, ALAM3COS2TH, OB_LPFAC, .TRUE.,
     +               PQ00_GLOB_STORE, P00_LOC_STORE, AKNORM_STORE,
     +               ANORMREF_STORE, IERR)
            LIRL_INDX(IR) = IDX_ARR(IR)
            SCALINT(IR) = SC*AINT
            SCALSIG(IR) = SC*SIGINT
            IF (REFINT_USE) THEN
               REFMEAN(IR) = REFINT
            ELSE
               WIMEAN = WIMEAN + SCALINT(IR)/SCALSIG(IR)**2
               WSIGMEAN = WSIGMEAN + 1/SCALSIG(IR)**2
            END IF
 20      CONTINUE
C            WMEAN = WIMEAN/WSIGMEAN
         IF (.NOT.REFINT_USE) THEN
            WMEAN = WIMEAN/WSIGMEAN
            DO 30 IR = 1, NREFOBS
               REFMEAN(IR) = WMEAN
 30         CONTINUE
         END IF
         LSM_NEXT_REFOBS = NREFOBS
      ELSE 
         LSM_NEXT_REFOBS = -1
      END IF
      RETURN
      END
