MODULE  nrm2_other
  CHARACTER (LEN=*), PARAMETER :: descript = &
        'the Kahan algorithm; no simple loop' 
CONTAINS
! Routines implementing the Kahan algorithm
! for computing the L2 norm of a real vector.
! [Communicated by W. Kahan, April 2012 and based on a Matlab
!  code -- not shown here.]
!
     FUNCTION dnrm2(n, x, incx) RESULT (y)
       USE set_precision, ONLY: dkind
       USE, INTRINSIC :: ieee_arithmetic
       USE, INTRINSIC :: ieee_features
       USE, INTRINSIC :: ieee_exceptions
       IMPLICIT NONE
       INTEGER, INTENT (IN) :: n, incx
       REAL (dkind), INTENT (IN) :: x(1:(n-1)*incx+1)
       REAL (dkind) :: y
! Constants:  All turn out to be integer powers of  2 
!             for IEEE double precision
!   rttau = sqrt(realmin) ;   rtomega = sqrt(realmax) ;
!   hugel = 1/(eps*rttau) ;     hugeu = rtomega ;
!   tinyl = sqrt(eps)/rtomega ; tinyu = rttau/eps ;    
!
! We set precomputed parameter values.
       REAL (dkind), PARAMETER :: zero = 0.0e0_dkind, one = 1.0e0_dkind
       REAL (dkind), PARAMETER :: hugel = SCALE(one, 512)
       INTEGER, PARAMETER :: hugeu = 563
       INTEGER, PARAMETER :: tinyl = -538
       REAL (dkind), PARAMETER :: tinyu = SCALE(one, -459)

! Local variables:
       REAL (dkind) :: ahat, big, norm
       REAL (dkind) :: s, t

       INCLUDE 'realKahan.inc'
       INCLUDE 'setStatusFlags.inc'
     END FUNCTION dnrm2

     FUNCTION snrm2(n, x, incx) RESULT (y)
       USE set_precision, ONLY: skind
       USE, INTRINSIC :: ieee_arithmetic
       USE, INTRINSIC :: ieee_features
       USE, INTRINSIC :: ieee_exceptions
       IMPLICIT NONE
       INTEGER, INTENT (IN) :: n, incx
       REAL (skind), INTENT (IN) :: x(1:(n-1)*incx+1)
       REAL (skind) :: y
! Constants:  All but tinyl are integer powers of  2 
!             for IEEE single precision.
!             To make tinyl a power of two we follow Kahan and
!             replace eps by eps/2.
!   rttau = sqrt(realmin) ;   rtomega = sqrt(realmax) ;
!   hugel = 1/(eps*rttau) ;     hugeu = rtomega ;
!   tinyl = sqrt(eps)/rtomega ; tinyu = rttau/eps ;    
!
! We set precomputed parameter values.
       REAL (skind), PARAMETER :: zero = 0.0e0_skind, one = 1.0e0_skind
       REAL (skind), PARAMETER :: hugel = SCALE(one, 64)
       INTEGER, PARAMETER :: hugeu = 86
       INTEGER, PARAMETER :: tinyl = -76
       REAL (skind), PARAMETER :: tinyu = SCALE(one, -40)

! Local variables:
       REAL (skind) :: ahat, big, norm
       REAL (skind), VOLATILE :: s, t

       INCLUDE 'realKahan.inc'
       INCLUDE 'setStatusFlags.inc'
     END FUNCTION snrm2

     FUNCTION dznrm2(n, x, incx) RESULT (y)
       USE set_precision, ONLY: dkind
       USE, INTRINSIC :: ieee_arithmetic
       USE, INTRINSIC :: ieee_features
       USE, INTRINSIC :: ieee_exceptions
       IMPLICIT NONE
       INTEGER, INTENT (IN) :: n, incx
       COMPLEX (dkind), INTENT (IN) :: x(1:(n-1)*incx+1)
       REAL (dkind) :: y, xr, xi
! Constants:  All turn out to be integer powers of  2 
!             for IEEE double precision
!   rttau = sqrt(realmin) ;   rtomega = sqrt(realmax) ;
!   hugel = 1/(eps*rttau) ;     hugeu = rtodmega ;
!   tinyl = sqrt(eps)/rtomega ; tinyu = rttau/eps ;    
!
! We set precomputed parameter values.
       REAL (dkind), PARAMETER :: zero = 0.0e0_dkind, one = 1.0e0_dkind
       REAL (dkind), PARAMETER :: hugel = SCALE(one, 512)
       INTEGER, PARAMETER :: hugeu = 563
       INTEGER, PARAMETER :: tinyl = -538
       REAL (dkind), PARAMETER :: tinyu = SCALE(one, -459)

! Local variables:
       REAL (dkind) :: ahat, big, norm
       REAL (dkind) :: s, t

       INCLUDE 'complexKahan.inc'
       INCLUDE 'setStatusFlags.inc'
     END FUNCTION dznrm2

     FUNCTION scnrm2(n, x, incx) RESULT (y)
       USE set_precision, ONLY: skind
       USE, INTRINSIC :: ieee_arithmetic
       USE, INTRINSIC :: ieee_features
       USE, INTRINSIC :: ieee_exceptions
       IMPLICIT NONE
       INTEGER, INTENT (IN) :: n, incx
       COMPLEX (skind), INTENT (IN) :: x(1:(n-1)*incx+1)
       REAL (skind) :: y, xr, xi
! Constants:  All but tinyl are integer powers of  2 
!             for IEEE single precision.
!             To make tinyl a power of two we follow Kahan and
!             replace eps by eps/2.
!   rttau = sqrt(realmin) ;   rtomega = sqrt(realmax) ;
!   hugel = 1/(eps*rttau) ;     hugeu = rtomega ;
!   tinyl = sqrt(eps)/rtomega ; tinyu = rttau/eps ;    
!
! We set precomputed parameter values.
       REAL (skind), PARAMETER :: zero = 0.0e0_skind, one = 1.0e0_skind
       REAL (skind), PARAMETER :: hugel = SCALE(one, 64)
       INTEGER, PARAMETER :: hugeu = 86
       INTEGER, PARAMETER :: tinyl = -76
       REAL (skind), PARAMETER :: tinyu = SCALE(one, -40)

! Local variables:
       REAL (skind) :: ahat, big, norm
       REAL (skind), VOLATILE :: s, t

       INCLUDE 'complexKahan.inc'
       INCLUDE 'setStatusFlags.inc'
     END FUNCTION scnrm2
END MODULE nrm2_other
