        INTEGER :: i, nn
        REAL(lp) :: comp, scaleFac, absx, hitest, t
        REAL(lp), PARAMETER :: zero = 0.0E0_lp, one = 1.0E0_lp
        REAL(lp), PARAMETER :: &
          cutlo = SQRT(tiny(zero)/epsilon(zero)), &
          cuthi = sqrt(huge(zero))

          res = zero
          comp = zero
          IF (n<=0 .OR. incx<=0) RETURN

          hitest = cuthi/REAL(n,KIND=lp)
          nn = 1 + (n-1)*incx
          i = 1

! Find the first non-zero element. If none return zero
          DO WHILE (x(i) == zero)
            i = i + incx
            IF (i>nn) RETURN
          END DO

! At least one non-zero element in the input vector.
! If the first non-zero is in the range [tiny, cutlo]
! then we scale to prevent unnecessary underflows.
! The scale factor is always chosen to be the maximum 
! absolute element value seen so far rescaling takes
! place if larger values appear in the input.
!
! If an element is detected whose absolute value is greater 
! than cutlo then the current partial sum is rescaled 
! in preparation for the next subrange.
          scaleFac = zero
          absx = ABS(x(i))
          DO WHILE (absx <= cutlo)
            IF (absx > scaleFac) THEN
! Rescale partial sum to use new larger value as scale factor
              res = res*(scaleFac/absx)*(scaleFac/absx)
              comp = comp*(scaleFac/absx)*(scaleFac/absx)
              comp = comp + one
              t = res
              res = t + comp
              comp = (t-res)+comp
              scaleFac = absx
            ELSE
! Just square and add the scaled element value to the partial sum
              comp = comp + (absx/scaleFac)*(absx/scaleFac)
              t = res
              res = t + comp
              comp = (t-res)+comp
            END IF
            i = i + incx
! Return if all elements are in the range [tiny, cutlo]
            IF (i > nn) THEN
              res = scaleFac*SQRT(res)
              RETURN
            ELSE
              absx = ABS(x(i))
            END IF
          END DO ! while elements in range [tiny, cutlo]

! Transition to mid-range (cutlo, hitest); no scaling is
! performed in this region. If the current element is greater
! than hitest then transition will be to the high range.
          res = (res*scaleFac)*scaleFac
          DO WHILE (absx < hitest)
            comp = comp + absx*absx
            t = res
            res = t + comp
            comp = (t-res) + comp
            i = i + incx
! Return result if all elements are less than hitest
            IF (i > nn) THEN
              res = sqrt(res)
              RETURN
            ELSE
              absx = ABS(x(i))
            END IF
          END DO ! while element in range (cutlo, hitest)

! Transition to high range. At least one element has been found
! in the range [hitest, huge]. All remaining elements will now
! be scaled.
          scaleFac = absx
          res = (res/scaleFac)/scaleFac
          comp = (comp/scaleFac)/scaleFac
          comp = comp + one
          t = res
          res = t + comp
          comp = (t-res) + comp

          DO i = i+incx, nn, incx
            absx = ABS(x(i))
            IF (absx > scaleFac) THEN
! Rescale partial sum to use new larger value as scale factor
              res = res*(scaleFac/absx)*(scaleFac/absx)
              comp = comp*(scaleFac/absx)*(scaleFac/absx)
              comp = comp + one
              t = res
              res = t + comp
              comp = (t-res)+comp
              scaleFac = absx
            ELSE
! Just square and add the scaled element value to the partial sum
              comp = comp + (absx/scaleFac)*(absx/scaleFac)
              t = res
              res = t + comp
              comp = (t-res)+comp
            END IF
          END DO

          res = SQRT(res)*scaleFac
