01:       SUBROUTINE XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO)
02: !
03: !  -- LAPACK auxiliary routine (version 3.0) --
04: !     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
05: !     September 19, 2006
06: !
07:       IMPLICIT NONE
08: !     .. Scalar Arguments ..
09:       INTEGER SRNAME_LEN, INFO
10: !     ..
11: !     .. Array Arguments ..
12:       CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
13: !     ..
14: !
15: !  Purpose
16: !  =======
17: !
18: !  XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK
19: !  and BLAS error handler.  Rather than taking a Fortran string argument
20: !  as the function's name, XERBLA_ARRAY takes an array of single
21: !  characters along with the array's length.  XERBLA_ARRAY then copies
22: !  up to 32 characters of that array into a Fortran string and passes
23: !  that to XERBLA.  If called with a non-positive SRNAME_LEN,
24: !  XERBLA_ARRAY will call XERBLA with a string of all blank characters.
25: !
26: !  Say some macro or other device makes XERBLA_ARRAY available to C99
27: !  by a name lapack_xerbla and with a common Fortran calling convention.
28: !  Then a C99 program could invoke XERBLA via:
29: !     {
30: !       int flen = strlen(__func__);
31: !       lapack_xerbla(__func__, &flen, &info);
32: !     }
33: !
34: !  Providing XERBLA_ARRAY is not necessary for intercepting LAPACK
35: !  errors.  XERBLA_ARRAY calls XERBLA.
36: !
37: !  Arguments
38: !  =========
39: !
40: !  SRNAME_ARRAY (input) CHARACTER(1) array, dimension (SRNAME_LEN)
41: !          The name of the routine which called XERBLA_ARRAY.
42: !
43: !  SRNAME_LEN (input) INTEGER
44: !          The length of the name in SRNAME_ARRAY.
45: !
46: !  INFO    (input) INTEGER
47: !          The position of the invalid parameter in the parameter list
48: !          of the calling routine.
49: !
50: ! =====================================================================
51: !
52: !     ..
53: !     .. Local Scalars ..
54:       INTEGER I
55: !     ..
56: !     .. Local Arrays ..
57:       CHARACTER*32 SRNAME
58: !     ..
59: !     .. Intrinsic Functions ..
60:       INTRINSIC MIN, LEN
61: !     ..
62: !     .. External Functions ..
63:       EXTERNAL XERBLA
64: !     ..
65: !     .. Executable Statements ..
66:       SRNAME = ''
67:       DO I = 1, MIN( SRNAME_LEN, LEN( SRNAME ) )
68:          SRNAME( I:I ) = SRNAME_ARRAY( I )
69:       END DO
70: 
71:       CALL XERBLA( SRNAME, INFO )
72: 
73:       RETURN
74:       END
75: