1 /* netlib/xerbla_array.f -- translated by f2c (version 20100827).
2    You must link the resulting object file with libf2c:
3 	on Microsoft Windows system, link with libf2c.lib;
4 	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5 	or, if you install libf2c.a in a standard place, with -lf2c -lm
6 	-- in that order, at the end of the command line, as in
7 		cc *.o -lf2c -lm
8 	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9 
10 		http://www.netlib.org/f2c/libf2c.zip
11 */
12 
13 #include "FLA_f2c.h"
14 
15 /* > \brief \b XERBLA_ARRAY */
16 
17 /*  =========== DOCUMENTATION =========== */
18 
19 /* Online html documentation available at */
20 /*            http://www.netlib.org/lapack/explore-html/ */
21 
22 /* > \htmlonly */
23 /* > Download XERBLA_ARRAY + dependencies */
24 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/xerbla_
25 array.f"> */
26 /* > [TGZ]</a> */
27 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/xerbla_
28 array.f"> */
29 /* > [ZIP]</a> */
30 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/xerbla_
31 array.f"> */
32 /* > [TXT]</a> */
33 /* > \endhtmlonly */
34 
35 /*  Definition: */
36 /*  =========== */
37 
38 /*       SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO) */
39 
40 /*       .. Scalar Arguments .. */
41 /*       INTEGER SRNAME_LEN, INFO */
42 /*       .. */
43 /*       .. Array Arguments .. */
44 /*       CHARACTER    SRNAME_ARRAY(SRNAME_LEN) */
45 /*       .. */
46 
47 
48 /* > \par Purpose: */
49 /*  ============= */
50 /* > */
51 /* > \verbatim */
52 /* > */
53 /* > XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK */
54 /* > and BLAS error handler.  Rather than taking a Fortran string argument */
55 /* > as the function's name, XERBLA_ARRAY takes an array of single */
56 /* > characters along with the array's length.  XERBLA_ARRAY then copies */
57 /* > up to 32 characters of that array into a Fortran string and passes */
58 /* > that to XERBLA.  If called with a non-positive SRNAME_LEN, */
59 /* > XERBLA_ARRAY will call XERBLA with a string of all blank characters. */
60 /* > */
61 /* > Say some macro or other device makes XERBLA_ARRAY available to C99 */
62 /* > by a name lapack_xerbla and with a common Fortran calling convention. */
63 /* > Then a C99 program could invoke XERBLA via: */
64 /* >    { */
65 /* >      int flen = strlen(__func__); */
66 /* >      lapack_xerbla(__func__, &flen, &info); */
67 /* >    } */
68 /* > */
69 /* > Providing XERBLA_ARRAY is not necessary for intercepting LAPACK */
70 /* > errors.  XERBLA_ARRAY calls XERBLA. */
71 /* > \endverbatim */
72 
73 /*  Arguments: */
74 /*  ========== */
75 
76 /* > \param[in] SRNAME_ARRAY */
77 /* > \verbatim */
78 /* >          SRNAME_ARRAY is CHARACTER    array, dimension (SRNAME_LEN) */
79 /* >          The name of the routine which called XERBLA_ARRAY. */
80 /* > \endverbatim */
81 /* > */
82 /* > \param[in] SRNAME_LEN */
83 /* > \verbatim */
84 /* >          SRNAME_LEN is INTEGER */
85 /* >          The length of the name in SRNAME_ARRAY. */
86 /* > \endverbatim */
87 /* > */
88 /* > \param[in] INFO */
89 /* > \verbatim */
90 /* >          INFO is INTEGER */
91 /* >          The position of the invalid parameter in the parameter list */
92 /* >          of the calling routine. */
93 /* > \endverbatim */
94 
95 /*  Authors: */
96 /*  ======== */
97 
98 /* > \author Univ. of Tennessee */
99 /* > \author Univ. of California Berkeley */
100 /* > \author Univ. of Colorado Denver */
101 /* > \author NAG Ltd. */
102 
103 /* > \date November 2011 */
104 
105 /* > \ingroup auxOTHERauxiliary */
106 
107 /*  ===================================================================== */
xerbla_array__(char * srname_array__,integer * srname_len__,integer * info)108 /* Subroutine */ int xerbla_array__(char *srname_array__, integer *
109                                     srname_len__, integer *info)
110 {
111     /* System generated locals */
112     integer i__1, i__2, i__3;
113 
114     /* Builtin functions */
115     /* Subroutine */
116     int s_copy(char *, char *);
117     integer i_len(char *, ftnlen);
118 
119     /* Local variables */
120     integer i__;
121     extern /* Subroutine */ int xerbla_(char *, integer *);
122     char srname[32];
123 
124 
125     /*  -- LAPACK auxiliary routine (version 3.4.0) -- */
126     /*  -- LAPACK is a software package provided by Univ. of Tennessee,    -- */
127     /*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
128     /*     November 2011 */
129 
130     /*     .. Scalar Arguments .. */
131     /*     .. */
132     /*     .. Array Arguments .. */
133     /*     .. */
134 
135     /* ===================================================================== */
136 
137     /*     .. */
138     /*     .. Local Scalars .. */
139     /*     .. */
140     /*     .. Local Arrays .. */
141     /*     .. */
142     /*     .. Intrinsic Functions .. */
143     /*     .. */
144     /*     .. External Functions .. */
145     /*     .. */
146     /*     .. Executable Statements .. */
147     /* Parameter adjustments */
148     --srname_array__;
149 
150     /* Function Body */
151     s_copy(srname, "");
152     /* Computing MIN */
153     i__2 = *srname_len__, i__3 = i_len(srname, (ftnlen)32);
154     i__1 = min(i__2,i__3);
155     for (i__ = 1; i__ <= i__1; ++i__)
156     {
157         *(unsigned char *)&srname[i__ - 1] = *(unsigned char *)&
158                                              srname_array__[i__];
159     }
160     xerbla_(srname, info);
161     return 0;
162 } /* xerbla_array__ */
163 
164