!+ Subroutine to calculate weightings across a contiguous band.
!
! Method:
!	The weighting coefficients are calculated and the integral
!	is formed.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date			Comment
!	1.0		12-04-95		First Version under RCS
!						(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE WEIGHTINGS_SINGLE(IERR
     &   , I_WEIGHT, L_WAVE_NUMBER
     &   , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &   , ABSCISSA_SHORTER, ABSCISSA_LONGER
     &   , N_ABSCISSA, ABSCISSA
     &   , I_BEGIN, N_INT_WEIGHT, WEIGHT_COEFF
     &   , INTEGRAL_WEIGHT
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/error.pcf'
!
!
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
!
      INTEGER	!, INTENT(IN)
     &     I_WEIGHT
!             WEIGHTING OPTION
     &   , N_SOLAR_POINTS
!             SIZE OF SOLAR SPECTRUM
     &   , N_ABSCISSA
!             NUMBER OF ABSCISSA POINTS
!
      INTEGER	!, INTENT(OUT)
     &     I_BEGIN
!             BEGINNING OF DATA RANGE
     &   , N_INT_WEIGHT
!             NUMBER OF POINTS OF INTEGRAL
!
      LOGICAL	!, INTENT(IN)
     &     L_WAVE_NUMBER
!             ABSCISSA IS WAVENUMBER
!
      REAL*8	!, INTENT(IN)
     &     T
!             TEMPERATURE OF BLACK BODY
     &   , ABSCISSA_SHORTER
!             SHORTER ABSCISSA OF BAND
     &   , ABSCISSA_LONGER
!             LONGER ABSCISSA OF BAND
     &   , ABSCISSA(N_ABSCISSA)
!             ABSCISSAE OF INPUT DATA
     &   , SOLAR_WAVELENGTH(NPD_SOLAR_POINTS)
!             WAVELENGTHS OF SOLAR SPECTRUM
     &   , SOLAR_IRRAD(NPD_SOLAR_POINTS)
!             SOLAR IRRADIANCES AT TOA
!
      REAL*8	!, INTENT(OUT)
     &     WEIGHT_COEFF(0: N_ABSCISSA)
!             WEIGHTING COEFFICIENTS
     &   , INTEGRAL_WEIGHT
!             INTEGRAL OF WEIGHTING FUNCTION
!
!
!     LOCAL VARIABLES
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , I_END
!             END OF DATA RANGE
!
      REAL*8
     &     FRACTION_LOWER
!             FRACTION OF LOWER EXTREME INTERVAL INCLUDED
     &   , FRACTION_UPPER
!             FRACTION OF UPPER EXTREME INTERVAL INCLUDED
     &   , WIDTH_LOWER
!             WIDTH OF LOWER INTERVAL
     &   , WIDTH_UPPER
!             WIDTH OF UPPER INTERVAL
     &   , WEIGHT_LOWER
!             WEIGHTING FOR LWOER POINT
     &   , WEIGHT_UPPER
!             WEIGHTING FOR UPPER POINT
!
!
!     FUNCTIONS CALLED:
      REAL*8
     &     FUNC_WEIGHT
!             WEIGHTING FUNCTION
      EXTERNAL
     &     FUNC_WEIGHT
!
!
!
!     FIND THE POINTS IN THE ARRAY OF ABSCISSAE WHICH LIE JUST
!     OUTSIDE THE BAND. BEGIN BY FINDING POINTS JUST WITHIN THE BAND.
      I_BEGIN=1
      I_END=N_ABSCISSA
1     IF (ABSCISSA(I_BEGIN).LE.ABSCISSA_SHORTER) THEN
         I_BEGIN=I_BEGIN+1
!        THIS LOOP MUST TERMINATE BECAUSE OF THE CHECK IN THE CALLING
!        ROUTINE.
         GOTO 1
      ENDIF
2     IF (ABSCISSA(I_END).GE.ABSCISSA_LONGER) THEN
         I_END=I_END-1
!        THIS LOOP MUST TERMINATE BECAUSE OF THE CHECK IN THE CALLING
!        ROUTINE.
         GOTO 2
      ENDIF
!     NOW RESET TO VALUES JUST OUTSIDE THE BAND.
      I_BEGIN=I_BEGIN-1
      I_END=I_END+1
!
!
!
!     ANY SCHEME FOR NUMERICAL QUADRATURE WILL INVOLVE ASSIGNING
!     WEIGHTINGS TO BE APPLIED AT THE POINTS WHERE DATA ARE AVAILABLE.
!     THERE WILL THEREFORE BE N_INT_WEIGHT = I_END-I_BEGIN INTERVALS 
!     TO BE WEIGHTED, SO THE WEIGHTING COEFFICIENTS MAY BE NUMBERED 
!     FROM 0 TO N_INT_WEIGHT.
!
      N_INT_WEIGHT=I_END-I_BEGIN
!     THE COEFFICIENTS AT THE EDGES ARE SET TO ASSUME 
!     LINEAR INTERPOLATION OF THE DATA.
!
      IF (N_INT_WEIGHT.GE.3) THEN
!
!        NORMAL CASE: 3 OR MORE WEIGHTING INTERVALS.
!
!        TWO LOWER EXTREME POINTS:
         WIDTH_LOWER=ABSCISSA(I_BEGIN+1)-ABSCISSA(I_BEGIN)
         FRACTION_LOWER=(ABSCISSA(I_BEGIN+1)-ABSCISSA_SHORTER)
     &      /WIDTH_LOWER
         WEIGHT_LOWER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA_SHORTER)
         WEIGHT_COEFF(0)
     &      =0.5D+00*WEIGHT_LOWER*WIDTH_LOWER*FRACTION_LOWER**2
         WIDTH_UPPER=ABSCISSA(I_BEGIN+2)-ABSCISSA(I_BEGIN+1)
         WEIGHT_UPPER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA(I_BEGIN+1))
         WEIGHT_COEFF(1)=0.5D+00*(WEIGHT_UPPER
     &      *(WIDTH_LOWER*FRACTION_LOWER+WIDTH_UPPER)
     &      +WEIGHT_LOWER*WIDTH_LOWER*FRACTION_LOWER
     &      *(1.0D+00-FRACTION_LOWER))
!
!        MIDDLE POINTS:
         DO I=2, N_INT_WEIGHT-2
            WIDTH_LOWER=WIDTH_UPPER
            WIDTH_UPPER=ABSCISSA(I_BEGIN+I+1)-ABSCISSA(I_BEGIN+I)
            WEIGHT_COEFF(I)=0.5D+00*(WIDTH_LOWER+WIDTH_UPPER)
     &         *FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &         , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &         , ABSCISSA(I_BEGIN+I))
         ENDDO
!
!        UPPER EXTREME POINTS:
         WIDTH_LOWER=WIDTH_UPPER
         WIDTH_UPPER=ABSCISSA(I_END)-ABSCISSA(I_END-1)
         FRACTION_UPPER=(ABSCISSA_LONGER-ABSCISSA(I_END-1))
     &      /WIDTH_UPPER
         WEIGHT_LOWER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA(I_END-1))
         WEIGHT_UPPER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA_LONGER)
         WEIGHT_COEFF(N_INT_WEIGHT-1)=0.5D+00*(WEIGHT_LOWER
     &      *(WIDTH_LOWER+WIDTH_UPPER*FRACTION_UPPER)
     &      +WEIGHT_UPPER*WIDTH_UPPER*FRACTION_UPPER
     &      *(1.0D+00-FRACTION_UPPER))
         WEIGHT_COEFF(N_INT_WEIGHT)=0.5D+00*WEIGHT_UPPER
     &      *FRACTION_UPPER**2*WIDTH_UPPER
!
      ELSE IF (N_INT_WEIGHT.EQ.2) THEN
!
!        WITH TWO INTERVALS THE CENTRAL WEIGHT IS EXCEPTIONAL
!
         WIDTH_LOWER=ABSCISSA(I_BEGIN+1)-ABSCISSA(I_BEGIN)
         WIDTH_UPPER=ABSCISSA(I_END)-ABSCISSA(I_END-1)
         FRACTION_LOWER=(ABSCISSA(I_BEGIN+1)-ABSCISSA_SHORTER)
     &      /WIDTH_LOWER
         FRACTION_UPPER=(ABSCISSA_LONGER-ABSCISSA(I_END-1))
     &      /WIDTH_UPPER
!
!        CONTRIBUTIONS OVER LOWER INTERVAL.
!
         WEIGHT_LOWER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA_SHORTER)
         WEIGHT_COEFF(0)
     &      =0.5D+00*WEIGHT_LOWER*WIDTH_LOWER*FRACTION_LOWER**2
         WEIGHT_UPPER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA(I_BEGIN+1))
         WEIGHT_COEFF(1)=0.5D+00*WIDTH_LOWER*FRACTION_LOWER
     &      *(WEIGHT_LOWER*(1.0D+00-FRACTION_LOWER)
     &      +WEIGHT_UPPER)
!
!        CONTRIBUTIONS FROM UPPER INTERVAL.
!
         WEIGHT_LOWER=WEIGHT_UPPER
         WEIGHT_UPPER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA_LONGER)
         WEIGHT_COEFF(1)=WEIGHT_COEFF(1)
     &      +0.5D+00*WIDTH_UPPER*FRACTION_UPPER
     &      *(WEIGHT_LOWER+WEIGHT_UPPER*(1.0D+00-FRACTION_UPPER))
         WEIGHT_COEFF(2)=0.5D+00*WIDTH_UPPER*WEIGHT_UPPER
     &      *FRACTION_UPPER**2
!
      ELSE IF (N_INT_WEIGHT.EQ.1) THEN
!
!        ONLY THE EDGE POINTS CONTRIBUTE
!
         WEIGHT_LOWER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA_SHORTER)
         WEIGHT_UPPER=FUNC_WEIGHT(I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD, T
     &      , ABSCISSA_LONGER)
!        CALCULATE FRACTIONS OF THE INTERVAL DELIMITED BY THE
!        EDGES OF THE BAND.
         WIDTH_UPPER=ABSCISSA(I_END)-ABSCISSA(I_BEGIN)
         FRACTION_LOWER=(ABSCISSA_SHORTER-ABSCISSA(I_BEGIN))
     &      /WIDTH_UPPER
         FRACTION_UPPER=(ABSCISSA_LONGER-ABSCISSA(I_BEGIN))
     &      /WIDTH_UPPER
         WEIGHT_COEFF(0)=0.5D+00*(ABSCISSA_LONGER-ABSCISSA_SHORTER)
     &      *(WEIGHT_LOWER*(1.0D+00-FRACTION_LOWER)
     &      +WEIGHT_UPPER*(1.0D+00-FRACTION_UPPER))
         WEIGHT_COEFF(1)=0.5D+00*(ABSCISSA_LONGER-ABSCISSA_SHORTER)
     &      *(WEIGHT_LOWER*FRACTION_LOWER+WEIGHT_UPPER*FRACTION_UPPER)
!
      ENDIF
!
!
!     EVALUATE INTEGRAL OF WEIGHTING FUNCTION.
      INTEGRAL_WEIGHT=0.0D+00
      DO I=0, N_INT_WEIGHT
         INTEGRAL_WEIGHT=INTEGRAL_WEIGHT+WEIGHT_COEFF(I)
      ENDDO
!
!
!
      RETURN
      END
