! Use meaningful names for the indices used to access the relevant
! IEEE status flags
    INTEGER, PARAMETER :: overflow = 1, underflow = 2, inexact = 3
! Use an array to store the inherited halting mode flags which
! are reset by the routine and then reset to their original values
    LOGICAL :: haltingFlags(5)

    LOGICAL :: nanInInput, infInInput
    INTEGER :: hiType, i, sc
    INTEGER, PARAMETER :: low=0, medium=1, high=2

! We deal with two special cases immediately.
! In both cases we mimic the bahaviour of the original BLAS
! Level 1 routine (Lawson et al, Algorithm 539: Basic Linear 
! Algebra Subprograms for Fortran Usage, ACM TOMS, 5(3), Sept 1979,
! pp 324--325.)
!
! n<=0 is taken to define a null vector. We return a norm
!      value of zero and we do not set any of the IEEE status
!      flags. This condition is tested first
!
! incx<=0 also returns a norm value of zero in line with
!      other implementations. 
!
! NOTE: If both n<=0 and incx<=0 on input only n<=0 may be tested.
!

! Save the current IEEE halting mode flags.
    CALL ieee_get_halting_mode(ieee_all, haltingFlags)

    y = zero
    IF (n<=0 .OR. incx<=0) THEN
     RETURN
    END IF

    hiType = low
    sc = hugeU
    nanInInput = .FALSE.
    infInInput = .FALSE.
    norm = zero
    s = zero

    big = hugel/sqrt(real(2*n,kind=kind(zero)))

! Turn on non-stop arithmetic and set all the status flags to
! FALSE (we reset the state we inherited on exit)
      CALL ieee_set_halting_mode(ieee_all, .FALSE.)
      CALL ieee_set_flag(ieee_all, .FALSE.)

    DO i = 1, (n-1)*incx+1, incx
      xi = REAL(x(i), kind=kind(zero))
! Look for any non-finite numbers in the input data
      IF (.NOT. ieee_is_finite(xi)) THEN
! Could be a NaN
        IF (ieee_is_nan(xi)) THEN
         nanInInput = .TRUE.
! Even though there is a Nan in the input there could still
! be an Inf which takes priority so we continue to scan
          CYCLE
       ELSE
! If we have got here we have an infinite value and
! the result must be Inf so we can return
          infInInput = .TRUE.
! Need to change to high range; scale s and norm 
         EXIT
       END IF
      ELSE
! We have a finite value -- don't do anything if we have seen
! a NaN since we don't need the sum of squares
        IF (nanInInput) CYCLE
! We now have the next in a sequence of finite values.
! Gather the result using compensated summation
        xi = ABS(xi)
        SELECT CASE (hiType)

        CASE(low)
        IF (xi <= tinyU) THEN
! All values found so far are in the low range -- perform scaled add
          s = s + SCALE(xi,sc)*SCALE(xi,sc)
        ELSE IF (xi >= big) THEN
! We are jumping from low range to high range so we can just
! reinitialize the scaled sum as the low range values can't 
! contribute
          sc = tinyl
          norm = zero
          s = SCALE(xi,sc)*SCALE(xi,sc)
          hiType = high
        ELSE
! We need to move to the middle range, scale s and norm.
! No scaling needed when in middle range
          s = SCALE(s, -2*sc) + xi*xi
          norm = SCALE(norm, -2*sc)
          sc = 0
          hiType = medium
       END IF
        
        CASE (medium)
! If current value is low or medium range just add it in
        IF (xi < big) THEN
          s = s + xi*xi
        ELSE
! Need to change to high range; scale s and norm
! Change scale factor
          sc = tinyl
          s = SCALE(s, 2*sc) + SCALE(xi,sc)*SCALE(xi,sc)
          norm = SCALE(norm, 2*sc)
          hiType = high
        END IF

        CASE (high)
! Just a scaled add
          s = s + SCALE(xi,sc)*SCALE(xi,sc)
        END SELECT

! Finish off with the compensated summation
        t = norm
        norm = t + s
        s = (t-norm)+s
      END IF

! The imaginary component of x(i) is dealt with in the same way
! as the real component
        xi = AIMAG(x(i))
! Look for any non-finite numbers in the input data
        IF (.NOT. ieee_is_finite(xi)) THEN
! Could be a NaN
          IF (ieee_is_nan(xi)) THEN
         nanInInput = .TRUE.
! Even though there is a Nan in the input there could still
! be an Inf which takes priority so we continue to scan
            CYCLE
       ELSE
! If we have got here we have an infinite value and
! the result must be Inf so we can return
            infInInput = .TRUE. 
         EXIT
       END IF
      ELSE
! We have a finite value -- don't do anything if we have seen
! a NaN since we don't need the sum of squares
        IF (nanInInput) CYCLE
! We now have the next in a sequence of finite values.
! Gather the result using compensated summation
        xi = ABS(xi)
        SELECT CASE (hiType)

        CASE(low)
        IF (xi <= tinyU) THEN
! All values found so far are in the low range -- perform scaled add
          s = s + SCALE(xi,sc)*SCALE(xi,sc)
        ELSE IF (xi >= big) THEN
! We are jumping from low range to high range so we can just
! reinitialize the scaled sum as the low range values can't 
! contribute
          sc = tinyl
          norm = zero
          s = SCALE(xi,sc)*SCALE(xi,sc)
          hiType = high
        ELSE
! We need to move to the middle range, scale s and norm.
! No scaling needed when in middle range
          s = SCALE(s, -2*sc) + xi*xi
          norm = SCALE(norm, -2*sc)
          sc = 0
          hiType = medium
        END IF
        
        CASE (medium)
! If current value is low or medium range just add it in
        IF (xi < big) THEN
          s = s + xi*xi
        ELSE
! Need to change to high range; scale s and norm
! Change scale factor
          sc = tinyl
          s = SCALE(s, 2*sc) + SCALE(xi,sc)*SCALE(xi,sc)
          norm = SCALE(norm, 2*sc)
          hiType = high
        END IF

        CASE (high)
! Just a scaled add
          s = s + SCALE(xi,sc)*SCALE(xi,sc)
        END SELECT

! Finish off with the compensated summation
        t = norm
        norm = t + s
        s = (t-norm)+s
      END IF
  END DO

! Sort out the return value
  IF (.NOT.(nanInInput .OR. infInInput)) THEN
! We have a numerical result which might overflow when scaled
     y = SQRT(norm)*SCALE(one, -sc)
  ELSE IF (infInInput) THEN
! Result is +Inf
     y = ieee_value(y, ieee_positive_inf)
  ELSE ! nan in input
! Return quiet Nan
     y = ieee_value(y, ieee_quiet_nan)
  END IF
