<!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/blas_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('blas__lite_8c.html','');
</script>
<div id="doc-content">
<div class="header">
<div class="headertitle">
<h1>src/libsphinxbase/util/blas_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__1 = 1;
<a name="l00025"></a>00025
<a name="l00026"></a>00026 logical lsame_(<span class="keywordtype">char</span> *ca, <span class="keywordtype">char</span> *cb)
<a name="l00027"></a>00027 {
<a name="l00028"></a>00028 <span class="comment">/* System generated locals */</span>
<a name="l00029"></a>00029 logical ret_val;
<a name="l00030"></a>00030
<a name="l00031"></a>00031 <span class="comment">/* Local variables */</span>
<a name="l00032"></a>00032 <span class="keyword">static</span> integer inta, intb, zcode;
<a name="l00033"></a>00033
<a name="l00034"></a>00034
<a name="l00035"></a>00035 <span class="comment">/*</span>
<a name="l00036"></a>00036 <span class="comment"> -- LAPACK auxiliary routine (version 3.0) --</span>
<a name="l00037"></a>00037 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l00038"></a>00038 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l00039"></a>00039 <span class="comment"> September 30, 1994</span>
<a name="l00040"></a>00040 <span class="comment"></span>
<a name="l00041"></a>00041 <span class="comment"></span>
<a name="l00042"></a>00042 <span class="comment"> Purpose</span>
<a name="l00043"></a>00043 <span class="comment"> =======</span>
<a name="l00044"></a>00044 <span class="comment"></span>
<a name="l00045"></a>00045 <span class="comment"> LSAME returns .TRUE. if CA is the same letter as CB regardless of</span>
<a name="l00046"></a>00046 <span class="comment"> case.</span>
<a name="l00047"></a>00047 <span class="comment"></span>
<a name="l00048"></a>00048 <span class="comment"> Arguments</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"> CA (input) CHARACTER*1</span>
<a name="l00052"></a>00052 <span class="comment"> CB (input) CHARACTER*1</span>
<a name="l00053"></a>00053 <span class="comment"> CA and CB specify the single characters to be compared.</span>
<a name="l00054"></a>00054 <span class="comment"></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"></span>
<a name="l00058"></a>00058 <span class="comment"> Test if the characters are equal</span>
<a name="l00059"></a>00059 <span class="comment">*/</span>
<a name="l00060"></a>00060
<a name="l00061"></a>00061 ret_val = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)ca == *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)cb;
<a name="l00062"></a>00062 <span class="keywordflow">if</span> (ret_val) {
<a name="l00063"></a>00063 <span class="keywordflow">return</span> ret_val;
<a name="l00064"></a>00064 }
<a name="l00065"></a>00065
<a name="l00066"></a>00066 <span class="comment">/* Now test for equivalence if both characters are alphabetic. */</span>
<a name="l00067"></a>00067
<a name="l00068"></a>00068 zcode = <span class="charliteral">'Z'</span>;
<a name="l00069"></a>00069
<a name="l00070"></a>00070 <span class="comment">/*</span>
<a name="l00071"></a>00071 <span class="comment"> Use 'Z' rather than 'A' so that ASCII can be detected on Prime</span>
<a name="l00072"></a>00072 <span class="comment"> machines, on which ICHAR returns a value with bit 8 set.</span>
<a name="l00073"></a>00073 <span class="comment"> ICHAR('A') on Prime machines returns 193 which is the same as</span>
<a name="l00074"></a>00074 <span class="comment"> ICHAR('A') on an EBCDIC machine.</span>
<a name="l00075"></a>00075 <span class="comment">*/</span>
<a name="l00076"></a>00076
<a name="l00077"></a>00077 inta = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)ca;
<a name="l00078"></a>00078 intb = *(<span class="keywordtype">unsigned</span> <span class="keywordtype">char</span> *)cb;
<a name="l00079"></a>00079
<a name="l00080"></a>00080 <span class="keywordflow">if</span> (zcode == 90 || zcode == 122) {
<a name="l00081"></a>00081
<a name="l00082"></a>00082 <span class="comment">/*</span>
<a name="l00083"></a>00083 <span class="comment"> ASCII is assumed - ZCODE is the ASCII code of either lower or</span>
<a name="l00084"></a>00084 <span class="comment"> upper case 'Z'.</span>
<a name="l00085"></a>00085 <span class="comment">*/</span>
<a name="l00086"></a>00086
<a name="l00087"></a>00087 <span class="keywordflow">if</span> (inta >= 97 && inta <= 122) {
<a name="l00088"></a>00088 inta += -32;
<a name="l00089"></a>00089 }
<a name="l00090"></a>00090 <span class="keywordflow">if</span> (intb >= 97 && intb <= 122) {
<a name="l00091"></a>00091 intb += -32;
<a name="l00092"></a>00092 }
<a name="l00093"></a>00093
<a name="l00094"></a>00094 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (zcode == 233 || zcode == 169) {
<a name="l00095"></a>00095
<a name="l00096"></a>00096 <span class="comment">/*</span>
<a name="l00097"></a>00097 <span class="comment"> EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or</span>
<a name="l00098"></a>00098 <span class="comment"> upper case 'Z'.</span>
<a name="l00099"></a>00099 <span class="comment">*/</span>
<a name="l00100"></a>00100
<a name="l00101"></a>00101 <span class="keywordflow">if</span> (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta
<a name="l00102"></a>00102 >= 162 && inta <= 169) {
<a name="l00103"></a>00103 inta += 64;
<a name="l00104"></a>00104 }
<a name="l00105"></a>00105 <span class="keywordflow">if</span> (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb
<a name="l00106"></a>00106 >= 162 && intb <= 169) {
<a name="l00107"></a>00107 intb += 64;
<a name="l00108"></a>00108 }
<a name="l00109"></a>00109
<a name="l00110"></a>00110 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (zcode == 218 || zcode == 250) {
<a name="l00111"></a>00111
<a name="l00112"></a>00112 <span class="comment">/*</span>
<a name="l00113"></a>00113 <span class="comment"> ASCII is assumed, on Prime machines - ZCODE is the ASCII code</span>
<a name="l00114"></a>00114 <span class="comment"> plus 128 of either lower or upper case 'Z'.</span>
<a name="l00115"></a>00115 <span class="comment">*/</span>
<a name="l00116"></a>00116
<a name="l00117"></a>00117 <span class="keywordflow">if</span> (inta >= 225 && inta <= 250) {
<a name="l00118"></a>00118 inta += -32;
<a name="l00119"></a>00119 }
<a name="l00120"></a>00120 <span class="keywordflow">if</span> (intb >= 225 && intb <= 250) {
<a name="l00121"></a>00121 intb += -32;
<a name="l00122"></a>00122 }
<a name="l00123"></a>00123 }
<a name="l00124"></a>00124 ret_val = inta == intb;
<a name="l00125"></a>00125
<a name="l00126"></a>00126 <span class="comment">/*</span>
<a name="l00127"></a>00127 <span class="comment"> RETURN</span>
<a name="l00128"></a>00128 <span class="comment"></span>
<a name="l00129"></a>00129 <span class="comment"> End of LSAME</span>
<a name="l00130"></a>00130 <span class="comment">*/</span>
<a name="l00131"></a>00131
<a name="l00132"></a>00132 <span class="keywordflow">return</span> ret_val;
<a name="l00133"></a>00133 } <span class="comment">/* lsame_ */</span>
<a name="l00134"></a>00134
<a name="l00135"></a>00135 doublereal sdot_(integer *n, real *sx, integer *incx, real *sy, integer *incy)
<a name="l00136"></a>00136 {
<a name="l00137"></a>00137 <span class="comment">/* System generated locals */</span>
<a name="l00138"></a>00138 integer i__1;
<a name="l00139"></a>00139 real ret_val;
<a name="l00140"></a>00140
<a name="l00141"></a>00141 <span class="comment">/* Local variables */</span>
<a name="l00142"></a>00142 <span class="keyword">static</span> integer i__, m, ix, iy, mp1;
<a name="l00143"></a>00143 <span class="keyword">static</span> real stemp;
<a name="l00144"></a>00144
<a name="l00145"></a>00145
<a name="l00146"></a>00146 <span class="comment">/*</span>
<a name="l00147"></a>00147 <span class="comment"> forms the dot product of two vectors.</span>
<a name="l00148"></a>00148 <span class="comment"> uses unrolled loops for increments equal to one.</span>
<a name="l00149"></a>00149 <span class="comment"> jack dongarra, linpack, 3/11/78.</span>
<a name="l00150"></a>00150 <span class="comment"> modified 12/3/93, array(1) declarations changed to array(*)</span>
<a name="l00151"></a>00151 <span class="comment">*/</span>
<a name="l00152"></a>00152
<a name="l00153"></a>00153
<a name="l00154"></a>00154 <span class="comment">/* Parameter adjustments */</span>
<a name="l00155"></a>00155 --sy;
<a name="l00156"></a>00156 --sx;
<a name="l00157"></a>00157
<a name="l00158"></a>00158 <span class="comment">/* Function Body */</span>
<a name="l00159"></a>00159 stemp = 0.f;
<a name="l00160"></a>00160 ret_val = 0.f;
<a name="l00161"></a>00161 <span class="keywordflow">if</span> (*n <= 0) {
<a name="l00162"></a>00162 <span class="keywordflow">return</span> ret_val;
<a name="l00163"></a>00163 }
<a name="l00164"></a>00164 <span class="keywordflow">if</span> (*incx == 1 && *incy == 1) {
<a name="l00165"></a>00165 <span class="keywordflow">goto</span> L20;
<a name="l00166"></a>00166 }
<a name="l00167"></a>00167
<a name="l00168"></a>00168 <span class="comment">/*</span>
<a name="l00169"></a>00169 <span class="comment"> code for unequal increments or equal increments</span>
<a name="l00170"></a>00170 <span class="comment"> not equal to 1</span>
<a name="l00171"></a>00171 <span class="comment">*/</span>
<a name="l00172"></a>00172
<a name="l00173"></a>00173 ix = 1;
<a name="l00174"></a>00174 iy = 1;
<a name="l00175"></a>00175 <span class="keywordflow">if</span> (*incx < 0) {
<a name="l00176"></a>00176 ix = (-(*n) + 1) * *incx + 1;
<a name="l00177"></a>00177 }
<a name="l00178"></a>00178 <span class="keywordflow">if</span> (*incy < 0) {
<a name="l00179"></a>00179 iy = (-(*n) + 1) * *incy + 1;
<a name="l00180"></a>00180 }
<a name="l00181"></a>00181 i__1 = *n;
<a name="l00182"></a>00182 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l00183"></a>00183 stemp += sx[ix] * sy[iy];
<a name="l00184"></a>00184 ix += *incx;
<a name="l00185"></a>00185 iy += *incy;
<a name="l00186"></a>00186 <span class="comment">/* L10: */</span>
<a name="l00187"></a>00187 }
<a name="l00188"></a>00188 ret_val = stemp;
<a name="l00189"></a>00189 <span class="keywordflow">return</span> ret_val;
<a name="l00190"></a>00190
<a name="l00191"></a>00191 <span class="comment">/*</span>
<a name="l00192"></a>00192 <span class="comment"> code for both increments equal to 1</span>
<a name="l00193"></a>00193 <span class="comment"></span>
<a name="l00194"></a>00194 <span class="comment"></span>
<a name="l00195"></a>00195 <span class="comment"> clean-up loop</span>
<a name="l00196"></a>00196 <span class="comment">*/</span>
<a name="l00197"></a>00197
<a name="l00198"></a>00198 L20:
<a name="l00199"></a>00199 m = *n % 5;
<a name="l00200"></a>00200 <span class="keywordflow">if</span> (m == 0) {
<a name="l00201"></a>00201 <span class="keywordflow">goto</span> L40;
<a name="l00202"></a>00202 }
<a name="l00203"></a>00203 i__1 = m;
<a name="l00204"></a>00204 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l00205"></a>00205 stemp += sx[i__] * sy[i__];
<a name="l00206"></a>00206 <span class="comment">/* L30: */</span>
<a name="l00207"></a>00207 }
<a name="l00208"></a>00208 <span class="keywordflow">if</span> (*n < 5) {
<a name="l00209"></a>00209 <span class="keywordflow">goto</span> L60;
<a name="l00210"></a>00210 }
<a name="l00211"></a>00211 L40:
<a name="l00212"></a>00212 mp1 = m + 1;
<a name="l00213"></a>00213 i__1 = *n;
<a name="l00214"></a>00214 <span class="keywordflow">for</span> (i__ = mp1; i__ <= i__1; i__ += 5) {
<a name="l00215"></a>00215 stemp = stemp + sx[i__] * sy[i__] + sx[i__ + 1] * sy[i__ + 1] + sx[
<a name="l00216"></a>00216 i__ + 2] * sy[i__ + 2] + sx[i__ + 3] * sy[i__ + 3] + sx[i__ +
<a name="l00217"></a>00217 4] * sy[i__ + 4];
<a name="l00218"></a>00218 <span class="comment">/* L50: */</span>
<a name="l00219"></a>00219 }
<a name="l00220"></a>00220 L60:
<a name="l00221"></a>00221 ret_val = stemp;
<a name="l00222"></a>00222 <span class="keywordflow">return</span> ret_val;
<a name="l00223"></a>00223 } <span class="comment">/* sdot_ */</span>
<a name="l00224"></a>00224
<a name="l00225"></a>00225 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> sgemm_(<span class="keywordtype">char</span> *transa, <span class="keywordtype">char</span> *transb, integer *m, integer *
<a name="l00226"></a>00226 n, integer *k, real *alpha, real *a, integer *lda, real *b, integer *
<a name="l00227"></a>00227 ldb, real *beta, real *c__, integer *ldc)
<a name="l00228"></a>00228 {
<a name="l00229"></a>00229 <span class="comment">/* System generated locals */</span>
<a name="l00230"></a>00230 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
<a name="l00231"></a>00231 i__3;
<a name="l00232"></a>00232
<a name="l00233"></a>00233 <span class="comment">/* Local variables */</span>
<a name="l00234"></a>00234 <span class="keyword">static</span> integer i__, j, l, info;
<a name="l00235"></a>00235 <span class="keyword">static</span> logical nota, notb;
<a name="l00236"></a>00236 <span class="keyword">static</span> real temp;
<a name="l00237"></a>00237 <span class="keyword">static</span> integer ncola;
<a name="l00238"></a>00238 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l00239"></a>00239 <span class="keyword">static</span> integer nrowa, nrowb;
<a name="l00240"></a>00240 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l00241"></a>00241
<a name="l00242"></a>00242
<a name="l00243"></a>00243 <span class="comment">/*</span>
<a name="l00244"></a>00244 <span class="comment"> Purpose</span>
<a name="l00245"></a>00245 <span class="comment"> =======</span>
<a name="l00246"></a>00246 <span class="comment"></span>
<a name="l00247"></a>00247 <span class="comment"> SGEMM performs one of the matrix-matrix operations</span>
<a name="l00248"></a>00248 <span class="comment"></span>
<a name="l00249"></a>00249 <span class="comment"> C := alpha*op( A )*op( B ) + beta*C,</span>
<a name="l00250"></a>00250 <span class="comment"></span>
<a name="l00251"></a>00251 <span class="comment"> where op( X ) is one of</span>
<a name="l00252"></a>00252 <span class="comment"></span>
<a name="l00253"></a>00253 <span class="comment"> op( X ) = X or op( X ) = X',</span>
<a name="l00254"></a>00254 <span class="comment"></span>
<a name="l00255"></a>00255 <span class="comment"> alpha and beta are scalars, and A, B and C are matrices, with op( A )</span>
<a name="l00256"></a>00256 <span class="comment"> an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.</span>
<a name="l00257"></a>00257 <span class="comment"></span>
<a name="l00258"></a>00258 <span class="comment"> Parameters</span>
<a name="l00259"></a>00259 <span class="comment"> ==========</span>
<a name="l00260"></a>00260 <span class="comment"></span>
<a name="l00261"></a>00261 <span class="comment"> TRANSA - CHARACTER*1.</span>
<a name="l00262"></a>00262 <span class="comment"> On entry, TRANSA specifies the form of op( A ) to be used in</span>
<a name="l00263"></a>00263 <span class="comment"> the matrix multiplication as follows:</span>
<a name="l00264"></a>00264 <span class="comment"></span>
<a name="l00265"></a>00265 <span class="comment"> TRANSA = 'N' or 'n', op( A ) = A.</span>
<a name="l00266"></a>00266 <span class="comment"></span>
<a name="l00267"></a>00267 <span class="comment"> TRANSA = 'T' or 't', op( A ) = A'.</span>
<a name="l00268"></a>00268 <span class="comment"></span>
<a name="l00269"></a>00269 <span class="comment"> TRANSA = 'C' or 'c', op( A ) = A'.</span>
<a name="l00270"></a>00270 <span class="comment"></span>
<a name="l00271"></a>00271 <span class="comment"> Unchanged on exit.</span>
<a name="l00272"></a>00272 <span class="comment"></span>
<a name="l00273"></a>00273 <span class="comment"> TRANSB - CHARACTER*1.</span>
<a name="l00274"></a>00274 <span class="comment"> On entry, TRANSB specifies the form of op( B ) to be used in</span>
<a name="l00275"></a>00275 <span class="comment"> the matrix multiplication as follows:</span>
<a name="l00276"></a>00276 <span class="comment"></span>
<a name="l00277"></a>00277 <span class="comment"> TRANSB = 'N' or 'n', op( B ) = B.</span>
<a name="l00278"></a>00278 <span class="comment"></span>
<a name="l00279"></a>00279 <span class="comment"> TRANSB = 'T' or 't', op( B ) = B'.</span>
<a name="l00280"></a>00280 <span class="comment"></span>
<a name="l00281"></a>00281 <span class="comment"> TRANSB = 'C' or 'c', op( B ) = B'.</span>
<a name="l00282"></a>00282 <span class="comment"></span>
<a name="l00283"></a>00283 <span class="comment"> Unchanged on exit.</span>
<a name="l00284"></a>00284 <span class="comment"></span>
<a name="l00285"></a>00285 <span class="comment"> M - INTEGER.</span>
<a name="l00286"></a>00286 <span class="comment"> On entry, M specifies the number of rows of the matrix</span>
<a name="l00287"></a>00287 <span class="comment"> op( A ) and of the matrix C. M must be at least zero.</span>
<a name="l00288"></a>00288 <span class="comment"> Unchanged on exit.</span>
<a name="l00289"></a>00289 <span class="comment"></span>
<a name="l00290"></a>00290 <span class="comment"> N - INTEGER.</span>
<a name="l00291"></a>00291 <span class="comment"> On entry, N specifies the number of columns of the matrix</span>
<a name="l00292"></a>00292 <span class="comment"> op( B ) and the number of columns of the matrix C. N must be</span>
<a name="l00293"></a>00293 <span class="comment"> at least zero.</span>
<a name="l00294"></a>00294 <span class="comment"> Unchanged on exit.</span>
<a name="l00295"></a>00295 <span class="comment"></span>
<a name="l00296"></a>00296 <span class="comment"> K - INTEGER.</span>
<a name="l00297"></a>00297 <span class="comment"> On entry, K specifies the number of columns of the matrix</span>
<a name="l00298"></a>00298 <span class="comment"> op( A ) and the number of rows of the matrix op( B ). K must</span>
<a name="l00299"></a>00299 <span class="comment"> be at least zero.</span>
<a name="l00300"></a>00300 <span class="comment"> Unchanged on exit.</span>
<a name="l00301"></a>00301 <span class="comment"></span>
<a name="l00302"></a>00302 <span class="comment"> ALPHA - REAL .</span>
<a name="l00303"></a>00303 <span class="comment"> On entry, ALPHA specifies the scalar alpha.</span>
<a name="l00304"></a>00304 <span class="comment"> Unchanged on exit.</span>
<a name="l00305"></a>00305 <span class="comment"></span>
<a name="l00306"></a>00306 <span class="comment"> A - REAL array of DIMENSION ( LDA, ka ), where ka is</span>
<a name="l00307"></a>00307 <span class="comment"> k when TRANSA = 'N' or 'n', and is m otherwise.</span>
<a name="l00308"></a>00308 <span class="comment"> Before entry with TRANSA = 'N' or 'n', the leading m by k</span>
<a name="l00309"></a>00309 <span class="comment"> part of the array A must contain the matrix A, otherwise</span>
<a name="l00310"></a>00310 <span class="comment"> the leading k by m part of the array A must contain the</span>
<a name="l00311"></a>00311 <span class="comment"> matrix A.</span>
<a name="l00312"></a>00312 <span class="comment"> Unchanged on exit.</span>
<a name="l00313"></a>00313 <span class="comment"></span>
<a name="l00314"></a>00314 <span class="comment"> LDA - INTEGER.</span>
<a name="l00315"></a>00315 <span class="comment"> On entry, LDA specifies the first dimension of A as declared</span>
<a name="l00316"></a>00316 <span class="comment"> in the calling (sub) program. When TRANSA = 'N' or 'n' then</span>
<a name="l00317"></a>00317 <span class="comment"> LDA must be at least max( 1, m ), otherwise LDA must be at</span>
<a name="l00318"></a>00318 <span class="comment"> least max( 1, k ).</span>
<a name="l00319"></a>00319 <span class="comment"> Unchanged on exit.</span>
<a name="l00320"></a>00320 <span class="comment"></span>
<a name="l00321"></a>00321 <span class="comment"> B - REAL array of DIMENSION ( LDB, kb ), where kb is</span>
<a name="l00322"></a>00322 <span class="comment"> n when TRANSB = 'N' or 'n', and is k otherwise.</span>
<a name="l00323"></a>00323 <span class="comment"> Before entry with TRANSB = 'N' or 'n', the leading k by n</span>
<a name="l00324"></a>00324 <span class="comment"> part of the array B must contain the matrix B, otherwise</span>
<a name="l00325"></a>00325 <span class="comment"> the leading n by k part of the array B must contain the</span>
<a name="l00326"></a>00326 <span class="comment"> matrix B.</span>
<a name="l00327"></a>00327 <span class="comment"> Unchanged on exit.</span>
<a name="l00328"></a>00328 <span class="comment"></span>
<a name="l00329"></a>00329 <span class="comment"> LDB - INTEGER.</span>
<a name="l00330"></a>00330 <span class="comment"> On entry, LDB specifies the first dimension of B as declared</span>
<a name="l00331"></a>00331 <span class="comment"> in the calling (sub) program. When TRANSB = 'N' or 'n' then</span>
<a name="l00332"></a>00332 <span class="comment"> LDB must be at least max( 1, k ), otherwise LDB must be at</span>
<a name="l00333"></a>00333 <span class="comment"> least max( 1, n ).</span>
<a name="l00334"></a>00334 <span class="comment"> Unchanged on exit.</span>
<a name="l00335"></a>00335 <span class="comment"></span>
<a name="l00336"></a>00336 <span class="comment"> BETA - REAL .</span>
<a name="l00337"></a>00337 <span class="comment"> On entry, BETA specifies the scalar beta. When BETA is</span>
<a name="l00338"></a>00338 <span class="comment"> supplied as zero then C need not be set on input.</span>
<a name="l00339"></a>00339 <span class="comment"> Unchanged on exit.</span>
<a name="l00340"></a>00340 <span class="comment"></span>
<a name="l00341"></a>00341 <span class="comment"> C - REAL array of DIMENSION ( LDC, n ).</span>
<a name="l00342"></a>00342 <span class="comment"> Before entry, the leading m by n part of the array C must</span>
<a name="l00343"></a>00343 <span class="comment"> contain the matrix C, except when beta is zero, in which</span>
<a name="l00344"></a>00344 <span class="comment"> case C need not be set on entry.</span>
<a name="l00345"></a>00345 <span class="comment"> On exit, the array C is overwritten by the m by n matrix</span>
<a name="l00346"></a>00346 <span class="comment"> ( alpha*op( A )*op( B ) + beta*C ).</span>
<a name="l00347"></a>00347 <span class="comment"></span>
<a name="l00348"></a>00348 <span class="comment"> LDC - INTEGER.</span>
<a name="l00349"></a>00349 <span class="comment"> On entry, LDC specifies the first dimension of C as declared</span>
<a name="l00350"></a>00350 <span class="comment"> in the calling (sub) program. LDC must be at least</span>
<a name="l00351"></a>00351 <span class="comment"> max( 1, m ).</span>
<a name="l00352"></a>00352 <span class="comment"> Unchanged on exit.</span>
<a name="l00353"></a>00353 <span class="comment"></span>
<a name="l00354"></a>00354 <span class="comment"></span>
<a name="l00355"></a>00355 <span class="comment"> Level 3 Blas routine.</span>
<a name="l00356"></a>00356 <span class="comment"></span>
<a name="l00357"></a>00357 <span class="comment"> -- Written on 8-February-1989.</span>
<a name="l00358"></a>00358 <span class="comment"> Jack Dongarra, Argonne National Laboratory.</span>
<a name="l00359"></a>00359 <span class="comment"> Iain Duff, AERE Harwell.</span>
<a name="l00360"></a>00360 <span class="comment"> Jeremy Du Croz, Numerical Algorithms Group Ltd.</span>
<a name="l00361"></a>00361 <span class="comment"> Sven Hammarling, Numerical Algorithms Group Ltd.</span>
<a name="l00362"></a>00362 <span class="comment"></span>
<a name="l00363"></a>00363 <span class="comment"></span>
<a name="l00364"></a>00364 <span class="comment"> Set NOTA and NOTB as true if A and B respectively are not</span>
<a name="l00365"></a>00365 <span class="comment"> transposed and set NROWA, NCOLA and NROWB as the number of rows</span>
<a name="l00366"></a>00366 <span class="comment"> and columns of A and the number of rows of B respectively.</span>
<a name="l00367"></a>00367 <span class="comment">*/</span>
<a name="l00368"></a>00368
<a name="l00369"></a>00369 <span class="comment">/* Parameter adjustments */</span>
<a name="l00370"></a>00370 a_dim1 = *lda;
<a name="l00371"></a>00371 a_offset = 1 + a_dim1;
<a name="l00372"></a>00372 a -= a_offset;
<a name="l00373"></a>00373 b_dim1 = *ldb;
<a name="l00374"></a>00374 b_offset = 1 + b_dim1;
<a name="l00375"></a>00375 b -= b_offset;
<a name="l00376"></a>00376 c_dim1 = *ldc;
<a name="l00377"></a>00377 c_offset = 1 + c_dim1;
<a name="l00378"></a>00378 c__ -= c_offset;
<a name="l00379"></a>00379
<a name="l00380"></a>00380 <span class="comment">/* Function Body */</span>
<a name="l00381"></a>00381 nota = lsame_(transa, <span class="stringliteral">"N"</span>);
<a name="l00382"></a>00382 notb = lsame_(transb, <span class="stringliteral">"N"</span>);
<a name="l00383"></a>00383 <span class="keywordflow">if</span> (nota) {
<a name="l00384"></a>00384 nrowa = *m;
<a name="l00385"></a>00385 ncola = *k;
<a name="l00386"></a>00386 } <span class="keywordflow">else</span> {
<a name="l00387"></a>00387 nrowa = *k;
<a name="l00388"></a>00388 ncola = *m;
<a name="l00389"></a>00389 }
<a name="l00390"></a>00390 <span class="keywordflow">if</span> (notb) {
<a name="l00391"></a>00391 nrowb = *k;
<a name="l00392"></a>00392 } <span class="keywordflow">else</span> {
<a name="l00393"></a>00393 nrowb = *n;
<a name="l00394"></a>00394 }
<a name="l00395"></a>00395
<a name="l00396"></a>00396 <span class="comment">/* Test the input parameters. */</span>
<a name="l00397"></a>00397
<a name="l00398"></a>00398 info = 0;
<a name="l00399"></a>00399 <span class="keywordflow">if</span> (! nota && ! lsame_(transa, <span class="stringliteral">"C"</span>) && ! lsame_(
<a name="l00400"></a>00400 transa, <span class="stringliteral">"T"</span>)) {
<a name="l00401"></a>00401 info = 1;
<a name="l00402"></a>00402 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (! notb && ! lsame_(transb, <span class="stringliteral">"C"</span>) && !
<a name="l00403"></a>00403 lsame_(transb, <span class="stringliteral">"T"</span>)) {
<a name="l00404"></a>00404 info = 2;
<a name="l00405"></a>00405 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*m < 0) {
<a name="l00406"></a>00406 info = 3;
<a name="l00407"></a>00407 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l00408"></a>00408 info = 4;
<a name="l00409"></a>00409 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*k < 0) {
<a name="l00410"></a>00410 info = 5;
<a name="l00411"></a>00411 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,nrowa)) {
<a name="l00412"></a>00412 info = 8;
<a name="l00413"></a>00413 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldb < max(1,nrowb)) {
<a name="l00414"></a>00414 info = 10;
<a name="l00415"></a>00415 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldc < max(1,*m)) {
<a name="l00416"></a>00416 info = 13;
<a name="l00417"></a>00417 }
<a name="l00418"></a>00418 <span class="keywordflow">if</span> (info != 0) {
<a name="l00419"></a>00419 xerbla_(<span class="stringliteral">"SGEMM "</span>, &info);
<a name="l00420"></a>00420 <span class="keywordflow">return</span> 0;
<a name="l00421"></a>00421 }
<a name="l00422"></a>00422
<a name="l00423"></a>00423 <span class="comment">/* Quick return if possible. */</span>
<a name="l00424"></a>00424
<a name="l00425"></a>00425 <span class="keywordflow">if</span> (*m == 0 || *n == 0 || (*alpha == 0.f || *k == 0) && *beta == 1.f) {
<a name="l00426"></a>00426 <span class="keywordflow">return</span> 0;
<a name="l00427"></a>00427 }
<a name="l00428"></a>00428
<a name="l00429"></a>00429 <span class="comment">/* And if alpha.eq.zero. */</span>
<a name="l00430"></a>00430
<a name="l00431"></a>00431 <span class="keywordflow">if</span> (*alpha == 0.f) {
<a name="l00432"></a>00432 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00433"></a>00433 i__1 = *n;
<a name="l00434"></a>00434 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00435"></a>00435 i__2 = *m;
<a name="l00436"></a>00436 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00437"></a>00437 c__[i__ + j * c_dim1] = 0.f;
<a name="l00438"></a>00438 <span class="comment">/* L10: */</span>
<a name="l00439"></a>00439 }
<a name="l00440"></a>00440 <span class="comment">/* L20: */</span>
<a name="l00441"></a>00441 }
<a name="l00442"></a>00442 } <span class="keywordflow">else</span> {
<a name="l00443"></a>00443 i__1 = *n;
<a name="l00444"></a>00444 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00445"></a>00445 i__2 = *m;
<a name="l00446"></a>00446 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00447"></a>00447 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l00448"></a>00448 <span class="comment">/* L30: */</span>
<a name="l00449"></a>00449 }
<a name="l00450"></a>00450 <span class="comment">/* L40: */</span>
<a name="l00451"></a>00451 }
<a name="l00452"></a>00452 }
<a name="l00453"></a>00453 <span class="keywordflow">return</span> 0;
<a name="l00454"></a>00454 }
<a name="l00455"></a>00455
<a name="l00456"></a>00456 <span class="comment">/* Start the operations. */</span>
<a name="l00457"></a>00457
<a name="l00458"></a>00458 <span class="keywordflow">if</span> (notb) {
<a name="l00459"></a>00459 <span class="keywordflow">if</span> (nota) {
<a name="l00460"></a>00460
<a name="l00461"></a>00461 <span class="comment">/* Form C := alpha*A*B + beta*C. */</span>
<a name="l00462"></a>00462
<a name="l00463"></a>00463 i__1 = *n;
<a name="l00464"></a>00464 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00465"></a>00465 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00466"></a>00466 i__2 = *m;
<a name="l00467"></a>00467 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00468"></a>00468 c__[i__ + j * c_dim1] = 0.f;
<a name="l00469"></a>00469 <span class="comment">/* L50: */</span>
<a name="l00470"></a>00470 }
<a name="l00471"></a>00471 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*beta != 1.f) {
<a name="l00472"></a>00472 i__2 = *m;
<a name="l00473"></a>00473 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00474"></a>00474 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l00475"></a>00475 <span class="comment">/* L60: */</span>
<a name="l00476"></a>00476 }
<a name="l00477"></a>00477 }
<a name="l00478"></a>00478 i__2 = *k;
<a name="l00479"></a>00479 <span class="keywordflow">for</span> (l = 1; l <= i__2; ++l) {
<a name="l00480"></a>00480 <span class="keywordflow">if</span> (b[l + j * b_dim1] != 0.f) {
<a name="l00481"></a>00481 temp = *alpha * b[l + j * b_dim1];
<a name="l00482"></a>00482 i__3 = *m;
<a name="l00483"></a>00483 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l00484"></a>00484 c__[i__ + j * c_dim1] += temp * a[i__ + l *
<a name="l00485"></a>00485 a_dim1];
<a name="l00486"></a>00486 <span class="comment">/* L70: */</span>
<a name="l00487"></a>00487 }
<a name="l00488"></a>00488 }
<a name="l00489"></a>00489 <span class="comment">/* L80: */</span>
<a name="l00490"></a>00490 }
<a name="l00491"></a>00491 <span class="comment">/* L90: */</span>
<a name="l00492"></a>00492 }
<a name="l00493"></a>00493 } <span class="keywordflow">else</span> {
<a name="l00494"></a>00494
<a name="l00495"></a>00495 <span class="comment">/* Form C := alpha*A'*B + beta*C */</span>
<a name="l00496"></a>00496
<a name="l00497"></a>00497 i__1 = *n;
<a name="l00498"></a>00498 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00499"></a>00499 i__2 = *m;
<a name="l00500"></a>00500 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00501"></a>00501 temp = 0.f;
<a name="l00502"></a>00502 i__3 = *k;
<a name="l00503"></a>00503 <span class="keywordflow">for</span> (l = 1; l <= i__3; ++l) {
<a name="l00504"></a>00504 temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];
<a name="l00505"></a>00505 <span class="comment">/* L100: */</span>
<a name="l00506"></a>00506 }
<a name="l00507"></a>00507 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00508"></a>00508 c__[i__ + j * c_dim1] = *alpha * temp;
<a name="l00509"></a>00509 } <span class="keywordflow">else</span> {
<a name="l00510"></a>00510 c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
<a name="l00511"></a>00511 i__ + j * c_dim1];
<a name="l00512"></a>00512 }
<a name="l00513"></a>00513 <span class="comment">/* L110: */</span>
<a name="l00514"></a>00514 }
<a name="l00515"></a>00515 <span class="comment">/* L120: */</span>
<a name="l00516"></a>00516 }
<a name="l00517"></a>00517 }
<a name="l00518"></a>00518 } <span class="keywordflow">else</span> {
<a name="l00519"></a>00519 <span class="keywordflow">if</span> (nota) {
<a name="l00520"></a>00520
<a name="l00521"></a>00521 <span class="comment">/* Form C := alpha*A*B' + beta*C */</span>
<a name="l00522"></a>00522
<a name="l00523"></a>00523 i__1 = *n;
<a name="l00524"></a>00524 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00525"></a>00525 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00526"></a>00526 i__2 = *m;
<a name="l00527"></a>00527 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00528"></a>00528 c__[i__ + j * c_dim1] = 0.f;
<a name="l00529"></a>00529 <span class="comment">/* L130: */</span>
<a name="l00530"></a>00530 }
<a name="l00531"></a>00531 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*beta != 1.f) {
<a name="l00532"></a>00532 i__2 = *m;
<a name="l00533"></a>00533 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00534"></a>00534 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l00535"></a>00535 <span class="comment">/* L140: */</span>
<a name="l00536"></a>00536 }
<a name="l00537"></a>00537 }
<a name="l00538"></a>00538 i__2 = *k;
<a name="l00539"></a>00539 <span class="keywordflow">for</span> (l = 1; l <= i__2; ++l) {
<a name="l00540"></a>00540 <span class="keywordflow">if</span> (b[j + l * b_dim1] != 0.f) {
<a name="l00541"></a>00541 temp = *alpha * b[j + l * b_dim1];
<a name="l00542"></a>00542 i__3 = *m;
<a name="l00543"></a>00543 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l00544"></a>00544 c__[i__ + j * c_dim1] += temp * a[i__ + l *
<a name="l00545"></a>00545 a_dim1];
<a name="l00546"></a>00546 <span class="comment">/* L150: */</span>
<a name="l00547"></a>00547 }
<a name="l00548"></a>00548 }
<a name="l00549"></a>00549 <span class="comment">/* L160: */</span>
<a name="l00550"></a>00550 }
<a name="l00551"></a>00551 <span class="comment">/* L170: */</span>
<a name="l00552"></a>00552 }
<a name="l00553"></a>00553 } <span class="keywordflow">else</span> {
<a name="l00554"></a>00554
<a name="l00555"></a>00555 <span class="comment">/* Form C := alpha*A'*B' + beta*C */</span>
<a name="l00556"></a>00556
<a name="l00557"></a>00557 i__1 = *n;
<a name="l00558"></a>00558 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00559"></a>00559 i__2 = *m;
<a name="l00560"></a>00560 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00561"></a>00561 temp = 0.f;
<a name="l00562"></a>00562 i__3 = *k;
<a name="l00563"></a>00563 <span class="keywordflow">for</span> (l = 1; l <= i__3; ++l) {
<a name="l00564"></a>00564 temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];
<a name="l00565"></a>00565 <span class="comment">/* L180: */</span>
<a name="l00566"></a>00566 }
<a name="l00567"></a>00567 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00568"></a>00568 c__[i__ + j * c_dim1] = *alpha * temp;
<a name="l00569"></a>00569 } <span class="keywordflow">else</span> {
<a name="l00570"></a>00570 c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
<a name="l00571"></a>00571 i__ + j * c_dim1];
<a name="l00572"></a>00572 }
<a name="l00573"></a>00573 <span class="comment">/* L190: */</span>
<a name="l00574"></a>00574 }
<a name="l00575"></a>00575 <span class="comment">/* L200: */</span>
<a name="l00576"></a>00576 }
<a name="l00577"></a>00577 }
<a name="l00578"></a>00578 }
<a name="l00579"></a>00579
<a name="l00580"></a>00580 <span class="keywordflow">return</span> 0;
<a name="l00581"></a>00581
<a name="l00582"></a>00582 <span class="comment">/* End of SGEMM . */</span>
<a name="l00583"></a>00583
<a name="l00584"></a>00584 } <span class="comment">/* sgemm_ */</span>
<a name="l00585"></a>00585
<a name="l00586"></a>00586 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> sgemv_(<span class="keywordtype">char</span> *trans, integer *m, integer *n, real *alpha,
<a name="l00587"></a>00587 real *a, integer *lda, real *x, integer *incx, real *beta, real *y,
<a name="l00588"></a>00588 integer *incy)
<a name="l00589"></a>00589 {
<a name="l00590"></a>00590 <span class="comment">/* System generated locals */</span>
<a name="l00591"></a>00591 integer a_dim1, a_offset, i__1, i__2;
<a name="l00592"></a>00592
<a name="l00593"></a>00593 <span class="comment">/* Local variables */</span>
<a name="l00594"></a>00594 <span class="keyword">static</span> integer i__, j, ix, iy, jx, jy, kx, ky, info;
<a name="l00595"></a>00595 <span class="keyword">static</span> real temp;
<a name="l00596"></a>00596 <span class="keyword">static</span> integer lenx, leny;
<a name="l00597"></a>00597 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l00598"></a>00598 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l00599"></a>00599
<a name="l00600"></a>00600
<a name="l00601"></a>00601 <span class="comment">/*</span>
<a name="l00602"></a>00602 <span class="comment"> Purpose</span>
<a name="l00603"></a>00603 <span class="comment"> =======</span>
<a name="l00604"></a>00604 <span class="comment"></span>
<a name="l00605"></a>00605 <span class="comment"> SGEMV performs one of the matrix-vector operations</span>
<a name="l00606"></a>00606 <span class="comment"></span>
<a name="l00607"></a>00607 <span class="comment"> y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,</span>
<a name="l00608"></a>00608 <span class="comment"></span>
<a name="l00609"></a>00609 <span class="comment"> where alpha and beta are scalars, x and y are vectors and A is an</span>
<a name="l00610"></a>00610 <span class="comment"> m by n matrix.</span>
<a name="l00611"></a>00611 <span class="comment"></span>
<a name="l00612"></a>00612 <span class="comment"> Parameters</span>
<a name="l00613"></a>00613 <span class="comment"> ==========</span>
<a name="l00614"></a>00614 <span class="comment"></span>
<a name="l00615"></a>00615 <span class="comment"> TRANS - CHARACTER*1.</span>
<a name="l00616"></a>00616 <span class="comment"> On entry, TRANS specifies the operation to be performed as</span>
<a name="l00617"></a>00617 <span class="comment"> follows:</span>
<a name="l00618"></a>00618 <span class="comment"></span>
<a name="l00619"></a>00619 <span class="comment"> TRANS = 'N' or 'n' y := alpha*A*x + beta*y.</span>
<a name="l00620"></a>00620 <span class="comment"></span>
<a name="l00621"></a>00621 <span class="comment"> TRANS = 'T' or 't' y := alpha*A'*x + beta*y.</span>
<a name="l00622"></a>00622 <span class="comment"></span>
<a name="l00623"></a>00623 <span class="comment"> TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.</span>
<a name="l00624"></a>00624 <span class="comment"></span>
<a name="l00625"></a>00625 <span class="comment"> Unchanged on exit.</span>
<a name="l00626"></a>00626 <span class="comment"></span>
<a name="l00627"></a>00627 <span class="comment"> M - INTEGER.</span>
<a name="l00628"></a>00628 <span class="comment"> On entry, M specifies the number of rows of the matrix A.</span>
<a name="l00629"></a>00629 <span class="comment"> M must be at least zero.</span>
<a name="l00630"></a>00630 <span class="comment"> Unchanged on exit.</span>
<a name="l00631"></a>00631 <span class="comment"></span>
<a name="l00632"></a>00632 <span class="comment"> N - INTEGER.</span>
<a name="l00633"></a>00633 <span class="comment"> On entry, N specifies the number of columns of the matrix A.</span>
<a name="l00634"></a>00634 <span class="comment"> N must be at least zero.</span>
<a name="l00635"></a>00635 <span class="comment"> Unchanged on exit.</span>
<a name="l00636"></a>00636 <span class="comment"></span>
<a name="l00637"></a>00637 <span class="comment"> ALPHA - REAL .</span>
<a name="l00638"></a>00638 <span class="comment"> On entry, ALPHA specifies the scalar alpha.</span>
<a name="l00639"></a>00639 <span class="comment"> Unchanged on exit.</span>
<a name="l00640"></a>00640 <span class="comment"></span>
<a name="l00641"></a>00641 <span class="comment"> A - REAL array of DIMENSION ( LDA, n ).</span>
<a name="l00642"></a>00642 <span class="comment"> Before entry, the leading m by n part of the array A must</span>
<a name="l00643"></a>00643 <span class="comment"> contain the matrix of coefficients.</span>
<a name="l00644"></a>00644 <span class="comment"> Unchanged on exit.</span>
<a name="l00645"></a>00645 <span class="comment"></span>
<a name="l00646"></a>00646 <span class="comment"> LDA - INTEGER.</span>
<a name="l00647"></a>00647 <span class="comment"> On entry, LDA specifies the first dimension of A as declared</span>
<a name="l00648"></a>00648 <span class="comment"> in the calling (sub) program. LDA must be at least</span>
<a name="l00649"></a>00649 <span class="comment"> max( 1, m ).</span>
<a name="l00650"></a>00650 <span class="comment"> Unchanged on exit.</span>
<a name="l00651"></a>00651 <span class="comment"></span>
<a name="l00652"></a>00652 <span class="comment"> X - REAL array of DIMENSION at least</span>
<a name="l00653"></a>00653 <span class="comment"> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'</span>
<a name="l00654"></a>00654 <span class="comment"> and at least</span>
<a name="l00655"></a>00655 <span class="comment"> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.</span>
<a name="l00656"></a>00656 <span class="comment"> Before entry, the incremented array X must contain the</span>
<a name="l00657"></a>00657 <span class="comment"> vector x.</span>
<a name="l00658"></a>00658 <span class="comment"> Unchanged on exit.</span>
<a name="l00659"></a>00659 <span class="comment"></span>
<a name="l00660"></a>00660 <span class="comment"> INCX - INTEGER.</span>
<a name="l00661"></a>00661 <span class="comment"> On entry, INCX specifies the increment for the elements of</span>
<a name="l00662"></a>00662 <span class="comment"> X. INCX must not be zero.</span>
<a name="l00663"></a>00663 <span class="comment"> Unchanged on exit.</span>
<a name="l00664"></a>00664 <span class="comment"></span>
<a name="l00665"></a>00665 <span class="comment"> BETA - REAL .</span>
<a name="l00666"></a>00666 <span class="comment"> On entry, BETA specifies the scalar beta. When BETA is</span>
<a name="l00667"></a>00667 <span class="comment"> supplied as zero then Y need not be set on input.</span>
<a name="l00668"></a>00668 <span class="comment"> Unchanged on exit.</span>
<a name="l00669"></a>00669 <span class="comment"></span>
<a name="l00670"></a>00670 <span class="comment"> Y - REAL array of DIMENSION at least</span>
<a name="l00671"></a>00671 <span class="comment"> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'</span>
<a name="l00672"></a>00672 <span class="comment"> and at least</span>
<a name="l00673"></a>00673 <span class="comment"> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.</span>
<a name="l00674"></a>00674 <span class="comment"> Before entry with BETA non-zero, the incremented array Y</span>
<a name="l00675"></a>00675 <span class="comment"> must contain the vector y. On exit, Y is overwritten by the</span>
<a name="l00676"></a>00676 <span class="comment"> updated vector y.</span>
<a name="l00677"></a>00677 <span class="comment"></span>
<a name="l00678"></a>00678 <span class="comment"> INCY - INTEGER.</span>
<a name="l00679"></a>00679 <span class="comment"> On entry, INCY specifies the increment for the elements of</span>
<a name="l00680"></a>00680 <span class="comment"> Y. INCY must not be zero.</span>
<a name="l00681"></a>00681 <span class="comment"> Unchanged on exit.</span>
<a name="l00682"></a>00682 <span class="comment"></span>
<a name="l00683"></a>00683 <span class="comment"></span>
<a name="l00684"></a>00684 <span class="comment"> Level 2 Blas routine.</span>
<a name="l00685"></a>00685 <span class="comment"></span>
<a name="l00686"></a>00686 <span class="comment"> -- Written on 22-October-1986.</span>
<a name="l00687"></a>00687 <span class="comment"> Jack Dongarra, Argonne National Lab.</span>
<a name="l00688"></a>00688 <span class="comment"> Jeremy Du Croz, Nag Central Office.</span>
<a name="l00689"></a>00689 <span class="comment"> Sven Hammarling, Nag Central Office.</span>
<a name="l00690"></a>00690 <span class="comment"> Richard Hanson, Sandia National Labs.</span>
<a name="l00691"></a>00691 <span class="comment"></span>
<a name="l00692"></a>00692 <span class="comment"></span>
<a name="l00693"></a>00693 <span class="comment"> Test the input parameters.</span>
<a name="l00694"></a>00694 <span class="comment">*/</span>
<a name="l00695"></a>00695
<a name="l00696"></a>00696 <span class="comment">/* Parameter adjustments */</span>
<a name="l00697"></a>00697 a_dim1 = *lda;
<a name="l00698"></a>00698 a_offset = 1 + a_dim1;
<a name="l00699"></a>00699 a -= a_offset;
<a name="l00700"></a>00700 --x;
<a name="l00701"></a>00701 --y;
<a name="l00702"></a>00702
<a name="l00703"></a>00703 <span class="comment">/* Function Body */</span>
<a name="l00704"></a>00704 info = 0;
<a name="l00705"></a>00705 <span class="keywordflow">if</span> (! lsame_(trans, <span class="stringliteral">"N"</span>) && ! lsame_(trans, <span class="stringliteral">"T"</span>) && ! lsame_(trans, <span class="stringliteral">"C"</span>)
<a name="l00706"></a>00706 ) {
<a name="l00707"></a>00707 info = 1;
<a name="l00708"></a>00708 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*m < 0) {
<a name="l00709"></a>00709 info = 2;
<a name="l00710"></a>00710 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l00711"></a>00711 info = 3;
<a name="l00712"></a>00712 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,*m)) {
<a name="l00713"></a>00713 info = 6;
<a name="l00714"></a>00714 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*incx == 0) {
<a name="l00715"></a>00715 info = 8;
<a name="l00716"></a>00716 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*incy == 0) {
<a name="l00717"></a>00717 info = 11;
<a name="l00718"></a>00718 }
<a name="l00719"></a>00719 <span class="keywordflow">if</span> (info != 0) {
<a name="l00720"></a>00720 xerbla_(<span class="stringliteral">"SGEMV "</span>, &info);
<a name="l00721"></a>00721 <span class="keywordflow">return</span> 0;
<a name="l00722"></a>00722 }
<a name="l00723"></a>00723
<a name="l00724"></a>00724 <span class="comment">/* Quick return if possible. */</span>
<a name="l00725"></a>00725
<a name="l00726"></a>00726 <span class="keywordflow">if</span> (*m == 0 || *n == 0 || *alpha == 0.f && *beta == 1.f) {
<a name="l00727"></a>00727 <span class="keywordflow">return</span> 0;
<a name="l00728"></a>00728 }
<a name="l00729"></a>00729
<a name="l00730"></a>00730 <span class="comment">/*</span>
<a name="l00731"></a>00731 <span class="comment"> Set LENX and LENY, the lengths of the vectors x and y, and set</span>
<a name="l00732"></a>00732 <span class="comment"> up the start points in X and Y.</span>
<a name="l00733"></a>00733 <span class="comment">*/</span>
<a name="l00734"></a>00734
<a name="l00735"></a>00735 <span class="keywordflow">if</span> (lsame_(trans, <span class="stringliteral">"N"</span>)) {
<a name="l00736"></a>00736 lenx = *n;
<a name="l00737"></a>00737 leny = *m;
<a name="l00738"></a>00738 } <span class="keywordflow">else</span> {
<a name="l00739"></a>00739 lenx = *m;
<a name="l00740"></a>00740 leny = *n;
<a name="l00741"></a>00741 }
<a name="l00742"></a>00742 <span class="keywordflow">if</span> (*incx > 0) {
<a name="l00743"></a>00743 kx = 1;
<a name="l00744"></a>00744 } <span class="keywordflow">else</span> {
<a name="l00745"></a>00745 kx = 1 - (lenx - 1) * *incx;
<a name="l00746"></a>00746 }
<a name="l00747"></a>00747 <span class="keywordflow">if</span> (*incy > 0) {
<a name="l00748"></a>00748 ky = 1;
<a name="l00749"></a>00749 } <span class="keywordflow">else</span> {
<a name="l00750"></a>00750 ky = 1 - (leny - 1) * *incy;
<a name="l00751"></a>00751 }
<a name="l00752"></a>00752
<a name="l00753"></a>00753 <span class="comment">/*</span>
<a name="l00754"></a>00754 <span class="comment"> Start the operations. In this version the elements of A are</span>
<a name="l00755"></a>00755 <span class="comment"> accessed sequentially with one pass through A.</span>
<a name="l00756"></a>00756 <span class="comment"></span>
<a name="l00757"></a>00757 <span class="comment"> First form y := beta*y.</span>
<a name="l00758"></a>00758 <span class="comment">*/</span>
<a name="l00759"></a>00759
<a name="l00760"></a>00760 <span class="keywordflow">if</span> (*beta != 1.f) {
<a name="l00761"></a>00761 <span class="keywordflow">if</span> (*incy == 1) {
<a name="l00762"></a>00762 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00763"></a>00763 i__1 = leny;
<a name="l00764"></a>00764 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l00765"></a>00765 y[i__] = 0.f;
<a name="l00766"></a>00766 <span class="comment">/* L10: */</span>
<a name="l00767"></a>00767 }
<a name="l00768"></a>00768 } <span class="keywordflow">else</span> {
<a name="l00769"></a>00769 i__1 = leny;
<a name="l00770"></a>00770 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l00771"></a>00771 y[i__] = *beta * y[i__];
<a name="l00772"></a>00772 <span class="comment">/* L20: */</span>
<a name="l00773"></a>00773 }
<a name="l00774"></a>00774 }
<a name="l00775"></a>00775 } <span class="keywordflow">else</span> {
<a name="l00776"></a>00776 iy = ky;
<a name="l00777"></a>00777 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l00778"></a>00778 i__1 = leny;
<a name="l00779"></a>00779 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l00780"></a>00780 y[iy] = 0.f;
<a name="l00781"></a>00781 iy += *incy;
<a name="l00782"></a>00782 <span class="comment">/* L30: */</span>
<a name="l00783"></a>00783 }
<a name="l00784"></a>00784 } <span class="keywordflow">else</span> {
<a name="l00785"></a>00785 i__1 = leny;
<a name="l00786"></a>00786 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l00787"></a>00787 y[iy] = *beta * y[iy];
<a name="l00788"></a>00788 iy += *incy;
<a name="l00789"></a>00789 <span class="comment">/* L40: */</span>
<a name="l00790"></a>00790 }
<a name="l00791"></a>00791 }
<a name="l00792"></a>00792 }
<a name="l00793"></a>00793 }
<a name="l00794"></a>00794 <span class="keywordflow">if</span> (*alpha == 0.f) {
<a name="l00795"></a>00795 <span class="keywordflow">return</span> 0;
<a name="l00796"></a>00796 }
<a name="l00797"></a>00797 <span class="keywordflow">if</span> (lsame_(trans, <span class="stringliteral">"N"</span>)) {
<a name="l00798"></a>00798
<a name="l00799"></a>00799 <span class="comment">/* Form y := alpha*A*x + y. */</span>
<a name="l00800"></a>00800
<a name="l00801"></a>00801 jx = kx;
<a name="l00802"></a>00802 <span class="keywordflow">if</span> (*incy == 1) {
<a name="l00803"></a>00803 i__1 = *n;
<a name="l00804"></a>00804 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00805"></a>00805 <span class="keywordflow">if</span> (x[jx] != 0.f) {
<a name="l00806"></a>00806 temp = *alpha * x[jx];
<a name="l00807"></a>00807 i__2 = *m;
<a name="l00808"></a>00808 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00809"></a>00809 y[i__] += temp * a[i__ + j * a_dim1];
<a name="l00810"></a>00810 <span class="comment">/* L50: */</span>
<a name="l00811"></a>00811 }
<a name="l00812"></a>00812 }
<a name="l00813"></a>00813 jx += *incx;
<a name="l00814"></a>00814 <span class="comment">/* L60: */</span>
<a name="l00815"></a>00815 }
<a name="l00816"></a>00816 } <span class="keywordflow">else</span> {
<a name="l00817"></a>00817 i__1 = *n;
<a name="l00818"></a>00818 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00819"></a>00819 <span class="keywordflow">if</span> (x[jx] != 0.f) {
<a name="l00820"></a>00820 temp = *alpha * x[jx];
<a name="l00821"></a>00821 iy = ky;
<a name="l00822"></a>00822 i__2 = *m;
<a name="l00823"></a>00823 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00824"></a>00824 y[iy] += temp * a[i__ + j * a_dim1];
<a name="l00825"></a>00825 iy += *incy;
<a name="l00826"></a>00826 <span class="comment">/* L70: */</span>
<a name="l00827"></a>00827 }
<a name="l00828"></a>00828 }
<a name="l00829"></a>00829 jx += *incx;
<a name="l00830"></a>00830 <span class="comment">/* L80: */</span>
<a name="l00831"></a>00831 }
<a name="l00832"></a>00832 }
<a name="l00833"></a>00833 } <span class="keywordflow">else</span> {
<a name="l00834"></a>00834
<a name="l00835"></a>00835 <span class="comment">/* Form y := alpha*A'*x + y. */</span>
<a name="l00836"></a>00836
<a name="l00837"></a>00837 jy = ky;
<a name="l00838"></a>00838 <span class="keywordflow">if</span> (*incx == 1) {
<a name="l00839"></a>00839 i__1 = *n;
<a name="l00840"></a>00840 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00841"></a>00841 temp = 0.f;
<a name="l00842"></a>00842 i__2 = *m;
<a name="l00843"></a>00843 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00844"></a>00844 temp += a[i__ + j * a_dim1] * x[i__];
<a name="l00845"></a>00845 <span class="comment">/* L90: */</span>
<a name="l00846"></a>00846 }
<a name="l00847"></a>00847 y[jy] += *alpha * temp;
<a name="l00848"></a>00848 jy += *incy;
<a name="l00849"></a>00849 <span class="comment">/* L100: */</span>
<a name="l00850"></a>00850 }
<a name="l00851"></a>00851 } <span class="keywordflow">else</span> {
<a name="l00852"></a>00852 i__1 = *n;
<a name="l00853"></a>00853 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l00854"></a>00854 temp = 0.f;
<a name="l00855"></a>00855 ix = kx;
<a name="l00856"></a>00856 i__2 = *m;
<a name="l00857"></a>00857 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00858"></a>00858 temp += a[i__ + j * a_dim1] * x[ix];
<a name="l00859"></a>00859 ix += *incx;
<a name="l00860"></a>00860 <span class="comment">/* L110: */</span>
<a name="l00861"></a>00861 }
<a name="l00862"></a>00862 y[jy] += *alpha * temp;
<a name="l00863"></a>00863 jy += *incy;
<a name="l00864"></a>00864 <span class="comment">/* L120: */</span>
<a name="l00865"></a>00865 }
<a name="l00866"></a>00866 }
<a name="l00867"></a>00867 }
<a name="l00868"></a>00868
<a name="l00869"></a>00869 <span class="keywordflow">return</span> 0;
<a name="l00870"></a>00870
<a name="l00871"></a>00871 <span class="comment">/* End of SGEMV . */</span>
<a name="l00872"></a>00872
<a name="l00873"></a>00873 } <span class="comment">/* sgemv_ */</span>
<a name="l00874"></a>00874
<a name="l00875"></a>00875 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> sscal_(integer *n, real *sa, real *sx, integer *incx)
<a name="l00876"></a>00876 {
<a name="l00877"></a>00877 <span class="comment">/* System generated locals */</span>
<a name="l00878"></a>00878 integer i__1, i__2;
<a name="l00879"></a>00879
<a name="l00880"></a>00880 <span class="comment">/* Local variables */</span>
<a name="l00881"></a>00881 <span class="keyword">static</span> integer i__, m, mp1, nincx;
<a name="l00882"></a>00882
<a name="l00883"></a>00883
<a name="l00884"></a>00884 <span class="comment">/*</span>
<a name="l00885"></a>00885 <span class="comment"> scales a vector by a constant.</span>
<a name="l00886"></a>00886 <span class="comment"> uses unrolled loops for increment equal to 1.</span>
<a name="l00887"></a>00887 <span class="comment"> jack dongarra, linpack, 3/11/78.</span>
<a name="l00888"></a>00888 <span class="comment"> modified 3/93 to return if incx .le. 0.</span>
<a name="l00889"></a>00889 <span class="comment"> modified 12/3/93, array(1) declarations changed to array(*)</span>
<a name="l00890"></a>00890 <span class="comment">*/</span>
<a name="l00891"></a>00891
<a name="l00892"></a>00892
<a name="l00893"></a>00893 <span class="comment">/* Parameter adjustments */</span>
<a name="l00894"></a>00894 --sx;
<a name="l00895"></a>00895
<a name="l00896"></a>00896 <span class="comment">/* Function Body */</span>
<a name="l00897"></a>00897 <span class="keywordflow">if</span> (*n <= 0 || *incx <= 0) {
<a name="l00898"></a>00898 <span class="keywordflow">return</span> 0;
<a name="l00899"></a>00899 }
<a name="l00900"></a>00900 <span class="keywordflow">if</span> (*incx == 1) {
<a name="l00901"></a>00901 <span class="keywordflow">goto</span> L20;
<a name="l00902"></a>00902 }
<a name="l00903"></a>00903
<a name="l00904"></a>00904 <span class="comment">/* code for increment not equal to 1 */</span>
<a name="l00905"></a>00905
<a name="l00906"></a>00906 nincx = *n * *incx;
<a name="l00907"></a>00907 i__1 = nincx;
<a name="l00908"></a>00908 i__2 = *incx;
<a name="l00909"></a>00909 <span class="keywordflow">for</span> (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
<a name="l00910"></a>00910 sx[i__] = *sa * sx[i__];
<a name="l00911"></a>00911 <span class="comment">/* L10: */</span>
<a name="l00912"></a>00912 }
<a name="l00913"></a>00913 <span class="keywordflow">return</span> 0;
<a name="l00914"></a>00914
<a name="l00915"></a>00915 <span class="comment">/*</span>
<a name="l00916"></a>00916 <span class="comment"> code for increment equal to 1</span>
<a name="l00917"></a>00917 <span class="comment"></span>
<a name="l00918"></a>00918 <span class="comment"></span>
<a name="l00919"></a>00919 <span class="comment"> clean-up loop</span>
<a name="l00920"></a>00920 <span class="comment">*/</span>
<a name="l00921"></a>00921
<a name="l00922"></a>00922 L20:
<a name="l00923"></a>00923 m = *n % 5;
<a name="l00924"></a>00924 <span class="keywordflow">if</span> (m == 0) {
<a name="l00925"></a>00925 <span class="keywordflow">goto</span> L40;
<a name="l00926"></a>00926 }
<a name="l00927"></a>00927 i__2 = m;
<a name="l00928"></a>00928 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l00929"></a>00929 sx[i__] = *sa * sx[i__];
<a name="l00930"></a>00930 <span class="comment">/* L30: */</span>
<a name="l00931"></a>00931 }
<a name="l00932"></a>00932 <span class="keywordflow">if</span> (*n < 5) {
<a name="l00933"></a>00933 <span class="keywordflow">return</span> 0;
<a name="l00934"></a>00934 }
<a name="l00935"></a>00935 L40:
<a name="l00936"></a>00936 mp1 = m + 1;
<a name="l00937"></a>00937 i__2 = *n;
<a name="l00938"></a>00938 <span class="keywordflow">for</span> (i__ = mp1; i__ <= i__2; i__ += 5) {
<a name="l00939"></a>00939 sx[i__] = *sa * sx[i__];
<a name="l00940"></a>00940 sx[i__ + 1] = *sa * sx[i__ + 1];
<a name="l00941"></a>00941 sx[i__ + 2] = *sa * sx[i__ + 2];
<a name="l00942"></a>00942 sx[i__ + 3] = *sa * sx[i__ + 3];
<a name="l00943"></a>00943 sx[i__ + 4] = *sa * sx[i__ + 4];
<a name="l00944"></a>00944 <span class="comment">/* L50: */</span>
<a name="l00945"></a>00945 }
<a name="l00946"></a>00946 <span class="keywordflow">return</span> 0;
<a name="l00947"></a>00947 } <span class="comment">/* sscal_ */</span>
<a name="l00948"></a>00948
<a name="l00949"></a>00949 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> ssymm_(<span class="keywordtype">char</span> *side, <span class="keywordtype">char</span> *uplo, integer *m, integer *n,
<a name="l00950"></a>00950 real *alpha, real *a, integer *lda, real *b, integer *ldb, real *beta,
<a name="l00951"></a>00951 real *c__, integer *ldc)
<a name="l00952"></a>00952 {
<a name="l00953"></a>00953 <span class="comment">/* System generated locals */</span>
<a name="l00954"></a>00954 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
<a name="l00955"></a>00955 i__3;
<a name="l00956"></a>00956
<a name="l00957"></a>00957 <span class="comment">/* Local variables */</span>
<a name="l00958"></a>00958 <span class="keyword">static</span> integer i__, j, k, info;
<a name="l00959"></a>00959 <span class="keyword">static</span> real temp1, temp2;
<a name="l00960"></a>00960 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l00961"></a>00961 <span class="keyword">static</span> integer nrowa;
<a name="l00962"></a>00962 <span class="keyword">static</span> logical upper;
<a name="l00963"></a>00963 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l00964"></a>00964
<a name="l00965"></a>00965
<a name="l00966"></a>00966 <span class="comment">/*</span>
<a name="l00967"></a>00967 <span class="comment"> Purpose</span>
<a name="l00968"></a>00968 <span class="comment"> =======</span>
<a name="l00969"></a>00969 <span class="comment"></span>
<a name="l00970"></a>00970 <span class="comment"> SSYMM performs one of the matrix-matrix operations</span>
<a name="l00971"></a>00971 <span class="comment"></span>
<a name="l00972"></a>00972 <span class="comment"> C := alpha*A*B + beta*C,</span>
<a name="l00973"></a>00973 <span class="comment"></span>
<a name="l00974"></a>00974 <span class="comment"> or</span>
<a name="l00975"></a>00975 <span class="comment"></span>
<a name="l00976"></a>00976 <span class="comment"> C := alpha*B*A + beta*C,</span>
<a name="l00977"></a>00977 <span class="comment"></span>
<a name="l00978"></a>00978 <span class="comment"> where alpha and beta are scalars, A is a symmetric matrix and B and</span>
<a name="l00979"></a>00979 <span class="comment"> C are m by n matrices.</span>
<a name="l00980"></a>00980 <span class="comment"></span>
<a name="l00981"></a>00981 <span class="comment"> Parameters</span>
<a name="l00982"></a>00982 <span class="comment"> ==========</span>
<a name="l00983"></a>00983 <span class="comment"></span>
<a name="l00984"></a>00984 <span class="comment"> SIDE - CHARACTER*1.</span>
<a name="l00985"></a>00985 <span class="comment"> On entry, SIDE specifies whether the symmetric matrix A</span>
<a name="l00986"></a>00986 <span class="comment"> appears on the left or right in the operation as follows:</span>
<a name="l00987"></a>00987 <span class="comment"></span>
<a name="l00988"></a>00988 <span class="comment"> SIDE = 'L' or 'l' C := alpha*A*B + beta*C,</span>
<a name="l00989"></a>00989 <span class="comment"></span>
<a name="l00990"></a>00990 <span class="comment"> SIDE = 'R' or 'r' C := alpha*B*A + beta*C,</span>
<a name="l00991"></a>00991 <span class="comment"></span>
<a name="l00992"></a>00992 <span class="comment"> Unchanged on exit.</span>
<a name="l00993"></a>00993 <span class="comment"></span>
<a name="l00994"></a>00994 <span class="comment"> UPLO - CHARACTER*1.</span>
<a name="l00995"></a>00995 <span class="comment"> On entry, UPLO specifies whether the upper or lower</span>
<a name="l00996"></a>00996 <span class="comment"> triangular part of the symmetric matrix A is to be</span>
<a name="l00997"></a>00997 <span class="comment"> referenced as follows:</span>
<a name="l00998"></a>00998 <span class="comment"></span>
<a name="l00999"></a>00999 <span class="comment"> UPLO = 'U' or 'u' Only the upper triangular part of the</span>
<a name="l01000"></a>01000 <span class="comment"> symmetric matrix is to be referenced.</span>
<a name="l01001"></a>01001 <span class="comment"></span>
<a name="l01002"></a>01002 <span class="comment"> UPLO = 'L' or 'l' Only the lower triangular part of the</span>
<a name="l01003"></a>01003 <span class="comment"> symmetric matrix is to be referenced.</span>
<a name="l01004"></a>01004 <span class="comment"></span>
<a name="l01005"></a>01005 <span class="comment"> Unchanged on exit.</span>
<a name="l01006"></a>01006 <span class="comment"></span>
<a name="l01007"></a>01007 <span class="comment"> M - INTEGER.</span>
<a name="l01008"></a>01008 <span class="comment"> On entry, M specifies the number of rows of the matrix C.</span>
<a name="l01009"></a>01009 <span class="comment"> M must be at least zero.</span>
<a name="l01010"></a>01010 <span class="comment"> Unchanged on exit.</span>
<a name="l01011"></a>01011 <span class="comment"></span>
<a name="l01012"></a>01012 <span class="comment"> N - INTEGER.</span>
<a name="l01013"></a>01013 <span class="comment"> On entry, N specifies the number of columns of the matrix C.</span>
<a name="l01014"></a>01014 <span class="comment"> N must be at least zero.</span>
<a name="l01015"></a>01015 <span class="comment"> Unchanged on exit.</span>
<a name="l01016"></a>01016 <span class="comment"></span>
<a name="l01017"></a>01017 <span class="comment"> ALPHA - REAL .</span>
<a name="l01018"></a>01018 <span class="comment"> On entry, ALPHA specifies the scalar alpha.</span>
<a name="l01019"></a>01019 <span class="comment"> Unchanged on exit.</span>
<a name="l01020"></a>01020 <span class="comment"></span>
<a name="l01021"></a>01021 <span class="comment"> A - REAL array of DIMENSION ( LDA, ka ), where ka is</span>
<a name="l01022"></a>01022 <span class="comment"> m when SIDE = 'L' or 'l' and is n otherwise.</span>
<a name="l01023"></a>01023 <span class="comment"> Before entry with SIDE = 'L' or 'l', the m by m part of</span>
<a name="l01024"></a>01024 <span class="comment"> the array A must contain the symmetric matrix, such that</span>
<a name="l01025"></a>01025 <span class="comment"> when UPLO = 'U' or 'u', the leading m by m upper triangular</span>
<a name="l01026"></a>01026 <span class="comment"> part of the array A must contain the upper triangular part</span>
<a name="l01027"></a>01027 <span class="comment"> of the symmetric matrix and the strictly lower triangular</span>
<a name="l01028"></a>01028 <span class="comment"> part of A is not referenced, and when UPLO = 'L' or 'l',</span>
<a name="l01029"></a>01029 <span class="comment"> the leading m by m lower triangular part of the array A</span>
<a name="l01030"></a>01030 <span class="comment"> must contain the lower triangular part of the symmetric</span>
<a name="l01031"></a>01031 <span class="comment"> matrix and the strictly upper triangular part of A is not</span>
<a name="l01032"></a>01032 <span class="comment"> referenced.</span>
<a name="l01033"></a>01033 <span class="comment"> Before entry with SIDE = 'R' or 'r', the n by n part of</span>
<a name="l01034"></a>01034 <span class="comment"> the array A must contain the symmetric matrix, such that</span>
<a name="l01035"></a>01035 <span class="comment"> when UPLO = 'U' or 'u', the leading n by n upper triangular</span>
<a name="l01036"></a>01036 <span class="comment"> part of the array A must contain the upper triangular part</span>
<a name="l01037"></a>01037 <span class="comment"> of the symmetric matrix and the strictly lower triangular</span>
<a name="l01038"></a>01038 <span class="comment"> part of A is not referenced, and when UPLO = 'L' or 'l',</span>
<a name="l01039"></a>01039 <span class="comment"> the leading n by n lower triangular part of the array A</span>
<a name="l01040"></a>01040 <span class="comment"> must contain the lower triangular part of the symmetric</span>
<a name="l01041"></a>01041 <span class="comment"> matrix and the strictly upper triangular part of A is not</span>
<a name="l01042"></a>01042 <span class="comment"> referenced.</span>
<a name="l01043"></a>01043 <span class="comment"> Unchanged on exit.</span>
<a name="l01044"></a>01044 <span class="comment"></span>
<a name="l01045"></a>01045 <span class="comment"> LDA - INTEGER.</span>
<a name="l01046"></a>01046 <span class="comment"> On entry, LDA specifies the first dimension of A as declared</span>
<a name="l01047"></a>01047 <span class="comment"> in the calling (sub) program. When SIDE = 'L' or 'l' then</span>
<a name="l01048"></a>01048 <span class="comment"> LDA must be at least max( 1, m ), otherwise LDA must be at</span>
<a name="l01049"></a>01049 <span class="comment"> least max( 1, n ).</span>
<a name="l01050"></a>01050 <span class="comment"> Unchanged on exit.</span>
<a name="l01051"></a>01051 <span class="comment"></span>
<a name="l01052"></a>01052 <span class="comment"> B - REAL array of DIMENSION ( LDB, n ).</span>
<a name="l01053"></a>01053 <span class="comment"> Before entry, the leading m by n part of the array B must</span>
<a name="l01054"></a>01054 <span class="comment"> contain the matrix B.</span>
<a name="l01055"></a>01055 <span class="comment"> Unchanged on exit.</span>
<a name="l01056"></a>01056 <span class="comment"></span>
<a name="l01057"></a>01057 <span class="comment"> LDB - INTEGER.</span>
<a name="l01058"></a>01058 <span class="comment"> On entry, LDB specifies the first dimension of B as declared</span>
<a name="l01059"></a>01059 <span class="comment"> in the calling (sub) program. LDB must be at least</span>
<a name="l01060"></a>01060 <span class="comment"> max( 1, m ).</span>
<a name="l01061"></a>01061 <span class="comment"> Unchanged on exit.</span>
<a name="l01062"></a>01062 <span class="comment"></span>
<a name="l01063"></a>01063 <span class="comment"> BETA - REAL .</span>
<a name="l01064"></a>01064 <span class="comment"> On entry, BETA specifies the scalar beta. When BETA is</span>
<a name="l01065"></a>01065 <span class="comment"> supplied as zero then C need not be set on input.</span>
<a name="l01066"></a>01066 <span class="comment"> Unchanged on exit.</span>
<a name="l01067"></a>01067 <span class="comment"></span>
<a name="l01068"></a>01068 <span class="comment"> C - REAL array of DIMENSION ( LDC, n ).</span>
<a name="l01069"></a>01069 <span class="comment"> Before entry, the leading m by n part of the array C must</span>
<a name="l01070"></a>01070 <span class="comment"> contain the matrix C, except when beta is zero, in which</span>
<a name="l01071"></a>01071 <span class="comment"> case C need not be set on entry.</span>
<a name="l01072"></a>01072 <span class="comment"> On exit, the array C is overwritten by the m by n updated</span>
<a name="l01073"></a>01073 <span class="comment"> matrix.</span>
<a name="l01074"></a>01074 <span class="comment"></span>
<a name="l01075"></a>01075 <span class="comment"> LDC - INTEGER.</span>
<a name="l01076"></a>01076 <span class="comment"> On entry, LDC specifies the first dimension of C as declared</span>
<a name="l01077"></a>01077 <span class="comment"> in the calling (sub) program. LDC must be at least</span>
<a name="l01078"></a>01078 <span class="comment"> max( 1, m ).</span>
<a name="l01079"></a>01079 <span class="comment"> Unchanged on exit.</span>
<a name="l01080"></a>01080 <span class="comment"></span>
<a name="l01081"></a>01081 <span class="comment"></span>
<a name="l01082"></a>01082 <span class="comment"> Level 3 Blas routine.</span>
<a name="l01083"></a>01083 <span class="comment"></span>
<a name="l01084"></a>01084 <span class="comment"> -- Written on 8-February-1989.</span>
<a name="l01085"></a>01085 <span class="comment"> Jack Dongarra, Argonne National Laboratory.</span>
<a name="l01086"></a>01086 <span class="comment"> Iain Duff, AERE Harwell.</span>
<a name="l01087"></a>01087 <span class="comment"> Jeremy Du Croz, Numerical Algorithms Group Ltd.</span>
<a name="l01088"></a>01088 <span class="comment"> Sven Hammarling, Numerical Algorithms Group Ltd.</span>
<a name="l01089"></a>01089 <span class="comment"></span>
<a name="l01090"></a>01090 <span class="comment"></span>
<a name="l01091"></a>01091 <span class="comment"> Set NROWA as the number of rows of A.</span>
<a name="l01092"></a>01092 <span class="comment">*/</span>
<a name="l01093"></a>01093
<a name="l01094"></a>01094 <span class="comment">/* Parameter adjustments */</span>
<a name="l01095"></a>01095 a_dim1 = *lda;
<a name="l01096"></a>01096 a_offset = 1 + a_dim1;
<a name="l01097"></a>01097 a -= a_offset;
<a name="l01098"></a>01098 b_dim1 = *ldb;
<a name="l01099"></a>01099 b_offset = 1 + b_dim1;
<a name="l01100"></a>01100 b -= b_offset;
<a name="l01101"></a>01101 c_dim1 = *ldc;
<a name="l01102"></a>01102 c_offset = 1 + c_dim1;
<a name="l01103"></a>01103 c__ -= c_offset;
<a name="l01104"></a>01104
<a name="l01105"></a>01105 <span class="comment">/* Function Body */</span>
<a name="l01106"></a>01106 <span class="keywordflow">if</span> (lsame_(side, <span class="stringliteral">"L"</span>)) {
<a name="l01107"></a>01107 nrowa = *m;
<a name="l01108"></a>01108 } <span class="keywordflow">else</span> {
<a name="l01109"></a>01109 nrowa = *n;
<a name="l01110"></a>01110 }
<a name="l01111"></a>01111 upper = lsame_(uplo, <span class="stringliteral">"U"</span>);
<a name="l01112"></a>01112
<a name="l01113"></a>01113 <span class="comment">/* Test the input parameters. */</span>
<a name="l01114"></a>01114
<a name="l01115"></a>01115 info = 0;
<a name="l01116"></a>01116 <span class="keywordflow">if</span> (! lsame_(side, <span class="stringliteral">"L"</span>) && ! lsame_(side, <span class="stringliteral">"R"</span>)) {
<a name="l01117"></a>01117 info = 1;
<a name="l01118"></a>01118 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (! upper && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l01119"></a>01119 info = 2;
<a name="l01120"></a>01120 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*m < 0) {
<a name="l01121"></a>01121 info = 3;
<a name="l01122"></a>01122 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l01123"></a>01123 info = 4;
<a name="l01124"></a>01124 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,nrowa)) {
<a name="l01125"></a>01125 info = 7;
<a name="l01126"></a>01126 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldb < max(1,*m)) {
<a name="l01127"></a>01127 info = 9;
<a name="l01128"></a>01128 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldc < max(1,*m)) {
<a name="l01129"></a>01129 info = 12;
<a name="l01130"></a>01130 }
<a name="l01131"></a>01131 <span class="keywordflow">if</span> (info != 0) {
<a name="l01132"></a>01132 xerbla_(<span class="stringliteral">"SSYMM "</span>, &info);
<a name="l01133"></a>01133 <span class="keywordflow">return</span> 0;
<a name="l01134"></a>01134 }
<a name="l01135"></a>01135
<a name="l01136"></a>01136 <span class="comment">/* Quick return if possible. */</span>
<a name="l01137"></a>01137
<a name="l01138"></a>01138 <span class="keywordflow">if</span> (*m == 0 || *n == 0 || *alpha == 0.f && *beta == 1.f) {
<a name="l01139"></a>01139 <span class="keywordflow">return</span> 0;
<a name="l01140"></a>01140 }
<a name="l01141"></a>01141
<a name="l01142"></a>01142 <span class="comment">/* And when alpha.eq.zero. */</span>
<a name="l01143"></a>01143
<a name="l01144"></a>01144 <span class="keywordflow">if</span> (*alpha == 0.f) {
<a name="l01145"></a>01145 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01146"></a>01146 i__1 = *n;
<a name="l01147"></a>01147 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01148"></a>01148 i__2 = *m;
<a name="l01149"></a>01149 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01150"></a>01150 c__[i__ + j * c_dim1] = 0.f;
<a name="l01151"></a>01151 <span class="comment">/* L10: */</span>
<a name="l01152"></a>01152 }
<a name="l01153"></a>01153 <span class="comment">/* L20: */</span>
<a name="l01154"></a>01154 }
<a name="l01155"></a>01155 } <span class="keywordflow">else</span> {
<a name="l01156"></a>01156 i__1 = *n;
<a name="l01157"></a>01157 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01158"></a>01158 i__2 = *m;
<a name="l01159"></a>01159 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01160"></a>01160 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l01161"></a>01161 <span class="comment">/* L30: */</span>
<a name="l01162"></a>01162 }
<a name="l01163"></a>01163 <span class="comment">/* L40: */</span>
<a name="l01164"></a>01164 }
<a name="l01165"></a>01165 }
<a name="l01166"></a>01166 <span class="keywordflow">return</span> 0;
<a name="l01167"></a>01167 }
<a name="l01168"></a>01168
<a name="l01169"></a>01169 <span class="comment">/* Start the operations. */</span>
<a name="l01170"></a>01170
<a name="l01171"></a>01171 <span class="keywordflow">if</span> (lsame_(side, <span class="stringliteral">"L"</span>)) {
<a name="l01172"></a>01172
<a name="l01173"></a>01173 <span class="comment">/* Form C := alpha*A*B + beta*C. */</span>
<a name="l01174"></a>01174
<a name="l01175"></a>01175 <span class="keywordflow">if</span> (upper) {
<a name="l01176"></a>01176 i__1 = *n;
<a name="l01177"></a>01177 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01178"></a>01178 i__2 = *m;
<a name="l01179"></a>01179 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01180"></a>01180 temp1 = *alpha * b[i__ + j * b_dim1];
<a name="l01181"></a>01181 temp2 = 0.f;
<a name="l01182"></a>01182 i__3 = i__ - 1;
<a name="l01183"></a>01183 <span class="keywordflow">for</span> (k = 1; k <= i__3; ++k) {
<a name="l01184"></a>01184 c__[k + j * c_dim1] += temp1 * a[k + i__ * a_dim1];
<a name="l01185"></a>01185 temp2 += b[k + j * b_dim1] * a[k + i__ * a_dim1];
<a name="l01186"></a>01186 <span class="comment">/* L50: */</span>
<a name="l01187"></a>01187 }
<a name="l01188"></a>01188 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01189"></a>01189 c__[i__ + j * c_dim1] = temp1 * a[i__ + i__ * a_dim1]
<a name="l01190"></a>01190 + *alpha * temp2;
<a name="l01191"></a>01191 } <span class="keywordflow">else</span> {
<a name="l01192"></a>01192 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]
<a name="l01193"></a>01193 + temp1 * a[i__ + i__ * a_dim1] + *alpha *
<a name="l01194"></a>01194 temp2;
<a name="l01195"></a>01195 }
<a name="l01196"></a>01196 <span class="comment">/* L60: */</span>
<a name="l01197"></a>01197 }
<a name="l01198"></a>01198 <span class="comment">/* L70: */</span>
<a name="l01199"></a>01199 }
<a name="l01200"></a>01200 } <span class="keywordflow">else</span> {
<a name="l01201"></a>01201 i__1 = *n;
<a name="l01202"></a>01202 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01203"></a>01203 <span class="keywordflow">for</span> (i__ = *m; i__ >= 1; --i__) {
<a name="l01204"></a>01204 temp1 = *alpha * b[i__ + j * b_dim1];
<a name="l01205"></a>01205 temp2 = 0.f;
<a name="l01206"></a>01206 i__2 = *m;
<a name="l01207"></a>01207 <span class="keywordflow">for</span> (k = i__ + 1; k <= i__2; ++k) {
<a name="l01208"></a>01208 c__[k + j * c_dim1] += temp1 * a[k + i__ * a_dim1];
<a name="l01209"></a>01209 temp2 += b[k + j * b_dim1] * a[k + i__ * a_dim1];
<a name="l01210"></a>01210 <span class="comment">/* L80: */</span>
<a name="l01211"></a>01211 }
<a name="l01212"></a>01212 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01213"></a>01213 c__[i__ + j * c_dim1] = temp1 * a[i__ + i__ * a_dim1]
<a name="l01214"></a>01214 + *alpha * temp2;
<a name="l01215"></a>01215 } <span class="keywordflow">else</span> {
<a name="l01216"></a>01216 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]
<a name="l01217"></a>01217 + temp1 * a[i__ + i__ * a_dim1] + *alpha *
<a name="l01218"></a>01218 temp2;
<a name="l01219"></a>01219 }
<a name="l01220"></a>01220 <span class="comment">/* L90: */</span>
<a name="l01221"></a>01221 }
<a name="l01222"></a>01222 <span class="comment">/* L100: */</span>
<a name="l01223"></a>01223 }
<a name="l01224"></a>01224 }
<a name="l01225"></a>01225 } <span class="keywordflow">else</span> {
<a name="l01226"></a>01226
<a name="l01227"></a>01227 <span class="comment">/* Form C := alpha*B*A + beta*C. */</span>
<a name="l01228"></a>01228
<a name="l01229"></a>01229 i__1 = *n;
<a name="l01230"></a>01230 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01231"></a>01231 temp1 = *alpha * a[j + j * a_dim1];
<a name="l01232"></a>01232 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01233"></a>01233 i__2 = *m;
<a name="l01234"></a>01234 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01235"></a>01235 c__[i__ + j * c_dim1] = temp1 * b[i__ + j * b_dim1];
<a name="l01236"></a>01236 <span class="comment">/* L110: */</span>
<a name="l01237"></a>01237 }
<a name="l01238"></a>01238 } <span class="keywordflow">else</span> {
<a name="l01239"></a>01239 i__2 = *m;
<a name="l01240"></a>01240 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01241"></a>01241 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1] +
<a name="l01242"></a>01242 temp1 * b[i__ + j * b_dim1];
<a name="l01243"></a>01243 <span class="comment">/* L120: */</span>
<a name="l01244"></a>01244 }
<a name="l01245"></a>01245 }
<a name="l01246"></a>01246 i__2 = j - 1;
<a name="l01247"></a>01247 <span class="keywordflow">for</span> (k = 1; k <= i__2; ++k) {
<a name="l01248"></a>01248 <span class="keywordflow">if</span> (upper) {
<a name="l01249"></a>01249 temp1 = *alpha * a[k + j * a_dim1];
<a name="l01250"></a>01250 } <span class="keywordflow">else</span> {
<a name="l01251"></a>01251 temp1 = *alpha * a[j + k * a_dim1];
<a name="l01252"></a>01252 }
<a name="l01253"></a>01253 i__3 = *m;
<a name="l01254"></a>01254 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l01255"></a>01255 c__[i__ + j * c_dim1] += temp1 * b[i__ + k * b_dim1];
<a name="l01256"></a>01256 <span class="comment">/* L130: */</span>
<a name="l01257"></a>01257 }
<a name="l01258"></a>01258 <span class="comment">/* L140: */</span>
<a name="l01259"></a>01259 }
<a name="l01260"></a>01260 i__2 = *n;
<a name="l01261"></a>01261 <span class="keywordflow">for</span> (k = j + 1; k <= i__2; ++k) {
<a name="l01262"></a>01262 <span class="keywordflow">if</span> (upper) {
<a name="l01263"></a>01263 temp1 = *alpha * a[j + k * a_dim1];
<a name="l01264"></a>01264 } <span class="keywordflow">else</span> {
<a name="l01265"></a>01265 temp1 = *alpha * a[k + j * a_dim1];
<a name="l01266"></a>01266 }
<a name="l01267"></a>01267 i__3 = *m;
<a name="l01268"></a>01268 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l01269"></a>01269 c__[i__ + j * c_dim1] += temp1 * b[i__ + k * b_dim1];
<a name="l01270"></a>01270 <span class="comment">/* L150: */</span>
<a name="l01271"></a>01271 }
<a name="l01272"></a>01272 <span class="comment">/* L160: */</span>
<a name="l01273"></a>01273 }
<a name="l01274"></a>01274 <span class="comment">/* L170: */</span>
<a name="l01275"></a>01275 }
<a name="l01276"></a>01276 }
<a name="l01277"></a>01277
<a name="l01278"></a>01278 <span class="keywordflow">return</span> 0;
<a name="l01279"></a>01279
<a name="l01280"></a>01280 <span class="comment">/* End of SSYMM . */</span>
<a name="l01281"></a>01281
<a name="l01282"></a>01282 } <span class="comment">/* ssymm_ */</span>
<a name="l01283"></a>01283
<a name="l01284"></a>01284 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> ssyrk_(<span class="keywordtype">char</span> *uplo, <span class="keywordtype">char</span> *trans, integer *n, integer *k,
<a name="l01285"></a>01285 real *alpha, real *a, integer *lda, real *beta, real *c__, integer *
<a name="l01286"></a>01286 ldc)
<a name="l01287"></a>01287 {
<a name="l01288"></a>01288 <span class="comment">/* System generated locals */</span>
<a name="l01289"></a>01289 integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
<a name="l01290"></a>01290
<a name="l01291"></a>01291 <span class="comment">/* Local variables */</span>
<a name="l01292"></a>01292 <span class="keyword">static</span> integer i__, j, l, info;
<a name="l01293"></a>01293 <span class="keyword">static</span> real temp;
<a name="l01294"></a>01294 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l01295"></a>01295 <span class="keyword">static</span> integer nrowa;
<a name="l01296"></a>01296 <span class="keyword">static</span> logical upper;
<a name="l01297"></a>01297 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l01298"></a>01298
<a name="l01299"></a>01299
<a name="l01300"></a>01300 <span class="comment">/*</span>
<a name="l01301"></a>01301 <span class="comment"> Purpose</span>
<a name="l01302"></a>01302 <span class="comment"> =======</span>
<a name="l01303"></a>01303 <span class="comment"></span>
<a name="l01304"></a>01304 <span class="comment"> SSYRK performs one of the symmetric rank k operations</span>
<a name="l01305"></a>01305 <span class="comment"></span>
<a name="l01306"></a>01306 <span class="comment"> C := alpha*A*A' + beta*C,</span>
<a name="l01307"></a>01307 <span class="comment"></span>
<a name="l01308"></a>01308 <span class="comment"> or</span>
<a name="l01309"></a>01309 <span class="comment"></span>
<a name="l01310"></a>01310 <span class="comment"> C := alpha*A'*A + beta*C,</span>
<a name="l01311"></a>01311 <span class="comment"></span>
<a name="l01312"></a>01312 <span class="comment"> where alpha and beta are scalars, C is an n by n symmetric matrix</span>
<a name="l01313"></a>01313 <span class="comment"> and A is an n by k matrix in the first case and a k by n matrix</span>
<a name="l01314"></a>01314 <span class="comment"> in the second case.</span>
<a name="l01315"></a>01315 <span class="comment"></span>
<a name="l01316"></a>01316 <span class="comment"> Parameters</span>
<a name="l01317"></a>01317 <span class="comment"> ==========</span>
<a name="l01318"></a>01318 <span class="comment"></span>
<a name="l01319"></a>01319 <span class="comment"> UPLO - CHARACTER*1.</span>
<a name="l01320"></a>01320 <span class="comment"> On entry, UPLO specifies whether the upper or lower</span>
<a name="l01321"></a>01321 <span class="comment"> triangular part of the array C is to be referenced as</span>
<a name="l01322"></a>01322 <span class="comment"> follows:</span>
<a name="l01323"></a>01323 <span class="comment"></span>
<a name="l01324"></a>01324 <span class="comment"> UPLO = 'U' or 'u' Only the upper triangular part of C</span>
<a name="l01325"></a>01325 <span class="comment"> is to be referenced.</span>
<a name="l01326"></a>01326 <span class="comment"></span>
<a name="l01327"></a>01327 <span class="comment"> UPLO = 'L' or 'l' Only the lower triangular part of C</span>
<a name="l01328"></a>01328 <span class="comment"> is to be referenced.</span>
<a name="l01329"></a>01329 <span class="comment"></span>
<a name="l01330"></a>01330 <span class="comment"> Unchanged on exit.</span>
<a name="l01331"></a>01331 <span class="comment"></span>
<a name="l01332"></a>01332 <span class="comment"> TRANS - CHARACTER*1.</span>
<a name="l01333"></a>01333 <span class="comment"> On entry, TRANS specifies the operation to be performed as</span>
<a name="l01334"></a>01334 <span class="comment"> follows:</span>
<a name="l01335"></a>01335 <span class="comment"></span>
<a name="l01336"></a>01336 <span class="comment"> TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.</span>
<a name="l01337"></a>01337 <span class="comment"></span>
<a name="l01338"></a>01338 <span class="comment"> TRANS = 'T' or 't' C := alpha*A'*A + beta*C.</span>
<a name="l01339"></a>01339 <span class="comment"></span>
<a name="l01340"></a>01340 <span class="comment"> TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.</span>
<a name="l01341"></a>01341 <span class="comment"></span>
<a name="l01342"></a>01342 <span class="comment"> Unchanged on exit.</span>
<a name="l01343"></a>01343 <span class="comment"></span>
<a name="l01344"></a>01344 <span class="comment"> N - INTEGER.</span>
<a name="l01345"></a>01345 <span class="comment"> On entry, N specifies the order of the matrix C. N must be</span>
<a name="l01346"></a>01346 <span class="comment"> at least zero.</span>
<a name="l01347"></a>01347 <span class="comment"> Unchanged on exit.</span>
<a name="l01348"></a>01348 <span class="comment"></span>
<a name="l01349"></a>01349 <span class="comment"> K - INTEGER.</span>
<a name="l01350"></a>01350 <span class="comment"> On entry with TRANS = 'N' or 'n', K specifies the number</span>
<a name="l01351"></a>01351 <span class="comment"> of columns of the matrix A, and on entry with</span>
<a name="l01352"></a>01352 <span class="comment"> TRANS = 'T' or 't' or 'C' or 'c', K specifies the number</span>
<a name="l01353"></a>01353 <span class="comment"> of rows of the matrix A. K must be at least zero.</span>
<a name="l01354"></a>01354 <span class="comment"> Unchanged on exit.</span>
<a name="l01355"></a>01355 <span class="comment"></span>
<a name="l01356"></a>01356 <span class="comment"> ALPHA - REAL .</span>
<a name="l01357"></a>01357 <span class="comment"> On entry, ALPHA specifies the scalar alpha.</span>
<a name="l01358"></a>01358 <span class="comment"> Unchanged on exit.</span>
<a name="l01359"></a>01359 <span class="comment"></span>
<a name="l01360"></a>01360 <span class="comment"> A - REAL array of DIMENSION ( LDA, ka ), where ka is</span>
<a name="l01361"></a>01361 <span class="comment"> k when TRANS = 'N' or 'n', and is n otherwise.</span>
<a name="l01362"></a>01362 <span class="comment"> Before entry with TRANS = 'N' or 'n', the leading n by k</span>
<a name="l01363"></a>01363 <span class="comment"> part of the array A must contain the matrix A, otherwise</span>
<a name="l01364"></a>01364 <span class="comment"> the leading k by n part of the array A must contain the</span>
<a name="l01365"></a>01365 <span class="comment"> matrix A.</span>
<a name="l01366"></a>01366 <span class="comment"> Unchanged on exit.</span>
<a name="l01367"></a>01367 <span class="comment"></span>
<a name="l01368"></a>01368 <span class="comment"> LDA - INTEGER.</span>
<a name="l01369"></a>01369 <span class="comment"> On entry, LDA specifies the first dimension of A as declared</span>
<a name="l01370"></a>01370 <span class="comment"> in the calling (sub) program. When TRANS = 'N' or 'n'</span>
<a name="l01371"></a>01371 <span class="comment"> then LDA must be at least max( 1, n ), otherwise LDA must</span>
<a name="l01372"></a>01372 <span class="comment"> be at least max( 1, k ).</span>
<a name="l01373"></a>01373 <span class="comment"> Unchanged on exit.</span>
<a name="l01374"></a>01374 <span class="comment"></span>
<a name="l01375"></a>01375 <span class="comment"> BETA - REAL .</span>
<a name="l01376"></a>01376 <span class="comment"> On entry, BETA specifies the scalar beta.</span>
<a name="l01377"></a>01377 <span class="comment"> Unchanged on exit.</span>
<a name="l01378"></a>01378 <span class="comment"></span>
<a name="l01379"></a>01379 <span class="comment"> C - REAL array of DIMENSION ( LDC, n ).</span>
<a name="l01380"></a>01380 <span class="comment"> Before entry with UPLO = 'U' or 'u', the leading n by n</span>
<a name="l01381"></a>01381 <span class="comment"> upper triangular part of the array C must contain the upper</span>
<a name="l01382"></a>01382 <span class="comment"> triangular part of the symmetric matrix and the strictly</span>
<a name="l01383"></a>01383 <span class="comment"> lower triangular part of C is not referenced. On exit, the</span>
<a name="l01384"></a>01384 <span class="comment"> upper triangular part of the array C is overwritten by the</span>
<a name="l01385"></a>01385 <span class="comment"> upper triangular part of the updated matrix.</span>
<a name="l01386"></a>01386 <span class="comment"> Before entry with UPLO = 'L' or 'l', the leading n by n</span>
<a name="l01387"></a>01387 <span class="comment"> lower triangular part of the array C must contain the lower</span>
<a name="l01388"></a>01388 <span class="comment"> triangular part of the symmetric matrix and the strictly</span>
<a name="l01389"></a>01389 <span class="comment"> upper triangular part of C is not referenced. On exit, the</span>
<a name="l01390"></a>01390 <span class="comment"> lower triangular part of the array C is overwritten by the</span>
<a name="l01391"></a>01391 <span class="comment"> lower triangular part of the updated matrix.</span>
<a name="l01392"></a>01392 <span class="comment"></span>
<a name="l01393"></a>01393 <span class="comment"> LDC - INTEGER.</span>
<a name="l01394"></a>01394 <span class="comment"> On entry, LDC specifies the first dimension of C as declared</span>
<a name="l01395"></a>01395 <span class="comment"> in the calling (sub) program. LDC must be at least</span>
<a name="l01396"></a>01396 <span class="comment"> max( 1, n ).</span>
<a name="l01397"></a>01397 <span class="comment"> Unchanged on exit.</span>
<a name="l01398"></a>01398 <span class="comment"></span>
<a name="l01399"></a>01399 <span class="comment"></span>
<a name="l01400"></a>01400 <span class="comment"> Level 3 Blas routine.</span>
<a name="l01401"></a>01401 <span class="comment"></span>
<a name="l01402"></a>01402 <span class="comment"> -- Written on 8-February-1989.</span>
<a name="l01403"></a>01403 <span class="comment"> Jack Dongarra, Argonne National Laboratory.</span>
<a name="l01404"></a>01404 <span class="comment"> Iain Duff, AERE Harwell.</span>
<a name="l01405"></a>01405 <span class="comment"> Jeremy Du Croz, Numerical Algorithms Group Ltd.</span>
<a name="l01406"></a>01406 <span class="comment"> Sven Hammarling, Numerical Algorithms Group Ltd.</span>
<a name="l01407"></a>01407 <span class="comment"></span>
<a name="l01408"></a>01408 <span class="comment"></span>
<a name="l01409"></a>01409 <span class="comment"> Test the input parameters.</span>
<a name="l01410"></a>01410 <span class="comment">*/</span>
<a name="l01411"></a>01411
<a name="l01412"></a>01412 <span class="comment">/* Parameter adjustments */</span>
<a name="l01413"></a>01413 a_dim1 = *lda;
<a name="l01414"></a>01414 a_offset = 1 + a_dim1;
<a name="l01415"></a>01415 a -= a_offset;
<a name="l01416"></a>01416 c_dim1 = *ldc;
<a name="l01417"></a>01417 c_offset = 1 + c_dim1;
<a name="l01418"></a>01418 c__ -= c_offset;
<a name="l01419"></a>01419
<a name="l01420"></a>01420 <span class="comment">/* Function Body */</span>
<a name="l01421"></a>01421 <span class="keywordflow">if</span> (lsame_(trans, <span class="stringliteral">"N"</span>)) {
<a name="l01422"></a>01422 nrowa = *n;
<a name="l01423"></a>01423 } <span class="keywordflow">else</span> {
<a name="l01424"></a>01424 nrowa = *k;
<a name="l01425"></a>01425 }
<a name="l01426"></a>01426 upper = lsame_(uplo, <span class="stringliteral">"U"</span>);
<a name="l01427"></a>01427
<a name="l01428"></a>01428 info = 0;
<a name="l01429"></a>01429 <span class="keywordflow">if</span> (! upper && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l01430"></a>01430 info = 1;
<a name="l01431"></a>01431 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (! lsame_(trans, <span class="stringliteral">"N"</span>) && ! lsame_(trans,
<a name="l01432"></a>01432 <span class="stringliteral">"T"</span>) && ! lsame_(trans, <span class="stringliteral">"C"</span>)) {
<a name="l01433"></a>01433 info = 2;
<a name="l01434"></a>01434 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l01435"></a>01435 info = 3;
<a name="l01436"></a>01436 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*k < 0) {
<a name="l01437"></a>01437 info = 4;
<a name="l01438"></a>01438 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,nrowa)) {
<a name="l01439"></a>01439 info = 7;
<a name="l01440"></a>01440 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldc < max(1,*n)) {
<a name="l01441"></a>01441 info = 10;
<a name="l01442"></a>01442 }
<a name="l01443"></a>01443 <span class="keywordflow">if</span> (info != 0) {
<a name="l01444"></a>01444 xerbla_(<span class="stringliteral">"SSYRK "</span>, &info);
<a name="l01445"></a>01445 <span class="keywordflow">return</span> 0;
<a name="l01446"></a>01446 }
<a name="l01447"></a>01447
<a name="l01448"></a>01448 <span class="comment">/* Quick return if possible. */</span>
<a name="l01449"></a>01449
<a name="l01450"></a>01450 <span class="keywordflow">if</span> (*n == 0 || (*alpha == 0.f || *k == 0) && *beta == 1.f) {
<a name="l01451"></a>01451 <span class="keywordflow">return</span> 0;
<a name="l01452"></a>01452 }
<a name="l01453"></a>01453
<a name="l01454"></a>01454 <span class="comment">/* And when alpha.eq.zero. */</span>
<a name="l01455"></a>01455
<a name="l01456"></a>01456 <span class="keywordflow">if</span> (*alpha == 0.f) {
<a name="l01457"></a>01457 <span class="keywordflow">if</span> (upper) {
<a name="l01458"></a>01458 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01459"></a>01459 i__1 = *n;
<a name="l01460"></a>01460 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01461"></a>01461 i__2 = j;
<a name="l01462"></a>01462 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01463"></a>01463 c__[i__ + j * c_dim1] = 0.f;
<a name="l01464"></a>01464 <span class="comment">/* L10: */</span>
<a name="l01465"></a>01465 }
<a name="l01466"></a>01466 <span class="comment">/* L20: */</span>
<a name="l01467"></a>01467 }
<a name="l01468"></a>01468 } <span class="keywordflow">else</span> {
<a name="l01469"></a>01469 i__1 = *n;
<a name="l01470"></a>01470 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01471"></a>01471 i__2 = j;
<a name="l01472"></a>01472 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01473"></a>01473 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l01474"></a>01474 <span class="comment">/* L30: */</span>
<a name="l01475"></a>01475 }
<a name="l01476"></a>01476 <span class="comment">/* L40: */</span>
<a name="l01477"></a>01477 }
<a name="l01478"></a>01478 }
<a name="l01479"></a>01479 } <span class="keywordflow">else</span> {
<a name="l01480"></a>01480 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01481"></a>01481 i__1 = *n;
<a name="l01482"></a>01482 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01483"></a>01483 i__2 = *n;
<a name="l01484"></a>01484 <span class="keywordflow">for</span> (i__ = j; i__ <= i__2; ++i__) {
<a name="l01485"></a>01485 c__[i__ + j * c_dim1] = 0.f;
<a name="l01486"></a>01486 <span class="comment">/* L50: */</span>
<a name="l01487"></a>01487 }
<a name="l01488"></a>01488 <span class="comment">/* L60: */</span>
<a name="l01489"></a>01489 }
<a name="l01490"></a>01490 } <span class="keywordflow">else</span> {
<a name="l01491"></a>01491 i__1 = *n;
<a name="l01492"></a>01492 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01493"></a>01493 i__2 = *n;
<a name="l01494"></a>01494 <span class="keywordflow">for</span> (i__ = j; i__ <= i__2; ++i__) {
<a name="l01495"></a>01495 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l01496"></a>01496 <span class="comment">/* L70: */</span>
<a name="l01497"></a>01497 }
<a name="l01498"></a>01498 <span class="comment">/* L80: */</span>
<a name="l01499"></a>01499 }
<a name="l01500"></a>01500 }
<a name="l01501"></a>01501 }
<a name="l01502"></a>01502 <span class="keywordflow">return</span> 0;
<a name="l01503"></a>01503 }
<a name="l01504"></a>01504
<a name="l01505"></a>01505 <span class="comment">/* Start the operations. */</span>
<a name="l01506"></a>01506
<a name="l01507"></a>01507 <span class="keywordflow">if</span> (lsame_(trans, <span class="stringliteral">"N"</span>)) {
<a name="l01508"></a>01508
<a name="l01509"></a>01509 <span class="comment">/* Form C := alpha*A*A' + beta*C. */</span>
<a name="l01510"></a>01510
<a name="l01511"></a>01511 <span class="keywordflow">if</span> (upper) {
<a name="l01512"></a>01512 i__1 = *n;
<a name="l01513"></a>01513 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01514"></a>01514 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01515"></a>01515 i__2 = j;
<a name="l01516"></a>01516 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01517"></a>01517 c__[i__ + j * c_dim1] = 0.f;
<a name="l01518"></a>01518 <span class="comment">/* L90: */</span>
<a name="l01519"></a>01519 }
<a name="l01520"></a>01520 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*beta != 1.f) {
<a name="l01521"></a>01521 i__2 = j;
<a name="l01522"></a>01522 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01523"></a>01523 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l01524"></a>01524 <span class="comment">/* L100: */</span>
<a name="l01525"></a>01525 }
<a name="l01526"></a>01526 }
<a name="l01527"></a>01527 i__2 = *k;
<a name="l01528"></a>01528 <span class="keywordflow">for</span> (l = 1; l <= i__2; ++l) {
<a name="l01529"></a>01529 <span class="keywordflow">if</span> (a[j + l * a_dim1] != 0.f) {
<a name="l01530"></a>01530 temp = *alpha * a[j + l * a_dim1];
<a name="l01531"></a>01531 i__3 = j;
<a name="l01532"></a>01532 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l01533"></a>01533 c__[i__ + j * c_dim1] += temp * a[i__ + l *
<a name="l01534"></a>01534 a_dim1];
<a name="l01535"></a>01535 <span class="comment">/* L110: */</span>
<a name="l01536"></a>01536 }
<a name="l01537"></a>01537 }
<a name="l01538"></a>01538 <span class="comment">/* L120: */</span>
<a name="l01539"></a>01539 }
<a name="l01540"></a>01540 <span class="comment">/* L130: */</span>
<a name="l01541"></a>01541 }
<a name="l01542"></a>01542 } <span class="keywordflow">else</span> {
<a name="l01543"></a>01543 i__1 = *n;
<a name="l01544"></a>01544 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01545"></a>01545 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01546"></a>01546 i__2 = *n;
<a name="l01547"></a>01547 <span class="keywordflow">for</span> (i__ = j; i__ <= i__2; ++i__) {
<a name="l01548"></a>01548 c__[i__ + j * c_dim1] = 0.f;
<a name="l01549"></a>01549 <span class="comment">/* L140: */</span>
<a name="l01550"></a>01550 }
<a name="l01551"></a>01551 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*beta != 1.f) {
<a name="l01552"></a>01552 i__2 = *n;
<a name="l01553"></a>01553 <span class="keywordflow">for</span> (i__ = j; i__ <= i__2; ++i__) {
<a name="l01554"></a>01554 c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
<a name="l01555"></a>01555 <span class="comment">/* L150: */</span>
<a name="l01556"></a>01556 }
<a name="l01557"></a>01557 }
<a name="l01558"></a>01558 i__2 = *k;
<a name="l01559"></a>01559 <span class="keywordflow">for</span> (l = 1; l <= i__2; ++l) {
<a name="l01560"></a>01560 <span class="keywordflow">if</span> (a[j + l * a_dim1] != 0.f) {
<a name="l01561"></a>01561 temp = *alpha * a[j + l * a_dim1];
<a name="l01562"></a>01562 i__3 = *n;
<a name="l01563"></a>01563 <span class="keywordflow">for</span> (i__ = j; i__ <= i__3; ++i__) {
<a name="l01564"></a>01564 c__[i__ + j * c_dim1] += temp * a[i__ + l *
<a name="l01565"></a>01565 a_dim1];
<a name="l01566"></a>01566 <span class="comment">/* L160: */</span>
<a name="l01567"></a>01567 }
<a name="l01568"></a>01568 }
<a name="l01569"></a>01569 <span class="comment">/* L170: */</span>
<a name="l01570"></a>01570 }
<a name="l01571"></a>01571 <span class="comment">/* L180: */</span>
<a name="l01572"></a>01572 }
<a name="l01573"></a>01573 }
<a name="l01574"></a>01574 } <span class="keywordflow">else</span> {
<a name="l01575"></a>01575
<a name="l01576"></a>01576 <span class="comment">/* Form C := alpha*A'*A + beta*C. */</span>
<a name="l01577"></a>01577
<a name="l01578"></a>01578 <span class="keywordflow">if</span> (upper) {
<a name="l01579"></a>01579 i__1 = *n;
<a name="l01580"></a>01580 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01581"></a>01581 i__2 = j;
<a name="l01582"></a>01582 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01583"></a>01583 temp = 0.f;
<a name="l01584"></a>01584 i__3 = *k;
<a name="l01585"></a>01585 <span class="keywordflow">for</span> (l = 1; l <= i__3; ++l) {
<a name="l01586"></a>01586 temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];
<a name="l01587"></a>01587 <span class="comment">/* L190: */</span>
<a name="l01588"></a>01588 }
<a name="l01589"></a>01589 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01590"></a>01590 c__[i__ + j * c_dim1] = *alpha * temp;
<a name="l01591"></a>01591 } <span class="keywordflow">else</span> {
<a name="l01592"></a>01592 c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
<a name="l01593"></a>01593 i__ + j * c_dim1];
<a name="l01594"></a>01594 }
<a name="l01595"></a>01595 <span class="comment">/* L200: */</span>
<a name="l01596"></a>01596 }
<a name="l01597"></a>01597 <span class="comment">/* L210: */</span>
<a name="l01598"></a>01598 }
<a name="l01599"></a>01599 } <span class="keywordflow">else</span> {
<a name="l01600"></a>01600 i__1 = *n;
<a name="l01601"></a>01601 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01602"></a>01602 i__2 = *n;
<a name="l01603"></a>01603 <span class="keywordflow">for</span> (i__ = j; i__ <= i__2; ++i__) {
<a name="l01604"></a>01604 temp = 0.f;
<a name="l01605"></a>01605 i__3 = *k;
<a name="l01606"></a>01606 <span class="keywordflow">for</span> (l = 1; l <= i__3; ++l) {
<a name="l01607"></a>01607 temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];
<a name="l01608"></a>01608 <span class="comment">/* L220: */</span>
<a name="l01609"></a>01609 }
<a name="l01610"></a>01610 <span class="keywordflow">if</span> (*beta == 0.f) {
<a name="l01611"></a>01611 c__[i__ + j * c_dim1] = *alpha * temp;
<a name="l01612"></a>01612 } <span class="keywordflow">else</span> {
<a name="l01613"></a>01613 c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
<a name="l01614"></a>01614 i__ + j * c_dim1];
<a name="l01615"></a>01615 }
<a name="l01616"></a>01616 <span class="comment">/* L230: */</span>
<a name="l01617"></a>01617 }
<a name="l01618"></a>01618 <span class="comment">/* L240: */</span>
<a name="l01619"></a>01619 }
<a name="l01620"></a>01620 }
<a name="l01621"></a>01621 }
<a name="l01622"></a>01622
<a name="l01623"></a>01623 <span class="keywordflow">return</span> 0;
<a name="l01624"></a>01624
<a name="l01625"></a>01625 <span class="comment">/* End of SSYRK . */</span>
<a name="l01626"></a>01626
<a name="l01627"></a>01627 } <span class="comment">/* ssyrk_ */</span>
<a name="l01628"></a>01628
<a name="l01629"></a>01629 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> strsm_(<span class="keywordtype">char</span> *side, <span class="keywordtype">char</span> *uplo, <span class="keywordtype">char</span> *transa, <span class="keywordtype">char</span> *diag,
<a name="l01630"></a>01630 integer *m, integer *n, real *alpha, real *a, integer *lda, real *b,
<a name="l01631"></a>01631 integer *ldb)
<a name="l01632"></a>01632 {
<a name="l01633"></a>01633 <span class="comment">/* System generated locals */</span>
<a name="l01634"></a>01634 integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
<a name="l01635"></a>01635
<a name="l01636"></a>01636 <span class="comment">/* Local variables */</span>
<a name="l01637"></a>01637 <span class="keyword">static</span> integer i__, j, k, info;
<a name="l01638"></a>01638 <span class="keyword">static</span> real temp;
<a name="l01639"></a>01639 <span class="keyword">static</span> logical lside;
<a name="l01640"></a>01640 <span class="keyword">extern</span> logical lsame_(<span class="keywordtype">char</span> *, <span class="keywordtype">char</span> *);
<a name="l01641"></a>01641 <span class="keyword">static</span> integer nrowa;
<a name="l01642"></a>01642 <span class="keyword">static</span> logical upper;
<a name="l01643"></a>01643 <span class="keyword">extern</span> <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *, integer *);
<a name="l01644"></a>01644 <span class="keyword">static</span> logical nounit;
<a name="l01645"></a>01645
<a name="l01646"></a>01646
<a name="l01647"></a>01647 <span class="comment">/*</span>
<a name="l01648"></a>01648 <span class="comment"> Purpose</span>
<a name="l01649"></a>01649 <span class="comment"> =======</span>
<a name="l01650"></a>01650 <span class="comment"></span>
<a name="l01651"></a>01651 <span class="comment"> STRSM solves one of the matrix equations</span>
<a name="l01652"></a>01652 <span class="comment"></span>
<a name="l01653"></a>01653 <span class="comment"> op( A )*X = alpha*B, or X*op( A ) = alpha*B,</span>
<a name="l01654"></a>01654 <span class="comment"></span>
<a name="l01655"></a>01655 <span class="comment"> where alpha is a scalar, X and B are m by n matrices, A is a unit, or</span>
<a name="l01656"></a>01656 <span class="comment"> non-unit, upper or lower triangular matrix and op( A ) is one of</span>
<a name="l01657"></a>01657 <span class="comment"></span>
<a name="l01658"></a>01658 <span class="comment"> op( A ) = A or op( A ) = A'.</span>
<a name="l01659"></a>01659 <span class="comment"></span>
<a name="l01660"></a>01660 <span class="comment"> The matrix X is overwritten on B.</span>
<a name="l01661"></a>01661 <span class="comment"></span>
<a name="l01662"></a>01662 <span class="comment"> Parameters</span>
<a name="l01663"></a>01663 <span class="comment"> ==========</span>
<a name="l01664"></a>01664 <span class="comment"></span>
<a name="l01665"></a>01665 <span class="comment"> SIDE - CHARACTER*1.</span>
<a name="l01666"></a>01666 <span class="comment"> On entry, SIDE specifies whether op( A ) appears on the left</span>
<a name="l01667"></a>01667 <span class="comment"> or right of X as follows:</span>
<a name="l01668"></a>01668 <span class="comment"></span>
<a name="l01669"></a>01669 <span class="comment"> SIDE = 'L' or 'l' op( A )*X = alpha*B.</span>
<a name="l01670"></a>01670 <span class="comment"></span>
<a name="l01671"></a>01671 <span class="comment"> SIDE = 'R' or 'r' X*op( A ) = alpha*B.</span>
<a name="l01672"></a>01672 <span class="comment"></span>
<a name="l01673"></a>01673 <span class="comment"> Unchanged on exit.</span>
<a name="l01674"></a>01674 <span class="comment"></span>
<a name="l01675"></a>01675 <span class="comment"> UPLO - CHARACTER*1.</span>
<a name="l01676"></a>01676 <span class="comment"> On entry, UPLO specifies whether the matrix A is an upper or</span>
<a name="l01677"></a>01677 <span class="comment"> lower triangular matrix as follows:</span>
<a name="l01678"></a>01678 <span class="comment"></span>
<a name="l01679"></a>01679 <span class="comment"> UPLO = 'U' or 'u' A is an upper triangular matrix.</span>
<a name="l01680"></a>01680 <span class="comment"></span>
<a name="l01681"></a>01681 <span class="comment"> UPLO = 'L' or 'l' A is a lower triangular matrix.</span>
<a name="l01682"></a>01682 <span class="comment"></span>
<a name="l01683"></a>01683 <span class="comment"> Unchanged on exit.</span>
<a name="l01684"></a>01684 <span class="comment"></span>
<a name="l01685"></a>01685 <span class="comment"> TRANSA - CHARACTER*1.</span>
<a name="l01686"></a>01686 <span class="comment"> On entry, TRANSA specifies the form of op( A ) to be used in</span>
<a name="l01687"></a>01687 <span class="comment"> the matrix multiplication as follows:</span>
<a name="l01688"></a>01688 <span class="comment"></span>
<a name="l01689"></a>01689 <span class="comment"> TRANSA = 'N' or 'n' op( A ) = A.</span>
<a name="l01690"></a>01690 <span class="comment"></span>
<a name="l01691"></a>01691 <span class="comment"> TRANSA = 'T' or 't' op( A ) = A'.</span>
<a name="l01692"></a>01692 <span class="comment"></span>
<a name="l01693"></a>01693 <span class="comment"> TRANSA = 'C' or 'c' op( A ) = A'.</span>
<a name="l01694"></a>01694 <span class="comment"></span>
<a name="l01695"></a>01695 <span class="comment"> Unchanged on exit.</span>
<a name="l01696"></a>01696 <span class="comment"></span>
<a name="l01697"></a>01697 <span class="comment"> DIAG - CHARACTER*1.</span>
<a name="l01698"></a>01698 <span class="comment"> On entry, DIAG specifies whether or not A is unit triangular</span>
<a name="l01699"></a>01699 <span class="comment"> as follows:</span>
<a name="l01700"></a>01700 <span class="comment"></span>
<a name="l01701"></a>01701 <span class="comment"> DIAG = 'U' or 'u' A is assumed to be unit triangular.</span>
<a name="l01702"></a>01702 <span class="comment"></span>
<a name="l01703"></a>01703 <span class="comment"> DIAG = 'N' or 'n' A is not assumed to be unit</span>
<a name="l01704"></a>01704 <span class="comment"> triangular.</span>
<a name="l01705"></a>01705 <span class="comment"></span>
<a name="l01706"></a>01706 <span class="comment"> Unchanged on exit.</span>
<a name="l01707"></a>01707 <span class="comment"></span>
<a name="l01708"></a>01708 <span class="comment"> M - INTEGER.</span>
<a name="l01709"></a>01709 <span class="comment"> On entry, M specifies the number of rows of B. M must be at</span>
<a name="l01710"></a>01710 <span class="comment"> least zero.</span>
<a name="l01711"></a>01711 <span class="comment"> Unchanged on exit.</span>
<a name="l01712"></a>01712 <span class="comment"></span>
<a name="l01713"></a>01713 <span class="comment"> N - INTEGER.</span>
<a name="l01714"></a>01714 <span class="comment"> On entry, N specifies the number of columns of B. N must be</span>
<a name="l01715"></a>01715 <span class="comment"> at least zero.</span>
<a name="l01716"></a>01716 <span class="comment"> Unchanged on exit.</span>
<a name="l01717"></a>01717 <span class="comment"></span>
<a name="l01718"></a>01718 <span class="comment"> ALPHA - REAL .</span>
<a name="l01719"></a>01719 <span class="comment"> On entry, ALPHA specifies the scalar alpha. When alpha is</span>
<a name="l01720"></a>01720 <span class="comment"> zero then A is not referenced and B need not be set before</span>
<a name="l01721"></a>01721 <span class="comment"> entry.</span>
<a name="l01722"></a>01722 <span class="comment"> Unchanged on exit.</span>
<a name="l01723"></a>01723 <span class="comment"></span>
<a name="l01724"></a>01724 <span class="comment"> A - REAL array of DIMENSION ( LDA, k ), where k is m</span>
<a name="l01725"></a>01725 <span class="comment"> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.</span>
<a name="l01726"></a>01726 <span class="comment"> Before entry with UPLO = 'U' or 'u', the leading k by k</span>
<a name="l01727"></a>01727 <span class="comment"> upper triangular part of the array A must contain the upper</span>
<a name="l01728"></a>01728 <span class="comment"> triangular matrix and the strictly lower triangular part of</span>
<a name="l01729"></a>01729 <span class="comment"> A is not referenced.</span>
<a name="l01730"></a>01730 <span class="comment"> Before entry with UPLO = 'L' or 'l', the leading k by k</span>
<a name="l01731"></a>01731 <span class="comment"> lower triangular part of the array A must contain the lower</span>
<a name="l01732"></a>01732 <span class="comment"> triangular matrix and the strictly upper triangular part of</span>
<a name="l01733"></a>01733 <span class="comment"> A is not referenced.</span>
<a name="l01734"></a>01734 <span class="comment"> Note that when DIAG = 'U' or 'u', the diagonal elements of</span>
<a name="l01735"></a>01735 <span class="comment"> A are not referenced either, but are assumed to be unity.</span>
<a name="l01736"></a>01736 <span class="comment"> Unchanged on exit.</span>
<a name="l01737"></a>01737 <span class="comment"></span>
<a name="l01738"></a>01738 <span class="comment"> LDA - INTEGER.</span>
<a name="l01739"></a>01739 <span class="comment"> On entry, LDA specifies the first dimension of A as declared</span>
<a name="l01740"></a>01740 <span class="comment"> in the calling (sub) program. When SIDE = 'L' or 'l' then</span>
<a name="l01741"></a>01741 <span class="comment"> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'</span>
<a name="l01742"></a>01742 <span class="comment"> then LDA must be at least max( 1, n ).</span>
<a name="l01743"></a>01743 <span class="comment"> Unchanged on exit.</span>
<a name="l01744"></a>01744 <span class="comment"></span>
<a name="l01745"></a>01745 <span class="comment"> B - REAL array of DIMENSION ( LDB, n ).</span>
<a name="l01746"></a>01746 <span class="comment"> Before entry, the leading m by n part of the array B must</span>
<a name="l01747"></a>01747 <span class="comment"> contain the right-hand side matrix B, and on exit is</span>
<a name="l01748"></a>01748 <span class="comment"> overwritten by the solution matrix X.</span>
<a name="l01749"></a>01749 <span class="comment"></span>
<a name="l01750"></a>01750 <span class="comment"> LDB - INTEGER.</span>
<a name="l01751"></a>01751 <span class="comment"> On entry, LDB specifies the first dimension of B as declared</span>
<a name="l01752"></a>01752 <span class="comment"> in the calling (sub) program. LDB must be at least</span>
<a name="l01753"></a>01753 <span class="comment"> max( 1, m ).</span>
<a name="l01754"></a>01754 <span class="comment"> Unchanged on exit.</span>
<a name="l01755"></a>01755 <span class="comment"></span>
<a name="l01756"></a>01756 <span class="comment"></span>
<a name="l01757"></a>01757 <span class="comment"> Level 3 Blas routine.</span>
<a name="l01758"></a>01758 <span class="comment"></span>
<a name="l01759"></a>01759 <span class="comment"></span>
<a name="l01760"></a>01760 <span class="comment"> -- Written on 8-February-1989.</span>
<a name="l01761"></a>01761 <span class="comment"> Jack Dongarra, Argonne National Laboratory.</span>
<a name="l01762"></a>01762 <span class="comment"> Iain Duff, AERE Harwell.</span>
<a name="l01763"></a>01763 <span class="comment"> Jeremy Du Croz, Numerical Algorithms Group Ltd.</span>
<a name="l01764"></a>01764 <span class="comment"> Sven Hammarling, Numerical Algorithms Group Ltd.</span>
<a name="l01765"></a>01765 <span class="comment"></span>
<a name="l01766"></a>01766 <span class="comment"></span>
<a name="l01767"></a>01767 <span class="comment"> Test the input parameters.</span>
<a name="l01768"></a>01768 <span class="comment">*/</span>
<a name="l01769"></a>01769
<a name="l01770"></a>01770 <span class="comment">/* Parameter adjustments */</span>
<a name="l01771"></a>01771 a_dim1 = *lda;
<a name="l01772"></a>01772 a_offset = 1 + a_dim1;
<a name="l01773"></a>01773 a -= a_offset;
<a name="l01774"></a>01774 b_dim1 = *ldb;
<a name="l01775"></a>01775 b_offset = 1 + b_dim1;
<a name="l01776"></a>01776 b -= b_offset;
<a name="l01777"></a>01777
<a name="l01778"></a>01778 <span class="comment">/* Function Body */</span>
<a name="l01779"></a>01779 lside = lsame_(side, <span class="stringliteral">"L"</span>);
<a name="l01780"></a>01780 <span class="keywordflow">if</span> (lside) {
<a name="l01781"></a>01781 nrowa = *m;
<a name="l01782"></a>01782 } <span class="keywordflow">else</span> {
<a name="l01783"></a>01783 nrowa = *n;
<a name="l01784"></a>01784 }
<a name="l01785"></a>01785 nounit = lsame_(diag, <span class="stringliteral">"N"</span>);
<a name="l01786"></a>01786 upper = lsame_(uplo, <span class="stringliteral">"U"</span>);
<a name="l01787"></a>01787
<a name="l01788"></a>01788 info = 0;
<a name="l01789"></a>01789 <span class="keywordflow">if</span> (! lside && ! lsame_(side, <span class="stringliteral">"R"</span>)) {
<a name="l01790"></a>01790 info = 1;
<a name="l01791"></a>01791 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (! upper && ! lsame_(uplo, <span class="stringliteral">"L"</span>)) {
<a name="l01792"></a>01792 info = 2;
<a name="l01793"></a>01793 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (! lsame_(transa, <span class="stringliteral">"N"</span>) && ! lsame_(transa,
<a name="l01794"></a>01794 <span class="stringliteral">"T"</span>) && ! lsame_(transa, <span class="stringliteral">"C"</span>)) {
<a name="l01795"></a>01795 info = 3;
<a name="l01796"></a>01796 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (! lsame_(diag, <span class="stringliteral">"U"</span>) && ! lsame_(diag,
<a name="l01797"></a>01797 <span class="stringliteral">"N"</span>)) {
<a name="l01798"></a>01798 info = 4;
<a name="l01799"></a>01799 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*m < 0) {
<a name="l01800"></a>01800 info = 5;
<a name="l01801"></a>01801 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*n < 0) {
<a name="l01802"></a>01802 info = 6;
<a name="l01803"></a>01803 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*lda < max(1,nrowa)) {
<a name="l01804"></a>01804 info = 9;
<a name="l01805"></a>01805 } <span class="keywordflow">else</span> <span class="keywordflow">if</span> (*ldb < max(1,*m)) {
<a name="l01806"></a>01806 info = 11;
<a name="l01807"></a>01807 }
<a name="l01808"></a>01808 <span class="keywordflow">if</span> (info != 0) {
<a name="l01809"></a>01809 xerbla_(<span class="stringliteral">"STRSM "</span>, &info);
<a name="l01810"></a>01810 <span class="keywordflow">return</span> 0;
<a name="l01811"></a>01811 }
<a name="l01812"></a>01812
<a name="l01813"></a>01813 <span class="comment">/* Quick return if possible. */</span>
<a name="l01814"></a>01814
<a name="l01815"></a>01815 <span class="keywordflow">if</span> (*n == 0) {
<a name="l01816"></a>01816 <span class="keywordflow">return</span> 0;
<a name="l01817"></a>01817 }
<a name="l01818"></a>01818
<a name="l01819"></a>01819 <span class="comment">/* And when alpha.eq.zero. */</span>
<a name="l01820"></a>01820
<a name="l01821"></a>01821 <span class="keywordflow">if</span> (*alpha == 0.f) {
<a name="l01822"></a>01822 i__1 = *n;
<a name="l01823"></a>01823 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01824"></a>01824 i__2 = *m;
<a name="l01825"></a>01825 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01826"></a>01826 b[i__ + j * b_dim1] = 0.f;
<a name="l01827"></a>01827 <span class="comment">/* L10: */</span>
<a name="l01828"></a>01828 }
<a name="l01829"></a>01829 <span class="comment">/* L20: */</span>
<a name="l01830"></a>01830 }
<a name="l01831"></a>01831 <span class="keywordflow">return</span> 0;
<a name="l01832"></a>01832 }
<a name="l01833"></a>01833
<a name="l01834"></a>01834 <span class="comment">/* Start the operations. */</span>
<a name="l01835"></a>01835
<a name="l01836"></a>01836 <span class="keywordflow">if</span> (lside) {
<a name="l01837"></a>01837 <span class="keywordflow">if</span> (lsame_(transa, <span class="stringliteral">"N"</span>)) {
<a name="l01838"></a>01838
<a name="l01839"></a>01839 <span class="comment">/* Form B := alpha*inv( A )*B. */</span>
<a name="l01840"></a>01840
<a name="l01841"></a>01841 <span class="keywordflow">if</span> (upper) {
<a name="l01842"></a>01842 i__1 = *n;
<a name="l01843"></a>01843 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01844"></a>01844 <span class="keywordflow">if</span> (*alpha != 1.f) {
<a name="l01845"></a>01845 i__2 = *m;
<a name="l01846"></a>01846 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01847"></a>01847 b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
<a name="l01848"></a>01848 ;
<a name="l01849"></a>01849 <span class="comment">/* L30: */</span>
<a name="l01850"></a>01850 }
<a name="l01851"></a>01851 }
<a name="l01852"></a>01852 <span class="keywordflow">for</span> (k = *m; k >= 1; --k) {
<a name="l01853"></a>01853 <span class="keywordflow">if</span> (b[k + j * b_dim1] != 0.f) {
<a name="l01854"></a>01854 <span class="keywordflow">if</span> (nounit) {
<a name="l01855"></a>01855 b[k + j * b_dim1] /= a[k + k * a_dim1];
<a name="l01856"></a>01856 }
<a name="l01857"></a>01857 i__2 = k - 1;
<a name="l01858"></a>01858 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01859"></a>01859 b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
<a name="l01860"></a>01860 i__ + k * a_dim1];
<a name="l01861"></a>01861 <span class="comment">/* L40: */</span>
<a name="l01862"></a>01862 }
<a name="l01863"></a>01863 }
<a name="l01864"></a>01864 <span class="comment">/* L50: */</span>
<a name="l01865"></a>01865 }
<a name="l01866"></a>01866 <span class="comment">/* L60: */</span>
<a name="l01867"></a>01867 }
<a name="l01868"></a>01868 } <span class="keywordflow">else</span> {
<a name="l01869"></a>01869 i__1 = *n;
<a name="l01870"></a>01870 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01871"></a>01871 <span class="keywordflow">if</span> (*alpha != 1.f) {
<a name="l01872"></a>01872 i__2 = *m;
<a name="l01873"></a>01873 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01874"></a>01874 b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
<a name="l01875"></a>01875 ;
<a name="l01876"></a>01876 <span class="comment">/* L70: */</span>
<a name="l01877"></a>01877 }
<a name="l01878"></a>01878 }
<a name="l01879"></a>01879 i__2 = *m;
<a name="l01880"></a>01880 <span class="keywordflow">for</span> (k = 1; k <= i__2; ++k) {
<a name="l01881"></a>01881 <span class="keywordflow">if</span> (b[k + j * b_dim1] != 0.f) {
<a name="l01882"></a>01882 <span class="keywordflow">if</span> (nounit) {
<a name="l01883"></a>01883 b[k + j * b_dim1] /= a[k + k * a_dim1];
<a name="l01884"></a>01884 }
<a name="l01885"></a>01885 i__3 = *m;
<a name="l01886"></a>01886 <span class="keywordflow">for</span> (i__ = k + 1; i__ <= i__3; ++i__) {
<a name="l01887"></a>01887 b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
<a name="l01888"></a>01888 i__ + k * a_dim1];
<a name="l01889"></a>01889 <span class="comment">/* L80: */</span>
<a name="l01890"></a>01890 }
<a name="l01891"></a>01891 }
<a name="l01892"></a>01892 <span class="comment">/* L90: */</span>
<a name="l01893"></a>01893 }
<a name="l01894"></a>01894 <span class="comment">/* L100: */</span>
<a name="l01895"></a>01895 }
<a name="l01896"></a>01896 }
<a name="l01897"></a>01897 } <span class="keywordflow">else</span> {
<a name="l01898"></a>01898
<a name="l01899"></a>01899 <span class="comment">/* Form B := alpha*inv( A' )*B. */</span>
<a name="l01900"></a>01900
<a name="l01901"></a>01901 <span class="keywordflow">if</span> (upper) {
<a name="l01902"></a>01902 i__1 = *n;
<a name="l01903"></a>01903 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01904"></a>01904 i__2 = *m;
<a name="l01905"></a>01905 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01906"></a>01906 temp = *alpha * b[i__ + j * b_dim1];
<a name="l01907"></a>01907 i__3 = i__ - 1;
<a name="l01908"></a>01908 <span class="keywordflow">for</span> (k = 1; k <= i__3; ++k) {
<a name="l01909"></a>01909 temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
<a name="l01910"></a>01910 <span class="comment">/* L110: */</span>
<a name="l01911"></a>01911 }
<a name="l01912"></a>01912 <span class="keywordflow">if</span> (nounit) {
<a name="l01913"></a>01913 temp /= a[i__ + i__ * a_dim1];
<a name="l01914"></a>01914 }
<a name="l01915"></a>01915 b[i__ + j * b_dim1] = temp;
<a name="l01916"></a>01916 <span class="comment">/* L120: */</span>
<a name="l01917"></a>01917 }
<a name="l01918"></a>01918 <span class="comment">/* L130: */</span>
<a name="l01919"></a>01919 }
<a name="l01920"></a>01920 } <span class="keywordflow">else</span> {
<a name="l01921"></a>01921 i__1 = *n;
<a name="l01922"></a>01922 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01923"></a>01923 <span class="keywordflow">for</span> (i__ = *m; i__ >= 1; --i__) {
<a name="l01924"></a>01924 temp = *alpha * b[i__ + j * b_dim1];
<a name="l01925"></a>01925 i__2 = *m;
<a name="l01926"></a>01926 <span class="keywordflow">for</span> (k = i__ + 1; k <= i__2; ++k) {
<a name="l01927"></a>01927 temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
<a name="l01928"></a>01928 <span class="comment">/* L140: */</span>
<a name="l01929"></a>01929 }
<a name="l01930"></a>01930 <span class="keywordflow">if</span> (nounit) {
<a name="l01931"></a>01931 temp /= a[i__ + i__ * a_dim1];
<a name="l01932"></a>01932 }
<a name="l01933"></a>01933 b[i__ + j * b_dim1] = temp;
<a name="l01934"></a>01934 <span class="comment">/* L150: */</span>
<a name="l01935"></a>01935 }
<a name="l01936"></a>01936 <span class="comment">/* L160: */</span>
<a name="l01937"></a>01937 }
<a name="l01938"></a>01938 }
<a name="l01939"></a>01939 }
<a name="l01940"></a>01940 } <span class="keywordflow">else</span> {
<a name="l01941"></a>01941 <span class="keywordflow">if</span> (lsame_(transa, <span class="stringliteral">"N"</span>)) {
<a name="l01942"></a>01942
<a name="l01943"></a>01943 <span class="comment">/* Form B := alpha*B*inv( A ). */</span>
<a name="l01944"></a>01944
<a name="l01945"></a>01945 <span class="keywordflow">if</span> (upper) {
<a name="l01946"></a>01946 i__1 = *n;
<a name="l01947"></a>01947 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l01948"></a>01948 <span class="keywordflow">if</span> (*alpha != 1.f) {
<a name="l01949"></a>01949 i__2 = *m;
<a name="l01950"></a>01950 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01951"></a>01951 b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
<a name="l01952"></a>01952 ;
<a name="l01953"></a>01953 <span class="comment">/* L170: */</span>
<a name="l01954"></a>01954 }
<a name="l01955"></a>01955 }
<a name="l01956"></a>01956 i__2 = j - 1;
<a name="l01957"></a>01957 <span class="keywordflow">for</span> (k = 1; k <= i__2; ++k) {
<a name="l01958"></a>01958 <span class="keywordflow">if</span> (a[k + j * a_dim1] != 0.f) {
<a name="l01959"></a>01959 i__3 = *m;
<a name="l01960"></a>01960 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l01961"></a>01961 b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
<a name="l01962"></a>01962 i__ + k * b_dim1];
<a name="l01963"></a>01963 <span class="comment">/* L180: */</span>
<a name="l01964"></a>01964 }
<a name="l01965"></a>01965 }
<a name="l01966"></a>01966 <span class="comment">/* L190: */</span>
<a name="l01967"></a>01967 }
<a name="l01968"></a>01968 <span class="keywordflow">if</span> (nounit) {
<a name="l01969"></a>01969 temp = 1.f / a[j + j * a_dim1];
<a name="l01970"></a>01970 i__2 = *m;
<a name="l01971"></a>01971 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01972"></a>01972 b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
<a name="l01973"></a>01973 <span class="comment">/* L200: */</span>
<a name="l01974"></a>01974 }
<a name="l01975"></a>01975 }
<a name="l01976"></a>01976 <span class="comment">/* L210: */</span>
<a name="l01977"></a>01977 }
<a name="l01978"></a>01978 } <span class="keywordflow">else</span> {
<a name="l01979"></a>01979 <span class="keywordflow">for</span> (j = *n; j >= 1; --j) {
<a name="l01980"></a>01980 <span class="keywordflow">if</span> (*alpha != 1.f) {
<a name="l01981"></a>01981 i__1 = *m;
<a name="l01982"></a>01982 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l01983"></a>01983 b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
<a name="l01984"></a>01984 ;
<a name="l01985"></a>01985 <span class="comment">/* L220: */</span>
<a name="l01986"></a>01986 }
<a name="l01987"></a>01987 }
<a name="l01988"></a>01988 i__1 = *n;
<a name="l01989"></a>01989 <span class="keywordflow">for</span> (k = j + 1; k <= i__1; ++k) {
<a name="l01990"></a>01990 <span class="keywordflow">if</span> (a[k + j * a_dim1] != 0.f) {
<a name="l01991"></a>01991 i__2 = *m;
<a name="l01992"></a>01992 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l01993"></a>01993 b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
<a name="l01994"></a>01994 i__ + k * b_dim1];
<a name="l01995"></a>01995 <span class="comment">/* L230: */</span>
<a name="l01996"></a>01996 }
<a name="l01997"></a>01997 }
<a name="l01998"></a>01998 <span class="comment">/* L240: */</span>
<a name="l01999"></a>01999 }
<a name="l02000"></a>02000 <span class="keywordflow">if</span> (nounit) {
<a name="l02001"></a>02001 temp = 1.f / a[j + j * a_dim1];
<a name="l02002"></a>02002 i__1 = *m;
<a name="l02003"></a>02003 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l02004"></a>02004 b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
<a name="l02005"></a>02005 <span class="comment">/* L250: */</span>
<a name="l02006"></a>02006 }
<a name="l02007"></a>02007 }
<a name="l02008"></a>02008 <span class="comment">/* L260: */</span>
<a name="l02009"></a>02009 }
<a name="l02010"></a>02010 }
<a name="l02011"></a>02011 } <span class="keywordflow">else</span> {
<a name="l02012"></a>02012
<a name="l02013"></a>02013 <span class="comment">/* Form B := alpha*B*inv( A' ). */</span>
<a name="l02014"></a>02014
<a name="l02015"></a>02015 <span class="keywordflow">if</span> (upper) {
<a name="l02016"></a>02016 <span class="keywordflow">for</span> (k = *n; k >= 1; --k) {
<a name="l02017"></a>02017 <span class="keywordflow">if</span> (nounit) {
<a name="l02018"></a>02018 temp = 1.f / a[k + k * a_dim1];
<a name="l02019"></a>02019 i__1 = *m;
<a name="l02020"></a>02020 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l02021"></a>02021 b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
<a name="l02022"></a>02022 <span class="comment">/* L270: */</span>
<a name="l02023"></a>02023 }
<a name="l02024"></a>02024 }
<a name="l02025"></a>02025 i__1 = k - 1;
<a name="l02026"></a>02026 <span class="keywordflow">for</span> (j = 1; j <= i__1; ++j) {
<a name="l02027"></a>02027 <span class="keywordflow">if</span> (a[j + k * a_dim1] != 0.f) {
<a name="l02028"></a>02028 temp = a[j + k * a_dim1];
<a name="l02029"></a>02029 i__2 = *m;
<a name="l02030"></a>02030 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l02031"></a>02031 b[i__ + j * b_dim1] -= temp * b[i__ + k *
<a name="l02032"></a>02032 b_dim1];
<a name="l02033"></a>02033 <span class="comment">/* L280: */</span>
<a name="l02034"></a>02034 }
<a name="l02035"></a>02035 }
<a name="l02036"></a>02036 <span class="comment">/* L290: */</span>
<a name="l02037"></a>02037 }
<a name="l02038"></a>02038 <span class="keywordflow">if</span> (*alpha != 1.f) {
<a name="l02039"></a>02039 i__1 = *m;
<a name="l02040"></a>02040 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__1; ++i__) {
<a name="l02041"></a>02041 b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
<a name="l02042"></a>02042 ;
<a name="l02043"></a>02043 <span class="comment">/* L300: */</span>
<a name="l02044"></a>02044 }
<a name="l02045"></a>02045 }
<a name="l02046"></a>02046 <span class="comment">/* L310: */</span>
<a name="l02047"></a>02047 }
<a name="l02048"></a>02048 } <span class="keywordflow">else</span> {
<a name="l02049"></a>02049 i__1 = *n;
<a name="l02050"></a>02050 <span class="keywordflow">for</span> (k = 1; k <= i__1; ++k) {
<a name="l02051"></a>02051 <span class="keywordflow">if</span> (nounit) {
<a name="l02052"></a>02052 temp = 1.f / a[k + k * a_dim1];
<a name="l02053"></a>02053 i__2 = *m;
<a name="l02054"></a>02054 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l02055"></a>02055 b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
<a name="l02056"></a>02056 <span class="comment">/* L320: */</span>
<a name="l02057"></a>02057 }
<a name="l02058"></a>02058 }
<a name="l02059"></a>02059 i__2 = *n;
<a name="l02060"></a>02060 <span class="keywordflow">for</span> (j = k + 1; j <= i__2; ++j) {
<a name="l02061"></a>02061 <span class="keywordflow">if</span> (a[j + k * a_dim1] != 0.f) {
<a name="l02062"></a>02062 temp = a[j + k * a_dim1];
<a name="l02063"></a>02063 i__3 = *m;
<a name="l02064"></a>02064 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__3; ++i__) {
<a name="l02065"></a>02065 b[i__ + j * b_dim1] -= temp * b[i__ + k *
<a name="l02066"></a>02066 b_dim1];
<a name="l02067"></a>02067 <span class="comment">/* L330: */</span>
<a name="l02068"></a>02068 }
<a name="l02069"></a>02069 }
<a name="l02070"></a>02070 <span class="comment">/* L340: */</span>
<a name="l02071"></a>02071 }
<a name="l02072"></a>02072 <span class="keywordflow">if</span> (*alpha != 1.f) {
<a name="l02073"></a>02073 i__2 = *m;
<a name="l02074"></a>02074 <span class="keywordflow">for</span> (i__ = 1; i__ <= i__2; ++i__) {
<a name="l02075"></a>02075 b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
<a name="l02076"></a>02076 ;
<a name="l02077"></a>02077 <span class="comment">/* L350: */</span>
<a name="l02078"></a>02078 }
<a name="l02079"></a>02079 }
<a name="l02080"></a>02080 <span class="comment">/* L360: */</span>
<a name="l02081"></a>02081 }
<a name="l02082"></a>02082 }
<a name="l02083"></a>02083 }
<a name="l02084"></a>02084 }
<a name="l02085"></a>02085
<a name="l02086"></a>02086 <span class="keywordflow">return</span> 0;
<a name="l02087"></a>02087
<a name="l02088"></a>02088 <span class="comment">/* End of STRSM . */</span>
<a name="l02089"></a>02089
<a name="l02090"></a>02090 } <span class="comment">/* strsm_ */</span>
<a name="l02091"></a>02091
<a name="l02092"></a>02092 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> xerbla_(<span class="keywordtype">char</span> *srname, integer *info)
<a name="l02093"></a>02093 {
<a name="l02094"></a>02094 <span class="comment">/* Format strings */</span>
<a name="l02095"></a>02095 <span class="keyword">static</span> <span class="keywordtype">char</span> fmt_9999[] = <span class="stringliteral">"(\002 ** On entry to \002,a6,\002 parameter nu"</span>
<a name="l02096"></a>02096 <span class="stringliteral">"mber \002,i2,\002 had \002,\002an illegal value\002)"</span>;
<a name="l02097"></a>02097
<a name="l02098"></a>02098 <span class="comment">/* Builtin functions */</span>
<a name="l02099"></a>02099 integer s_wsfe(<a class="code" href="structcilist.html">cilist</a> *), do_fio(integer *, <span class="keywordtype">char</span> *, ftnlen), e_wsfe(<span class="keywordtype">void</span>);
<a name="l02100"></a>02100 <span class="comment">/* Subroutine */</span> <span class="keywordtype">int</span> s_stop(<span class="keywordtype">char</span> *, ftnlen);
<a name="l02101"></a>02101
<a name="l02102"></a>02102 <span class="comment">/* Fortran I/O blocks */</span>
<a name="l02103"></a>02103 <span class="keyword">static</span> <a class="code" href="structcilist.html">cilist</a> io___60 = { 0, 6, 0, fmt_9999, 0 };
<a name="l02104"></a>02104
<a name="l02105"></a>02105
<a name="l02106"></a>02106 <span class="comment">/*</span>
<a name="l02107"></a>02107 <span class="comment"> -- LAPACK auxiliary routine (preliminary version) --</span>
<a name="l02108"></a>02108 <span class="comment"> Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,</span>
<a name="l02109"></a>02109 <span class="comment"> Courant Institute, Argonne National Lab, and Rice University</span>
<a name="l02110"></a>02110 <span class="comment"> February 29, 1992</span>
<a name="l02111"></a>02111 <span class="comment"></span>
<a name="l02112"></a>02112 <span class="comment"></span>
<a name="l02113"></a>02113 <span class="comment"> Purpose</span>
<a name="l02114"></a>02114 <span class="comment"> =======</span>
<a name="l02115"></a>02115 <span class="comment"></span>
<a name="l02116"></a>02116 <span class="comment"> XERBLA is an error handler for the LAPACK routines.</span>
<a name="l02117"></a>02117 <span class="comment"> It is called by an LAPACK routine if an input parameter has an</span>
<a name="l02118"></a>02118 <span class="comment"> invalid value. A message is printed and execution stops.</span>
<a name="l02119"></a>02119 <span class="comment"></span>
<a name="l02120"></a>02120 <span class="comment"> Installers may consider modifying the STOP statement in order to</span>
<a name="l02121"></a>02121 <span class="comment"> call system-specific exception-handling facilities.</span>
<a name="l02122"></a>02122 <span class="comment"></span>
<a name="l02123"></a>02123 <span class="comment"> Arguments</span>
<a name="l02124"></a>02124 <span class="comment"> =========</span>
<a name="l02125"></a>02125 <span class="comment"></span>
<a name="l02126"></a>02126 <span class="comment"> SRNAME (input) CHARACTER*6</span>
<a name="l02127"></a>02127 <span class="comment"> The name of the routine which called XERBLA.</span>
<a name="l02128"></a>02128 <span class="comment"></span>
<a name="l02129"></a>02129 <span class="comment"> INFO (input) INTEGER</span>
<a name="l02130"></a>02130 <span class="comment"> The position of the invalid parameter in the parameter list</span>
<a name="l02131"></a>02131 <span class="comment"> of the calling routine.</span>
<a name="l02132"></a>02132 <span class="comment">*/</span>
<a name="l02133"></a>02133
<a name="l02134"></a>02134
<a name="l02135"></a>02135 s_wsfe(&io___60);
<a name="l02136"></a>02136 do_fio(&c__1, srname, (ftnlen)6);
<a name="l02137"></a>02137 do_fio(&c__1, (<span class="keywordtype">char</span> *)&(*info), (ftnlen)<span class="keyword">sizeof</span>(integer));
<a name="l02138"></a>02138 e_wsfe();
<a name="l02139"></a>02139
<a name="l02140"></a>02140 s_stop(<span class="stringliteral">""</span>, (ftnlen)0);
<a name="l02141"></a>02141
<a name="l02142"></a>02142
<a name="l02143"></a>02143 <span class="comment">/* End of XERBLA */</span>
<a name="l02144"></a>02144
<a name="l02145"></a>02145 <span class="keywordflow">return</span> 0;
<a name="l02146"></a>02146 } <span class="comment">/* xerbla_ */</span>
<a name="l02147"></a>02147
</pre></div></div>
</div>
<div id="nav-path" class="navpath">
<ul>
<li class="navelem"><b>blas_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
>
68
