      INTEGER, PARAMETER :: small=1, med=2, big=3
      REAL(wp) :: a(3), xi
      INTEGER :: i

      res=zero

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

      a = zero
      DO i=1,(n-1)*incx+1,incx
        xi=ABS(x(i))

        IF(xi > bu) THEN
! Scale to try and avoid overflow
          a(big)=a(big)+SCALE(xi,rsu)*SCALE(xi,rsu)
        ELSE IF(xi < b) THEN
! Scale to try and avoid underflow
          a(small)=a(small)+SCALE(xi,rs)*SCALE(xi,rs)
        ELSE
          a(med)=a(med)+xi*xi
        END IF

      END DO

      a(med) = SQRT(a(med))

      IF (a(big) == zero .AND. a(small) == zero) THEN
! Only contribution is the middle interval
        res = a(med)
      ELSE IF (a(big) > zero) THEN
! Contribution from high interval; test for possible 
! real overflow
        a(big) = SQRT(a(big))
        IF (a(big) > oflimit) THEN
! An overflow has really occurred
          res = ieee_value(res, ieee_positive_inf)
        ELSE
! OK for representable return value, scale and add
! contribution from middle range if appropriate
	  res = SCALE(a(big),su)
! Note here that a(med) == 0 is NOT a special case since
! the following test fails and the return value in these
! curcumstances has alread been set
          IF (a(med) > sqrteps*res) THEN
            res = res*SQRT(one + (a(med)/res)*(a(med)/res))
          END IF
        END IF
      ELSE ! a(small) is non-zero and may make a contribution
           ! depending on its size relative to a(med)
        a(small) = SCALE(SQRT(a(small)),s)
        IF (a(med) == zero) THEN
          res = a(small)
        ELSE IF (a(small) > sqrteps*a(med)) THEN
          res = a(med)*SQRT(one + (a(small)/a(med))*(a(small)/a(med)))
        ELSE
          res = a(med)
        END IF

      END IF
! res now contains the required return value
