<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/xhtml;charset=UTF-8"/>
<title>SphinxBase: src/libsphinxbase/util/slapack_lite.c Source File</title>
<link href="tabs.css" rel="stylesheet" type="text/css"/>
<link href="navtree.css" rel="stylesheet" type="text/css"/>
<script type="text/javascript" src="jquery.js"></script>
<script type="text/javascript" src="navtree.js"></script>
<script type="text/javascript" src="resize.js"></script>
<script type="text/javascript">
$(document).ready(initResizable);
</script>
<link href="doxygen.css" rel="stylesheet" type="text/css"/>
</head>
<body>
<!-- Generated by Doxygen 1.7.3 -->
<div id="top">
<div id="titlearea">
<table cellspacing="0" cellpadding="0">
<tbody>
<tr style="height: 56px;">
<td style="padding-left: 0.5em;">
<div id="projectname">SphinxBase <span id="projectnumber">0.6</span></div>
</td>
</tr>
</tbody>
</table>
</div>
<div id="navrow1" class="tabs">
<ul class="tablist">
<li><a href="index.html"><span>Main Page</span></a></li>
<li><a href="pages.html"><span>Related Pages</span></a></li>
<li><a href="annotated.html"><span>Data Structures</span></a></li>
<li class="current"><a href="files.html"><span>Files</span></a></li>
</ul>
</div>
<div id="navrow2" class="tabs2">
<ul class="tablist">
<li><a href="files.html"><span>File List</span></a></li>
<li><a href="globals.html"><span>Globals</span></a></li>
</ul>
</div>
</div>
<div id="side-nav" class="ui-resizable side-nav-resizable">
<div id="nav-tree">
<div id="nav-tree-contents">
</div>
</div>
<div id="splitbar" style="-moz-user-select:none;"
class="ui-resizable-handle">
</div>
</div>
<script type="text/javascript">
initNavTree('slapack__lite_8c.html','');
</script>
<div id="doc-content">
<div class="header">
<div class="headertitle">
<h1>src/libsphinxbase/util/slapack_lite.c</h1> </div>
</div>
<div class="contents">
<div class="fragment"><pre class="fragment"><a name="l00001"></a>00001 <span class="comment">/*</span>
<a name="l00002"></a>00002 <span class="comment">NOTE: This is generated code. Look in README.python for information on</span>
<a name="l00003"></a>00003 <span class="comment"> remaking this file.</span>
<a name="l00004"></a>00004 <span class="comment">*/</span>
<a name="l00005"></a>00005 <span class="preprocessor">#include "sphinxbase/f2c.h"</span>
<a name="l00006"></a>00006
<a name="l00007"></a>00007 <span class="preprocessor">#ifdef HAVE_CONFIG</span>
<a name="l00008"></a>00008 <span class="preprocessor"></span><span class="preprocessor">#include "config.h"</span>
<a name="l00009"></a>00009 <span class="preprocessor">#else</span>
<a name="l00010"></a>00010 <span class="preprocessor"></span><span class="keyword">extern</span> doublereal slamch_(<span class="keywordtype">char</span> *);
<a name="l00011"></a>00011 <span class="preprocessor">#define EPSILON slamch_("Epsilon")</span>
<a name="l00012"></a>00012 <span class="preprocessor"></span><span class="preprocessor">#define SAFEMINIMUM slamch_("Safe minimum")</span>
<a name="l00013"></a>00013 <span class="preprocessor"></span><span class="preprocessor">#define PRECISION slamch_("Precision")</span>
<a name="l00014"></a>00014 <span class="preprocessor"></span><span class="preprocessor">#define BASE slamch_("Base")</span>
<a name="l00015"></a>00015 <span class="preprocessor"></span><span class="preprocessor">#endif</span>
<a name="l00016"></a>00016 <span class="preprocessor"></span>
<a name="l00017"></a>00017
<a name="l00018"></a>00018 <span class="keyword">extern</span> doublereal slapy2_(real *, real *);
<a name="l00019"></a>00019
<a name="l00020"></a>00020
<a name="l00021"></a>00021
<a name="l00022"></a>00022 <span class="comment">/* Table of constant values */</span>
<a name="l00023"></a>00023
<a name="l00024"></a>00024 <span class="keyword">static</span> integer c__0 = 0;
<a name="l00025"></a>00025 <span class="keyword">static</span> real c_b163 = 0.f;
<a name="l00026"></a>00026 <span class="keyword">static</span> real c_b164 = 1.f;
<a name="l00027"></a>00027 <span class="keyword">static</span> integer c__1 = 1;
<a name="l00028"></a>00028 <span class="keyword">static</span> real c_b181 = -1.f;
<a name="l00029"></a>00029 <span class="keyword">static</span> integer c_n1 = -1;
<a name="l00030"></a>00030
<a name="l00031"></a>00031 integer ieeeck_(integer *ispec, real *zero, real *one)
<a name="l00032"></a>00032 {
<a name="l00033"></a>00033 <span class="comment">/* System generated locals */</span>
<a name="l00034"></a>00034 integer ret_val;
<a name="l00035"></a>00035
<a name="l00036"></a>00036 <span class="comment">/* Local variables */</span>
<a name="l00037"></a>00037 <span class="keyword">static</span> real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro,
<a name="l00038"></a>00038 newzro;
<a name="l00039"></a>00039
<a name="l00040"></a>00040
<a name="l00041"></a>00041 <span class="comment">/*</span>
<a name="l00042"></a>00042 <span class="comment"> -- LAPACK auxiliary routine (version 3.0) --</span>
<a name="l00043"></a>00043 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l00044"></a>00044 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l00045"></a>00045 <span class="comment"> June 30, 1998</span>
<a name="l00046"></a>00046 <span class="comment"></span>
<a name="l00047"></a>00047 <span class="comment"></span>
<a name="l00048"></a>00048 <span class="comment"> Purpose</span>
<a name="l00049"></a>00049 <span class="comment"> =======</span>
<a name="l00050"></a>00050 <span class="comment"></span>
<a name="l00051"></a>00051 <span class="comment"> IEEECK is called from the ILAENV to verify that Infinity and</span>
<a name="l00052"></a>00052 <span class="comment"> possibly NaN arithmetic is safe (i.e. will not trap).</span>
<a name="l00053"></a>00053 <span class="comment"></span>
<a name="l00054"></a>00054 <span class="comment"> Arguments</span>
<a name="l00055"></a>00055 <span class="comment"> =========</span>
<a name="l00056"></a>00056 <span class="comment"></span>
<a name="l00057"></a>00057 <span class="comment"> ISPEC (input) INTEGER</span>
<a name="l00058"></a>00058 <span class="comment"> Specifies whether to test just for inifinity arithmetic</span>
<a name="l00059"></a>00059 <span class="comment"> or whether to test for infinity and NaN arithmetic.</span>
<a name="l00060"></a>00060 <span class="comment"> = 0: Verify infinity arithmetic only.</span>
<a name="l00061"></a>00061 <span class="comment"> = 1: Verify infinity and NaN arithmetic.</span>
<a name="l00062"></a>00062 <span class="comment"></span>
<a name="l00063"></a>00063 <span class="comment"> ZERO (input) REAL</span>
<a name="l00064"></a>00064 <span class="comment"> Must contain the value 0.0</span>
<a name="l00065"></a>00065 <span class="comment"> This is passed to prevent the compiler from optimizing</span>
<a name="l00066"></a>00066 <span class="comment"> away this code.</span>
<a name="l00067"></a>00067 <span class="comment"></span>
<a name="l00068"></a>00068 <span class="comment"> ONE (input) REAL</span>
<a name="l00069"></a>00069 <span class="comment"> Must contain the value 1.0</span>
<a name="l00070"></a>00070 <span class="comment"> This is passed to prevent the compiler from optimizing</span>
<a name="l00071"></a>00071 <span class="comment"> away this code.</span>
<a name="l00072"></a>00072 <span class="comment"></span>
<a name="l00073"></a>00073 <span class="comment"> RETURN VALUE: INTEGER</span>
<a name="l00074"></a>00074 <span class="comment"> = 0: Arithmetic failed to produce the correct answers</span>
<a name="l00075"></a>00075 <span class="comment"> = 1: Arithmetic produced the correct answers</span>
<a name="l00076"></a>00076 <span class="comment">*/</span>
<a name="l00077"></a>00077
<a name="l00078"></a>00078 ret_val = 1;
<a name="l00079"></a>00079
<a name="l00080"></a>00080 posinf = *one / *zero;
<a name="l00081"></a>00081 <span class="keywordflow">if</span> (posinf <= *one) {
<a name="l00082"></a>00082 ret_val = 0;
<a name="l00083"></a>00083 <span class="keywordflow">return</span> ret_val;
<a name="l00084"></a>00084 }
<a name="l00085"></a>00085
<a name="l00086"></a>00086 neginf = -(*one) / *zero;
<a name="l00087"></a>00087 <span class="keywordflow">if</span> (neginf >= *zero) {
<a name="l00088"></a>00088 ret_val = 0;
<a name="l00089"></a>00089 <span class="keywordflow">return</span> ret_val;
<a name="l00090"></a>00090 }
<a name="l00091"></a>00091
<a name="l00092"></a>00092 negzro = *one / (neginf + *one);
<a name="l00093"></a>00093 <span class="keywordflow">if</span> (negzro != *zero) {
<a name="l00094"></a>00094 ret_val = 0;
<a name="l00095"></a>00095 <span class="keywordflow">return</span> ret_val;
<a name="l00096"></a>00096 }
<a name="l00097"></a>00097
<a name="l00098"></a>00098 neginf = *one / negzro;
<a name="l00099"></a>00099 <span class="keywordflow">if</span> (neginf >= *zero) {
<a name="l00100"></a>00100 ret_val = 0;
<a name="l00101"></a>00101 <span class="keywordflow">return</span> ret_val;
<a name="l00102"></a>00102 }
<a name="l00103"></a>00103
<a name="l00104"></a>00104 newzro = negzro + *zero;
<a name="l00105"></a>00105 <span class="keywordflow">if</span> (newzro != *zero) {
<a name="l00106"></a>00106 ret_val = 0;
<a name="l00107"></a>00107 <span class="keywordflow">return</span> ret_val;
<a name="l00108"></a>00108 }
<a name="l00109"></a>00109
<a name="l00110"></a>00110 posinf = *one / newzro;
<a name="l00111"></a>00111 <span class="keywordflow">if</span> (posinf <= *one) {
<a name="l00112"></a>00112 ret_val = 0;
<a name="l00113"></a>00113 <span class="keywordflow">return</span> ret_val;
<a name="l00114"></a>00114 }
<a name="l00115"></a>00115
<a name="l00116"></a>00116 neginf *= posinf;
<a name="l00117"></a>00117 <span class="keywordflow">if</span> (neginf >= *zero) {
<a name="l00118"></a>00118 ret_val = 0;
<a name="l00119"></a>00119 <span class="keywordflow">return</span> ret_val;
<a name="l00120"></a>00120 }
<a name="l00121"></a>00121
<a name="l00122"></a>00122 posinf *= posinf;
<a name="l00123"></a>00123 <span class="keywordflow">if</span> (posinf <= *one) {
<a name="l00124"></a>00124 ret_val = 0;
<a name="l00125"></a>00125 <span class="keywordflow">return</span> ret_val;
<a name="l00126"></a>00126 }
<a name="l00127"></a>00127
<a name="l00128"></a>00128
<a name="l00129"></a>00129 <span class="comment">/* Return if we were only asked to check infinity arithmetic */</span>
<a name="l00130"></a>00130
<a name="l00131"></a>00131 <span class="keywordflow">if</span> (*ispec == 0) {
<a name="l00132"></a>00132 <span class="keywordflow">return</span> ret_val;
<a name="l00133"></a>00133 }
<a name="l00134"></a>00134
<a name="l00135"></a>00135 nan1 = posinf + neginf;
<a name="l00136"></a>00136
<a name="l00137"></a>00137 nan2 = posinf / neginf;
<a name="l00138"></a>00138
<a name="l00139"></a>00139 nan3 = posinf / posinf;
<a name="l00140"></a>00140
<a name="l00141"></a>00141 nan4 = posinf * *zero;
<a name="l00142"></a>00142
<a name="l00143"></a>00143 nan5 = neginf * negzro;
<a name="l00144"></a>00144
<a name="l00145"></a>00145 nan6 = nan5 * 0.f;
<a name="l00146"></a>00146
<a name="l00147"></a>00147 <span class="keywordflow">if</span> (nan1 == nan1) {
<a name="l00148"></a>00148 ret_val = 0;
<a name="l00149"></a>00149 <span class="keywordflow">return</span> ret_val;
<a name="l00150"></a>00150 }
<a name="l00151"></a>00151
<a name="l00152"></a>00152 <span class="keywordflow">if</span> (nan2 == nan2) {
<a name="l00153"></a>00153 ret_val = 0;
<a name="l00154"></a>00154 <span class="keywordflow">return</span> ret_val;
<a name="l00155"></a>00155 }
<a name="l00156"></a>00156
<a name="l00157"></a>00157 <span class="keywordflow">if</span> (nan3 == nan3) {
<a name="l00158"></a>00158 ret_val = 0;
<a name="l00159"></a>00159 <span class="keywordflow">return</span> ret_val;
<a name="l00160"></a>00160 }
<a name="l00161"></a>00161
<a name="l00162"></a>00162 <span class="keywordflow">if</span> (nan4 == nan4) {
<a name="l00163"></a>00163 ret_val = 0;
<a name="l00164"></a>00164 <span class="keywordflow">return</span> ret_val;
<a name="l00165"></a>00165 }
<a name="l00166"></a>00166
<a name="l00167"></a>00167 <span class="keywordflow">if</span> (nan5 == nan5) {
<a name="l00168"></a>00168 ret_val = 0;
<a name="l00169"></a>00169 <span class="keywordflow">return</span> ret_val;
<a name="l00170"></a>00170 }
<a name="l00171"></a>00171
<a name="l00172"></a>00172 <span class="keywordflow">if</span> (nan6 == nan6) {
<a name="l00173"></a>00173 ret_val = 0;
<a name="l00174"></a>00174 <span class="keywordflow">return</span> ret_val;
<a name="l00175"></a>00175 }
<a name="l00176"></a>00176
<a name="l00177"></a>00177 <span class="keywordflow">return</span> ret_val;
<a name="l00178"></a>00178 } <span class="comment">/* ieeeck_ */</span>
<a name="l00179"></a>00179
<a name="l00180"></a>00180 integer ilaenv_(integer *ispec, <span class="keywordtype">char</span> *name__, <span class="keywordtype">char</span> *opts, integer *n1,
<a name="l00181"></a>00181 integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen
<a name="l00182"></a>00182 opts_len)
<a name="l00183"></a>00183 {
<a name="l00184"></a>00184 <span class="comment">/* System generated locals */</span>
<a name="l00185"></a>00185 integer ret_val;
<a name="l00186"></a>00186
<a name="l00187"></a>00187 <span class="comment">/* Builtin functions */</span>
<a name="l00188"></a>00188 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> s_copy(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, ftnlen, ftnlen);
<a name="l00189"></a>00189 integer s_cmp(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, ftnlen, ftnlen);
<a name="l00190"></a>00190
<a name="l00191"></a>00191 <span class="comment">/* Local variables */</span>
<a name="l00192"></a>00192 <span class="keyword">static</span> integer i__;
<a name="l00193"></a>00193 <span class="keyword">static</span> <span class="keywordtype">char</span> c1[1], c2[2], c3[3], c4[2];
<a name="l00194"></a>00194 <span class="keyword">static</span> integer ic, nb, iz, nx;
<a name="l00195"></a>00195 <span class="keyword">static</span> logical cname, sname;
<a name="l00196"></a>00196 <span class="keyword">static</span> integer nbmin;
<a name="l00197"></a>00197 <span class="keyword">extern</span> integer ieeeck_(integer *, real *, real *);
<a name="l00198"></a>00198 <span class="keyword">static</span> <span class="keywordtype">char</span> subnam[6];
<a name="l00199"></a>00199
<a name="l00200"></a>00200
<a name="l00201"></a>00201 <span class="comment">/*</span>
<a name="l00202"></a>00202 <span class="comment"> -- LAPACK auxiliary routine (version 3.0) --</span>
<a name="l00203"></a>00203 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l00204"></a>00204 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l00205"></a>00205 <span class="comment"> June 30, 1999</span>
<a name="l00206"></a>00206 <span class="comment"></span>
<a name="l00207"></a>00207 <span class="comment"></span>
<a name="l00208"></a>00208 <span class="comment"> Purpose</span>
<a name="l00209"></a>00209 <span class="comment"> =======</span>
<a name="l00210"></a>00210 <span class="comment"></span>
<a name="l00211"></a>00211 <span class="comment"> ILAENV is called from the LAPACK routines to choose problem-dependent</span>
<a name="l00212"></a>00212 <span class="comment"> parameters for the local environment. See ISPEC for a description of</span>
<a name="l00213"></a>00213 <span class="comment"> the parameters.</span>
<a name="l00214"></a>00214 <span class="comment"></span>
<a name="l00215"></a>00215 <span class="comment"> This version provides a set of parameters which should give good,</span>
<a name="l00216"></a>00216 <span class="comment"> but not optimal, performance on many of the currently available</span>
<a name="l00217"></a>00217 <span class="comment"> computers. Users are encouraged to modify this subroutine to set</span>
<a name="l00218"></a>00218 <span class="comment"> the tuning parameters for their particular machine using the option</span>
<a name="l00219"></a>00219 <span class="comment"> and problem size information in the arguments.</span>
<a name="l00220"></a>00220 <span class="comment"></span>
<a name="l00221"></a>00221 <span class="comment"> This routine will not function correctly if it is converted to all</span>
<a name="l00222"></a>00222 <span class="comment"> lower case. Converting it to all upper case is allowed.</span>
<a name="l00223"></a>00223 <span class="comment"></span>
<a name="l00224"></a>00224 <span class="comment"> Arguments</span>
<a name="l00225"></a>00225 <span class="comment"> =========</span>
<a name="l00226"></a>00226 <span class="comment"></span>
<a name="l00227"></a>00227 <span class="comment"> ISPEC (input) INTEGER</span>
<a name="l00228"></a>00228 <span class="comment"> Specifies the parameter to be returned as the value of</span>
<a name="l00229"></a>00229 <span class="comment"> ILAENV.</span>
<a name="l00230"></a>00230 <span class="comment"> = 1: the optimal blocksize; if this value is 1, an unblocked</span>
<a name="l00231"></a>00231 <span class="comment"> algorithm will give the best performance.</span>
<a name="l00232"></a>00232 <span class="comment"> = 2: the minimum block size for which the block routine</span>
<a name="l00233"></a>00233 <span class="comment"> should be used; if the usable block size is less than</span>
<a name="l00234"></a>00234 <span class="comment"> this value, an unblocked routine should be used.</span>
<a name="l00235"></a>00235 <span class="comment"> = 3: the crossover point (in a block routine, for N less</span>
<a name="l00236"></a>00236 <span class="comment"> than this value, an unblocked routine should be used)</span>
<a name="l00237"></a>00237 <span class="comment"> = 4: the number of shifts, used in the nonsymmetric</span>
<a name="l00238"></a>00238 <span class="comment"> eigenvalue routines</span>
<a name="l00239"></a>00239 <span class="comment"> = 5: the minimum column dimension for blocking to be used;</span>
<a name="l00240"></a>00240 <span class="comment"> rectangular blocks must have dimension at least k by m,</span>
<a name="l00241"></a>00241 <span class="comment"> where k is given by ILAENV(2,...) and m by ILAENV(5,...)</span>
<a name="l00242"></a>00242 <span class="comment"> = 6: the crossover point for the SVD (when reducing an m by n</span>
<a name="l00243"></a>00243 <span class="comment"> matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds</span>
<a name="l00244"></a>00244 <span class="comment"> this value, a QR factorization is used first to reduce</span>
<a name="l00245"></a>00245 <span class="comment"> the matrix to a triangular form.)</span>
<a name="l00246"></a>00246 <span class="comment"> = 7: the number of processors</span>
<a name="l00247"></a>00247 <span class="comment"> = 8: the crossover point for the multishift QR and QZ methods</span>
<a name="l00248"></a>00248 <span class="comment"> for nonsymmetric eigenvalue problems.</span>
<a name="l00249"></a>00249 <span class="comment"> = 9: maximum size of the subproblems at the bottom of the</span>
<a name="l00250"></a>00250 <span class="comment"> computation tree in the divide-and-conquer algorithm</span>
<a name="l00251"></a>00251 <span class="comment"> (used by xGELSD and xGESDD)</span>
<a name="l00252"></a>00252 <span class="comment"> =10: ieee NaN arithmetic can be trusted not to trap</span>
<a name="l00253"></a>00253 <span class="comment"> =11: infinity arithmetic can be trusted not to trap</span>
<a name="l00254"></a>00254 <span class="comment"></span>
<a name="l00255"></a>00255 <span class="comment"> NAME (input) CHARACTER*(*)</span>
<a name="l00256"></a>00256 <span class="comment"> The name of the calling subroutine, in either upper case or</span>
<a name="l00257"></a>00257 <span class="comment"> lower case.</span>
<a name="l00258"></a>00258 <span class="comment"></span>
<a name="l00259"></a>00259 <span class="comment"> OPTS (input) CHARACTER*(*)</span>
<a name="l00260"></a>00260 <span class="comment"> The character options to the subroutine NAME, concatenated</span>
<a name="l00261"></a>00261 <span class="comment"> into a single character string. For example, UPLO = 'U',</span>
<a name="l00262"></a>00262 <span class="comment"> TRANS = 'T', and DIAG = 'N' for a triangular routine would</span>
<a name="l00263"></a>00263 <span class="comment"> be specified as OPTS = 'UTN'.</span>
<a name="l00264"></a>00264 <span class="comment"></span>
<a name="l00265"></a>00265 <span class="comment"> N1 (input) INTEGER</span>
<a name="l00266"></a>00266 <span class="comment"> N2 (input) INTEGER</span>
<a name="l00267"></a>00267 <span class="comment"> N3 (input) INTEGER</span>
<a name="l00268"></a>00268 <span class="comment"> N4 (input) INTEGER</span>
<a name="l00269"></a>00269 <span class="comment"> Problem dimensions for the subroutine NAME; these may not all</span>
<a name="l00270"></a>00270 <span class="comment"> be required.</span>
<a name="l00271"></a>00271 <span class="comment"></span>
<a name="l00272"></a>00272 <span class="comment"> (ILAENV) (output) INTEGER</span>
<a name="l00273"></a>00273 <span class="comment"> >= 0: the value of the parameter specified by ISPEC</span>
<a name="l00274"></a>00274 <span class="comment"> < 0: if ILAENV = -k, the k-th argument had an illegal value.</span>
<a name="l00275"></a>00275 <span class="comment"></span>
<a name="l00276"></a>00276 <span class="comment"> Further Details</span>
<a name="l00277"></a>00277 <span class="comment"> ===============</span>
<a name="l00278"></a>00278 <span class="comment"></span>
<a name="l00279"></a>00279 <span class="comment"> The following conventions have been used when calling ILAENV from the</span>
<a name="l00280"></a>00280 <span class="comment"> LAPACK routines:</span>
<a name="l00281"></a>00281 <span class="comment"> 1) OPTS is a concatenation of all of the character options to</span>
<a name="l00282"></a>00282 <span class="comment"> subroutine NAME, in the same order that they appear in the</span>
<a name="l00283"></a>00283 <span class="comment"> argument list for NAME, even if they are not used in determining</span>
<a name="l00284"></a>00284 <span class="comment"> the value of the parameter specified by ISPEC.</span>
<a name="l00285"></a>00285 <span class="comment"> 2) The problem dimensions N1, N2, N3, N4 are specified in the order</span>
<a name="l00286"></a>00286 <span class="comment"> that they appear in the argument list for NAME. N1 is used</span>
<a name="l00287"></a>00287 <span class="comment"> first, N2 second, and so on, and unused problem dimensions are</span>
<a name="l00288"></a>00288 <span class="comment"> passed a value of -1.</span>
<a name="l00289"></a>00289 <span class="comment"> 3) The parameter value returned by ILAENV is checked for validity in</span>
<a name="l00290"></a>00290 <span class="comment"> the calling subroutine. For example, ILAENV is used to retrieve</span>
<a name="l00291"></a>00291 <span class="comment"> the optimal blocksize for STRTRI as follows:</span>
<a name="l00292"></a>00292 <span class="comment"></span>
<a name="l00293"></a>00293 <span class="comment"> NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )</span>
<a name="l00294"></a>00294 <span class="comment"> IF( NB.LE.1 ) NB = MAX( 1, N )</span>
<a name="l00295"></a>00295 <span class="comment"></span>
<a name="l00296"></a>00296 <span class="comment"> =====================================================================</span>
<a name="l00297"></a>00297 <span class="comment">*/</span>
<a name="l00298"></a>00298
<a name="l00299"></a>00299
<a name="l00300"></a>00300 <span class="keywordflow">switch</span> (*ispec) {
<a name="l00301"></a>00301 <span class="keywordflow">case</span> 1: <span class="keywordflow">goto</span> L100;
<a name="l00302"></a>00302 <span class="keywordflow">case</span> 2: <span class="keywordflow">goto</span> L100;
<a name="l00303"></a>00303 <span class="keywordflow">case</span> 3: <span class="keywordflow">goto</span> L100;
<a name="l00304"></a>00304 <span class="keywordflow">case</span> 4: <span class="keywordflow">goto</span> L400;
<a name="l00305"></a>00305 <span class="keywordflow">case</span> 5: <span class="keywordflow">goto</span> L500;
<a name="l00306"></a>00306 <span class="keywordflow">case</span> 6: <span class="keywordflow">goto</span> L600;
<a name="l00307"></a>00307 <span class="keywordflow">case</span> 7: <span class="keywordflow">goto</span> L700;
<a name="l00308"></a>00308 <span class="keywordflow">case</span> 8: <span class="keywordflow">goto</span> L800;
<a name="l00309"></a>00309 <span class="keywordflow">case</span> 9: <span class="keywordflow">goto</span> L900;
<a name="l00310"></a>00310 <span class="keywordflow">case</span> 10: <span class="keywordflow">goto</span> L1000;
<a name="l00311"></a>00311 <span class="keywordflow">case</span> 11: <span class="keywordflow">goto</span> L1100;
<a name="l00312"></a>00312 }
<a name="l00313"></a>00313
<a name="l00314"></a>00314 <span class="comment">/* Invalid value for ISPEC */</span>
<a name="l00315"></a>00315
<a name="l00316"></a>00316 ret_val = -1;
<a name="l00317"></a>00317 <span class="keywordflow">return</span> ret_val;
<a name="l00318"></a>00318
<a name="l00319"></a>00319 L100:
<a name="l00320"></a>00320
<a name="l00321"></a>00321 <span class="comment">/* Convert NAME to upper case if the first character is lower case. */</span>
<a name="l00322"></a>00322
<a name="l00323"></a>00323 ret_val = 1;
<a name="l00324"></a>00324 s_copy(subnam, name__, (ftnlen)6, name_len);
<a name="l00325"></a>00325 ic = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)subnam;
<a name="l00326"></a>00326 iz = <span class="charliteral">'Z'</span>;
<a name="l00327"></a>00327 <span class="keywordflow">if</span> (iz == 90 || iz == 122) {
<a name="l00328"></a>00328
<a name="l00329"></a>00329 <span class="comment">/* ASCII character set */</span>
<a name="l00330"></a>00330
<a name="l00331"></a>00331 <span class="keywordflow">if</span> (ic >= 97 && ic <= 122) {
<a name="l00332"></a>00332 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)subnam = (<span class="keywordtype">char</span>) (ic - 32);
<a name="l00333"></a>00333 <span class="keywordflow">for</span> (i__ = 2; i__ <= 6; ++i__) {
<a name="l00334"></a>00334 ic = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)&subnam[i__ - 1];
<a name="l00335"></a>00335 <span class="keywordflow">if</span> (ic >= 97 && ic <= 122) {
<a name="l00336"></a>00336 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)&subnam[i__ - 1] = (<span class="keywordtype">char</span>) (ic - 32);
<a name="l00337"></a>00337 }
<a name="l00338"></a>00338 <span class="comment">/* L10: */</span>
<a name="l00339"></a>00339 }
<a name="l00340"></a>00340 }
<a name="l00341"></a>00341
<a name="l00342"></a>00342 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (iz == 233 || iz == 169) {
<a name="l00343"></a>00343
<a name="l00344"></a>00344 <span class="comment">/* EBCDIC character set */</span>
<a name="l00345"></a>00345
<a name="l00346"></a>00346 <span class="keywordflow">if</span> (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
<a name="l00347"></a>00347 ic <= 169) {
<a name="l00348"></a>00348 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)subnam = (<span class="keywordtype">char</span>) (ic + 64);
<a name="l00349"></a>00349 <span class="keywordflow">for</span> (i__ = 2; i__ <= 6; ++i__) {
<a name="l00350"></a>00350 ic = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)&subnam[i__ - 1];
<a name="l00351"></a>00351 <span class="keywordflow">if</span> (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
<a name="l00352"></a>00352 162 && ic <= 169) {
<a name="l00353"></a>00353 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)&subnam[i__ - 1] = (<span class="keywordtype">char</span>) (ic + 64);
<a name="l00354"></a>00354 }
<a name="l00355"></a>00355 <span class="comment">/* L20: */</span>
<a name="l00356"></a>00356 }
<a name="l00357"></a>00357 }
<a name="l00358"></a>00358
<a name="l00359"></a>00359 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (iz == 218 || iz == 250) {
<a name="l00360"></a>00360
<a name="l00361"></a>00361 <span class="comment">/* Prime machines: ASCII+128 */</span>
<a name="l00362"></a>00362
<a name="l00363"></a>00363 <span class="keywordflow">if</span> (ic >= 225 && ic <= 250) {
<a name="l00364"></a>00364 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)subnam = (<span class="keywordtype">char</span>) (ic - 32);
<a name="l00365"></a>00365 <span class="keywordflow">for</span> (i__ = 2; i__ <= 6; ++i__) {
<a name="l00366"></a>00366 ic = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)&subnam[i__ - 1];
<a name="l00367"></a>00367 <span class="keywordflow">if</span> (ic >= 225 && ic <= 250) {
<a name="l00368"></a>00368 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)&subnam[i__ - 1] = (<span class="keywordtype">char</span>) (ic - 32);
<a name="l00369"></a>00369 }
<a name="l00370"></a>00370 <span class="comment">/* L30: */</span>
<a name="l00371"></a>00371 }
<a name="l00372"></a>00372 }
<a name="l00373"></a>00373 }
<a name="l00374"></a>00374
<a name="l00375"></a>00375 *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c1 = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)subnam;
<a name="l00376"></a>00376 sname = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c1 == <span class="charliteral">'S'</span> || *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c1 == <span class="charliteral">'D'</span>;
<a name="l00377"></a>00377 cname = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c1 == <span class="charliteral">'C'</span> || *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c1 == <span class="charliteral">'Z'</span>;
<a name="l00378"></a>00378 <span class="keywordflow">if</span> (! (cname || sname)) {
<a name="l00379"></a>00379 <span class="keywordflow">return</span> ret_val;
<a name="l00380"></a>00380 }
<a name="l00381"></a>00381 s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
<a name="l00382"></a>00382 s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
<a name="l00383"></a>00383 s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
<a name="l00384"></a>00384
<a name="l00385"></a>00385 <span class="keywordflow">switch</span> (*ispec) {
<a name="l00386"></a>00386 <span class="keywordflow">case</span> 1: <span class="keywordflow">goto</span> L110;
<a name="l00387"></a>00387 <span class="keywordflow">case</span> 2: <span class="keywordflow">goto</span> L200;
<a name="l00388"></a>00388 <span class="keywordflow">case</span> 3: <span class="keywordflow">goto</span> L300;
<a name="l00389"></a>00389 }
<a name="l00390"></a>00390
<a name="l00391"></a>00391 L110:
<a name="l00392"></a>00392
<a name="l00393"></a>00393 <span class="comment">/*</span>
<a name="l00394"></a>00394 <span class="comment"> ISPEC = 1: block size</span>
<a name="l00395"></a>00395 <span class="comment"></span>
<a name="l00396"></a>00396 <span class="comment"> In these examples, separate code is provided for setting NB for</span>
<a name="l00397"></a>00397 <span class="comment"> real and complex. We assume that NB will take the same value in</span>
<a name="l00398"></a>00398 <span class="comment"> single or double precision.</span>
<a name="l00399"></a>00399 <span class="comment">*/</span>
<a name="l00400"></a>00400
<a name="l00401"></a>00401 nb = 1;
<a name="l00402"></a>00402
<a name="l00403"></a>00403 <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"GE"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00404"></a>00404 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00405"></a>00405 <span class="keywordflow">if</span> (sname) {
<a name="l00406"></a>00406 nb = 64;
<a name="l00407"></a>00407 } <span class="keywordflow">else</span> {
<a name="l00408"></a>00408 nb = 64;
<a name="l00409"></a>00409 }
<a name="l00410"></a>00410 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"QRF"</span>, (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
<a name="l00411"></a>00411 <span class="stringliteral">"RQF"</span>, (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"LQF"</span>, (ftnlen)
<a name="l00412"></a>00412 3, (ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"QLF"</span>, (ftnlen)3, (ftnlen)3)
<a name="l00413"></a>00413 == 0) {
<a name="l00414"></a>00414 <span class="keywordflow">if</span> (sname) {
<a name="l00415"></a>00415 nb = 32;
<a name="l00416"></a>00416 } <span class="keywordflow">else</span> {
<a name="l00417"></a>00417 nb = 32;
<a name="l00418"></a>00418 }
<a name="l00419"></a>00419 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"HRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00420"></a>00420 <span class="keywordflow">if</span> (sname) {
<a name="l00421"></a>00421 nb = 32;
<a name="l00422"></a>00422 } <span class="keywordflow">else</span> {
<a name="l00423"></a>00423 nb = 32;
<a name="l00424"></a>00424 }
<a name="l00425"></a>00425 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"BRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00426"></a>00426 <span class="keywordflow">if</span> (sname) {
<a name="l00427"></a>00427 nb = 32;
<a name="l00428"></a>00428 } <span class="keywordflow">else</span> {
<a name="l00429"></a>00429 nb = 32;
<a name="l00430"></a>00430 }
<a name="l00431"></a>00431 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRI"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00432"></a>00432 <span class="keywordflow">if</span> (sname) {
<a name="l00433"></a>00433 nb = 64;
<a name="l00434"></a>00434 } <span class="keywordflow">else</span> {
<a name="l00435"></a>00435 nb = 64;
<a name="l00436"></a>00436 }
<a name="l00437"></a>00437 }
<a name="l00438"></a>00438 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"PO"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00439"></a>00439 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00440"></a>00440 <span class="keywordflow">if</span> (sname) {
<a name="l00441"></a>00441 nb = 64;
<a name="l00442"></a>00442 } <span class="keywordflow">else</span> {
<a name="l00443"></a>00443 nb = 64;
<a name="l00444"></a>00444 }
<a name="l00445"></a>00445 }
<a name="l00446"></a>00446 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"SY"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00447"></a>00447 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00448"></a>00448 <span class="keywordflow">if</span> (sname) {
<a name="l00449"></a>00449 nb = 64;
<a name="l00450"></a>00450 } <span class="keywordflow">else</span> {
<a name="l00451"></a>00451 nb = 64;
<a name="l00452"></a>00452 }
<a name="l00453"></a>00453 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c3, <span class="stringliteral">"TRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00454"></a>00454 nb = 32;
<a name="l00455"></a>00455 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c3, <span class="stringliteral">"GST"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00456"></a>00456 nb = 64;
<a name="l00457"></a>00457 }
<a name="l00458"></a>00458 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (cname && s_cmp(c2, <span class="stringliteral">"HE"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00459"></a>00459 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00460"></a>00460 nb = 64;
<a name="l00461"></a>00461 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00462"></a>00462 nb = 32;
<a name="l00463"></a>00463 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"GST"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00464"></a>00464 nb = 64;
<a name="l00465"></a>00465 }
<a name="l00466"></a>00466 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c2, <span class="stringliteral">"OR"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00467"></a>00467 <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'G'</span>) {
<a name="l00468"></a>00468 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00469"></a>00469 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00470"></a>00470 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00471"></a>00471 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00472"></a>00472 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00473"></a>00473 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00474"></a>00474 nb = 32;
<a name="l00475"></a>00475 }
<a name="l00476"></a>00476 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'M'</span>) {
<a name="l00477"></a>00477 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00478"></a>00478 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00479"></a>00479 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00480"></a>00480 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00481"></a>00481 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00482"></a>00482 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00483"></a>00483 nb = 32;
<a name="l00484"></a>00484 }
<a name="l00485"></a>00485 }
<a name="l00486"></a>00486 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (cname && s_cmp(c2, <span class="stringliteral">"UN"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00487"></a>00487 <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'G'</span>) {
<a name="l00488"></a>00488 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00489"></a>00489 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00490"></a>00490 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00491"></a>00491 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00492"></a>00492 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00493"></a>00493 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00494"></a>00494 nb = 32;
<a name="l00495"></a>00495 }
<a name="l00496"></a>00496 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'M'</span>) {
<a name="l00497"></a>00497 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00498"></a>00498 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00499"></a>00499 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00500"></a>00500 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00501"></a>00501 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00502"></a>00502 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00503"></a>00503 nb = 32;
<a name="l00504"></a>00504 }
<a name="l00505"></a>00505 }
<a name="l00506"></a>00506 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"GB"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00507"></a>00507 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00508"></a>00508 <span class="keywordflow">if</span> (sname) {
<a name="l00509"></a>00509 <span class="keywordflow">if</span> (*n4 <= 64) {
<a name="l00510"></a>00510 nb = 1;
<a name="l00511"></a>00511 } <span class="keywordflow">else</span> {
<a name="l00512"></a>00512 nb = 32;
<a name="l00513"></a>00513 }
<a name="l00514"></a>00514 } <span class="keywordflow">else</span> {
<a name="l00515"></a>00515 <span class="keywordflow">if</span> (*n4 <= 64) {
<a name="l00516"></a>00516 nb = 1;
<a name="l00517"></a>00517 } <span class="keywordflow">else</span> {
<a name="l00518"></a>00518 nb = 32;
<a name="l00519"></a>00519 }
<a name="l00520"></a>00520 }
<a name="l00521"></a>00521 }
<a name="l00522"></a>00522 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"PB"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00523"></a>00523 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00524"></a>00524 <span class="keywordflow">if</span> (sname) {
<a name="l00525"></a>00525 <span class="keywordflow">if</span> (*n2 <= 64) {
<a name="l00526"></a>00526 nb = 1;
<a name="l00527"></a>00527 } <span class="keywordflow">else</span> {
<a name="l00528"></a>00528 nb = 32;
<a name="l00529"></a>00529 }
<a name="l00530"></a>00530 } <span class="keywordflow">else</span> {
<a name="l00531"></a>00531 <span class="keywordflow">if</span> (*n2 <= 64) {
<a name="l00532"></a>00532 nb = 1;
<a name="l00533"></a>00533 } <span class="keywordflow">else</span> {
<a name="l00534"></a>00534 nb = 32;
<a name="l00535"></a>00535 }
<a name="l00536"></a>00536 }
<a name="l00537"></a>00537 }
<a name="l00538"></a>00538 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00539"></a>00539 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRI"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00540"></a>00540 <span class="keywordflow">if</span> (sname) {
<a name="l00541"></a>00541 nb = 64;
<a name="l00542"></a>00542 } <span class="keywordflow">else</span> {
<a name="l00543"></a>00543 nb = 64;
<a name="l00544"></a>00544 }
<a name="l00545"></a>00545 }
<a name="l00546"></a>00546 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"LA"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00547"></a>00547 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"UUM"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00548"></a>00548 <span class="keywordflow">if</span> (sname) {
<a name="l00549"></a>00549 nb = 64;
<a name="l00550"></a>00550 } <span class="keywordflow">else</span> {
<a name="l00551"></a>00551 nb = 64;
<a name="l00552"></a>00552 }
<a name="l00553"></a>00553 }
<a name="l00554"></a>00554 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c2, <span class="stringliteral">"ST"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00555"></a>00555 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"EBZ"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00556"></a>00556 nb = 1;
<a name="l00557"></a>00557 }
<a name="l00558"></a>00558 }
<a name="l00559"></a>00559 ret_val = nb;
<a name="l00560"></a>00560 <span class="keywordflow">return</span> ret_val;
<a name="l00561"></a>00561
<a name="l00562"></a>00562 L200:
<a name="l00563"></a>00563
<a name="l00564"></a>00564 <span class="comment">/* ISPEC = 2: minimum block size */</span>
<a name="l00565"></a>00565
<a name="l00566"></a>00566 nbmin = 2;
<a name="l00567"></a>00567 <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"GE"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00568"></a>00568 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"QRF"</span>, (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"RQF"</span>, (
<a name="l00569"></a>00569 ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"LQF"</span>, (ftnlen)3, (
<a name="l00570"></a>00570 ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"QLF"</span>, (ftnlen)3, (ftnlen)3) == 0)
<a name="l00571"></a>00571 {
<a name="l00572"></a>00572 <span class="keywordflow">if</span> (sname) {
<a name="l00573"></a>00573 nbmin = 2;
<a name="l00574"></a>00574 } <span class="keywordflow">else</span> {
<a name="l00575"></a>00575 nbmin = 2;
<a name="l00576"></a>00576 }
<a name="l00577"></a>00577 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"HRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00578"></a>00578 <span class="keywordflow">if</span> (sname) {
<a name="l00579"></a>00579 nbmin = 2;
<a name="l00580"></a>00580 } <span class="keywordflow">else</span> {
<a name="l00581"></a>00581 nbmin = 2;
<a name="l00582"></a>00582 }
<a name="l00583"></a>00583 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"BRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00584"></a>00584 <span class="keywordflow">if</span> (sname) {
<a name="l00585"></a>00585 nbmin = 2;
<a name="l00586"></a>00586 } <span class="keywordflow">else</span> {
<a name="l00587"></a>00587 nbmin = 2;
<a name="l00588"></a>00588 }
<a name="l00589"></a>00589 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRI"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00590"></a>00590 <span class="keywordflow">if</span> (sname) {
<a name="l00591"></a>00591 nbmin = 2;
<a name="l00592"></a>00592 } <span class="keywordflow">else</span> {
<a name="l00593"></a>00593 nbmin = 2;
<a name="l00594"></a>00594 }
<a name="l00595"></a>00595 }
<a name="l00596"></a>00596 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"SY"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00597"></a>00597 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRF"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00598"></a>00598 <span class="keywordflow">if</span> (sname) {
<a name="l00599"></a>00599 nbmin = 8;
<a name="l00600"></a>00600 } <span class="keywordflow">else</span> {
<a name="l00601"></a>00601 nbmin = 8;
<a name="l00602"></a>00602 }
<a name="l00603"></a>00603 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c3, <span class="stringliteral">"TRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00604"></a>00604 nbmin = 2;
<a name="l00605"></a>00605 }
<a name="l00606"></a>00606 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (cname && s_cmp(c2, <span class="stringliteral">"HE"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00607"></a>00607 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00608"></a>00608 nbmin = 2;
<a name="l00609"></a>00609 }
<a name="l00610"></a>00610 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c2, <span class="stringliteral">"OR"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00611"></a>00611 <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'G'</span>) {
<a name="l00612"></a>00612 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00613"></a>00613 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00614"></a>00614 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00615"></a>00615 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00616"></a>00616 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00617"></a>00617 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00618"></a>00618 nbmin = 2;
<a name="l00619"></a>00619 }
<a name="l00620"></a>00620 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'M'</span>) {
<a name="l00621"></a>00621 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00622"></a>00622 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00623"></a>00623 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00624"></a>00624 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00625"></a>00625 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00626"></a>00626 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00627"></a>00627 nbmin = 2;
<a name="l00628"></a>00628 }
<a name="l00629"></a>00629 }
<a name="l00630"></a>00630 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (cname && s_cmp(c2, <span class="stringliteral">"UN"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00631"></a>00631 <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'G'</span>) {
<a name="l00632"></a>00632 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00633"></a>00633 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00634"></a>00634 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00635"></a>00635 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00636"></a>00636 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00637"></a>00637 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00638"></a>00638 nbmin = 2;
<a name="l00639"></a>00639 }
<a name="l00640"></a>00640 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'M'</span>) {
<a name="l00641"></a>00641 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00642"></a>00642 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00643"></a>00643 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00644"></a>00644 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00645"></a>00645 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00646"></a>00646 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00647"></a>00647 nbmin = 2;
<a name="l00648"></a>00648 }
<a name="l00649"></a>00649 }
<a name="l00650"></a>00650 }
<a name="l00651"></a>00651 ret_val = nbmin;
<a name="l00652"></a>00652 <span class="keywordflow">return</span> ret_val;
<a name="l00653"></a>00653
<a name="l00654"></a>00654 L300:
<a name="l00655"></a>00655
<a name="l00656"></a>00656 <span class="comment">/* ISPEC = 3: crossover point */</span>
<a name="l00657"></a>00657
<a name="l00658"></a>00658 nx = 0;
<a name="l00659"></a>00659 <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"GE"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00660"></a>00660 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"QRF"</span>, (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"RQF"</span>, (
<a name="l00661"></a>00661 ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"LQF"</span>, (ftnlen)3, (
<a name="l00662"></a>00662 ftnlen)3) == 0 || s_cmp(c3, <span class="stringliteral">"QLF"</span>, (ftnlen)3, (ftnlen)3) == 0)
<a name="l00663"></a>00663 {
<a name="l00664"></a>00664 <span class="keywordflow">if</span> (sname) {
<a name="l00665"></a>00665 nx = 128;
<a name="l00666"></a>00666 } <span class="keywordflow">else</span> {
<a name="l00667"></a>00667 nx = 128;
<a name="l00668"></a>00668 }
<a name="l00669"></a>00669 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"HRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00670"></a>00670 <span class="keywordflow">if</span> (sname) {
<a name="l00671"></a>00671 nx = 128;
<a name="l00672"></a>00672 } <span class="keywordflow">else</span> {
<a name="l00673"></a>00673 nx = 128;
<a name="l00674"></a>00674 }
<a name="l00675"></a>00675 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"BRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00676"></a>00676 <span class="keywordflow">if</span> (sname) {
<a name="l00677"></a>00677 nx = 128;
<a name="l00678"></a>00678 } <span class="keywordflow">else</span> {
<a name="l00679"></a>00679 nx = 128;
<a name="l00680"></a>00680 }
<a name="l00681"></a>00681 }
<a name="l00682"></a>00682 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (s_cmp(c2, <span class="stringliteral">"SY"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00683"></a>00683 <span class="keywordflow">if</span> (sname && s_cmp(c3, <span class="stringliteral">"TRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00684"></a>00684 nx = 32;
<a name="l00685"></a>00685 }
<a name="l00686"></a>00686 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (cname && s_cmp(c2, <span class="stringliteral">"HE"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00687"></a>00687 <span class="keywordflow">if</span> (s_cmp(c3, <span class="stringliteral">"TRD"</span>, (ftnlen)3, (ftnlen)3) == 0) {
<a name="l00688"></a>00688 nx = 32;
<a name="l00689"></a>00689 }
<a name="l00690"></a>00690 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (sname && s_cmp(c2, <span class="stringliteral">"OR"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00691"></a>00691 <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'G'</span>) {
<a name="l00692"></a>00692 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00693"></a>00693 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00694"></a>00694 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00695"></a>00695 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00696"></a>00696 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00697"></a>00697 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00698"></a>00698 nx = 128;
<a name="l00699"></a>00699 }
<a name="l00700"></a>00700 }
<a name="l00701"></a>00701 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (cname && s_cmp(c2, <span class="stringliteral">"UN"</span>, (ftnlen)2, (ftnlen)2) == 0) {
<a name="l00702"></a>00702 <span class="keywordflow">if</span> (*(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)c3 == <span class="charliteral">'G'</span>) {
<a name="l00703"></a>00703 <span class="keywordflow">if</span> (s_cmp(c4, <span class="stringliteral">"QR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"RQ"</span>,
<a name="l00704"></a>00704 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"LQ"</span>, (ftnlen)2, (
<a name="l00705"></a>00705 ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"QL"</span>, (ftnlen)2, (ftnlen)2) ==
<a name="l00706"></a>00706 0 || s_cmp(c4, <span class="stringliteral">"HR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
<a name="l00707"></a>00707 c4, <span class="stringliteral">"TR"</span>, (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, <span class="stringliteral">"BR"</span>, (
<a name="l00708"></a>00708 ftnlen)2, (ftnlen)2) == 0) {
<a name="l00709"></a>00709 nx = 128;
<a name="l00710"></a>00710 }
<a name="l00711"></a>00711 }
<a name="l00712"></a>00712 }
<a name="l00713"></a>00713 ret_val = nx;
<a name="l00714"></a>00714 <span class="keywordflow">return</span> ret_val;
<a name="l00715"></a>00715
<a name="l00716"></a>00716 L400:
<a name="l00717"></a>00717
<a name="l00718"></a>00718 <span class="comment">/* ISPEC = 4: number of shifts (used by xHSEQR) */</span>
<a name="l00719"></a>00719
<a name="l00720"></a>00720 ret_val = 6;
<a name="l00721"></a>00721 <span class="keywordflow">return</span> ret_val;
<a name="l00722"></a>00722
<a name="l00723"></a>00723 L500:
<a name="l00724"></a>00724
<a name="l00725"></a>00725 <span class="comment">/* ISPEC = 5: minimum column dimension (not used) */</span>
<a name="l00726"></a>00726
<a name="l00727"></a>00727 ret_val = 2;
<a name="l00728"></a>00728 <span class="keywordflow">return</span> ret_val;
<a name="l00729"></a>00729
<a name="l00730"></a>00730 L600:
<a name="l00731"></a>00731
<a name="l00732"></a>00732 <span class="comment">/* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */</span>
<a name="l00733"></a>00733
<a name="l00734"></a>00734 ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
<a name="l00735"></a>00735 <span class="keywordflow">return</span> ret_val;
<a name="l00736"></a>00736
<a name="l00737"></a>00737 L700:
<a name="l00738"></a>00738
<a name="l00739"></a>00739 <span class="comment">/* ISPEC = 7: number of processors (not used) */</span>
<a name="l00740"></a>00740
<a name="l00741"></a>00741 ret_val = 1;
<a name="l00742"></a>00742 <span class="keywordflow">return</span> ret_val;
<a name="l00743"></a>00743
<a name="l00744"></a>00744 L800:
<a name="l00745"></a>00745
<a name="l00746"></a>00746 <span class="comment">/* ISPEC = 8: crossover point for multishift (used by xHSEQR) */</span>
<a name="l00747"></a>00747
<a name="l00748"></a>00748 ret_val = 50;
<a name="l00749"></a>00749 <span class="keywordflow">return</span> ret_val;
<a name="l00750"></a>00750
<a name="l00751"></a>00751 L900:
<a name="l00752"></a>00752
<a name="l00753"></a>00753 <span class="comment">/*</span>
<a name="l00754"></a>00754 <span class="comment"> ISPEC = 9: maximum size of the subproblems at the bottom of the</span>
<a name="l00755"></a>00755 <span class="comment"> computation tree in the divide-and-conquer algorithm</span>
<a name="l00756"></a>00756 <span class="comment"> (used by xGELSD and xGESDD)</span>
<a name="l00757"></a>00757 <span class="comment">*/</span>
<a name="l00758"></a>00758
<a name="l00759"></a>00759 ret_val = 25;
<a name="l00760"></a>00760 <span class="keywordflow">return</span> ret_val;
<a name="l00761"></a>00761
<a name="l00762"></a>00762 L1000:
<a name="l00763"></a>00763
<a name="l00764"></a>00764 <span class="comment">/*</span>
<a name="l00765"></a>00765 <span class="comment"> ISPEC = 10: ieee NaN arithmetic can be trusted not to trap</span>
<a name="l00766"></a>00766 <span class="comment"></span>
<a name="l00767"></a>00767 <span class="comment"> ILAENV = 0</span>
<a name="l00768"></a>00768 <span class="comment">*/</span>
<a name="l00769"></a>00769 ret_val = 1;
<a name="l00770"></a>00770 <span class="keywordflow">if</span> (ret_val == 1) {
<a name="l00771"></a>00771 ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
<a name="l00772"></a>00772 }
<a name="l00773"></a>00773 <span class="keywordflow">return</span> ret_val;
<a name="l00774"></a>00774
<a name="l00775"></a>00775 L1100:
<a name="l00776"></a>00776
<a name="l00777"></a>00777 <span class="comment">/*</span>
<a name="l00778"></a>00778 <span class="comment"> ISPEC = 11: infinity arithmetic can be trusted not to trap</span>
<a name="l00779"></a>00779 <span class="comment"></span>
<a name="l00780"></a>00780 <span class="comment"> ILAENV = 0</span>
<a name="l00781"></a>00781 <span class="comment">*/</span>
<a name="l00782"></a>00782 ret_val = 1;
<a name="l00783"></a>00783 <span class="keywordflow">if</span> (ret_val == 1) {
<a name="l00784"></a>00784 ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
<a name="l00785"></a>00785 }
<a name="l00786"></a>00786 <span class="keywordflow">return</span> ret_val;
<a name="l00787"></a>00787
<a name="l00788"></a>00788 <span class="comment">/* End of ILAENV */</span>
<a name="l00789"></a>00789
<a name="l00790"></a>00790 } <span class="comment">/* ilaenv_ */</span>
<a name="l00791"></a>00791
<a name="l00792"></a>00792 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> sposv_(<span class="keywordtype">char</span> *uplo, integer *n, integer *nrhs, real *a,
<a name="l00793"></a>00793 integer *lda, real *b, integer *ldb, integer *info)
<a name="l00794"></a>00794 {
<a name="l00795"></a>00795 <span class="comment">/* System generated locals */</span>
<a name="l00796"></a>00796 integer a_dim1, a_offset, b_dim1, b_offset, i__1;
<a name="l00797"></a>00797
<a name="l00798"></a>00798 <span class="comment">/* Local variables */</span>
<a name="l00799"></a>00799 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l00800"></a>00800 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *), spotrf_(
<a name="l00801"></a>00801 <span class="keywordtype">char</span> *, integer *, real *, integer *, integer *), spotrs_(
<a name="l00802"></a>00802 <span class="keywordtype">char</span> *, integer *, integer *, real *, integer *, real *, integer *
<a name="l00803"></a>00803 , integer *);
<a name="l00804"></a>00804
<a name="l00805"></a>00805
<a name="l00806"></a>00806 <span class="comment">/*</span>
<a name="l00807"></a>00807 <span class="comment"> -- LAPACK driver routine (version 3.0) --</span>
<a name="l00808"></a>00808 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l00809"></a>00809 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l00810"></a>00810 <span class="comment"> March 31, 1993</span>
<a name="l00811"></a>00811 <span class="comment"></span>
<a name="l00812"></a>00812 <span class="comment"></span>
<a name="l00813"></a>00813 <span class="comment"> Purpose</span>
<a name="l00814"></a>00814 <span class="comment"> =======</span>
<a name="l00815"></a>00815 <span class="comment"></span>
<a name="l00816"></a>00816 <span class="comment"> SPOSV computes the solution to a real system of linear equations</span>
<a name="l00817"></a>00817 <span class="comment"> A * X = B,</span>
<a name="l00818"></a>00818 <span class="comment"> where A is an N-by-N symmetric positive definite matrix and X and B</span>
<a name="l00819"></a>00819 <span class="comment"> are N-by-NRHS matrices.</span>
<a name="l00820"></a>00820 <span class="comment"></span>
<a name="l00821"></a>00821 <span class="comment"> The Cholesky decomposition is used to factor A as</span>
<a name="l00822"></a>00822 <span class="comment"> A = U**T* U, if UPLO = 'U', or</span>
<a name="l00823"></a>00823 <span class="comment"> A = L * L**T, if UPLO = 'L',</span>
<a name="l00824"></a>00824 <span class="comment"> where U is an upper triangular matrix and L is a lower triangular</span>
<a name="l00825"></a>00825 <span class="comment"> matrix. The factored form of A is then used to solve the system of</span>
<a name="l00826"></a>00826 <span class="comment"> equations A * X = B.</span>
<a name="l00827"></a>00827 <span class="comment"></span>
<a name="l00828"></a>00828 <span class="comment"> Arguments</span>
<a name="l00829"></a>00829 <span class="comment"> =========</span>
<a name="l00830"></a>00830 <span class="comment"></span>
<a name="l00831"></a>00831 <span class="comment"> UPLO (input) CHARACTER*1</span>
<a name="l00832"></a>00832 <span class="comment"> = 'U': Upper triangle of A is stored;</span>
<a name="l00833"></a>00833 <span class="comment"> = 'L': Lower triangle of A is stored.</span>
<a name="l00834"></a>00834 <span class="comment"></span>
<a name="l00835"></a>00835 <span class="comment"> N (input) INTEGER</span>
<a name="l00836"></a>00836 <span class="comment"> The number of linear equations, i.e., the order of the</span>
<a name="l00837"></a>00837 <span class="comment"> matrix A. N >= 0.</span>
<a name="l00838"></a>00838 <span class="comment"></span>
<a name="l00839"></a>00839 <span class="comment"> NRHS (input) INTEGER</span>
<a name="l00840"></a>00840 <span class="comment"> The number of right hand sides, i.e., the number of columns</span>
<a name="l00841"></a>00841 <span class="comment"> of the matrix B. NRHS >= 0.</span>
<a name="l00842"></a>00842 <span class="comment"></span>
<a name="l00843"></a>00843 <span class="comment"> A (input/output) REAL array, dimension (LDA,N)</span>
<a name="l00844"></a>00844 <span class="comment"> On entry, the symmetric matrix A. If UPLO = 'U', the leading</span>
<a name="l00845"></a>00845 <span class="comment"> N-by-N upper triangular part of A contains the upper</span>
<a name="l00846"></a>00846 <span class="comment"> triangular part of the matrix A, and the strictly lower</span>
<a name="l00847"></a>00847 <span class="comment"> triangular part of A is not referenced. If UPLO = 'L', the</span>
<a name="l00848"></a>00848 <span class="comment"> leading N-by-N lower triangular part of A contains the lower</span>
<a name="l00849"></a>00849 <span class="comment"> triangular part of the matrix A, and the strictly upper</span>
<a name="l00850"></a>00850 <span class="comment"> triangular part of A is not referenced.</span>
<a name="l00851"></a>00851 <span class="comment"></span>
<a name="l00852"></a>00852 <span class="comment"> On exit, if INFO = 0, the factor U or L from the Cholesky</span>
<a name="l00853"></a>00853 <span class="comment"> factorization A = U**T*U or A = L*L**T.</span>
<a name="l00854"></a>00854 <span class="comment"></span>
<a name="l00855"></a>00855 <span class="comment"> LDA (input) INTEGER</span>
<a name="l00856"></a>00856 <span class="comment"> The leading dimension of the array A. LDA >= max(1,N).</span>
<a name="l00857"></a>00857 <span class="comment"></span>
<a name="l00858"></a>00858 <span class="comment"> B (input/output) REAL array, dimension (LDB,NRHS)</span>
<a name="l00859"></a>00859 <span class="comment"> On entry, the N-by-NRHS right hand side matrix B.</span>
<a name="l00860"></a>00860 <span class="comment"> On exit, if INFO = 0, the N-by-NRHS solution matrix X.</span>
<a name="l00861"></a>00861 <span class="comment"></span>
<a name="l00862"></a>00862 <span class="comment"> LDB (input) INTEGER</span>
<a name="l00863"></a>00863 <span class="comment"> The leading dimension of the array B. LDB >= max(1,N).</span>
<a name="l00864"></a>00864 <span class="comment"></span>
<a name="l00865"></a>00865 <span class="comment"> INFO (output) INTEGER</span>
<a name="l00866"></a>00866 <span class="comment"> = 0: successful exit</span>
<a name="l00867"></a>00867 <span class="comment"> < 0: if INFO = -i, the i-th argument had an illegal value</span>
<a name="l00868"></a>00868 <span class="comment"> > 0: if INFO = i, the leading minor of order i of A is not</span>
<a name="l00869"></a>00869 <span class="comment"> positive definite, so the factorization could not be</span>
<a name="l00870"></a>00870 <span class="comment"> completed, and the solution has not been computed.</span>
<a name="l00871"></a>00871 <span class="comment"></span>
<a name="l00872"></a>00872 <span class="comment"> =====================================================================</span>
<a name="l00873"></a>00873 <span class="comment"></span>
<a name="l00874"></a>00874 <span class="comment"></span>
<a name="l00875"></a>00875 <span class="comment"> Test the input parameters.</span>
<a name="l00876"></a>00876 <span class="comment">*/</span>
<a name="l00877"></a>00877
<a name="l00878"></a>00878 <span class="comment">/* Parameter adjustments */</span>
<a name="l00879"></a>00879 a_dim1 = *lda;
<a name="l00880"></a>00880 a_offset = 1 + a_dim1;
<a name="l00881"></a>00881 a -= a_offset;
<a name="l00882"></a>00882 b_dim1 = *ldb;
<a name="l00883"></a>00883 b_offset = 1 + b_dim1;
<a name="l00884"></a>00884 b -= b_offset;
<a name="l00885"></a>00885
<a name="l00886"></a>00886 <span class="comment">/* Function Body */</span>
<a name="l00887"></a>00887 *info = 0;
<a name="l00888"></a>00888 <span class="keywordflow">if</span> (! lsame_(uplo, <span class="stringliteral">"U"</span>) && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l00889"></a>00889 *info = -1;
<a name="l00890"></a>00890 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l00891"></a>00891 *info = -2;
<a name="l00892"></a>00892 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*nrhs < 0) {
<a name="l00893"></a>00893 *info = -3;
<a name="l00894"></a>00894 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,*n)) {
<a name="l00895"></a>00895 *info = -5;
<a name="l00896"></a>00896 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldb < max(1,*n)) {
<a name="l00897"></a>00897 *info = -7;
<a name="l00898"></a>00898 }
<a name="l00899"></a>00899 <span class="keywordflow">if</span> (*info != 0) {
<a name="l00900"></a>00900 i__1 = -(*info);
<a name="l00901"></a>00901 xerbla_(<span class="stringliteral">"SPOSV "</span>, &i__1);
<a name="l00902"></a>00902 <span class="keywordflow">return</span> 0;
<a name="l00903"></a>00903 }
<a name="l00904"></a>00904
<a name="l00905"></a>00905 <span class="comment">/* Compute the Cholesky factorization A = U'*U or A = L*L'. */</span>
<a name="l00906"></a>00906
<a name="l00907"></a>00907 spotrf_(uplo, n, &a[a_offset], lda, info);
<a name="l00908"></a>00908 <span class="keywordflow">if</span> (*info == 0) {
<a name="l00909"></a>00909
<a name="l00910"></a>00910 <span class="comment">/* Solve the system A*X = B, overwriting B with X. */</span>
<a name="l00911"></a>00911
<a name="l00912"></a>00912 spotrs_(uplo, n, nrhs, &a[a_offset], lda, &b[b_offset], ldb, info);
<a name="l00913"></a>00913
<a name="l00914"></a>00914 }
<a name="l00915"></a>00915 <span class="keywordflow">return</span> 0;
<a name="l00916"></a>00916
<a name="l00917"></a>00917 <span class="comment">/* End of SPOSV */</span>
<a name="l00918"></a>00918
<a name="l00919"></a>00919 } <span class="comment">/* sposv_ */</span>
<a name="l00920"></a>00920
<a name="l00921"></a>00921 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> spotf2_(<span class="keywordtype">char</span> *uplo, integer *n, real *a, integer *lda,
<a name="l00922"></a>00922 integer *info)
<a name="l00923"></a>00923 {
<a name="l00924"></a>00924 <span class="comment">/* System generated locals */</span>
<a name="l00925"></a>00925 integer a_dim1, a_offset, i__1, i__2, i__3;
<a name="l00926"></a>00926 real r__1;
<a name="l00927"></a>00927
<a name="l00928"></a>00928 <span class="comment">/* Builtin functions */</span>
<a name="l00929"></a>00929 <span class="keywordtype">double</span> sqrt(doublereal);
<a name="l00930"></a>00930
<a name="l00931"></a>00931 <span class="comment">/* Local variables */</span>
<a name="l00932"></a>00932 <span class="keyword">static</span> integer j;
<a name="l00933"></a>00933 <span class="keyword">static</span> real ajj;
<a name="l00934"></a>00934 <span class="keyword">extern</span> doublereal sdot_(integer *, real *, integer *, real *, integer *);
<a name="l00935"></a>00935 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l00936"></a>00936 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> sscal_(integer *, real *, real *, integer *),
<a name="l00937"></a>00937 sgemv_(<span class="keywordtype">char</span> *, integer *, integer *, real *, real *, integer *,
<a name="l00938"></a>00938 real *, integer *, real *, real *, integer *);
<a name="l00939"></a>00939 <span class="keyword">static</span> logical upper;
<a name="l00940"></a>00940 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l00941"></a>00941
<a name="l00942"></a>00942
<a name="l00943"></a>00943 <span class="comment">/*</span>
<a name="l00944"></a>00944 <span class="comment"> -- LAPACK routine (version 3.0) --</span>
<a name="l00945"></a>00945 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l00946"></a>00946 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l00947"></a>00947 <span class="comment"> February 29, 1992</span>
<a name="l00948"></a>00948 <span class="comment"></span>
<a name="l00949"></a>00949 <span class="comment"></span>
<a name="l00950"></a>00950 <span class="comment"> Purpose</span>
<a name="l00951"></a>00951 <span class="comment"> =======</span>
<a name="l00952"></a>00952 <span class="comment"></span>
<a name="l00953"></a>00953 <span class="comment"> SPOTF2 computes the Cholesky factorization of a real symmetric</span>
<a name="l00954"></a>00954 <span class="comment"> positive definite matrix A.</span>
<a name="l00955"></a>00955 <span class="comment"></span>
<a name="l00956"></a>00956 <span class="comment"> The factorization has the form</span>
<a name="l00957"></a>00957 <span class="comment"> A = U' * U , if UPLO = 'U', or</span>
<a name="l00958"></a>00958 <span class="comment"> A = L * L', if UPLO = 'L',</span>
<a name="l00959"></a>00959 <span class="comment"> where U is an upper triangular matrix and L is lower triangular.</span>
<a name="l00960"></a>00960 <span class="comment"></span>
<a name="l00961"></a>00961 <span class="comment"> This is the unblocked version of the algorithm, calling Level 2 BLAS.</span>
<a name="l00962"></a>00962 <span class="comment"></span>
<a name="l00963"></a>00963 <span class="comment"> Arguments</span>
<a name="l00964"></a>00964 <span class="comment"> =========</span>
<a name="l00965"></a>00965 <span class="comment"></span>
<a name="l00966"></a>00966 <span class="comment"> UPLO (input) CHARACTER*1</span>
<a name="l00967"></a>00967 <span class="comment"> Specifies whether the upper or lower triangular part of the</span>
<a name="l00968"></a>00968 <span class="comment"> symmetric matrix A is stored.</span>
<a name="l00969"></a>00969 <span class="comment"> = 'U': Upper triangular</span>
<a name="l00970"></a>00970 <span class="comment"> = 'L': Lower triangular</span>
<a name="l00971"></a>00971 <span class="comment"></span>
<a name="l00972"></a>00972 <span class="comment"> N (input) INTEGER</span>
<a name="l00973"></a>00973 <span class="comment"> The order of the matrix A. N >= 0.</span>
<a name="l00974"></a>00974 <span class="comment"></span>
<a name="l00975"></a>00975 <span class="comment"> A (input/output) REAL array, dimension (LDA,N)</span>
<a name="l00976"></a>00976 <span class="comment"> On entry, the symmetric matrix A. If UPLO = 'U', the leading</span>
<a name="l00977"></a>00977 <span class="comment"> n by n upper triangular part of A contains the upper</span>
<a name="l00978"></a>00978 <span class="comment"> triangular part of the matrix A, and the strictly lower</span>
<a name="l00979"></a>00979 <span class="comment"> triangular part of A is not referenced. If UPLO = 'L', the</span>
<a name="l00980"></a>00980 <span class="comment"> leading n by n lower triangular part of A contains the lower</span>
<a name="l00981"></a>00981 <span class="comment"> triangular part of the matrix A, and the strictly upper</span>
<a name="l00982"></a>00982 <span class="comment"> triangular part of A is not referenced.</span>
<a name="l00983"></a>00983 <span class="comment"></span>
<a name="l00984"></a>00984 <span class="comment"> On exit, if INFO = 0, the factor U or L from the Cholesky</span>
<a name="l00985"></a>00985 <span class="comment"> factorization A = U'*U or A = L*L'.</span>
<a name="l00986"></a>00986 <span class="comment"></span>
<a name="l00987"></a>00987 <span class="comment"> LDA (input) INTEGER</span>
<a name="l00988"></a>00988 <span class="comment"> The leading dimension of the array A. LDA >= max(1,N).</span>
<a name="l00989"></a>00989 <span class="comment"></span>
<a name="l00990"></a>00990 <span class="comment"> INFO (output) INTEGER</span>
<a name="l00991"></a>00991 <span class="comment"> = 0: successful exit</span>
<a name="l00992"></a>00992 <span class="comment"> < 0: if INFO = -k, the k-th argument had an illegal value</span>
<a name="l00993"></a>00993 <span class="comment"> > 0: if INFO = k, the leading minor of order k is not</span>
<a name="l00994"></a>00994 <span class="comment"> positive definite, and the factorization could not be</span>
<a name="l00995"></a>00995 <span class="comment"> completed.</span>
<a name="l00996"></a>00996 <span class="comment"></span>
<a name="l00997"></a>00997 <span class="comment"> =====================================================================</span>
<a name="l00998"></a>00998 <span class="comment"></span>
<a name="l00999"></a>00999 <span class="comment"></span>
<a name="l01000"></a>01000 <span class="comment"> Test the input parameters.</span>
<a name="l01001"></a>01001 <span class="comment">*/</span>
<a name="l01002"></a>01002
<a name="l01003"></a>01003 <span class="comment">/* Parameter adjustments */</span>
<a name="l01004"></a>01004 a_dim1 = *lda;
<a name="l01005"></a>01005 a_offset = 1 + a_dim1;
<a name="l01006"></a>01006 a -= a_offset;
<a name="l01007"></a>01007
<a name="l01008"></a>01008 <span class="comment">/* Function Body */</span>
<a name="l01009"></a>01009 *info = 0;
<a name="l01010"></a>01010 upper = lsame_(uplo, <span class="stringliteral">"U"</span>);
<a name="l01011"></a>01011 <span class="keywordflow">if</span> (! upper && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l01012"></a>01012 *info = -1;
<a name="l01013"></a>01013 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l01014"></a>01014 *info = -2;
<a name="l01015"></a>01015 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,*n)) {
<a name="l01016"></a>01016 *info = -4;
<a name="l01017"></a>01017 }
<a name="l01018"></a>01018 <span class="keywordflow">if</span> (*info != 0) {
<a name="l01019"></a>01019 i__1 = -(*info);
<a name="l01020"></a>01020 xerbla_(<span class="stringliteral">"SPOTF2"</span>, &i__1);
<a name="l01021"></a>01021 <span class="keywordflow">return</span> 0;
<a name="l01022"></a>01022 }
<a name="l01023"></a>01023
<a name="l01024"></a>01024 <span class="comment">/* Quick return if possible */</span>
<a name="l01025"></a>01025
<a name="l01026"></a>01026 <span class="keywordflow">if</span> (*n == 0) {
<a name="l01027"></a>01027 <span class="keywordflow">return</span> 0;
<a name="l01028"></a>01028 }
<a name="l01029"></a>01029
<a name="l01030"></a>01030 <span class="keywordflow">if</span> (upper) {
<a name="l01031"></a>01031
<a name="l01032"></a>01032 <span class="comment">/* Compute the Cholesky factorization A = U'*U. */</span>
<a name="l01033"></a>01033
<a name="l01034"></a>01034 i__1 = *n;
<a name="l01035"></a>01035 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01036"></a>01036
<a name="l01037"></a>01037 <span class="comment">/* Compute U(J,J) and test for non-positive-definiteness. */</span>
<a name="l01038"></a>01038
<a name="l01039"></a>01039 i__2 = j - 1;
<a name="l01040"></a>01040 ajj = a[j + j * a_dim1] - sdot_(&i__2, &a[j * a_dim1 + 1], &c__1,
<a name="l01041"></a>01041 &a[j * a_dim1 + 1], &c__1);
<a name="l01042"></a>01042 <span class="keywordflow">if</span> (ajj <= 0.f) {
<a name="l01043"></a>01043 a[j + j * a_dim1] = ajj;
<a name="l01044"></a>01044 <span class="keywordflow">goto</span> L30;
<a name="l01045"></a>01045 }
<a name="l01046"></a>01046 ajj = sqrt(ajj);
<a name="l01047"></a>01047 a[j + j * a_dim1] = ajj;
<a name="l01048"></a>01048
<a name="l01049"></a>01049 <span class="comment">/* Compute elements J+1:N of row J. */</span>
<a name="l01050"></a>01050
<a name="l01051"></a>01051 <span class="keywordflow">if</span> (j < *n) {
<a name="l01052"></a>01052 i__2 = j - 1;
<a name="l01053"></a>01053 i__3 = *n - j;
<a name="l01054"></a>01054 sgemv_(<span class="stringliteral">"Transpose"</span>, &i__2, &i__3, &c_b181, &a[(j + 1) *
<a name="l01055"></a>01055 a_dim1 + 1], lda, &a[j * a_dim1 + 1], &c__1, &c_b164,
<a name="l01056"></a>01056 &a[j + (j + 1) * a_dim1], lda);
<a name="l01057"></a>01057 i__2 = *n - j;
<a name="l01058"></a>01058 r__1 = 1.f / ajj;
<a name="l01059"></a>01059 sscal_(&i__2, &r__1, &a[j + (j + 1) * a_dim1], lda);
<a name="l01060"></a>01060 }
<a name="l01061"></a>01061 <span class="comment">/* L10: */</span>
<a name="l01062"></a>01062 }
<a name="l01063"></a>01063 } <span class="keywordflow">else</span> {
<a name="l01064"></a>01064
<a name="l01065"></a>01065 <span class="comment">/* Compute the Cholesky factorization A = L*L'. */</span>
<a name="l01066"></a>01066
<a name="l01067"></a>01067 i__1 = *n;
<a name="l01068"></a>01068 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01069"></a>01069
<a name="l01070"></a>01070 <span class="comment">/* Compute L(J,J) and test for non-positive-definiteness. */</span>
<a name="l01071"></a>01071
<a name="l01072"></a>01072 i__2 = j - 1;
<a name="l01073"></a>01073 ajj = a[j + j * a_dim1] - sdot_(&i__2, &a[j + a_dim1], lda, &a[j
<a name="l01074"></a>01074 + a_dim1], lda);
<a name="l01075"></a>01075 <span class="keywordflow">if</span> (ajj <= 0.f) {
<a name="l01076"></a>01076 a[j + j * a_dim1] = ajj;
<a name="l01077"></a>01077 <span class="keywordflow">goto</span> L30;
<a name="l01078"></a>01078 }
<a name="l01079"></a>01079 ajj = sqrt(ajj);
<a name="l01080"></a>01080 a[j + j * a_dim1] = ajj;
<a name="l01081"></a>01081
<a name="l01082"></a>01082 <span class="comment">/* Compute elements J+1:N of column J. */</span>
<a name="l01083"></a>01083
<a name="l01084"></a>01084 <span class="keywordflow">if</span> (j < *n) {
<a name="l01085"></a>01085 i__2 = *n - j;
<a name="l01086"></a>01086 i__3 = j - 1;
<a name="l01087"></a>01087 sgemv_(<span class="stringliteral">"No transpose"</span>, &i__2, &i__3, &c_b181, &a[j + 1 +
<a name="l01088"></a>01088 a_dim1], lda, &a[j + a_dim1], lda, &c_b164, &a[j + 1
<a name="l01089"></a>01089 + j * a_dim1], &c__1);
<a name="l01090"></a>01090 i__2 = *n - j;
<a name="l01091"></a>01091 r__1 = 1.f / ajj;
<a name="l01092"></a>01092 sscal_(&i__2, &r__1, &a[j + 1 + j * a_dim1], &c__1);
<a name="l01093"></a>01093 }
<a name="l01094"></a>01094 <span class="comment">/* L20: */</span>
<a name="l01095"></a>01095 }
<a name="l01096"></a>01096 }
<a name="l01097"></a>01097 <span class="keywordflow">goto</span> L40;
<a name="l01098"></a>01098
<a name="l01099"></a>01099 L30:
<a name="l01100"></a>01100 *info = j;
<a name="l01101"></a>01101
<a name="l01102"></a>01102 L40:
<a name="l01103"></a>01103 <span class="keywordflow">return</span> 0;
<a name="l01104"></a>01104
<a name="l01105"></a>01105 <span class="comment">/* End of SPOTF2 */</span>
<a name="l01106"></a>01106
<a name="l01107"></a>01107 } <span class="comment">/* spotf2_ */</span>
<a name="l01108"></a>01108
<a name="l01109"></a>01109 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> spotrf_(<span class="keywordtype">char</span> *uplo, integer *n, real *a, integer *lda,
<a name="l01110"></a>01110 integer *info)
<a name="l01111"></a>01111 {
<a name="l01112"></a>01112 <span class="comment">/* System generated locals */</span>
<a name="l01113"></a>01113 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
<a name="l01114"></a>01114
<a name="l01115"></a>01115 <span class="comment">/* Local variables */</span>
<a name="l01116"></a>01116 <span class="keyword">static</span> integer j, jb, nb;
<a name="l01117"></a>01117 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l01118"></a>01118 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> sgemm_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, integer *, integer *,
<a name="l01119"></a>01119 integer *, real *, real *, integer *, real *, integer *, real *,
<a name="l01120"></a>01120 real *, integer *);
<a name="l01121"></a>01121 <span class="keyword">static</span> logical upper;
<a name="l01122"></a>01122 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> strsm_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *,
<a name="l01123"></a>01123 integer *, integer *, real *, real *, integer *, real *, integer *
<a name="l01124"></a>01124 ), ssyrk_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, integer
<a name="l01125"></a>01125 *, integer *, real *, real *, integer *, real *, real *, integer *
<a name="l01126"></a>01126 ), spotf2_(<span class="keywordtype">char</span> *, integer *, real *, integer *,
<a name="l01127"></a>01127 integer *), xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l01128"></a>01128 <span class="keyword">extern</span> integer ilaenv_(integer *, <span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, integer *, integer *,
<a name="l01129"></a>01129 integer *, integer *, ftnlen, ftnlen);
<a name="l01130"></a>01130
<a name="l01131"></a>01131
<a name="l01132"></a>01132 <span class="comment">/*</span>
<a name="l01133"></a>01133 <span class="comment"> -- LAPACK routine (version 3.0) --</span>
<a name="l01134"></a>01134 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l01135"></a>01135 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l01136"></a>01136 <span class="comment"> March 31, 1993</span>
<a name="l01137"></a>01137 <span class="comment"></span>
<a name="l01138"></a>01138 <span class="comment"></span>
<a name="l01139"></a>01139 <span class="comment"> Purpose</span>
<a name="l01140"></a>01140 <span class="comment"> =======</span>
<a name="l01141"></a>01141 <span class="comment"></span>
<a name="l01142"></a>01142 <span class="comment"> SPOTRF computes the Cholesky factorization of a real symmetric</span>
<a name="l01143"></a>01143 <span class="comment"> positive definite matrix A.</span>
<a name="l01144"></a>01144 <span class="comment"></span>
<a name="l01145"></a>01145 <span class="comment"> The factorization has the form</span>
<a name="l01146"></a>01146 <span class="comment"> A = U**T * U, if UPLO = 'U', or</span>
<a name="l01147"></a>01147 <span class="comment"> A = L * L**T, if UPLO = 'L',</span>
<a name="l01148"></a>01148 <span class="comment"> where U is an upper triangular matrix and L is lower triangular.</span>
<a name="l01149"></a>01149 <span class="comment"></span>
<a name="l01150"></a>01150 <span class="comment"> This is the block version of the algorithm, calling Level 3 BLAS.</span>
<a name="l01151"></a>01151 <span class="comment"></span>
<a name="l01152"></a>01152 <span class="comment"> Arguments</span>
<a name="l01153"></a>01153 <span class="comment"> =========</span>
<a name="l01154"></a>01154 <span class="comment"></span>
<a name="l01155"></a>01155 <span class="comment"> UPLO (input) CHARACTER*1</span>
<a name="l01156"></a>01156 <span class="comment"> = 'U': Upper triangle of A is stored;</span>
<a name="l01157"></a>01157 <span class="comment"> = 'L': Lower triangle of A is stored.</span>
<a name="l01158"></a>01158 <span class="comment"></span>
<a name="l01159"></a>01159 <span class="comment"> N (input) INTEGER</span>
<a name="l01160"></a>01160 <span class="comment"> The order of the matrix A. N >= 0.</span>
<a name="l01161"></a>01161 <span class="comment"></span>
<a name="l01162"></a>01162 <span class="comment"> A (input/output) REAL array, dimension (LDA,N)</span>
<a name="l01163"></a>01163 <span class="comment"> On entry, the symmetric matrix A. If UPLO = 'U', the leading</span>
<a name="l01164"></a>01164 <span class="comment"> N-by-N upper triangular part of A contains the upper</span>
<a name="l01165"></a>01165 <span class="comment"> triangular part of the matrix A, and the strictly lower</span>
<a name="l01166"></a>01166 <span class="comment"> triangular part of A is not referenced. If UPLO = 'L', the</span>
<a name="l01167"></a>01167 <span class="comment"> leading N-by-N lower triangular part of A contains the lower</span>
<a name="l01168"></a>01168 <span class="comment"> triangular part of the matrix A, and the strictly upper</span>
<a name="l01169"></a>01169 <span class="comment"> triangular part of A is not referenced.</span>
<a name="l01170"></a>01170 <span class="comment"></span>
<a name="l01171"></a>01171 <span class="comment"> On exit, if INFO = 0, the factor U or L from the Cholesky</span>
<a name="l01172"></a>01172 <span class="comment"> factorization A = U**T*U or A = L*L**T.</span>
<a name="l01173"></a>01173 <span class="comment"></span>
<a name="l01174"></a>01174 <span class="comment"> LDA (input) INTEGER</span>
<a name="l01175"></a>01175 <span class="comment"> The leading dimension of the array A. LDA >= max(1,N).</span>
<a name="l01176"></a>01176 <span class="comment"></span>
<a name="l01177"></a>01177 <span class="comment"> INFO (output) INTEGER</span>
<a name="l01178"></a>01178 <span class="comment"> = 0: successful exit</span>
<a name="l01179"></a>01179 <span class="comment"> < 0: if INFO = -i, the i-th argument had an illegal value</span>
<a name="l01180"></a>01180 <span class="comment"> > 0: if INFO = i, the leading minor of order i is not</span>
<a name="l01181"></a>01181 <span class="comment"> positive definite, and the factorization could not be</span>
<a name="l01182"></a>01182 <span class="comment"> completed.</span>
<a name="l01183"></a>01183 <span class="comment"></span>
<a name="l01184"></a>01184 <span class="comment"> =====================================================================</span>
<a name="l01185"></a>01185 <span class="comment"></span>
<a name="l01186"></a>01186 <span class="comment"></span>
<a name="l01187"></a>01187 <span class="comment"> Test the input parameters.</span>
<a name="l01188"></a>01188 <span class="comment">*/</span>
<a name="l01189"></a>01189
<a name="l01190"></a>01190 <span class="comment">/* Parameter adjustments */</span>
<a name="l01191"></a>01191 a_dim1 = *lda;
<a name="l01192"></a>01192 a_offset = 1 + a_dim1;
<a name="l01193"></a>01193 a -= a_offset;
<a name="l01194"></a>01194
<a name="l01195"></a>01195 <span class="comment">/* Function Body */</span>
<a name="l01196"></a>01196 *info = 0;
<a name="l01197"></a>01197 upper = lsame_(uplo, <span class="stringliteral">"U"</span>);
<a name="l01198"></a>01198 <span class="keywordflow">if</span> (! upper && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l01199"></a>01199 *info = -1;
<a name="l01200"></a>01200 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l01201"></a>01201 *info = -2;
<a name="l01202"></a>01202 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,*n)) {
<a name="l01203"></a>01203 *info = -4;
<a name="l01204"></a>01204 }
<a name="l01205"></a>01205 <span class="keywordflow">if</span> (*info != 0) {
<a name="l01206"></a>01206 i__1 = -(*info);
<a name="l01207"></a>01207 xerbla_(<span class="stringliteral">"SPOTRF"</span>, &i__1);
<a name="l01208"></a>01208 <span class="keywordflow">return</span> 0;
<a name="l01209"></a>01209 }
<a name="l01210"></a>01210
<a name="l01211"></a>01211 <span class="comment">/* Quick return if possible */</span>
<a name="l01212"></a>01212
<a name="l01213"></a>01213 <span class="keywordflow">if</span> (*n == 0) {
<a name="l01214"></a>01214 <span class="keywordflow">return</span> 0;
<a name="l01215"></a>01215 }
<a name="l01216"></a>01216
<a name="l01217"></a>01217 <span class="comment">/* Determine the block size for this environment. */</span>
<a name="l01218"></a>01218
<a name="l01219"></a>01219 nb = ilaenv_(&c__1, <span class="stringliteral">"SPOTRF"</span>, uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
<a name="l01220"></a>01220 ftnlen)1);
<a name="l01221"></a>01221 <span class="keywordflow">if</span> (nb <= 1 || nb >= *n) {
<a name="l01222"></a>01222
<a name="l01223"></a>01223 <span class="comment">/* Use unblocked code. */</span>
<a name="l01224"></a>01224
<a name="l01225"></a>01225 spotf2_(uplo, n, &a[a_offset], lda, info);
<a name="l01226"></a>01226 } <span class="keywordflow">else</span> {
<a name="l01227"></a>01227
<a name="l01228"></a>01228 <span class="comment">/* Use blocked code. */</span>
<a name="l01229"></a>01229
<a name="l01230"></a>01230 <span class="keywordflow">if</span> (upper) {
<a name="l01231"></a>01231
<a name="l01232"></a>01232 <span class="comment">/* Compute the Cholesky factorization A = U'*U. */</span>
<a name="l01233"></a>01233
<a name="l01234"></a>01234 i__1 = *n;
<a name="l01235"></a>01235 i__2 = nb;
<a name="l01236"></a>01236 <span class="keywordflow">for</span> (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
<a name="l01237"></a>01237
<a name="l01238"></a>01238 <span class="comment">/*</span>
<a name="l01239"></a>01239 <span class="comment"> Update and factorize the current diagonal block and test</span>
<a name="l01240"></a>01240 <span class="comment"> for non-positive-definiteness.</span>
<a name="l01241"></a>01241 <span class="comment"></span>
<a name="l01242"></a>01242 <span class="comment"> Computing MIN</span>
<a name="l01243"></a>01243 <span class="comment">*/</span>
<a name="l01244"></a>01244 i__3 = nb, i__4 = *n - j + 1;
<a name="l01245"></a>01245 jb = min(i__3,i__4);
<a name="l01246"></a>01246 i__3 = j - 1;
<a name="l01247"></a>01247 ssyrk_(<span class="stringliteral">"Upper"</span>, <span class="stringliteral">"Transpose"</span>, &jb, &i__3, &c_b181, &a[j *
<a name="l01248"></a>01248 a_dim1 + 1], lda, &c_b164, &a[j + j * a_dim1], lda);
<a name="l01249"></a>01249 spotf2_(<span class="stringliteral">"Upper"</span>, &jb, &a[j + j * a_dim1], lda, info);
<a name="l01250"></a>01250 <span class="keywordflow">if</span> (*info != 0) {
<a name="l01251"></a>01251 <span class="keywordflow">goto</span> L30;
<a name="l01252"></a>01252 }
<a name="l01253"></a>01253 <span class="keywordflow">if</span> (j + jb <= *n) {
<a name="l01254"></a>01254
<a name="l01255"></a>01255 <span class="comment">/* Compute the current block row. */</span>
<a name="l01256"></a>01256
<a name="l01257"></a>01257 i__3 = *n - j - jb + 1;
<a name="l01258"></a>01258 i__4 = j - 1;
<a name="l01259"></a>01259 sgemm_(<span class="stringliteral">"Transpose"</span>, <span class="stringliteral">"No transpose"</span>, &jb, &i__3, &i__4, &
<a name="l01260"></a>01260 c_b181, &a[j * a_dim1 + 1], lda, &a[(j + jb) *
<a name="l01261"></a>01261 a_dim1 + 1], lda, &c_b164, &a[j + (j + jb) *
<a name="l01262"></a>01262 a_dim1], lda);
<a name="l01263"></a>01263 i__3 = *n - j - jb + 1;
<a name="l01264"></a>01264 strsm_(<span class="stringliteral">"Left"</span>, <span class="stringliteral">"Upper"</span>, <span class="stringliteral">"Transpose"</span>, <span class="stringliteral">"Non-unit"</span>, &jb, &
<a name="l01265"></a>01265 i__3, &c_b164, &a[j + j * a_dim1], lda, &a[j + (j
<a name="l01266"></a>01266 + jb) * a_dim1], lda);
<a name="l01267"></a>01267 }
<a name="l01268"></a>01268 <span class="comment">/* L10: */</span>
<a name="l01269"></a>01269 }
<a name="l01270"></a>01270
<a name="l01271"></a>01271 } <span class="keywordflow">else</span> {
<a name="l01272"></a>01272
<a name="l01273"></a>01273 <span class="comment">/* Compute the Cholesky factorization A = L*L'. */</span>
<a name="l01274"></a>01274
<a name="l01275"></a>01275 i__2 = *n;
<a name="l01276"></a>01276 i__1 = nb;
<a name="l01277"></a>01277 <span class="keywordflow">for</span> (j = 1; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
<a name="l01278"></a>01278
<a name="l01279"></a>01279 <span class="comment">/*</span>
<a name="l01280"></a>01280 <span class="comment"> Update and factorize the current diagonal block and test</span>
<a name="l01281"></a>01281 <span class="comment"> for non-positive-definiteness.</span>
<a name="l01282"></a>01282 <span class="comment"></span>
<a name="l01283"></a>01283 <span class="comment"> Computing MIN</span>
<a name="l01284"></a>01284 <span class="comment">*/</span>
<a name="l01285"></a>01285 i__3 = nb, i__4 = *n - j + 1;
<a name="l01286"></a>01286 jb = min(i__3,i__4);
<a name="l01287"></a>01287 i__3 = j - 1;
<a name="l01288"></a>01288 ssyrk_(<span class="stringliteral">"Lower"</span>, <span class="stringliteral">"No transpose"</span>, &jb, &i__3, &c_b181, &a[j +
<a name="l01289"></a>01289 a_dim1], lda, &c_b164, &a[j + j * a_dim1], lda);
<a name="l01290"></a>01290 spotf2_(<span class="stringliteral">"Lower"</span>, &jb, &a[j + j * a_dim1], lda, info);
<a name="l01291"></a>01291 <span class="keywordflow">if</span> (*info != 0) {
<a name="l01292"></a>01292 <span class="keywordflow">goto</span> L30;
<a name="l01293"></a>01293 }
<a name="l01294"></a>01294 <span class="keywordflow">if</span> (j + jb <= *n) {
<a name="l01295"></a>01295
<a name="l01296"></a>01296 <span class="comment">/* Compute the current block column. */</span>
<a name="l01297"></a>01297
<a name="l01298"></a>01298 i__3 = *n - j - jb + 1;
<a name="l01299"></a>01299 i__4 = j - 1;
<a name="l01300"></a>01300 sgemm_(<span class="stringliteral">"No transpose"</span>, <span class="stringliteral">"Transpose"</span>, &i__3, &jb, &i__4, &
<a name="l01301"></a>01301 c_b181, &a[j + jb + a_dim1], lda, &a[j + a_dim1],
<a name="l01302"></a>01302 lda, &c_b164, &a[j + jb + j * a_dim1], lda);
<a name="l01303"></a>01303 i__3 = *n - j - jb + 1;
<a name="l01304"></a>01304 strsm_(<span class="stringliteral">"Right"</span>, <span class="stringliteral">"Lower"</span>, <span class="stringliteral">"Transpose"</span>, <span class="stringliteral">"Non-unit"</span>, &i__3, &
<a name="l01305"></a>01305 jb, &c_b164, &a[j + j * a_dim1], lda, &a[j + jb +
<a name="l01306"></a>01306 j * a_dim1], lda);
<a name="l01307"></a>01307 }
<a name="l01308"></a>01308 <span class="comment">/* L20: */</span>
<a name="l01309"></a>01309 }
<a name="l01310"></a>01310 }
<a name="l01311"></a>01311 }
<a name="l01312"></a>01312 <span class="keywordflow">goto</span> L40;
<a name="l01313"></a>01313
<a name="l01314"></a>01314 L30:
<a name="l01315"></a>01315 *info = *info + j - 1;
<a name="l01316"></a>01316
<a name="l01317"></a>01317 L40:
<a name="l01318"></a>01318 <span class="keywordflow">return</span> 0;
<a name="l01319"></a>01319
<a name="l01320"></a>01320 <span class="comment">/* End of SPOTRF */</span>
<a name="l01321"></a>01321
<a name="l01322"></a>01322 } <span class="comment">/* spotrf_ */</span>
<a name="l01323"></a>01323
<a name="l01324"></a>01324 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> spotrs_(<span class="keywordtype">char</span> *uplo, integer *n, integer *nrhs, real *a,
<a name="l01325"></a>01325 integer *lda, real *b, integer *ldb, integer *info)
<a name="l01326"></a>01326 {
<a name="l01327"></a>01327 <span class="comment">/* System generated locals */</span>
<a name="l01328"></a>01328 integer a_dim1, a_offset, b_dim1, b_offset, i__1;
<a name="l01329"></a>01329
<a name="l01330"></a>01330 <span class="comment">/* Local variables */</span>
<a name="l01331"></a>01331 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l01332"></a>01332 <span class="keyword">static</span> logical upper;
<a name="l01333"></a>01333 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> strsm_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *,
<a name="l01334"></a>01334 integer *, integer *, real *, real *, integer *, real *, integer *
<a name="l01335"></a>01335 ), xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l01336"></a>01336
<a name="l01337"></a>01337
<a name="l01338"></a>01338 <span class="comment">/*</span>
<a name="l01339"></a>01339 <span class="comment"> -- LAPACK routine (version 3.0) --</span>
<a name="l01340"></a>01340 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l01341"></a>01341 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l01342"></a>01342 <span class="comment"> March 31, 1993</span>
<a name="l01343"></a>01343 <span class="comment"></span>
<a name="l01344"></a>01344 <span class="comment"></span>
<a name="l01345"></a>01345 <span class="comment"> Purpose</span>
<a name="l01346"></a>01346 <span class="comment"> =======</span>
<a name="l01347"></a>01347 <span class="comment"></span>
<a name="l01348"></a>01348 <span class="comment"> SPOTRS solves a system of linear equations A*X = B with a symmetric</span>
<a name="l01349"></a>01349 <span class="comment"> positive definite matrix A using the Cholesky factorization</span>
<a name="l01350"></a>01350 <span class="comment"> A = U**T*U or A = L*L**T computed by SPOTRF.</span>
<a name="l01351"></a>01351 <span class="comment"></span>
<a name="l01352"></a>01352 <span class="comment"> Arguments</span>
<a name="l01353"></a>01353 <span class="comment"> =========</span>
<a name="l01354"></a>01354 <span class="comment"></span>
<a name="l01355"></a>01355 <span class="comment"> UPLO (input) CHARACTER*1</span>
<a name="l01356"></a>01356 <span class="comment"> = 'U': Upper triangle of A is stored;</span>
<a name="l01357"></a>01357 <span class="comment"> = 'L': Lower triangle of A is stored.</span>
<a name="l01358"></a>01358 <span class="comment"></span>
<a name="l01359"></a>01359 <span class="comment"> N (input) INTEGER</span>
<a name="l01360"></a>01360 <span class="comment"> The order of the matrix A. N >= 0.</span>
<a name="l01361"></a>01361 <span class="comment"></span>
<a name="l01362"></a>01362 <span class="comment"> NRHS (input) INTEGER</span>
<a name="l01363"></a>01363 <span class="comment"> The number of right hand sides, i.e., the number of columns</span>
<a name="l01364"></a>01364 <span class="comment"> of the matrix B. NRHS >= 0.</span>
<a name="l01365"></a>01365 <span class="comment"></span>
<a name="l01366"></a>01366 <span class="comment"> A (input) REAL array, dimension (LDA,N)</span>
<a name="l01367"></a>01367 <span class="comment"> The triangular factor U or L from the Cholesky factorization</span>
<a name="l01368"></a>01368 <span class="comment"> A = U**T*U or A = L*L**T, as computed by SPOTRF.</span>
<a name="l01369"></a>01369 <span class="comment"></span>
<a name="l01370"></a>01370 <span class="comment"> LDA (input) INTEGER</span>
<a name="l01371"></a>01371 <span class="comment"> The leading dimension of the array A. LDA >= max(1,N).</span>
<a name="l01372"></a>01372 <span class="comment"></span>
<a name="l01373"></a>01373 <span class="comment"> B (input/output) REAL array, dimension (LDB,NRHS)</span>
<a name="l01374"></a>01374 <span class="comment"> On entry, the right hand side matrix B.</span>
<a name="l01375"></a>01375 <span class="comment"> On exit, the solution matrix X.</span>
<a name="l01376"></a>01376 <span class="comment"></span>
<a name="l01377"></a>01377 <span class="comment"> LDB (input) INTEGER</span>
<a name="l01378"></a>01378 <span class="comment"> The leading dimension of the array B. LDB >= max(1,N).</span>
<a name="l01379"></a>01379 <span class="comment"></span>
<a name="l01380"></a>01380 <span class="comment"> INFO (output) INTEGER</span>
<a name="l01381"></a>01381 <span class="comment"> = 0: successful exit</span>
<a name="l01382"></a>01382 <span class="comment"> < 0: if INFO = -i, the i-th argument had an illegal value</span>
<a name="l01383"></a>01383 <span class="comment"></span>
<a name="l01384"></a>01384 <span class="comment"> =====================================================================</span>
<a name="l01385"></a>01385 <span class="comment"></span>
<a name="l01386"></a>01386 <span class="comment"></span>
<a name="l01387"></a>01387 <span class="comment"> Test the input parameters.</span>
<a name="l01388"></a>01388 <span class="comment">*/</span>
<a name="l01389"></a>01389
<a name="l01390"></a>01390 <span class="comment">/* Parameter adjustments */</span>
<a name="l01391"></a>01391 a_dim1 = *lda;
<a name="l01392"></a>01392 a_offset = 1 + a_dim1;
<a name="l01393"></a>01393 a -= a_offset;
<a name="l01394"></a>01394 b_dim1 = *ldb;
<a name="l01395"></a>01395 b_offset = 1 + b_dim1;
<a name="l01396"></a>01396 b -= b_offset;
<a name="l01397"></a>01397
<a name="l01398"></a>01398 <span class="comment">/* Function Body */</span>
<a name="l01399"></a>01399 *info = 0;
<a name="l01400"></a>01400 upper = lsame_(uplo, <span class="stringliteral">"U"</span>);
<a name="l01401"></a>01401 <span class="keywordflow">if</span> (! upper && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l01402"></a>01402 *info = -1;
<a name="l01403"></a>01403 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l01404"></a>01404 *info = -2;
<a name="l01405"></a>01405 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*nrhs < 0) {
<a name="l01406"></a>01406 *info = -3;
<a name="l01407"></a>01407 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,*n)) {
<a name="l01408"></a>01408 *info = -5;
<a name="l01409"></a>01409 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldb < max(1,*n)) {
<a name="l01410"></a>01410 *info = -7;
<a name="l01411"></a>01411 }
<a name="l01412"></a>01412 <span class="keywordflow">if</span> (*info != 0) {
<a name="l01413"></a>01413 i__1 = -(*info);
<a name="l01414"></a>01414 xerbla_(<span class="stringliteral">"SPOTRS"</span>, &i__1);
<a name="l01415"></a>01415 <span class="keywordflow">return</span> 0;
<a name="l01416"></a>01416 }
<a name="l01417"></a>01417
<a name="l01418"></a>01418 <span class="comment">/* Quick return if possible */</span>
<a name="l01419"></a>01419
<a name="l01420"></a>01420 <span class="keywordflow">if</span> (*n == 0 || *nrhs == 0) {
<a name="l01421"></a>01421 <span class="keywordflow">return</span> 0;
<a name="l01422"></a>01422 }
<a name="l01423"></a>01423
<a name="l01424"></a>01424 <span class="keywordflow">if</span> (upper) {
<a name="l01425"></a>01425
<a name="l01426"></a>01426 <span class="comment">/*</span>
<a name="l01427"></a>01427 <span class="comment"> Solve A*X = B where A = U'*U.</span>
<a name="l01428"></a>01428 <span class="comment"></span>
<a name="l01429"></a>01429 <span class="comment"> Solve U'*X = B, overwriting B with X.</span>
<a name="l01430"></a>01430 <span class="comment">*/</span>
<a name="l01431"></a>01431
<a name="l01432"></a>01432 strsm_(<span class="stringliteral">"Left"</span>, <span class="stringliteral">"Upper"</span>, <span class="stringliteral">"Transpose"</span>, <span class="stringliteral">"Non-unit"</span>, n, nrhs, &c_b164, &a[
<a name="l01433"></a>01433 a_offset], lda, &b[b_offset], ldb);
<a name="l01434"></a>01434
<a name="l01435"></a>01435 <span class="comment">/* Solve U*X = B, overwriting B with X. */</span>
<a name="l01436"></a>01436
<a name="l01437"></a>01437 strsm_(<span class="stringliteral">"Left"</span>, <span class="stringliteral">"Upper"</span>, <span class="stringliteral">"No transpose"</span>, <span class="stringliteral">"Non-unit"</span>, n, nrhs, &c_b164,
<a name="l01438"></a>01438 &a[a_offset], lda, &b[b_offset], ldb);
<a name="l01439"></a>01439 } <span class="keywordflow">else</span> {
<a name="l01440"></a>01440
<a name="l01441"></a>01441 <span class="comment">/*</span>
<a name="l01442"></a>01442 <span class="comment"> Solve A*X = B where A = L*L'.</span>
<a name="l01443"></a>01443 <span class="comment"></span>
<a name="l01444"></a>01444 <span class="comment"> Solve L*X = B, overwriting B with X.</span>
<a name="l01445"></a>01445 <span class="comment">*/</span>
<a name="l01446"></a>01446
<a name="l01447"></a>01447 strsm_(<span class="stringliteral">"Left"</span>, <span class="stringliteral">"Lower"</span>, <span class="stringliteral">"No transpose"</span>, <span class="stringliteral">"Non-unit"</span>, n, nrhs, &c_b164,
<a name="l01448"></a>01448 &a[a_offset], lda, &b[b_offset], ldb);
<a name="l01449"></a>01449
<a name="l01450"></a>01450 <span class="comment">/* Solve L'*X = B, overwriting B with X. */</span>
<a name="l01451"></a>01451
<a name="l01452"></a>01452 strsm_(<span class="stringliteral">"Left"</span>, <span class="stringliteral">"Lower"</span>, <span class="stringliteral">"Transpose"</span>, <span class="stringliteral">"Non-unit"</span>, n, nrhs, &c_b164, &a[
<a name="l01453"></a>01453 a_offset], lda, &b[b_offset], ldb);
<a name="l01454"></a>01454 }
<a name="l01455"></a>01455
<a name="l01456"></a>01456 <span class="keywordflow">return</span> 0;
<a name="l01457"></a>01457
<a name="l01458"></a>01458 <span class="comment">/* End of SPOTRS */</span>
<a name="l01459"></a>01459
<a name="l01460"></a>01460 } <span class="comment">/* spotrs_ */</span>
<a name="l01461"></a>01461
</pre></div></div>
</div>
<div id="nav-path" class="navpath">
<ul>
<li class="navelem"><b>slapack_lite.c</b> </li>
<li class="footer">Generated on Tue Apr 19 2011 for SphinxBase by 
<a href="http://www.doxygen.org/index.html">
<img class="footer" src="doxygen.png" alt="doxygen"/></a> 1.7.3 </li>
</ul>
</div>
</body>
</html>
distrib
>
Fedora
>
14
>
x86_64
>
media
>
updates
>
by-pkgid
>
0b420d0fce195cf4115dc6a3be5c2da2
>
files
>
326
