        INTEGER :: i, nn
        REAL(lp) :: scale, absx, hitest
        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
          IF (n<=0 .OR. incx<=0) RETURN

          hitest = cuthi/SQRT(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.
          scale = zero
          absx = ABS(x(i))
          DO WHILE (absx <= cutlo)
            CALL scaledUpdate
            i = i + incx
! Return if all elements are in the range [tiny, cutlo]
            IF (i > nn) THEN
              res = scale*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*scale)*scale
          DO WHILE (absx < hitest)
            res = res + absx*absx
            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.
          scale = absx
          res = one + (res/scale)/scale

          DO i = i+incx, nn, incx
            absx = ABS(x(i))
            CALL scaledUpdate
          END DO

          res = SQRT(res)*scale
      CONTAINS
          SUBROUTINE scaledUpdate
! Use routine call to prevent code being repeated when updating
! the partial sum due to a larger current element being found.
! We are assuming here that, if necessary, the compiler will
! in-line this code to gain efficiency.

            IF (absx > scale) THEN
! Rescale partial sum to use new larger value as scale factor
              res = one + res*(scale/absx)*(scale/absx)
              scale = absx
            ELSE
! Just square and add the scaled element value to the partial sum
              res = res + (absx/scale)*(absx/scale)
            END IF

        END SUBROUTINE scaledUpdate
