1 SUBROUTINE XERBLA_ARRAY(SRNAME_ARRAY, SRNAME_LEN, INFO)
2 *
3 * -- LAPACK auxiliary routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * September 19, 2006
6 *
7 IMPLICIT NONE
8 * .. Scalar Arguments ..
9 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
2 *
3 * -- LAPACK auxiliary routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * September 19, 2006
6 *
7 IMPLICIT NONE
8 * .. Scalar Arguments ..
9 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