        INTEGER :: i
! 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 flag information locally and for storing
! the inherited halting mode flags which are reset by the
! routine and then reset to their original values
        LOGICAL :: signal(1:3), haltingFlags(5)

! 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.

        norm = zero
        IF (n<=0 .OR. incx<=0) THEN
          RETURN
        END IF
          
! Save the current IEEE halting mode flags.
        CALL ieee_get_halting_mode(ieee_all, haltingFlags)

! Turn on non-stop arithmetic.
        CALL ieee_set_halting_mode(ieee_all, .FALSE.)
        signal(1:3) = .FALSE.

! Try a simple loop; this will be adequate for the vast
! majority of practical applications. We use a compensated
! summation to ensure as accurate a result as possible.
! NOTE: The use of the compensated summation ensures that
!       some data sets that lose accuracy using the
!       original version of nrm2 now return an accurate
!       result (see Remark for further details)
        s = zero
        DO i = 1, (n-1)*incx + 1, incx
          s = s + REAL(x(i), KIND(x(i)))*REAL(x(i), KIND(x(i)))
          t = norm
          norm = t + s
          s = (t-norm) + s
          s = s + AIMAG(x(i))*AIMAG(x(i))
          t = norm
          norm = t + s
          s = (t-norm) + s
        END DO 
        norm = sqrt(norm)

! We now need to check that the simple loop did not encounter
! any arithmetic problems:
!  a) Inf in input vector or overflow from finite data: check
!     finite value returned in norm. Note that we do not need
!     to check the overflow signal here as this test will 
!     cover both cases.
!  b) underflow: check underflow status flag; if signalling
!     then scaling is required to obtain an accurate result.
!  c) nan: check for a NaN result; this most likely indicates
!     a NaN value in the input vector.
        CALL ieee_get_flag(ieee_overflow, signal(overflow))
        CALL ieee_get_flag(ieee_underflow, signal(underflow))
        IF (signal(underflow) .OR. &
          ieee_is_nan(norm) .OR. .NOT. ieee_is_finite(norm)) THEN

! Reset status flags that may have been set by executing
! the simple loop.  These were only set to steer the
! computation internally and we are now effectively
! starting the computation again using Kahan's method.
          CALL ieee_set_flag(ieee_all, .FALSE.)

! Rare event! Call Kahan!
! The Kahan routine is effectively stand alone in that
! it deals with setting any required flags on exit
