        INTEGER :: i, nn
        REAL(lp) :: scale, rxi, ixi, 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
          rxi = ABS(REAL(x(i), KIND=lp))
          ixi = ABS(AIMAG(x(i)))

          DO WHILE (rxi <= cutlo .AND. ixi <= 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
              rxi = ABS(REAL(x(i), KIND=lp))
              ixi = ABS(AIMAG(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
          scale = one
          DO WHILE (rxi < hitest .AND. &
                    ixi < hitest)
            res = res + rxi*rxi + ixi*ixi
            i = i + incx
! Return result if all elements are less than hitest
            IF (i > nn) THEN
              res = sqrt(res)
              RETURN
            ELSE
              rxi = ABS(REAL(x(i), KIND=lp))
              ixi = ABS(AIMAG(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.

          DO
            CALL scaledUpdate
            i = i + incx
            IF (i > nn) THEN
              res = SQRT(res)*scale
              RETURN
            ELSE
              rxi = ABS(REAL(x(i), KIND=lp))
              ixi = ABS(AIMAG(x(i)))
            END IF
          END DO

      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.
            REAL(lp) :: tsc, osc
! tsc and/or osc may assigned NaN -- Section 14.9 of the
! Fortran 2008 standard only requires that +, -, * and /
! plus IEEE_REM and IEEE_RINT (from IEEE_ARITHMETIC) will
! propagate a NaN. Thus we rewrite:
!           tsc = MAX(rxi, ixi)
!           osc = MIN(rxi, ixi)
! as:
            tsc = rxi
            osc = ixi
            IF(ixi > rxi) THEN
              tsc = ixi
              osc = rxi
            END IF

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

          END SUBROUTINE scaledUpdate
