Move LAPACK trunk into position.

1 files changed, 74 insertions, 0 deletions

diff --git a/SRC/xerbla_array.f b/SRC/xerbla_array.f
new file mode 100644
index 00000000..30a91362
--- /dev/null
+++ b/SRC/xerbla_array.f
@@ -0,0 +1,74 @@
+      SUBROUTINE XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO)
+!
+!  -- LAPACK auxiliary routine (version 3.1) --
+!     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+!     September 19, 2006
+!
+      IMPLICIT NONE
+!     .. Scalar Arguments ..
+      INTEGER SRNAME_LEN, INFO
+!     ..
+!     .. Array Arguments ..
+      CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
+!     ..
+!
+!  Purpose
+!  =======
+!
+!  XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK
+!  and BLAS error handler.  Rather than taking a Fortran string argument
+!  as the function's name, XERBLA_ARRAY takes an array of single
+!  characters along with the array's length.  XERBLA_ARRAY then copies
+!  up to 32 characters of that array into a Fortran string and passes
+!  that to XERBLA.  If called with a non-positive SRNAME_LEN,
+!  XERBLA_ARRAY will call XERBLA with a string of all blank characters.
+!
+!  Say some macro or other device makes XERBLA_ARRAY available to C99
+!  by a name lapack_xerbla and with a common Fortran calling convention.
+!  Then a C99 program could invoke XERBLA via:
+!     {
+!       int flen = strlen(__func__);
+!       lapack_xerbla(__func__, &flen, &info);
+!     }
+!
+!  Providing XERBLA_ARRAY is not necessary for intercepting LAPACK
+!  errors.  XERBLA_ARRAY calls XERBLA.
+!
+!  Arguments
+!  =========
+!
+!  SRNAME_ARRAY (input) CHARACTER(1) array, dimension (SRNAME_LEN)
+!          The name of the routine which called XERBLA_ARRAY.
+!
+!  SRNAME_LEN (input) INTEGER
+!          The length of the name in SRNAME_ARRAY.
+!
+!  INFO    (input) INTEGER
+!          The position of the invalid parameter in the parameter list
+!          of the calling routine.
+!
+! =====================================================================
+!
+!     ..
+!     .. Local Scalars ..
+      INTEGER I
+!     ..
+!     .. Local Arrays ..
+      CHARACTER(32) SRNAME
+!     ..
+!     .. Intrinsic Functions ..
+      INTRINSIC MIN, LEN
+!     ..
+!     .. External Functions ..
+      EXTERNAL XERBLA
+!     ..
+!     .. Executable Statements ..
+      SRNAME = ''
+      DO I = 1, MIN(SRNAME_LEN, LEN(SRNAME))
+         SRNAME(I:I) = SRNAME_ARRAY(I)
+      END DO
+
+      CALL XERBLA(SRNAME, INFO)
+
+      RETURN
+      END