00001 SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2.2) -- 00004 * 00005 * -- June 2010 00006 * 00007 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00008 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00009 * 00010 IMPLICIT NONE 00011 * .. Scalar Arguments .. 00012 INTEGER SRNAME_LEN, INFO 00013 * .. 00014 * .. Array Arguments .. 00015 CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK 00022 * and BLAS error handler. Rather than taking a Fortran string argument 00023 * as the function's name, XERBLA_ARRAY takes an array of single 00024 * characters along with the array's length. XERBLA_ARRAY then copies 00025 * up to 32 characters of that array into a Fortran string and passes 00026 * that to XERBLA. If called with a non-positive SRNAME_LEN, 00027 * XERBLA_ARRAY will call XERBLA with a string of all blank characters. 00028 * 00029 * Say some macro or other device makes XERBLA_ARRAY available to C99 00030 * by a name lapack_xerbla and with a common Fortran calling convention. 00031 * Then a C99 program could invoke XERBLA via: 00032 * { 00033 * int flen = strlen(__func__); 00034 * lapack_xerbla(__func__, &flen, &info); 00035 * } 00036 * 00037 * Providing XERBLA_ARRAY is not necessary for intercepting LAPACK 00038 * errors. XERBLA_ARRAY calls XERBLA. 00039 * 00040 * Arguments 00041 * ========= 00042 * 00043 * SRNAME_ARRAY (input) CHARACTER(1) array, dimension (SRNAME_LEN) 00044 * The name of the routine which called XERBLA_ARRAY. 00045 * 00046 * SRNAME_LEN (input) INTEGER 00047 * The length of the name in SRNAME_ARRAY. 00048 * 00049 * INFO (input) INTEGER 00050 * The position of the invalid parameter in the parameter list 00051 * of the calling routine. 00052 * 00053 * ===================================================================== 00054 * 00055 * .. 00056 * .. Local Scalars .. 00057 INTEGER I 00058 * .. 00059 * .. Local Arrays .. 00060 CHARACTER*32 SRNAME 00061 * .. 00062 * .. Intrinsic Functions .. 00063 INTRINSIC MIN, LEN 00064 * .. 00065 * .. External Functions .. 00066 EXTERNAL XERBLA 00067 * .. 00068 * .. Executable Statements .. 00069 SRNAME = '' 00070 DO I = 1, MIN( SRNAME_LEN, LEN( SRNAME ) ) 00071 SRNAME( I:I ) = SRNAME_ARRAY( I ) 00072 END DO 00073 00074 CALL XERBLA( SRNAME, INFO ) 00075 00076 RETURN 00077 END
1.7.2