! This variant of Blue's A,gorithm makes use of the fact that
! all three component sums of squares cannot contribute to the
! final result. If an element is found in the high range then
! any contribution in the low range can be ignored, The final
! summation is thus either just a(med) or a(med) + a(outer)
! where outer is high if either just high or high and low range
! values are present or low if low range values occur but no
! high range values.

  LOGICAL :: bigData
  INTEGER :: i, sc
  REAL(wp) :: amed, aouter, xi, ymin

  res = zero
! Fast return
  IF (n<=0 .OR. incx<=0) THEN
    RETURN
  END IF

  amed = zero
  aouter = zero
  bigData = .FALSE.

! Loop through elements collecting middle and/or low range
! values. Stop at the first element found in the high range 
! having overwritten any value that might already have been 
! collected in aouter.
  DO i = 1, (n-1)*incx+1, incx
! Deal with real part
    xi = ABS(REAL(x(i), KIND=wp))
    IF (xi > bu) THEN
! Element found in high range; overwrite any existing 
! contribution from the low range and exit loop
      aouter = SCALE(xi,rsu)*SCALE(xi,rsu)
      bigData = .TRUE.
! Set bigdata and process imaginary part
    ELSE IF (xi >= b) THEN
      amed = amed + xi*xi
    ELSE
! Collect contribution from elements in the low range
      aouter = aouter + SCALE(xi,rs)*SCALE(xi,rs)
    END IF

! Then the imaginary part
    xi = ABS(AIMAG(x(i)))
    IF (xi > bu) THEN
! Element found in high range; overwrite any existing 
! contribution from the low range and exit loop
!
! If bigData has been set TRUE then the real part of this
! element was in the large range and we need to add this
! large component into the scaled accumulator. Otherwise
! we just overwrite the scaled accumulator which in this
! case involves zeroing it.
      IF (.NOT. bigData) aouter = zero
      aouter = aouter + SCALE(xi,rsu)*SCALE(xi,rsu)
      bigData = .TRUE.
    ELSE IF (xi >= b) THEN
      amed = amed + xi*xi
    ELSE
! Collect contribution from elements in the low range
      IF (.NOT. bigData) aouter = aouter + SCALE(xi,rs)*SCALE(xi,rs)
    END IF
    IF (bigData) EXIT
  END DO

! At this point either i > (n-1)*incx+1 in which case we have
! processed all the elements in the vector and the body of the
! next loop will not be executed. Otherwise, the rest of the 
! vector is processed with elements < b being ignored starting 
! from element i+1.
  DO i = i+1, (n-1)*incx+1, incx
    xi = ABS(REAL(x(i), KIND=wp))
    IF (xi > bu) THEN
! Update contribution from high range. Scale to try and avoid
! overflow.
      aouter = aouter + SCALE(xi,rsu)*SCALE(xi,rsu)
    ELSE IF (xi >= b) THEN
! Collect mid range contributions
      amed = amed + xi*xi
! Dangling ELSE IF
! Ignore any low range values
    END IF
    xi = ABS(AIMAG(x(i)))
    IF (xi > bu) THEN
! Update contribution from high range. Scale to try and avoid
! overflow.
      aouter = aouter + SCALE(xi,rsu)*SCALE(xi,rsu)
    ELSE IF (xi >= b) THEN
! Collect mid range contributions
      amed = amed + xi*xi
! Dangling ELSE IF
! Ignore any low range values
    END IF
  END DO

  amed = SQRT(amed)
  IF (aouter == zero) THEN
! If aouter is still zero then all the elements are mid-range
! and the result is already in amed.
    res = amed
  ELSE
! There is scaling to be taken care of -- set scaling factor
! to be used
    IF (bigData) THEN
      sc = su
    ELSE
      sc = s
    END IF
    aouter = SQRT(aouter)
! Contribution from the high range; overflow possible
    IF (aouter > oflimit) THEN
! Real overflow condition
     res = ieee_value(res, ieee_positive_inf)
! From hereon we know we have a representable norm value
    ELSE IF (amed == zero) THEN
! Only the scaled accumulator counts, descale.
        res = SCALE(aouter,sc)
    ELSE
! We have two non-zero accumulators, check if they both
! contribute and, if so, safely compute the combined value
      ymin = MIN(amed, SCALE(aouter,sc))
! Put the result in place in case the other accumulator
! does not contribute
      res = MAX(amed, SCALE(aouter,sc))
      IF (ymin >= sqrteps*res) THEN
	res = res*SQRT(one + (ymin/res)*(ymin/res))
      END IF
    END IF
  END IF  
