/*1* NOTE: This is generated code. Look in numpy/linalg/lapack_lite for2* information on remaking this file.3*/4#include "f2c.h"56#ifdef HAVE_CONFIG7#include "config.h"8#else9extern doublereal dlamch_(char *);10#define EPSILON dlamch_("Epsilon")11#define SAFEMINIMUM dlamch_("Safe minimum")12#define PRECISION dlamch_("Precision")13#define BASE dlamch_("Base")14#endif1516extern doublereal dlapy2_(doublereal *x, doublereal *y);1718/*19f2c knows the exact rules for precedence, and so omits parentheses where not20strictly necessary. Since this is generated code, we don't really care if21it's readable, and we know what is written is correct. So don't warn about22them.23*/24#if defined(__GNUC__)25#pragma GCC diagnostic ignored "-Wparentheses"26#endif272829/* Table of constant values */3031static singlecomplex c_b21 = {1.f,0.f};32static doublecomplex c_b1078 = {1.,0.};3334/* Subroutine */ int caxpy_(integer *n, singlecomplex *ca, singlecomplex *cx, integer *35incx, singlecomplex *cy, integer *incy)36{37/* System generated locals */38integer i__1, i__2, i__3, i__4;39singlecomplex q__1, q__2;4041/* Local variables */42static integer i__, ix, iy;43extern doublereal scabs1_(singlecomplex *);444546/*47Purpose48=======4950CAXPY constant times a vector plus a vector.5152Further Details53===============5455jack dongarra, linpack, 3/11/78.56modified 12/3/93, array(1) declarations changed to array(*)5758=====================================================================59*/6061/* Parameter adjustments */62--cy;63--cx;6465/* Function Body */66if (*n <= 0) {67return 0;68}69if (scabs1_(ca) == 0.f) {70return 0;71}72if (*incx == 1 && *incy == 1) {73goto L20;74}7576/*77code for unequal increments or equal increments78not equal to 179*/8081ix = 1;82iy = 1;83if (*incx < 0) {84ix = (-(*n) + 1) * *incx + 1;85}86if (*incy < 0) {87iy = (-(*n) + 1) * *incy + 1;88}89i__1 = *n;90for (i__ = 1; i__ <= i__1; ++i__) {91i__2 = iy;92i__3 = iy;93i__4 = ix;94q__2.r = ca->r * cx[i__4].r - ca->i * cx[i__4].i, q__2.i = ca->r * cx[95i__4].i + ca->i * cx[i__4].r;96q__1.r = cy[i__3].r + q__2.r, q__1.i = cy[i__3].i + q__2.i;97cy[i__2].r = q__1.r, cy[i__2].i = q__1.i;98ix += *incx;99iy += *incy;100/* L10: */101}102return 0;103104/* code for both increments equal to 1 */105106L20:107i__1 = *n;108for (i__ = 1; i__ <= i__1; ++i__) {109i__2 = i__;110i__3 = i__;111i__4 = i__;112q__2.r = ca->r * cx[i__4].r - ca->i * cx[i__4].i, q__2.i = ca->r * cx[113i__4].i + ca->i * cx[i__4].r;114q__1.r = cy[i__3].r + q__2.r, q__1.i = cy[i__3].i + q__2.i;115cy[i__2].r = q__1.r, cy[i__2].i = q__1.i;116/* L30: */117}118return 0;119} /* caxpy_ */120121/* Subroutine */ int ccopy_(integer *n, singlecomplex *cx, integer *incx, singlecomplex *122cy, integer *incy)123{124/* System generated locals */125integer i__1, i__2, i__3;126127/* Local variables */128static integer i__, ix, iy;129130131/*132Purpose133=======134135CCOPY copies a vector x to a vector y.136137Further Details138===============139140jack dongarra, linpack, 3/11/78.141modified 12/3/93, array(1) declarations changed to array(*)142143=====================================================================144*/145146/* Parameter adjustments */147--cy;148--cx;149150/* Function Body */151if (*n <= 0) {152return 0;153}154if (*incx == 1 && *incy == 1) {155goto L20;156}157158/*159code for unequal increments or equal increments160not equal to 1161*/162163ix = 1;164iy = 1;165if (*incx < 0) {166ix = (-(*n) + 1) * *incx + 1;167}168if (*incy < 0) {169iy = (-(*n) + 1) * *incy + 1;170}171i__1 = *n;172for (i__ = 1; i__ <= i__1; ++i__) {173i__2 = iy;174i__3 = ix;175cy[i__2].r = cx[i__3].r, cy[i__2].i = cx[i__3].i;176ix += *incx;177iy += *incy;178/* L10: */179}180return 0;181182/* code for both increments equal to 1 */183184L20:185i__1 = *n;186for (i__ = 1; i__ <= i__1; ++i__) {187i__2 = i__;188i__3 = i__;189cy[i__2].r = cx[i__3].r, cy[i__2].i = cx[i__3].i;190/* L30: */191}192return 0;193} /* ccopy_ */194195/* Complex */ VOID cdotc_(singlecomplex * ret_val, integer *n, singlecomplex *cx, integer196*incx, singlecomplex *cy, integer *incy)197{198/* System generated locals */199integer i__1, i__2;200singlecomplex q__1, q__2, q__3;201202/* Local variables */203static integer i__, ix, iy;204static singlecomplex ctemp;205206207/*208Purpose209=======210211forms the dot product of two vectors, conjugating the first212vector.213214Further Details215===============216217jack dongarra, linpack, 3/11/78.218modified 12/3/93, array(1) declarations changed to array(*)219220=====================================================================221*/222223/* Parameter adjustments */224--cy;225--cx;226227/* Function Body */228ctemp.r = 0.f, ctemp.i = 0.f;229ret_val->r = 0.f, ret_val->i = 0.f;230if (*n <= 0) {231return ;232}233if (*incx == 1 && *incy == 1) {234goto L20;235}236237/*238code for unequal increments or equal increments239not equal to 1240*/241242ix = 1;243iy = 1;244if (*incx < 0) {245ix = (-(*n) + 1) * *incx + 1;246}247if (*incy < 0) {248iy = (-(*n) + 1) * *incy + 1;249}250i__1 = *n;251for (i__ = 1; i__ <= i__1; ++i__) {252r_cnjg(&q__3, &cx[ix]);253i__2 = iy;254q__2.r = q__3.r * cy[i__2].r - q__3.i * cy[i__2].i, q__2.i = q__3.r *255cy[i__2].i + q__3.i * cy[i__2].r;256q__1.r = ctemp.r + q__2.r, q__1.i = ctemp.i + q__2.i;257ctemp.r = q__1.r, ctemp.i = q__1.i;258ix += *incx;259iy += *incy;260/* L10: */261}262ret_val->r = ctemp.r, ret_val->i = ctemp.i;263return ;264265/* code for both increments equal to 1 */266267L20:268i__1 = *n;269for (i__ = 1; i__ <= i__1; ++i__) {270r_cnjg(&q__3, &cx[i__]);271i__2 = i__;272q__2.r = q__3.r * cy[i__2].r - q__3.i * cy[i__2].i, q__2.i = q__3.r *273cy[i__2].i + q__3.i * cy[i__2].r;274q__1.r = ctemp.r + q__2.r, q__1.i = ctemp.i + q__2.i;275ctemp.r = q__1.r, ctemp.i = q__1.i;276/* L30: */277}278ret_val->r = ctemp.r, ret_val->i = ctemp.i;279return ;280} /* cdotc_ */281282/* Complex */ VOID cdotu_(singlecomplex * ret_val, integer *n, singlecomplex *cx, integer283*incx, singlecomplex *cy, integer *incy)284{285/* System generated locals */286integer i__1, i__2, i__3;287singlecomplex q__1, q__2;288289/* Local variables */290static integer i__, ix, iy;291static singlecomplex ctemp;292293294/*295Purpose296=======297298CDOTU forms the dot product of two vectors.299300Further Details301===============302303jack dongarra, linpack, 3/11/78.304modified 12/3/93, array(1) declarations changed to array(*)305306=====================================================================307*/308309/* Parameter adjustments */310--cy;311--cx;312313/* Function Body */314ctemp.r = 0.f, ctemp.i = 0.f;315ret_val->r = 0.f, ret_val->i = 0.f;316if (*n <= 0) {317return ;318}319if (*incx == 1 && *incy == 1) {320goto L20;321}322323/*324code for unequal increments or equal increments325not equal to 1326*/327328ix = 1;329iy = 1;330if (*incx < 0) {331ix = (-(*n) + 1) * *incx + 1;332}333if (*incy < 0) {334iy = (-(*n) + 1) * *incy + 1;335}336i__1 = *n;337for (i__ = 1; i__ <= i__1; ++i__) {338i__2 = ix;339i__3 = iy;340q__2.r = cx[i__2].r * cy[i__3].r - cx[i__2].i * cy[i__3].i, q__2.i =341cx[i__2].r * cy[i__3].i + cx[i__2].i * cy[i__3].r;342q__1.r = ctemp.r + q__2.r, q__1.i = ctemp.i + q__2.i;343ctemp.r = q__1.r, ctemp.i = q__1.i;344ix += *incx;345iy += *incy;346/* L10: */347}348ret_val->r = ctemp.r, ret_val->i = ctemp.i;349return ;350351/* code for both increments equal to 1 */352353L20:354i__1 = *n;355for (i__ = 1; i__ <= i__1; ++i__) {356i__2 = i__;357i__3 = i__;358q__2.r = cx[i__2].r * cy[i__3].r - cx[i__2].i * cy[i__3].i, q__2.i =359cx[i__2].r * cy[i__3].i + cx[i__2].i * cy[i__3].r;360q__1.r = ctemp.r + q__2.r, q__1.i = ctemp.i + q__2.i;361ctemp.r = q__1.r, ctemp.i = q__1.i;362/* L30: */363}364ret_val->r = ctemp.r, ret_val->i = ctemp.i;365return ;366} /* cdotu_ */367368/* Subroutine */ int cgemm_(char *transa, char *transb, integer *m, integer *369n, integer *k, singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *b,370integer *ldb, singlecomplex *beta, singlecomplex *c__, integer *ldc)371{372/* System generated locals */373integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,374i__3, i__4, i__5, i__6;375singlecomplex q__1, q__2, q__3, q__4;376377/* Local variables */378static integer i__, j, l, info;379static logical nota, notb;380static singlecomplex temp;381static logical conja, conjb;382extern logical lsame_(char *, char *);383static integer nrowa, nrowb;384extern /* Subroutine */ int xerbla_(char *, integer *);385386387/*388Purpose389=======390391CGEMM performs one of the matrix-matrix operations392393C := alpha*op( A )*op( B ) + beta*C,394395where op( X ) is one of396397op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ),398399alpha and beta are scalars, and A, B and C are matrices, with op( A )400an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.401402Arguments403==========404405TRANSA - CHARACTER*1.406On entry, TRANSA specifies the form of op( A ) to be used in407the matrix multiplication as follows:408409TRANSA = 'N' or 'n', op( A ) = A.410411TRANSA = 'T' or 't', op( A ) = A'.412413TRANSA = 'C' or 'c', op( A ) = conjg( A' ).414415Unchanged on exit.416417TRANSB - CHARACTER*1.418On entry, TRANSB specifies the form of op( B ) to be used in419the matrix multiplication as follows:420421TRANSB = 'N' or 'n', op( B ) = B.422423TRANSB = 'T' or 't', op( B ) = B'.424425TRANSB = 'C' or 'c', op( B ) = conjg( B' ).426427Unchanged on exit.428429M - INTEGER.430On entry, M specifies the number of rows of the matrix431op( A ) and of the matrix C. M must be at least zero.432Unchanged on exit.433434N - INTEGER.435On entry, N specifies the number of columns of the matrix436op( B ) and the number of columns of the matrix C. N must be437at least zero.438Unchanged on exit.439440K - INTEGER.441On entry, K specifies the number of columns of the matrix442op( A ) and the number of rows of the matrix op( B ). K must443be at least zero.444Unchanged on exit.445446ALPHA - COMPLEX .447On entry, ALPHA specifies the scalar alpha.448Unchanged on exit.449450A - COMPLEX array of DIMENSION ( LDA, ka ), where ka is451k when TRANSA = 'N' or 'n', and is m otherwise.452Before entry with TRANSA = 'N' or 'n', the leading m by k453part of the array A must contain the matrix A, otherwise454the leading k by m part of the array A must contain the455matrix A.456Unchanged on exit.457458LDA - INTEGER.459On entry, LDA specifies the first dimension of A as declared460in the calling (sub) program. When TRANSA = 'N' or 'n' then461LDA must be at least max( 1, m ), otherwise LDA must be at462least max( 1, k ).463Unchanged on exit.464465B - COMPLEX array of DIMENSION ( LDB, kb ), where kb is466n when TRANSB = 'N' or 'n', and is k otherwise.467Before entry with TRANSB = 'N' or 'n', the leading k by n468part of the array B must contain the matrix B, otherwise469the leading n by k part of the array B must contain the470matrix B.471Unchanged on exit.472473LDB - INTEGER.474On entry, LDB specifies the first dimension of B as declared475in the calling (sub) program. When TRANSB = 'N' or 'n' then476LDB must be at least max( 1, k ), otherwise LDB must be at477least max( 1, n ).478Unchanged on exit.479480BETA - COMPLEX .481On entry, BETA specifies the scalar beta. When BETA is482supplied as zero then C need not be set on input.483Unchanged on exit.484485C - COMPLEX array of DIMENSION ( LDC, n ).486Before entry, the leading m by n part of the array C must487contain the matrix C, except when beta is zero, in which488case C need not be set on entry.489On exit, the array C is overwritten by the m by n matrix490( alpha*op( A )*op( B ) + beta*C ).491492LDC - INTEGER.493On entry, LDC specifies the first dimension of C as declared494in the calling (sub) program. LDC must be at least495max( 1, m ).496Unchanged on exit.497498Further Details499===============500501Level 3 Blas routine.502503-- Written on 8-February-1989.504Jack Dongarra, Argonne National Laboratory.505Iain Duff, AERE Harwell.506Jeremy Du Croz, Numerical Algorithms Group Ltd.507Sven Hammarling, Numerical Algorithms Group Ltd.508509=====================================================================510511512Set NOTA and NOTB as true if A and B respectively are not513conjugated or transposed, set CONJA and CONJB as true if A and514B respectively are to be transposed but not conjugated and set515NROWA and NROWB as the number of rows and columns of A516and the number of rows of B respectively.517*/518519/* Parameter adjustments */520a_dim1 = *lda;521a_offset = 1 + a_dim1;522a -= a_offset;523b_dim1 = *ldb;524b_offset = 1 + b_dim1;525b -= b_offset;526c_dim1 = *ldc;527c_offset = 1 + c_dim1;528c__ -= c_offset;529530/* Function Body */531nota = lsame_(transa, "N");532notb = lsame_(transb, "N");533conja = lsame_(transa, "C");534conjb = lsame_(transb, "C");535if (nota) {536nrowa = *m;537} else {538nrowa = *k;539}540if (notb) {541nrowb = *k;542} else {543nrowb = *n;544}545546/* Test the input parameters. */547548info = 0;549if (! nota && ! conja && ! lsame_(transa, "T")) {550info = 1;551} else if (! notb && ! conjb && ! lsame_(transb, "T")) {552info = 2;553} else if (*m < 0) {554info = 3;555} else if (*n < 0) {556info = 4;557} else if (*k < 0) {558info = 5;559} else if (*lda < max(1,nrowa)) {560info = 8;561} else if (*ldb < max(1,nrowb)) {562info = 10;563} else if (*ldc < max(1,*m)) {564info = 13;565}566if (info != 0) {567xerbla_("CGEMM ", &info);568return 0;569}570571/* Quick return if possible. */572573if (*m == 0 || *n == 0 || (alpha->r == 0.f && alpha->i == 0.f || *k == 0)574&& (beta->r == 1.f && beta->i == 0.f)) {575return 0;576}577578/* And when alpha.eq.zero. */579580if (alpha->r == 0.f && alpha->i == 0.f) {581if (beta->r == 0.f && beta->i == 0.f) {582i__1 = *n;583for (j = 1; j <= i__1; ++j) {584i__2 = *m;585for (i__ = 1; i__ <= i__2; ++i__) {586i__3 = i__ + j * c_dim1;587c__[i__3].r = 0.f, c__[i__3].i = 0.f;588/* L10: */589}590/* L20: */591}592} else {593i__1 = *n;594for (j = 1; j <= i__1; ++j) {595i__2 = *m;596for (i__ = 1; i__ <= i__2; ++i__) {597i__3 = i__ + j * c_dim1;598i__4 = i__ + j * c_dim1;599q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4].i,600q__1.i = beta->r * c__[i__4].i + beta->i * c__[601i__4].r;602c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;603/* L30: */604}605/* L40: */606}607}608return 0;609}610611/* Start the operations. */612613if (notb) {614if (nota) {615616/* Form C := alpha*A*B + beta*C. */617618i__1 = *n;619for (j = 1; j <= i__1; ++j) {620if (beta->r == 0.f && beta->i == 0.f) {621i__2 = *m;622for (i__ = 1; i__ <= i__2; ++i__) {623i__3 = i__ + j * c_dim1;624c__[i__3].r = 0.f, c__[i__3].i = 0.f;625/* L50: */626}627} else if (beta->r != 1.f || beta->i != 0.f) {628i__2 = *m;629for (i__ = 1; i__ <= i__2; ++i__) {630i__3 = i__ + j * c_dim1;631i__4 = i__ + j * c_dim1;632q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]633.i, q__1.i = beta->r * c__[i__4].i + beta->i *634c__[i__4].r;635c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;636/* L60: */637}638}639i__2 = *k;640for (l = 1; l <= i__2; ++l) {641i__3 = l + j * b_dim1;642if (b[i__3].r != 0.f || b[i__3].i != 0.f) {643i__3 = l + j * b_dim1;644q__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,645q__1.i = alpha->r * b[i__3].i + alpha->i * b[646i__3].r;647temp.r = q__1.r, temp.i = q__1.i;648i__3 = *m;649for (i__ = 1; i__ <= i__3; ++i__) {650i__4 = i__ + j * c_dim1;651i__5 = i__ + j * c_dim1;652i__6 = i__ + l * a_dim1;653q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,654q__2.i = temp.r * a[i__6].i + temp.i * a[655i__6].r;656q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]657.i + q__2.i;658c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;659/* L70: */660}661}662/* L80: */663}664/* L90: */665}666} else if (conja) {667668/* Form C := alpha*conjg( A' )*B + beta*C. */669670i__1 = *n;671for (j = 1; j <= i__1; ++j) {672i__2 = *m;673for (i__ = 1; i__ <= i__2; ++i__) {674temp.r = 0.f, temp.i = 0.f;675i__3 = *k;676for (l = 1; l <= i__3; ++l) {677r_cnjg(&q__3, &a[l + i__ * a_dim1]);678i__4 = l + j * b_dim1;679q__2.r = q__3.r * b[i__4].r - q__3.i * b[i__4].i,680q__2.i = q__3.r * b[i__4].i + q__3.i * b[i__4]681.r;682q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;683temp.r = q__1.r, temp.i = q__1.i;684/* L100: */685}686if (beta->r == 0.f && beta->i == 0.f) {687i__3 = i__ + j * c_dim1;688q__1.r = alpha->r * temp.r - alpha->i * temp.i,689q__1.i = alpha->r * temp.i + alpha->i *690temp.r;691c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;692} else {693i__3 = i__ + j * c_dim1;694q__2.r = alpha->r * temp.r - alpha->i * temp.i,695q__2.i = alpha->r * temp.i + alpha->i *696temp.r;697i__4 = i__ + j * c_dim1;698q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]699.i, q__3.i = beta->r * c__[i__4].i + beta->i *700c__[i__4].r;701q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;702c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;703}704/* L110: */705}706/* L120: */707}708} else {709710/* Form C := alpha*A'*B + beta*C */711712i__1 = *n;713for (j = 1; j <= i__1; ++j) {714i__2 = *m;715for (i__ = 1; i__ <= i__2; ++i__) {716temp.r = 0.f, temp.i = 0.f;717i__3 = *k;718for (l = 1; l <= i__3; ++l) {719i__4 = l + i__ * a_dim1;720i__5 = l + j * b_dim1;721q__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]722.i, q__2.i = a[i__4].r * b[i__5].i + a[i__4]723.i * b[i__5].r;724q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;725temp.r = q__1.r, temp.i = q__1.i;726/* L130: */727}728if (beta->r == 0.f && beta->i == 0.f) {729i__3 = i__ + j * c_dim1;730q__1.r = alpha->r * temp.r - alpha->i * temp.i,731q__1.i = alpha->r * temp.i + alpha->i *732temp.r;733c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;734} else {735i__3 = i__ + j * c_dim1;736q__2.r = alpha->r * temp.r - alpha->i * temp.i,737q__2.i = alpha->r * temp.i + alpha->i *738temp.r;739i__4 = i__ + j * c_dim1;740q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]741.i, q__3.i = beta->r * c__[i__4].i + beta->i *742c__[i__4].r;743q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;744c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;745}746/* L140: */747}748/* L150: */749}750}751} else if (nota) {752if (conjb) {753754/* Form C := alpha*A*conjg( B' ) + beta*C. */755756i__1 = *n;757for (j = 1; j <= i__1; ++j) {758if (beta->r == 0.f && beta->i == 0.f) {759i__2 = *m;760for (i__ = 1; i__ <= i__2; ++i__) {761i__3 = i__ + j * c_dim1;762c__[i__3].r = 0.f, c__[i__3].i = 0.f;763/* L160: */764}765} else if (beta->r != 1.f || beta->i != 0.f) {766i__2 = *m;767for (i__ = 1; i__ <= i__2; ++i__) {768i__3 = i__ + j * c_dim1;769i__4 = i__ + j * c_dim1;770q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]771.i, q__1.i = beta->r * c__[i__4].i + beta->i *772c__[i__4].r;773c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;774/* L170: */775}776}777i__2 = *k;778for (l = 1; l <= i__2; ++l) {779i__3 = j + l * b_dim1;780if (b[i__3].r != 0.f || b[i__3].i != 0.f) {781r_cnjg(&q__2, &b[j + l * b_dim1]);782q__1.r = alpha->r * q__2.r - alpha->i * q__2.i,783q__1.i = alpha->r * q__2.i + alpha->i *784q__2.r;785temp.r = q__1.r, temp.i = q__1.i;786i__3 = *m;787for (i__ = 1; i__ <= i__3; ++i__) {788i__4 = i__ + j * c_dim1;789i__5 = i__ + j * c_dim1;790i__6 = i__ + l * a_dim1;791q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,792q__2.i = temp.r * a[i__6].i + temp.i * a[793i__6].r;794q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]795.i + q__2.i;796c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;797/* L180: */798}799}800/* L190: */801}802/* L200: */803}804} else {805806/* Form C := alpha*A*B' + beta*C */807808i__1 = *n;809for (j = 1; j <= i__1; ++j) {810if (beta->r == 0.f && beta->i == 0.f) {811i__2 = *m;812for (i__ = 1; i__ <= i__2; ++i__) {813i__3 = i__ + j * c_dim1;814c__[i__3].r = 0.f, c__[i__3].i = 0.f;815/* L210: */816}817} else if (beta->r != 1.f || beta->i != 0.f) {818i__2 = *m;819for (i__ = 1; i__ <= i__2; ++i__) {820i__3 = i__ + j * c_dim1;821i__4 = i__ + j * c_dim1;822q__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]823.i, q__1.i = beta->r * c__[i__4].i + beta->i *824c__[i__4].r;825c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;826/* L220: */827}828}829i__2 = *k;830for (l = 1; l <= i__2; ++l) {831i__3 = j + l * b_dim1;832if (b[i__3].r != 0.f || b[i__3].i != 0.f) {833i__3 = j + l * b_dim1;834q__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,835q__1.i = alpha->r * b[i__3].i + alpha->i * b[836i__3].r;837temp.r = q__1.r, temp.i = q__1.i;838i__3 = *m;839for (i__ = 1; i__ <= i__3; ++i__) {840i__4 = i__ + j * c_dim1;841i__5 = i__ + j * c_dim1;842i__6 = i__ + l * a_dim1;843q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,844q__2.i = temp.r * a[i__6].i + temp.i * a[845i__6].r;846q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]847.i + q__2.i;848c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;849/* L230: */850}851}852/* L240: */853}854/* L250: */855}856}857} else if (conja) {858if (conjb) {859860/* Form C := alpha*conjg( A' )*conjg( B' ) + beta*C. */861862i__1 = *n;863for (j = 1; j <= i__1; ++j) {864i__2 = *m;865for (i__ = 1; i__ <= i__2; ++i__) {866temp.r = 0.f, temp.i = 0.f;867i__3 = *k;868for (l = 1; l <= i__3; ++l) {869r_cnjg(&q__3, &a[l + i__ * a_dim1]);870r_cnjg(&q__4, &b[j + l * b_dim1]);871q__2.r = q__3.r * q__4.r - q__3.i * q__4.i, q__2.i =872q__3.r * q__4.i + q__3.i * q__4.r;873q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;874temp.r = q__1.r, temp.i = q__1.i;875/* L260: */876}877if (beta->r == 0.f && beta->i == 0.f) {878i__3 = i__ + j * c_dim1;879q__1.r = alpha->r * temp.r - alpha->i * temp.i,880q__1.i = alpha->r * temp.i + alpha->i *881temp.r;882c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;883} else {884i__3 = i__ + j * c_dim1;885q__2.r = alpha->r * temp.r - alpha->i * temp.i,886q__2.i = alpha->r * temp.i + alpha->i *887temp.r;888i__4 = i__ + j * c_dim1;889q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]890.i, q__3.i = beta->r * c__[i__4].i + beta->i *891c__[i__4].r;892q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;893c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;894}895/* L270: */896}897/* L280: */898}899} else {900901/* Form C := alpha*conjg( A' )*B' + beta*C */902903i__1 = *n;904for (j = 1; j <= i__1; ++j) {905i__2 = *m;906for (i__ = 1; i__ <= i__2; ++i__) {907temp.r = 0.f, temp.i = 0.f;908i__3 = *k;909for (l = 1; l <= i__3; ++l) {910r_cnjg(&q__3, &a[l + i__ * a_dim1]);911i__4 = j + l * b_dim1;912q__2.r = q__3.r * b[i__4].r - q__3.i * b[i__4].i,913q__2.i = q__3.r * b[i__4].i + q__3.i * b[i__4]914.r;915q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;916temp.r = q__1.r, temp.i = q__1.i;917/* L290: */918}919if (beta->r == 0.f && beta->i == 0.f) {920i__3 = i__ + j * c_dim1;921q__1.r = alpha->r * temp.r - alpha->i * temp.i,922q__1.i = alpha->r * temp.i + alpha->i *923temp.r;924c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;925} else {926i__3 = i__ + j * c_dim1;927q__2.r = alpha->r * temp.r - alpha->i * temp.i,928q__2.i = alpha->r * temp.i + alpha->i *929temp.r;930i__4 = i__ + j * c_dim1;931q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]932.i, q__3.i = beta->r * c__[i__4].i + beta->i *933c__[i__4].r;934q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;935c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;936}937/* L300: */938}939/* L310: */940}941}942} else {943if (conjb) {944945/* Form C := alpha*A'*conjg( B' ) + beta*C */946947i__1 = *n;948for (j = 1; j <= i__1; ++j) {949i__2 = *m;950for (i__ = 1; i__ <= i__2; ++i__) {951temp.r = 0.f, temp.i = 0.f;952i__3 = *k;953for (l = 1; l <= i__3; ++l) {954i__4 = l + i__ * a_dim1;955r_cnjg(&q__3, &b[j + l * b_dim1]);956q__2.r = a[i__4].r * q__3.r - a[i__4].i * q__3.i,957q__2.i = a[i__4].r * q__3.i + a[i__4].i *958q__3.r;959q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;960temp.r = q__1.r, temp.i = q__1.i;961/* L320: */962}963if (beta->r == 0.f && beta->i == 0.f) {964i__3 = i__ + j * c_dim1;965q__1.r = alpha->r * temp.r - alpha->i * temp.i,966q__1.i = alpha->r * temp.i + alpha->i *967temp.r;968c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;969} else {970i__3 = i__ + j * c_dim1;971q__2.r = alpha->r * temp.r - alpha->i * temp.i,972q__2.i = alpha->r * temp.i + alpha->i *973temp.r;974i__4 = i__ + j * c_dim1;975q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]976.i, q__3.i = beta->r * c__[i__4].i + beta->i *977c__[i__4].r;978q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;979c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;980}981/* L330: */982}983/* L340: */984}985} else {986987/* Form C := alpha*A'*B' + beta*C */988989i__1 = *n;990for (j = 1; j <= i__1; ++j) {991i__2 = *m;992for (i__ = 1; i__ <= i__2; ++i__) {993temp.r = 0.f, temp.i = 0.f;994i__3 = *k;995for (l = 1; l <= i__3; ++l) {996i__4 = l + i__ * a_dim1;997i__5 = j + l * b_dim1;998q__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]999.i, q__2.i = a[i__4].r * b[i__5].i + a[i__4]1000.i * b[i__5].r;1001q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;1002temp.r = q__1.r, temp.i = q__1.i;1003/* L350: */1004}1005if (beta->r == 0.f && beta->i == 0.f) {1006i__3 = i__ + j * c_dim1;1007q__1.r = alpha->r * temp.r - alpha->i * temp.i,1008q__1.i = alpha->r * temp.i + alpha->i *1009temp.r;1010c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;1011} else {1012i__3 = i__ + j * c_dim1;1013q__2.r = alpha->r * temp.r - alpha->i * temp.i,1014q__2.i = alpha->r * temp.i + alpha->i *1015temp.r;1016i__4 = i__ + j * c_dim1;1017q__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]1018.i, q__3.i = beta->r * c__[i__4].i + beta->i *1019c__[i__4].r;1020q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;1021c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;1022}1023/* L360: */1024}1025/* L370: */1026}1027}1028}10291030return 0;10311032/* End of CGEMM . */10331034} /* cgemm_ */10351036/* Subroutine */ int cgemv_(char *trans, integer *m, integer *n, singlecomplex *1037alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *1038beta, singlecomplex *y, integer *incy)1039{1040/* System generated locals */1041integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;1042singlecomplex q__1, q__2, q__3;10431044/* Local variables */1045static integer i__, j, ix, iy, jx, jy, kx, ky, info;1046static singlecomplex temp;1047static integer lenx, leny;1048extern logical lsame_(char *, char *);1049extern /* Subroutine */ int xerbla_(char *, integer *);1050static logical noconj;105110521053/*1054Purpose1055=======10561057CGEMV performs one of the matrix-vector operations10581059y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or10601061y := alpha*conjg( A' )*x + beta*y,10621063where alpha and beta are scalars, x and y are vectors and A is an1064m by n matrix.10651066Arguments1067==========10681069TRANS - CHARACTER*1.1070On entry, TRANS specifies the operation to be performed as1071follows:10721073TRANS = 'N' or 'n' y := alpha*A*x + beta*y.10741075TRANS = 'T' or 't' y := alpha*A'*x + beta*y.10761077TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + beta*y.10781079Unchanged on exit.10801081M - INTEGER.1082On entry, M specifies the number of rows of the matrix A.1083M must be at least zero.1084Unchanged on exit.10851086N - INTEGER.1087On entry, N specifies the number of columns of the matrix A.1088N must be at least zero.1089Unchanged on exit.10901091ALPHA - COMPLEX .1092On entry, ALPHA specifies the scalar alpha.1093Unchanged on exit.10941095A - COMPLEX array of DIMENSION ( LDA, n ).1096Before entry, the leading m by n part of the array A must1097contain the matrix of coefficients.1098Unchanged on exit.10991100LDA - INTEGER.1101On entry, LDA specifies the first dimension of A as declared1102in the calling (sub) program. LDA must be at least1103max( 1, m ).1104Unchanged on exit.11051106X - COMPLEX array of DIMENSION at least1107( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'1108and at least1109( 1 + ( m - 1 )*abs( INCX ) ) otherwise.1110Before entry, the incremented array X must contain the1111vector x.1112Unchanged on exit.11131114INCX - INTEGER.1115On entry, INCX specifies the increment for the elements of1116X. INCX must not be zero.1117Unchanged on exit.11181119BETA - COMPLEX .1120On entry, BETA specifies the scalar beta. When BETA is1121supplied as zero then Y need not be set on input.1122Unchanged on exit.11231124Y - COMPLEX array of DIMENSION at least1125( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'1126and at least1127( 1 + ( n - 1 )*abs( INCY ) ) otherwise.1128Before entry with BETA non-zero, the incremented array Y1129must contain the vector y. On exit, Y is overwritten by the1130updated vector y.11311132INCY - INTEGER.1133On entry, INCY specifies the increment for the elements of1134Y. INCY must not be zero.1135Unchanged on exit.11361137Further Details1138===============11391140Level 2 Blas routine.11411142-- Written on 22-October-1986.1143Jack Dongarra, Argonne National Lab.1144Jeremy Du Croz, Nag Central Office.1145Sven Hammarling, Nag Central Office.1146Richard Hanson, Sandia National Labs.11471148=====================================================================114911501151Test the input parameters.1152*/11531154/* Parameter adjustments */1155a_dim1 = *lda;1156a_offset = 1 + a_dim1;1157a -= a_offset;1158--x;1159--y;11601161/* Function Body */1162info = 0;1163if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")1164) {1165info = 1;1166} else if (*m < 0) {1167info = 2;1168} else if (*n < 0) {1169info = 3;1170} else if (*lda < max(1,*m)) {1171info = 6;1172} else if (*incx == 0) {1173info = 8;1174} else if (*incy == 0) {1175info = 11;1176}1177if (info != 0) {1178xerbla_("CGEMV ", &info);1179return 0;1180}11811182/* Quick return if possible. */11831184if (*m == 0 || *n == 0 || alpha->r == 0.f && alpha->i == 0.f && (beta->r1185== 1.f && beta->i == 0.f)) {1186return 0;1187}11881189noconj = lsame_(trans, "T");11901191/*1192Set LENX and LENY, the lengths of the vectors x and y, and set1193up the start points in X and Y.1194*/11951196if (lsame_(trans, "N")) {1197lenx = *n;1198leny = *m;1199} else {1200lenx = *m;1201leny = *n;1202}1203if (*incx > 0) {1204kx = 1;1205} else {1206kx = 1 - (lenx - 1) * *incx;1207}1208if (*incy > 0) {1209ky = 1;1210} else {1211ky = 1 - (leny - 1) * *incy;1212}12131214/*1215Start the operations. In this version the elements of A are1216accessed sequentially with one pass through A.12171218First form y := beta*y.1219*/12201221if (beta->r != 1.f || beta->i != 0.f) {1222if (*incy == 1) {1223if (beta->r == 0.f && beta->i == 0.f) {1224i__1 = leny;1225for (i__ = 1; i__ <= i__1; ++i__) {1226i__2 = i__;1227y[i__2].r = 0.f, y[i__2].i = 0.f;1228/* L10: */1229}1230} else {1231i__1 = leny;1232for (i__ = 1; i__ <= i__1; ++i__) {1233i__2 = i__;1234i__3 = i__;1235q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,1236q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]1237.r;1238y[i__2].r = q__1.r, y[i__2].i = q__1.i;1239/* L20: */1240}1241}1242} else {1243iy = ky;1244if (beta->r == 0.f && beta->i == 0.f) {1245i__1 = leny;1246for (i__ = 1; i__ <= i__1; ++i__) {1247i__2 = iy;1248y[i__2].r = 0.f, y[i__2].i = 0.f;1249iy += *incy;1250/* L30: */1251}1252} else {1253i__1 = leny;1254for (i__ = 1; i__ <= i__1; ++i__) {1255i__2 = iy;1256i__3 = iy;1257q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,1258q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]1259.r;1260y[i__2].r = q__1.r, y[i__2].i = q__1.i;1261iy += *incy;1262/* L40: */1263}1264}1265}1266}1267if (alpha->r == 0.f && alpha->i == 0.f) {1268return 0;1269}1270if (lsame_(trans, "N")) {12711272/* Form y := alpha*A*x + y. */12731274jx = kx;1275if (*incy == 1) {1276i__1 = *n;1277for (j = 1; j <= i__1; ++j) {1278i__2 = jx;1279if (x[i__2].r != 0.f || x[i__2].i != 0.f) {1280i__2 = jx;1281q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,1282q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]1283.r;1284temp.r = q__1.r, temp.i = q__1.i;1285i__2 = *m;1286for (i__ = 1; i__ <= i__2; ++i__) {1287i__3 = i__;1288i__4 = i__;1289i__5 = i__ + j * a_dim1;1290q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,1291q__2.i = temp.r * a[i__5].i + temp.i * a[i__5]1292.r;1293q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i +1294q__2.i;1295y[i__3].r = q__1.r, y[i__3].i = q__1.i;1296/* L50: */1297}1298}1299jx += *incx;1300/* L60: */1301}1302} else {1303i__1 = *n;1304for (j = 1; j <= i__1; ++j) {1305i__2 = jx;1306if (x[i__2].r != 0.f || x[i__2].i != 0.f) {1307i__2 = jx;1308q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,1309q__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]1310.r;1311temp.r = q__1.r, temp.i = q__1.i;1312iy = ky;1313i__2 = *m;1314for (i__ = 1; i__ <= i__2; ++i__) {1315i__3 = iy;1316i__4 = iy;1317i__5 = i__ + j * a_dim1;1318q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,1319q__2.i = temp.r * a[i__5].i + temp.i * a[i__5]1320.r;1321q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i +1322q__2.i;1323y[i__3].r = q__1.r, y[i__3].i = q__1.i;1324iy += *incy;1325/* L70: */1326}1327}1328jx += *incx;1329/* L80: */1330}1331}1332} else {13331334/* Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y. */13351336jy = ky;1337if (*incx == 1) {1338i__1 = *n;1339for (j = 1; j <= i__1; ++j) {1340temp.r = 0.f, temp.i = 0.f;1341if (noconj) {1342i__2 = *m;1343for (i__ = 1; i__ <= i__2; ++i__) {1344i__3 = i__ + j * a_dim1;1345i__4 = i__;1346q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]1347.i, q__2.i = a[i__3].r * x[i__4].i + a[i__3]1348.i * x[i__4].r;1349q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;1350temp.r = q__1.r, temp.i = q__1.i;1351/* L90: */1352}1353} else {1354i__2 = *m;1355for (i__ = 1; i__ <= i__2; ++i__) {1356r_cnjg(&q__3, &a[i__ + j * a_dim1]);1357i__3 = i__;1358q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i,1359q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3]1360.r;1361q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;1362temp.r = q__1.r, temp.i = q__1.i;1363/* L100: */1364}1365}1366i__2 = jy;1367i__3 = jy;1368q__2.r = alpha->r * temp.r - alpha->i * temp.i, q__2.i =1369alpha->r * temp.i + alpha->i * temp.r;1370q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;1371y[i__2].r = q__1.r, y[i__2].i = q__1.i;1372jy += *incy;1373/* L110: */1374}1375} else {1376i__1 = *n;1377for (j = 1; j <= i__1; ++j) {1378temp.r = 0.f, temp.i = 0.f;1379ix = kx;1380if (noconj) {1381i__2 = *m;1382for (i__ = 1; i__ <= i__2; ++i__) {1383i__3 = i__ + j * a_dim1;1384i__4 = ix;1385q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]1386.i, q__2.i = a[i__3].r * x[i__4].i + a[i__3]1387.i * x[i__4].r;1388q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;1389temp.r = q__1.r, temp.i = q__1.i;1390ix += *incx;1391/* L120: */1392}1393} else {1394i__2 = *m;1395for (i__ = 1; i__ <= i__2; ++i__) {1396r_cnjg(&q__3, &a[i__ + j * a_dim1]);1397i__3 = ix;1398q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i,1399q__2.i = q__3.r * x[i__3].i + q__3.i * x[i__3]1400.r;1401q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;1402temp.r = q__1.r, temp.i = q__1.i;1403ix += *incx;1404/* L130: */1405}1406}1407i__2 = jy;1408i__3 = jy;1409q__2.r = alpha->r * temp.r - alpha->i * temp.i, q__2.i =1410alpha->r * temp.i + alpha->i * temp.r;1411q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;1412y[i__2].r = q__1.r, y[i__2].i = q__1.i;1413jy += *incy;1414/* L140: */1415}1416}1417}14181419return 0;14201421/* End of CGEMV . */14221423} /* cgemv_ */14241425/* Subroutine */ int cgerc_(integer *m, integer *n, singlecomplex *alpha, singlecomplex *1426x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda)1427{1428/* System generated locals */1429integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;1430singlecomplex q__1, q__2;14311432/* Local variables */1433static integer i__, j, ix, jy, kx, info;1434static singlecomplex temp;1435extern /* Subroutine */ int xerbla_(char *, integer *);143614371438/*1439Purpose1440=======14411442CGERC performs the rank 1 operation14431444A := alpha*x*conjg( y' ) + A,14451446where alpha is a scalar, x is an m element vector, y is an n element1447vector and A is an m by n matrix.14481449Arguments1450==========14511452M - INTEGER.1453On entry, M specifies the number of rows of the matrix A.1454M must be at least zero.1455Unchanged on exit.14561457N - INTEGER.1458On entry, N specifies the number of columns of the matrix A.1459N must be at least zero.1460Unchanged on exit.14611462ALPHA - COMPLEX .1463On entry, ALPHA specifies the scalar alpha.1464Unchanged on exit.14651466X - COMPLEX array of dimension at least1467( 1 + ( m - 1 )*abs( INCX ) ).1468Before entry, the incremented array X must contain the m1469element vector x.1470Unchanged on exit.14711472INCX - INTEGER.1473On entry, INCX specifies the increment for the elements of1474X. INCX must not be zero.1475Unchanged on exit.14761477Y - COMPLEX array of dimension at least1478( 1 + ( n - 1 )*abs( INCY ) ).1479Before entry, the incremented array Y must contain the n1480element vector y.1481Unchanged on exit.14821483INCY - INTEGER.1484On entry, INCY specifies the increment for the elements of1485Y. INCY must not be zero.1486Unchanged on exit.14871488A - COMPLEX array of DIMENSION ( LDA, n ).1489Before entry, the leading m by n part of the array A must1490contain the matrix of coefficients. On exit, A is1491overwritten by the updated matrix.14921493LDA - INTEGER.1494On entry, LDA specifies the first dimension of A as declared1495in the calling (sub) program. LDA must be at least1496max( 1, m ).1497Unchanged on exit.14981499Further Details1500===============15011502Level 2 Blas routine.15031504-- Written on 22-October-1986.1505Jack Dongarra, Argonne National Lab.1506Jeremy Du Croz, Nag Central Office.1507Sven Hammarling, Nag Central Office.1508Richard Hanson, Sandia National Labs.15091510=====================================================================151115121513Test the input parameters.1514*/15151516/* Parameter adjustments */1517--x;1518--y;1519a_dim1 = *lda;1520a_offset = 1 + a_dim1;1521a -= a_offset;15221523/* Function Body */1524info = 0;1525if (*m < 0) {1526info = 1;1527} else if (*n < 0) {1528info = 2;1529} else if (*incx == 0) {1530info = 5;1531} else if (*incy == 0) {1532info = 7;1533} else if (*lda < max(1,*m)) {1534info = 9;1535}1536if (info != 0) {1537xerbla_("CGERC ", &info);1538return 0;1539}15401541/* Quick return if possible. */15421543if (*m == 0 || *n == 0 || alpha->r == 0.f && alpha->i == 0.f) {1544return 0;1545}15461547/*1548Start the operations. In this version the elements of A are1549accessed sequentially with one pass through A.1550*/15511552if (*incy > 0) {1553jy = 1;1554} else {1555jy = 1 - (*n - 1) * *incy;1556}1557if (*incx == 1) {1558i__1 = *n;1559for (j = 1; j <= i__1; ++j) {1560i__2 = jy;1561if (y[i__2].r != 0.f || y[i__2].i != 0.f) {1562r_cnjg(&q__2, &y[jy]);1563q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i =1564alpha->r * q__2.i + alpha->i * q__2.r;1565temp.r = q__1.r, temp.i = q__1.i;1566i__2 = *m;1567for (i__ = 1; i__ <= i__2; ++i__) {1568i__3 = i__ + j * a_dim1;1569i__4 = i__ + j * a_dim1;1570i__5 = i__;1571q__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, q__2.i =1572x[i__5].r * temp.i + x[i__5].i * temp.r;1573q__1.r = a[i__4].r + q__2.r, q__1.i = a[i__4].i + q__2.i;1574a[i__3].r = q__1.r, a[i__3].i = q__1.i;1575/* L10: */1576}1577}1578jy += *incy;1579/* L20: */1580}1581} else {1582if (*incx > 0) {1583kx = 1;1584} else {1585kx = 1 - (*m - 1) * *incx;1586}1587i__1 = *n;1588for (j = 1; j <= i__1; ++j) {1589i__2 = jy;1590if (y[i__2].r != 0.f || y[i__2].i != 0.f) {1591r_cnjg(&q__2, &y[jy]);1592q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i =1593alpha->r * q__2.i + alpha->i * q__2.r;1594temp.r = q__1.r, temp.i = q__1.i;1595ix = kx;1596i__2 = *m;1597for (i__ = 1; i__ <= i__2; ++i__) {1598i__3 = i__ + j * a_dim1;1599i__4 = i__ + j * a_dim1;1600i__5 = ix;1601q__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, q__2.i =1602x[i__5].r * temp.i + x[i__5].i * temp.r;1603q__1.r = a[i__4].r + q__2.r, q__1.i = a[i__4].i + q__2.i;1604a[i__3].r = q__1.r, a[i__3].i = q__1.i;1605ix += *incx;1606/* L30: */1607}1608}1609jy += *incy;1610/* L40: */1611}1612}16131614return 0;16151616/* End of CGERC . */16171618} /* cgerc_ */16191620/* Subroutine */ int cgeru_(integer *m, integer *n, singlecomplex *alpha, singlecomplex *1621x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda)1622{1623/* System generated locals */1624integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;1625singlecomplex q__1, q__2;16261627/* Local variables */1628static integer i__, j, ix, jy, kx, info;1629static singlecomplex temp;1630extern /* Subroutine */ int xerbla_(char *, integer *);163116321633/*1634Purpose1635=======16361637CGERU performs the rank 1 operation16381639A := alpha*x*y' + A,16401641where alpha is a scalar, x is an m element vector, y is an n element1642vector and A is an m by n matrix.16431644Arguments1645==========16461647M - INTEGER.1648On entry, M specifies the number of rows of the matrix A.1649M must be at least zero.1650Unchanged on exit.16511652N - INTEGER.1653On entry, N specifies the number of columns of the matrix A.1654N must be at least zero.1655Unchanged on exit.16561657ALPHA - COMPLEX .1658On entry, ALPHA specifies the scalar alpha.1659Unchanged on exit.16601661X - COMPLEX array of dimension at least1662( 1 + ( m - 1 )*abs( INCX ) ).1663Before entry, the incremented array X must contain the m1664element vector x.1665Unchanged on exit.16661667INCX - INTEGER.1668On entry, INCX specifies the increment for the elements of1669X. INCX must not be zero.1670Unchanged on exit.16711672Y - COMPLEX array of dimension at least1673( 1 + ( n - 1 )*abs( INCY ) ).1674Before entry, the incremented array Y must contain the n1675element vector y.1676Unchanged on exit.16771678INCY - INTEGER.1679On entry, INCY specifies the increment for the elements of1680Y. INCY must not be zero.1681Unchanged on exit.16821683A - COMPLEX array of DIMENSION ( LDA, n ).1684Before entry, the leading m by n part of the array A must1685contain the matrix of coefficients. On exit, A is1686overwritten by the updated matrix.16871688LDA - INTEGER.1689On entry, LDA specifies the first dimension of A as declared1690in the calling (sub) program. LDA must be at least1691max( 1, m ).1692Unchanged on exit.16931694Further Details1695===============16961697Level 2 Blas routine.16981699-- Written on 22-October-1986.1700Jack Dongarra, Argonne National Lab.1701Jeremy Du Croz, Nag Central Office.1702Sven Hammarling, Nag Central Office.1703Richard Hanson, Sandia National Labs.17041705=====================================================================170617071708Test the input parameters.1709*/17101711/* Parameter adjustments */1712--x;1713--y;1714a_dim1 = *lda;1715a_offset = 1 + a_dim1;1716a -= a_offset;17171718/* Function Body */1719info = 0;1720if (*m < 0) {1721info = 1;1722} else if (*n < 0) {1723info = 2;1724} else if (*incx == 0) {1725info = 5;1726} else if (*incy == 0) {1727info = 7;1728} else if (*lda < max(1,*m)) {1729info = 9;1730}1731if (info != 0) {1732xerbla_("CGERU ", &info);1733return 0;1734}17351736/* Quick return if possible. */17371738if (*m == 0 || *n == 0 || alpha->r == 0.f && alpha->i == 0.f) {1739return 0;1740}17411742/*1743Start the operations. In this version the elements of A are1744accessed sequentially with one pass through A.1745*/17461747if (*incy > 0) {1748jy = 1;1749} else {1750jy = 1 - (*n - 1) * *incy;1751}1752if (*incx == 1) {1753i__1 = *n;1754for (j = 1; j <= i__1; ++j) {1755i__2 = jy;1756if (y[i__2].r != 0.f || y[i__2].i != 0.f) {1757i__2 = jy;1758q__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, q__1.i =1759alpha->r * y[i__2].i + alpha->i * y[i__2].r;1760temp.r = q__1.r, temp.i = q__1.i;1761i__2 = *m;1762for (i__ = 1; i__ <= i__2; ++i__) {1763i__3 = i__ + j * a_dim1;1764i__4 = i__ + j * a_dim1;1765i__5 = i__;1766q__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, q__2.i =1767x[i__5].r * temp.i + x[i__5].i * temp.r;1768q__1.r = a[i__4].r + q__2.r, q__1.i = a[i__4].i + q__2.i;1769a[i__3].r = q__1.r, a[i__3].i = q__1.i;1770/* L10: */1771}1772}1773jy += *incy;1774/* L20: */1775}1776} else {1777if (*incx > 0) {1778kx = 1;1779} else {1780kx = 1 - (*m - 1) * *incx;1781}1782i__1 = *n;1783for (j = 1; j <= i__1; ++j) {1784i__2 = jy;1785if (y[i__2].r != 0.f || y[i__2].i != 0.f) {1786i__2 = jy;1787q__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, q__1.i =1788alpha->r * y[i__2].i + alpha->i * y[i__2].r;1789temp.r = q__1.r, temp.i = q__1.i;1790ix = kx;1791i__2 = *m;1792for (i__ = 1; i__ <= i__2; ++i__) {1793i__3 = i__ + j * a_dim1;1794i__4 = i__ + j * a_dim1;1795i__5 = ix;1796q__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, q__2.i =1797x[i__5].r * temp.i + x[i__5].i * temp.r;1798q__1.r = a[i__4].r + q__2.r, q__1.i = a[i__4].i + q__2.i;1799a[i__3].r = q__1.r, a[i__3].i = q__1.i;1800ix += *incx;1801/* L30: */1802}1803}1804jy += *incy;1805/* L40: */1806}1807}18081809return 0;18101811/* End of CGERU . */18121813} /* cgeru_ */18141815/* Subroutine */ int chemv_(char *uplo, integer *n, singlecomplex *alpha, singlecomplex *1816a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y,1817integer *incy)1818{1819/* System generated locals */1820integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;1821real r__1;1822singlecomplex q__1, q__2, q__3, q__4;18231824/* Local variables */1825static integer i__, j, ix, iy, jx, jy, kx, ky, info;1826static singlecomplex temp1, temp2;1827extern logical lsame_(char *, char *);1828extern /* Subroutine */ int xerbla_(char *, integer *);182918301831/*1832Purpose1833=======18341835CHEMV performs the matrix-vector operation18361837y := alpha*A*x + beta*y,18381839where alpha and beta are scalars, x and y are n element vectors and1840A is an n by n hermitian matrix.18411842Arguments1843==========18441845UPLO - CHARACTER*1.1846On entry, UPLO specifies whether the upper or lower1847triangular part of the array A is to be referenced as1848follows:18491850UPLO = 'U' or 'u' Only the upper triangular part of A1851is to be referenced.18521853UPLO = 'L' or 'l' Only the lower triangular part of A1854is to be referenced.18551856Unchanged on exit.18571858N - INTEGER.1859On entry, N specifies the order of the matrix A.1860N must be at least zero.1861Unchanged on exit.18621863ALPHA - COMPLEX .1864On entry, ALPHA specifies the scalar alpha.1865Unchanged on exit.18661867A - COMPLEX array of DIMENSION ( LDA, n ).1868Before entry with UPLO = 'U' or 'u', the leading n by n1869upper triangular part of the array A must contain the upper1870triangular part of the hermitian matrix and the strictly1871lower triangular part of A is not referenced.1872Before entry with UPLO = 'L' or 'l', the leading n by n1873lower triangular part of the array A must contain the lower1874triangular part of the hermitian matrix and the strictly1875upper triangular part of A is not referenced.1876Note that the imaginary parts of the diagonal elements need1877not be set and are assumed to be zero.1878Unchanged on exit.18791880LDA - INTEGER.1881On entry, LDA specifies the first dimension of A as declared1882in the calling (sub) program. LDA must be at least1883max( 1, n ).1884Unchanged on exit.18851886X - COMPLEX array of dimension at least1887( 1 + ( n - 1 )*abs( INCX ) ).1888Before entry, the incremented array X must contain the n1889element vector x.1890Unchanged on exit.18911892INCX - INTEGER.1893On entry, INCX specifies the increment for the elements of1894X. INCX must not be zero.1895Unchanged on exit.18961897BETA - COMPLEX .1898On entry, BETA specifies the scalar beta. When BETA is1899supplied as zero then Y need not be set on input.1900Unchanged on exit.19011902Y - COMPLEX array of dimension at least1903( 1 + ( n - 1 )*abs( INCY ) ).1904Before entry, the incremented array Y must contain the n1905element vector y. On exit, Y is overwritten by the updated1906vector y.19071908INCY - INTEGER.1909On entry, INCY specifies the increment for the elements of1910Y. INCY must not be zero.1911Unchanged on exit.19121913Further Details1914===============19151916Level 2 Blas routine.19171918-- Written on 22-October-1986.1919Jack Dongarra, Argonne National Lab.1920Jeremy Du Croz, Nag Central Office.1921Sven Hammarling, Nag Central Office.1922Richard Hanson, Sandia National Labs.19231924=====================================================================192519261927Test the input parameters.1928*/19291930/* Parameter adjustments */1931a_dim1 = *lda;1932a_offset = 1 + a_dim1;1933a -= a_offset;1934--x;1935--y;19361937/* Function Body */1938info = 0;1939if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {1940info = 1;1941} else if (*n < 0) {1942info = 2;1943} else if (*lda < max(1,*n)) {1944info = 5;1945} else if (*incx == 0) {1946info = 7;1947} else if (*incy == 0) {1948info = 10;1949}1950if (info != 0) {1951xerbla_("CHEMV ", &info);1952return 0;1953}19541955/* Quick return if possible. */19561957if (*n == 0 || alpha->r == 0.f && alpha->i == 0.f && (beta->r == 1.f &&1958beta->i == 0.f)) {1959return 0;1960}19611962/* Set up the start points in X and Y. */19631964if (*incx > 0) {1965kx = 1;1966} else {1967kx = 1 - (*n - 1) * *incx;1968}1969if (*incy > 0) {1970ky = 1;1971} else {1972ky = 1 - (*n - 1) * *incy;1973}19741975/*1976Start the operations. In this version the elements of A are1977accessed sequentially with one pass through the triangular part1978of A.19791980First form y := beta*y.1981*/19821983if (beta->r != 1.f || beta->i != 0.f) {1984if (*incy == 1) {1985if (beta->r == 0.f && beta->i == 0.f) {1986i__1 = *n;1987for (i__ = 1; i__ <= i__1; ++i__) {1988i__2 = i__;1989y[i__2].r = 0.f, y[i__2].i = 0.f;1990/* L10: */1991}1992} else {1993i__1 = *n;1994for (i__ = 1; i__ <= i__1; ++i__) {1995i__2 = i__;1996i__3 = i__;1997q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,1998q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]1999.r;2000y[i__2].r = q__1.r, y[i__2].i = q__1.i;2001/* L20: */2002}2003}2004} else {2005iy = ky;2006if (beta->r == 0.f && beta->i == 0.f) {2007i__1 = *n;2008for (i__ = 1; i__ <= i__1; ++i__) {2009i__2 = iy;2010y[i__2].r = 0.f, y[i__2].i = 0.f;2011iy += *incy;2012/* L30: */2013}2014} else {2015i__1 = *n;2016for (i__ = 1; i__ <= i__1; ++i__) {2017i__2 = iy;2018i__3 = iy;2019q__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,2020q__1.i = beta->r * y[i__3].i + beta->i * y[i__3]2021.r;2022y[i__2].r = q__1.r, y[i__2].i = q__1.i;2023iy += *incy;2024/* L40: */2025}2026}2027}2028}2029if (alpha->r == 0.f && alpha->i == 0.f) {2030return 0;2031}2032if (lsame_(uplo, "U")) {20332034/* Form y when A is stored in upper triangle. */20352036if (*incx == 1 && *incy == 1) {2037i__1 = *n;2038for (j = 1; j <= i__1; ++j) {2039i__2 = j;2040q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =2041alpha->r * x[i__2].i + alpha->i * x[i__2].r;2042temp1.r = q__1.r, temp1.i = q__1.i;2043temp2.r = 0.f, temp2.i = 0.f;2044i__2 = j - 1;2045for (i__ = 1; i__ <= i__2; ++i__) {2046i__3 = i__;2047i__4 = i__;2048i__5 = i__ + j * a_dim1;2049q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,2050q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]2051.r;2052q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;2053y[i__3].r = q__1.r, y[i__3].i = q__1.i;2054r_cnjg(&q__3, &a[i__ + j * a_dim1]);2055i__3 = i__;2056q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =2057q__3.r * x[i__3].i + q__3.i * x[i__3].r;2058q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;2059temp2.r = q__1.r, temp2.i = q__1.i;2060/* L50: */2061}2062i__2 = j;2063i__3 = j;2064i__4 = j + j * a_dim1;2065r__1 = a[i__4].r;2066q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;2067q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;2068q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i =2069alpha->r * temp2.i + alpha->i * temp2.r;2070q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;2071y[i__2].r = q__1.r, y[i__2].i = q__1.i;2072/* L60: */2073}2074} else {2075jx = kx;2076jy = ky;2077i__1 = *n;2078for (j = 1; j <= i__1; ++j) {2079i__2 = jx;2080q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =2081alpha->r * x[i__2].i + alpha->i * x[i__2].r;2082temp1.r = q__1.r, temp1.i = q__1.i;2083temp2.r = 0.f, temp2.i = 0.f;2084ix = kx;2085iy = ky;2086i__2 = j - 1;2087for (i__ = 1; i__ <= i__2; ++i__) {2088i__3 = iy;2089i__4 = iy;2090i__5 = i__ + j * a_dim1;2091q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,2092q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]2093.r;2094q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;2095y[i__3].r = q__1.r, y[i__3].i = q__1.i;2096r_cnjg(&q__3, &a[i__ + j * a_dim1]);2097i__3 = ix;2098q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =2099q__3.r * x[i__3].i + q__3.i * x[i__3].r;2100q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;2101temp2.r = q__1.r, temp2.i = q__1.i;2102ix += *incx;2103iy += *incy;2104/* L70: */2105}2106i__2 = jy;2107i__3 = jy;2108i__4 = j + j * a_dim1;2109r__1 = a[i__4].r;2110q__3.r = r__1 * temp1.r, q__3.i = r__1 * temp1.i;2111q__2.r = y[i__3].r + q__3.r, q__2.i = y[i__3].i + q__3.i;2112q__4.r = alpha->r * temp2.r - alpha->i * temp2.i, q__4.i =2113alpha->r * temp2.i + alpha->i * temp2.r;2114q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;2115y[i__2].r = q__1.r, y[i__2].i = q__1.i;2116jx += *incx;2117jy += *incy;2118/* L80: */2119}2120}2121} else {21222123/* Form y when A is stored in lower triangle. */21242125if (*incx == 1 && *incy == 1) {2126i__1 = *n;2127for (j = 1; j <= i__1; ++j) {2128i__2 = j;2129q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =2130alpha->r * x[i__2].i + alpha->i * x[i__2].r;2131temp1.r = q__1.r, temp1.i = q__1.i;2132temp2.r = 0.f, temp2.i = 0.f;2133i__2 = j;2134i__3 = j;2135i__4 = j + j * a_dim1;2136r__1 = a[i__4].r;2137q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;2138q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;2139y[i__2].r = q__1.r, y[i__2].i = q__1.i;2140i__2 = *n;2141for (i__ = j + 1; i__ <= i__2; ++i__) {2142i__3 = i__;2143i__4 = i__;2144i__5 = i__ + j * a_dim1;2145q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,2146q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]2147.r;2148q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;2149y[i__3].r = q__1.r, y[i__3].i = q__1.i;2150r_cnjg(&q__3, &a[i__ + j * a_dim1]);2151i__3 = i__;2152q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =2153q__3.r * x[i__3].i + q__3.i * x[i__3].r;2154q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;2155temp2.r = q__1.r, temp2.i = q__1.i;2156/* L90: */2157}2158i__2 = j;2159i__3 = j;2160q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i =2161alpha->r * temp2.i + alpha->i * temp2.r;2162q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;2163y[i__2].r = q__1.r, y[i__2].i = q__1.i;2164/* L100: */2165}2166} else {2167jx = kx;2168jy = ky;2169i__1 = *n;2170for (j = 1; j <= i__1; ++j) {2171i__2 = jx;2172q__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, q__1.i =2173alpha->r * x[i__2].i + alpha->i * x[i__2].r;2174temp1.r = q__1.r, temp1.i = q__1.i;2175temp2.r = 0.f, temp2.i = 0.f;2176i__2 = jy;2177i__3 = jy;2178i__4 = j + j * a_dim1;2179r__1 = a[i__4].r;2180q__2.r = r__1 * temp1.r, q__2.i = r__1 * temp1.i;2181q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;2182y[i__2].r = q__1.r, y[i__2].i = q__1.i;2183ix = jx;2184iy = jy;2185i__2 = *n;2186for (i__ = j + 1; i__ <= i__2; ++i__) {2187ix += *incx;2188iy += *incy;2189i__3 = iy;2190i__4 = iy;2191i__5 = i__ + j * a_dim1;2192q__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,2193q__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]2194.r;2195q__1.r = y[i__4].r + q__2.r, q__1.i = y[i__4].i + q__2.i;2196y[i__3].r = q__1.r, y[i__3].i = q__1.i;2197r_cnjg(&q__3, &a[i__ + j * a_dim1]);2198i__3 = ix;2199q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i, q__2.i =2200q__3.r * x[i__3].i + q__3.i * x[i__3].r;2201q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;2202temp2.r = q__1.r, temp2.i = q__1.i;2203/* L110: */2204}2205i__2 = jy;2206i__3 = jy;2207q__2.r = alpha->r * temp2.r - alpha->i * temp2.i, q__2.i =2208alpha->r * temp2.i + alpha->i * temp2.r;2209q__1.r = y[i__3].r + q__2.r, q__1.i = y[i__3].i + q__2.i;2210y[i__2].r = q__1.r, y[i__2].i = q__1.i;2211jx += *incx;2212jy += *incy;2213/* L120: */2214}2215}2216}22172218return 0;22192220/* End of CHEMV . */22212222} /* chemv_ */22232224/* Subroutine */ int cher2_(char *uplo, integer *n, singlecomplex *alpha, singlecomplex *2225x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda)2226{2227/* System generated locals */2228integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;2229real r__1;2230singlecomplex q__1, q__2, q__3, q__4;22312232/* Local variables */2233static integer i__, j, ix, iy, jx, jy, kx, ky, info;2234static singlecomplex temp1, temp2;2235extern logical lsame_(char *, char *);2236extern /* Subroutine */ int xerbla_(char *, integer *);223722382239/*2240Purpose2241=======22422243CHER2 performs the hermitian rank 2 operation22442245A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,22462247where alpha is a scalar, x and y are n element vectors and A is an n2248by n hermitian matrix.22492250Arguments2251==========22522253UPLO - CHARACTER*1.2254On entry, UPLO specifies whether the upper or lower2255triangular part of the array A is to be referenced as2256follows:22572258UPLO = 'U' or 'u' Only the upper triangular part of A2259is to be referenced.22602261UPLO = 'L' or 'l' Only the lower triangular part of A2262is to be referenced.22632264Unchanged on exit.22652266N - INTEGER.2267On entry, N specifies the order of the matrix A.2268N must be at least zero.2269Unchanged on exit.22702271ALPHA - COMPLEX .2272On entry, ALPHA specifies the scalar alpha.2273Unchanged on exit.22742275X - COMPLEX array of dimension at least2276( 1 + ( n - 1 )*abs( INCX ) ).2277Before entry, the incremented array X must contain the n2278element vector x.2279Unchanged on exit.22802281INCX - INTEGER.2282On entry, INCX specifies the increment for the elements of2283X. INCX must not be zero.2284Unchanged on exit.22852286Y - COMPLEX array of dimension at least2287( 1 + ( n - 1 )*abs( INCY ) ).2288Before entry, the incremented array Y must contain the n2289element vector y.2290Unchanged on exit.22912292INCY - INTEGER.2293On entry, INCY specifies the increment for the elements of2294Y. INCY must not be zero.2295Unchanged on exit.22962297A - COMPLEX array of DIMENSION ( LDA, n ).2298Before entry with UPLO = 'U' or 'u', the leading n by n2299upper triangular part of the array A must contain the upper2300triangular part of the hermitian matrix and the strictly2301lower triangular part of A is not referenced. On exit, the2302upper triangular part of the array A is overwritten by the2303upper triangular part of the updated matrix.2304Before entry with UPLO = 'L' or 'l', the leading n by n2305lower triangular part of the array A must contain the lower2306triangular part of the hermitian matrix and the strictly2307upper triangular part of A is not referenced. On exit, the2308lower triangular part of the array A is overwritten by the2309lower triangular part of the updated matrix.2310Note that the imaginary parts of the diagonal elements need2311not be set, they are assumed to be zero, and on exit they2312are set to zero.23132314LDA - INTEGER.2315On entry, LDA specifies the first dimension of A as declared2316in the calling (sub) program. LDA must be at least2317max( 1, n ).2318Unchanged on exit.23192320Further Details2321===============23222323Level 2 Blas routine.23242325-- Written on 22-October-1986.2326Jack Dongarra, Argonne National Lab.2327Jeremy Du Croz, Nag Central Office.2328Sven Hammarling, Nag Central Office.2329Richard Hanson, Sandia National Labs.23302331=====================================================================233223332334Test the input parameters.2335*/23362337/* Parameter adjustments */2338--x;2339--y;2340a_dim1 = *lda;2341a_offset = 1 + a_dim1;2342a -= a_offset;23432344/* Function Body */2345info = 0;2346if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {2347info = 1;2348} else if (*n < 0) {2349info = 2;2350} else if (*incx == 0) {2351info = 5;2352} else if (*incy == 0) {2353info = 7;2354} else if (*lda < max(1,*n)) {2355info = 9;2356}2357if (info != 0) {2358xerbla_("CHER2 ", &info);2359return 0;2360}23612362/* Quick return if possible. */23632364if (*n == 0 || alpha->r == 0.f && alpha->i == 0.f) {2365return 0;2366}23672368/*2369Set up the start points in X and Y if the increments are not both2370unity.2371*/23722373if (*incx != 1 || *incy != 1) {2374if (*incx > 0) {2375kx = 1;2376} else {2377kx = 1 - (*n - 1) * *incx;2378}2379if (*incy > 0) {2380ky = 1;2381} else {2382ky = 1 - (*n - 1) * *incy;2383}2384jx = kx;2385jy = ky;2386}23872388/*2389Start the operations. In this version the elements of A are2390accessed sequentially with one pass through the triangular part2391of A.2392*/23932394if (lsame_(uplo, "U")) {23952396/* Form A when A is stored in the upper triangle. */23972398if (*incx == 1 && *incy == 1) {2399i__1 = *n;2400for (j = 1; j <= i__1; ++j) {2401i__2 = j;2402i__3 = j;2403if (x[i__2].r != 0.f || x[i__2].i != 0.f || (y[i__3].r != 0.f2404|| y[i__3].i != 0.f)) {2405r_cnjg(&q__2, &y[j]);2406q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i =2407alpha->r * q__2.i + alpha->i * q__2.r;2408temp1.r = q__1.r, temp1.i = q__1.i;2409i__2 = j;2410q__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,2411q__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]2412.r;2413r_cnjg(&q__1, &q__2);2414temp2.r = q__1.r, temp2.i = q__1.i;2415i__2 = j - 1;2416for (i__ = 1; i__ <= i__2; ++i__) {2417i__3 = i__ + j * a_dim1;2418i__4 = i__ + j * a_dim1;2419i__5 = i__;2420q__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,2421q__3.i = x[i__5].r * temp1.i + x[i__5].i *2422temp1.r;2423q__2.r = a[i__4].r + q__3.r, q__2.i = a[i__4].i +2424q__3.i;2425i__6 = i__;2426q__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,2427q__4.i = y[i__6].r * temp2.i + y[i__6].i *2428temp2.r;2429q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;2430a[i__3].r = q__1.r, a[i__3].i = q__1.i;2431/* L10: */2432}2433i__2 = j + j * a_dim1;2434i__3 = j + j * a_dim1;2435i__4 = j;2436q__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,2437q__2.i = x[i__4].r * temp1.i + x[i__4].i *2438temp1.r;2439i__5 = j;2440q__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,2441q__3.i = y[i__5].r * temp2.i + y[i__5].i *2442temp2.r;2443q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;2444r__1 = a[i__3].r + q__1.r;2445a[i__2].r = r__1, a[i__2].i = 0.f;2446} else {2447i__2 = j + j * a_dim1;2448i__3 = j + j * a_dim1;2449r__1 = a[i__3].r;2450a[i__2].r = r__1, a[i__2].i = 0.f;2451}2452/* L20: */2453}2454} else {2455i__1 = *n;2456for (j = 1; j <= i__1; ++j) {2457i__2 = jx;2458i__3 = jy;2459if (x[i__2].r != 0.f || x[i__2].i != 0.f || (y[i__3].r != 0.f2460|| y[i__3].i != 0.f)) {2461r_cnjg(&q__2, &y[jy]);2462q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i =2463alpha->r * q__2.i + alpha->i * q__2.r;2464temp1.r = q__1.r, temp1.i = q__1.i;2465i__2 = jx;2466q__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,2467q__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]2468.r;2469r_cnjg(&q__1, &q__2);2470temp2.r = q__1.r, temp2.i = q__1.i;2471ix = kx;2472iy = ky;2473i__2 = j - 1;2474for (i__ = 1; i__ <= i__2; ++i__) {2475i__3 = i__ + j * a_dim1;2476i__4 = i__ + j * a_dim1;2477i__5 = ix;2478q__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,2479q__3.i = x[i__5].r * temp1.i + x[i__5].i *2480temp1.r;2481q__2.r = a[i__4].r + q__3.r, q__2.i = a[i__4].i +2482q__3.i;2483i__6 = iy;2484q__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,2485q__4.i = y[i__6].r * temp2.i + y[i__6].i *2486temp2.r;2487q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;2488a[i__3].r = q__1.r, a[i__3].i = q__1.i;2489ix += *incx;2490iy += *incy;2491/* L30: */2492}2493i__2 = j + j * a_dim1;2494i__3 = j + j * a_dim1;2495i__4 = jx;2496q__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,2497q__2.i = x[i__4].r * temp1.i + x[i__4].i *2498temp1.r;2499i__5 = jy;2500q__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,2501q__3.i = y[i__5].r * temp2.i + y[i__5].i *2502temp2.r;2503q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;2504r__1 = a[i__3].r + q__1.r;2505a[i__2].r = r__1, a[i__2].i = 0.f;2506} else {2507i__2 = j + j * a_dim1;2508i__3 = j + j * a_dim1;2509r__1 = a[i__3].r;2510a[i__2].r = r__1, a[i__2].i = 0.f;2511}2512jx += *incx;2513jy += *incy;2514/* L40: */2515}2516}2517} else {25182519/* Form A when A is stored in the lower triangle. */25202521if (*incx == 1 && *incy == 1) {2522i__1 = *n;2523for (j = 1; j <= i__1; ++j) {2524i__2 = j;2525i__3 = j;2526if (x[i__2].r != 0.f || x[i__2].i != 0.f || (y[i__3].r != 0.f2527|| y[i__3].i != 0.f)) {2528r_cnjg(&q__2, &y[j]);2529q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i =2530alpha->r * q__2.i + alpha->i * q__2.r;2531temp1.r = q__1.r, temp1.i = q__1.i;2532i__2 = j;2533q__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,2534q__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]2535.r;2536r_cnjg(&q__1, &q__2);2537temp2.r = q__1.r, temp2.i = q__1.i;2538i__2 = j + j * a_dim1;2539i__3 = j + j * a_dim1;2540i__4 = j;2541q__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,2542q__2.i = x[i__4].r * temp1.i + x[i__4].i *2543temp1.r;2544i__5 = j;2545q__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,2546q__3.i = y[i__5].r * temp2.i + y[i__5].i *2547temp2.r;2548q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;2549r__1 = a[i__3].r + q__1.r;2550a[i__2].r = r__1, a[i__2].i = 0.f;2551i__2 = *n;2552for (i__ = j + 1; i__ <= i__2; ++i__) {2553i__3 = i__ + j * a_dim1;2554i__4 = i__ + j * a_dim1;2555i__5 = i__;2556q__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,2557q__3.i = x[i__5].r * temp1.i + x[i__5].i *2558temp1.r;2559q__2.r = a[i__4].r + q__3.r, q__2.i = a[i__4].i +2560q__3.i;2561i__6 = i__;2562q__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,2563q__4.i = y[i__6].r * temp2.i + y[i__6].i *2564temp2.r;2565q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;2566a[i__3].r = q__1.r, a[i__3].i = q__1.i;2567/* L50: */2568}2569} else {2570i__2 = j + j * a_dim1;2571i__3 = j + j * a_dim1;2572r__1 = a[i__3].r;2573a[i__2].r = r__1, a[i__2].i = 0.f;2574}2575/* L60: */2576}2577} else {2578i__1 = *n;2579for (j = 1; j <= i__1; ++j) {2580i__2 = jx;2581i__3 = jy;2582if (x[i__2].r != 0.f || x[i__2].i != 0.f || (y[i__3].r != 0.f2583|| y[i__3].i != 0.f)) {2584r_cnjg(&q__2, &y[jy]);2585q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i =2586alpha->r * q__2.i + alpha->i * q__2.r;2587temp1.r = q__1.r, temp1.i = q__1.i;2588i__2 = jx;2589q__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,2590q__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]2591.r;2592r_cnjg(&q__1, &q__2);2593temp2.r = q__1.r, temp2.i = q__1.i;2594i__2 = j + j * a_dim1;2595i__3 = j + j * a_dim1;2596i__4 = jx;2597q__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,2598q__2.i = x[i__4].r * temp1.i + x[i__4].i *2599temp1.r;2600i__5 = jy;2601q__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,2602q__3.i = y[i__5].r * temp2.i + y[i__5].i *2603temp2.r;2604q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;2605r__1 = a[i__3].r + q__1.r;2606a[i__2].r = r__1, a[i__2].i = 0.f;2607ix = jx;2608iy = jy;2609i__2 = *n;2610for (i__ = j + 1; i__ <= i__2; ++i__) {2611ix += *incx;2612iy += *incy;2613i__3 = i__ + j * a_dim1;2614i__4 = i__ + j * a_dim1;2615i__5 = ix;2616q__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,2617q__3.i = x[i__5].r * temp1.i + x[i__5].i *2618temp1.r;2619q__2.r = a[i__4].r + q__3.r, q__2.i = a[i__4].i +2620q__3.i;2621i__6 = iy;2622q__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,2623q__4.i = y[i__6].r * temp2.i + y[i__6].i *2624temp2.r;2625q__1.r = q__2.r + q__4.r, q__1.i = q__2.i + q__4.i;2626a[i__3].r = q__1.r, a[i__3].i = q__1.i;2627/* L70: */2628}2629} else {2630i__2 = j + j * a_dim1;2631i__3 = j + j * a_dim1;2632r__1 = a[i__3].r;2633a[i__2].r = r__1, a[i__2].i = 0.f;2634}2635jx += *incx;2636jy += *incy;2637/* L80: */2638}2639}2640}26412642return 0;26432644/* End of CHER2 . */26452646} /* cher2_ */26472648/* Subroutine */ int cher2k_(char *uplo, char *trans, integer *n, integer *k,2649singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *b, integer *ldb,2650real *beta, singlecomplex *c__, integer *ldc)2651{2652/* System generated locals */2653integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,2654i__3, i__4, i__5, i__6, i__7;2655real r__1;2656singlecomplex q__1, q__2, q__3, q__4, q__5, q__6;26572658/* Local variables */2659static integer i__, j, l, info;2660static singlecomplex temp1, temp2;2661extern logical lsame_(char *, char *);2662static integer nrowa;2663static logical upper;2664extern /* Subroutine */ int xerbla_(char *, integer *);266526662667/*2668Purpose2669=======26702671CHER2K performs one of the hermitian rank 2k operations26722673C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + beta*C,26742675or26762677C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + beta*C,26782679where alpha and beta are scalars with beta real, C is an n by n2680hermitian matrix and A and B are n by k matrices in the first case2681and k by n matrices in the second case.26822683Arguments2684==========26852686UPLO - CHARACTER*1.2687On entry, UPLO specifies whether the upper or lower2688triangular part of the array C is to be referenced as2689follows:26902691UPLO = 'U' or 'u' Only the upper triangular part of C2692is to be referenced.26932694UPLO = 'L' or 'l' Only the lower triangular part of C2695is to be referenced.26962697Unchanged on exit.26982699TRANS - CHARACTER*1.2700On entry, TRANS specifies the operation to be performed as2701follows:27022703TRANS = 'N' or 'n' C := alpha*A*conjg( B' ) +2704conjg( alpha )*B*conjg( A' ) +2705beta*C.27062707TRANS = 'C' or 'c' C := alpha*conjg( A' )*B +2708conjg( alpha )*conjg( B' )*A +2709beta*C.27102711Unchanged on exit.27122713N - INTEGER.2714On entry, N specifies the order of the matrix C. N must be2715at least zero.2716Unchanged on exit.27172718K - INTEGER.2719On entry with TRANS = 'N' or 'n', K specifies the number2720of columns of the matrices A and B, and on entry with2721TRANS = 'C' or 'c', K specifies the number of rows of the2722matrices A and B. K must be at least zero.2723Unchanged on exit.27242725ALPHA - COMPLEX .2726On entry, ALPHA specifies the scalar alpha.2727Unchanged on exit.27282729A - COMPLEX array of DIMENSION ( LDA, ka ), where ka is2730k when TRANS = 'N' or 'n', and is n otherwise.2731Before entry with TRANS = 'N' or 'n', the leading n by k2732part of the array A must contain the matrix A, otherwise2733the leading k by n part of the array A must contain the2734matrix A.2735Unchanged on exit.27362737LDA - INTEGER.2738On entry, LDA specifies the first dimension of A as declared2739in the calling (sub) program. When TRANS = 'N' or 'n'2740then LDA must be at least max( 1, n ), otherwise LDA must2741be at least max( 1, k ).2742Unchanged on exit.27432744B - COMPLEX array of DIMENSION ( LDB, kb ), where kb is2745k when TRANS = 'N' or 'n', and is n otherwise.2746Before entry with TRANS = 'N' or 'n', the leading n by k2747part of the array B must contain the matrix B, otherwise2748the leading k by n part of the array B must contain the2749matrix B.2750Unchanged on exit.27512752LDB - INTEGER.2753On entry, LDB specifies the first dimension of B as declared2754in the calling (sub) program. When TRANS = 'N' or 'n'2755then LDB must be at least max( 1, n ), otherwise LDB must2756be at least max( 1, k ).2757Unchanged on exit.27582759BETA - REAL .2760On entry, BETA specifies the scalar beta.2761Unchanged on exit.27622763C - COMPLEX array of DIMENSION ( LDC, n ).2764Before entry with UPLO = 'U' or 'u', the leading n by n2765upper triangular part of the array C must contain the upper2766triangular part of the hermitian matrix and the strictly2767lower triangular part of C is not referenced. On exit, the2768upper triangular part of the array C is overwritten by the2769upper triangular part of the updated matrix.2770Before entry with UPLO = 'L' or 'l', the leading n by n2771lower triangular part of the array C must contain the lower2772triangular part of the hermitian matrix and the strictly2773upper triangular part of C is not referenced. On exit, the2774lower triangular part of the array C is overwritten by the2775lower triangular part of the updated matrix.2776Note that the imaginary parts of the diagonal elements need2777not be set, they are assumed to be zero, and on exit they2778are set to zero.27792780LDC - INTEGER.2781On entry, LDC specifies the first dimension of C as declared2782in the calling (sub) program. LDC must be at least2783max( 1, n ).2784Unchanged on exit.27852786Further Details2787===============27882789Level 3 Blas routine.27902791-- Written on 8-February-1989.2792Jack Dongarra, Argonne National Laboratory.2793Iain Duff, AERE Harwell.2794Jeremy Du Croz, Numerical Algorithms Group Ltd.2795Sven Hammarling, Numerical Algorithms Group Ltd.27962797-- Modified 8-Nov-93 to set C(J,J) to REAL( C(J,J) ) when BETA = 1.2798Ed Anderson, Cray Research Inc.27992800=====================================================================280128022803Test the input parameters.2804*/28052806/* Parameter adjustments */2807a_dim1 = *lda;2808a_offset = 1 + a_dim1;2809a -= a_offset;2810b_dim1 = *ldb;2811b_offset = 1 + b_dim1;2812b -= b_offset;2813c_dim1 = *ldc;2814c_offset = 1 + c_dim1;2815c__ -= c_offset;28162817/* Function Body */2818if (lsame_(trans, "N")) {2819nrowa = *n;2820} else {2821nrowa = *k;2822}2823upper = lsame_(uplo, "U");28242825info = 0;2826if (! upper && ! lsame_(uplo, "L")) {2827info = 1;2828} else if (! lsame_(trans, "N") && ! lsame_(trans,2829"C")) {2830info = 2;2831} else if (*n < 0) {2832info = 3;2833} else if (*k < 0) {2834info = 4;2835} else if (*lda < max(1,nrowa)) {2836info = 7;2837} else if (*ldb < max(1,nrowa)) {2838info = 9;2839} else if (*ldc < max(1,*n)) {2840info = 12;2841}2842if (info != 0) {2843xerbla_("CHER2K", &info);2844return 0;2845}28462847/* Quick return if possible. */28482849if (*n == 0 || (alpha->r == 0.f && alpha->i == 0.f || *k == 0) && *beta ==28501.f) {2851return 0;2852}28532854/* And when alpha.eq.zero. */28552856if (alpha->r == 0.f && alpha->i == 0.f) {2857if (upper) {2858if (*beta == 0.f) {2859i__1 = *n;2860for (j = 1; j <= i__1; ++j) {2861i__2 = j;2862for (i__ = 1; i__ <= i__2; ++i__) {2863i__3 = i__ + j * c_dim1;2864c__[i__3].r = 0.f, c__[i__3].i = 0.f;2865/* L10: */2866}2867/* L20: */2868}2869} else {2870i__1 = *n;2871for (j = 1; j <= i__1; ++j) {2872i__2 = j - 1;2873for (i__ = 1; i__ <= i__2; ++i__) {2874i__3 = i__ + j * c_dim1;2875i__4 = i__ + j * c_dim1;2876q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[2877i__4].i;2878c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;2879/* L30: */2880}2881i__2 = j + j * c_dim1;2882i__3 = j + j * c_dim1;2883r__1 = *beta * c__[i__3].r;2884c__[i__2].r = r__1, c__[i__2].i = 0.f;2885/* L40: */2886}2887}2888} else {2889if (*beta == 0.f) {2890i__1 = *n;2891for (j = 1; j <= i__1; ++j) {2892i__2 = *n;2893for (i__ = j; i__ <= i__2; ++i__) {2894i__3 = i__ + j * c_dim1;2895c__[i__3].r = 0.f, c__[i__3].i = 0.f;2896/* L50: */2897}2898/* L60: */2899}2900} else {2901i__1 = *n;2902for (j = 1; j <= i__1; ++j) {2903i__2 = j + j * c_dim1;2904i__3 = j + j * c_dim1;2905r__1 = *beta * c__[i__3].r;2906c__[i__2].r = r__1, c__[i__2].i = 0.f;2907i__2 = *n;2908for (i__ = j + 1; i__ <= i__2; ++i__) {2909i__3 = i__ + j * c_dim1;2910i__4 = i__ + j * c_dim1;2911q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[2912i__4].i;2913c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;2914/* L70: */2915}2916/* L80: */2917}2918}2919}2920return 0;2921}29222923/* Start the operations. */29242925if (lsame_(trans, "N")) {29262927/*2928Form C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) +2929C.2930*/29312932if (upper) {2933i__1 = *n;2934for (j = 1; j <= i__1; ++j) {2935if (*beta == 0.f) {2936i__2 = j;2937for (i__ = 1; i__ <= i__2; ++i__) {2938i__3 = i__ + j * c_dim1;2939c__[i__3].r = 0.f, c__[i__3].i = 0.f;2940/* L90: */2941}2942} else if (*beta != 1.f) {2943i__2 = j - 1;2944for (i__ = 1; i__ <= i__2; ++i__) {2945i__3 = i__ + j * c_dim1;2946i__4 = i__ + j * c_dim1;2947q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[2948i__4].i;2949c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;2950/* L100: */2951}2952i__2 = j + j * c_dim1;2953i__3 = j + j * c_dim1;2954r__1 = *beta * c__[i__3].r;2955c__[i__2].r = r__1, c__[i__2].i = 0.f;2956} else {2957i__2 = j + j * c_dim1;2958i__3 = j + j * c_dim1;2959r__1 = c__[i__3].r;2960c__[i__2].r = r__1, c__[i__2].i = 0.f;2961}2962i__2 = *k;2963for (l = 1; l <= i__2; ++l) {2964i__3 = j + l * a_dim1;2965i__4 = j + l * b_dim1;2966if (a[i__3].r != 0.f || a[i__3].i != 0.f || (b[i__4].r !=29670.f || b[i__4].i != 0.f)) {2968r_cnjg(&q__2, &b[j + l * b_dim1]);2969q__1.r = alpha->r * q__2.r - alpha->i * q__2.i,2970q__1.i = alpha->r * q__2.i + alpha->i *2971q__2.r;2972temp1.r = q__1.r, temp1.i = q__1.i;2973i__3 = j + l * a_dim1;2974q__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,2975q__2.i = alpha->r * a[i__3].i + alpha->i * a[2976i__3].r;2977r_cnjg(&q__1, &q__2);2978temp2.r = q__1.r, temp2.i = q__1.i;2979i__3 = j - 1;2980for (i__ = 1; i__ <= i__3; ++i__) {2981i__4 = i__ + j * c_dim1;2982i__5 = i__ + j * c_dim1;2983i__6 = i__ + l * a_dim1;2984q__3.r = a[i__6].r * temp1.r - a[i__6].i *2985temp1.i, q__3.i = a[i__6].r * temp1.i + a[2986i__6].i * temp1.r;2987q__2.r = c__[i__5].r + q__3.r, q__2.i = c__[i__5]2988.i + q__3.i;2989i__7 = i__ + l * b_dim1;2990q__4.r = b[i__7].r * temp2.r - b[i__7].i *2991temp2.i, q__4.i = b[i__7].r * temp2.i + b[2992i__7].i * temp2.r;2993q__1.r = q__2.r + q__4.r, q__1.i = q__2.i +2994q__4.i;2995c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;2996/* L110: */2997}2998i__3 = j + j * c_dim1;2999i__4 = j + j * c_dim1;3000i__5 = j + l * a_dim1;3001q__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,3002q__2.i = a[i__5].r * temp1.i + a[i__5].i *3003temp1.r;3004i__6 = j + l * b_dim1;3005q__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,3006q__3.i = b[i__6].r * temp2.i + b[i__6].i *3007temp2.r;3008q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;3009r__1 = c__[i__4].r + q__1.r;3010c__[i__3].r = r__1, c__[i__3].i = 0.f;3011}3012/* L120: */3013}3014/* L130: */3015}3016} else {3017i__1 = *n;3018for (j = 1; j <= i__1; ++j) {3019if (*beta == 0.f) {3020i__2 = *n;3021for (i__ = j; i__ <= i__2; ++i__) {3022i__3 = i__ + j * c_dim1;3023c__[i__3].r = 0.f, c__[i__3].i = 0.f;3024/* L140: */3025}3026} else if (*beta != 1.f) {3027i__2 = *n;3028for (i__ = j + 1; i__ <= i__2; ++i__) {3029i__3 = i__ + j * c_dim1;3030i__4 = i__ + j * c_dim1;3031q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[3032i__4].i;3033c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3034/* L150: */3035}3036i__2 = j + j * c_dim1;3037i__3 = j + j * c_dim1;3038r__1 = *beta * c__[i__3].r;3039c__[i__2].r = r__1, c__[i__2].i = 0.f;3040} else {3041i__2 = j + j * c_dim1;3042i__3 = j + j * c_dim1;3043r__1 = c__[i__3].r;3044c__[i__2].r = r__1, c__[i__2].i = 0.f;3045}3046i__2 = *k;3047for (l = 1; l <= i__2; ++l) {3048i__3 = j + l * a_dim1;3049i__4 = j + l * b_dim1;3050if (a[i__3].r != 0.f || a[i__3].i != 0.f || (b[i__4].r !=30510.f || b[i__4].i != 0.f)) {3052r_cnjg(&q__2, &b[j + l * b_dim1]);3053q__1.r = alpha->r * q__2.r - alpha->i * q__2.i,3054q__1.i = alpha->r * q__2.i + alpha->i *3055q__2.r;3056temp1.r = q__1.r, temp1.i = q__1.i;3057i__3 = j + l * a_dim1;3058q__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,3059q__2.i = alpha->r * a[i__3].i + alpha->i * a[3060i__3].r;3061r_cnjg(&q__1, &q__2);3062temp2.r = q__1.r, temp2.i = q__1.i;3063i__3 = *n;3064for (i__ = j + 1; i__ <= i__3; ++i__) {3065i__4 = i__ + j * c_dim1;3066i__5 = i__ + j * c_dim1;3067i__6 = i__ + l * a_dim1;3068q__3.r = a[i__6].r * temp1.r - a[i__6].i *3069temp1.i, q__3.i = a[i__6].r * temp1.i + a[3070i__6].i * temp1.r;3071q__2.r = c__[i__5].r + q__3.r, q__2.i = c__[i__5]3072.i + q__3.i;3073i__7 = i__ + l * b_dim1;3074q__4.r = b[i__7].r * temp2.r - b[i__7].i *3075temp2.i, q__4.i = b[i__7].r * temp2.i + b[3076i__7].i * temp2.r;3077q__1.r = q__2.r + q__4.r, q__1.i = q__2.i +3078q__4.i;3079c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;3080/* L160: */3081}3082i__3 = j + j * c_dim1;3083i__4 = j + j * c_dim1;3084i__5 = j + l * a_dim1;3085q__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,3086q__2.i = a[i__5].r * temp1.i + a[i__5].i *3087temp1.r;3088i__6 = j + l * b_dim1;3089q__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,3090q__3.i = b[i__6].r * temp2.i + b[i__6].i *3091temp2.r;3092q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;3093r__1 = c__[i__4].r + q__1.r;3094c__[i__3].r = r__1, c__[i__3].i = 0.f;3095}3096/* L170: */3097}3098/* L180: */3099}3100}3101} else {31023103/*3104Form C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A +3105C.3106*/31073108if (upper) {3109i__1 = *n;3110for (j = 1; j <= i__1; ++j) {3111i__2 = j;3112for (i__ = 1; i__ <= i__2; ++i__) {3113temp1.r = 0.f, temp1.i = 0.f;3114temp2.r = 0.f, temp2.i = 0.f;3115i__3 = *k;3116for (l = 1; l <= i__3; ++l) {3117r_cnjg(&q__3, &a[l + i__ * a_dim1]);3118i__4 = l + j * b_dim1;3119q__2.r = q__3.r * b[i__4].r - q__3.i * b[i__4].i,3120q__2.i = q__3.r * b[i__4].i + q__3.i * b[i__4]3121.r;3122q__1.r = temp1.r + q__2.r, q__1.i = temp1.i + q__2.i;3123temp1.r = q__1.r, temp1.i = q__1.i;3124r_cnjg(&q__3, &b[l + i__ * b_dim1]);3125i__4 = l + j * a_dim1;3126q__2.r = q__3.r * a[i__4].r - q__3.i * a[i__4].i,3127q__2.i = q__3.r * a[i__4].i + q__3.i * a[i__4]3128.r;3129q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;3130temp2.r = q__1.r, temp2.i = q__1.i;3131/* L190: */3132}3133if (i__ == j) {3134if (*beta == 0.f) {3135i__3 = j + j * c_dim1;3136q__2.r = alpha->r * temp1.r - alpha->i * temp1.i,3137q__2.i = alpha->r * temp1.i + alpha->i *3138temp1.r;3139r_cnjg(&q__4, alpha);3140q__3.r = q__4.r * temp2.r - q__4.i * temp2.i,3141q__3.i = q__4.r * temp2.i + q__4.i *3142temp2.r;3143q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +3144q__3.i;3145r__1 = q__1.r;3146c__[i__3].r = r__1, c__[i__3].i = 0.f;3147} else {3148i__3 = j + j * c_dim1;3149i__4 = j + j * c_dim1;3150q__2.r = alpha->r * temp1.r - alpha->i * temp1.i,3151q__2.i = alpha->r * temp1.i + alpha->i *3152temp1.r;3153r_cnjg(&q__4, alpha);3154q__3.r = q__4.r * temp2.r - q__4.i * temp2.i,3155q__3.i = q__4.r * temp2.i + q__4.i *3156temp2.r;3157q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +3158q__3.i;3159r__1 = *beta * c__[i__4].r + q__1.r;3160c__[i__3].r = r__1, c__[i__3].i = 0.f;3161}3162} else {3163if (*beta == 0.f) {3164i__3 = i__ + j * c_dim1;3165q__2.r = alpha->r * temp1.r - alpha->i * temp1.i,3166q__2.i = alpha->r * temp1.i + alpha->i *3167temp1.r;3168r_cnjg(&q__4, alpha);3169q__3.r = q__4.r * temp2.r - q__4.i * temp2.i,3170q__3.i = q__4.r * temp2.i + q__4.i *3171temp2.r;3172q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +3173q__3.i;3174c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3175} else {3176i__3 = i__ + j * c_dim1;3177i__4 = i__ + j * c_dim1;3178q__3.r = *beta * c__[i__4].r, q__3.i = *beta *3179c__[i__4].i;3180q__4.r = alpha->r * temp1.r - alpha->i * temp1.i,3181q__4.i = alpha->r * temp1.i + alpha->i *3182temp1.r;3183q__2.r = q__3.r + q__4.r, q__2.i = q__3.i +3184q__4.i;3185r_cnjg(&q__6, alpha);3186q__5.r = q__6.r * temp2.r - q__6.i * temp2.i,3187q__5.i = q__6.r * temp2.i + q__6.i *3188temp2.r;3189q__1.r = q__2.r + q__5.r, q__1.i = q__2.i +3190q__5.i;3191c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3192}3193}3194/* L200: */3195}3196/* L210: */3197}3198} else {3199i__1 = *n;3200for (j = 1; j <= i__1; ++j) {3201i__2 = *n;3202for (i__ = j; i__ <= i__2; ++i__) {3203temp1.r = 0.f, temp1.i = 0.f;3204temp2.r = 0.f, temp2.i = 0.f;3205i__3 = *k;3206for (l = 1; l <= i__3; ++l) {3207r_cnjg(&q__3, &a[l + i__ * a_dim1]);3208i__4 = l + j * b_dim1;3209q__2.r = q__3.r * b[i__4].r - q__3.i * b[i__4].i,3210q__2.i = q__3.r * b[i__4].i + q__3.i * b[i__4]3211.r;3212q__1.r = temp1.r + q__2.r, q__1.i = temp1.i + q__2.i;3213temp1.r = q__1.r, temp1.i = q__1.i;3214r_cnjg(&q__3, &b[l + i__ * b_dim1]);3215i__4 = l + j * a_dim1;3216q__2.r = q__3.r * a[i__4].r - q__3.i * a[i__4].i,3217q__2.i = q__3.r * a[i__4].i + q__3.i * a[i__4]3218.r;3219q__1.r = temp2.r + q__2.r, q__1.i = temp2.i + q__2.i;3220temp2.r = q__1.r, temp2.i = q__1.i;3221/* L220: */3222}3223if (i__ == j) {3224if (*beta == 0.f) {3225i__3 = j + j * c_dim1;3226q__2.r = alpha->r * temp1.r - alpha->i * temp1.i,3227q__2.i = alpha->r * temp1.i + alpha->i *3228temp1.r;3229r_cnjg(&q__4, alpha);3230q__3.r = q__4.r * temp2.r - q__4.i * temp2.i,3231q__3.i = q__4.r * temp2.i + q__4.i *3232temp2.r;3233q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +3234q__3.i;3235r__1 = q__1.r;3236c__[i__3].r = r__1, c__[i__3].i = 0.f;3237} else {3238i__3 = j + j * c_dim1;3239i__4 = j + j * c_dim1;3240q__2.r = alpha->r * temp1.r - alpha->i * temp1.i,3241q__2.i = alpha->r * temp1.i + alpha->i *3242temp1.r;3243r_cnjg(&q__4, alpha);3244q__3.r = q__4.r * temp2.r - q__4.i * temp2.i,3245q__3.i = q__4.r * temp2.i + q__4.i *3246temp2.r;3247q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +3248q__3.i;3249r__1 = *beta * c__[i__4].r + q__1.r;3250c__[i__3].r = r__1, c__[i__3].i = 0.f;3251}3252} else {3253if (*beta == 0.f) {3254i__3 = i__ + j * c_dim1;3255q__2.r = alpha->r * temp1.r - alpha->i * temp1.i,3256q__2.i = alpha->r * temp1.i + alpha->i *3257temp1.r;3258r_cnjg(&q__4, alpha);3259q__3.r = q__4.r * temp2.r - q__4.i * temp2.i,3260q__3.i = q__4.r * temp2.i + q__4.i *3261temp2.r;3262q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +3263q__3.i;3264c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3265} else {3266i__3 = i__ + j * c_dim1;3267i__4 = i__ + j * c_dim1;3268q__3.r = *beta * c__[i__4].r, q__3.i = *beta *3269c__[i__4].i;3270q__4.r = alpha->r * temp1.r - alpha->i * temp1.i,3271q__4.i = alpha->r * temp1.i + alpha->i *3272temp1.r;3273q__2.r = q__3.r + q__4.r, q__2.i = q__3.i +3274q__4.i;3275r_cnjg(&q__6, alpha);3276q__5.r = q__6.r * temp2.r - q__6.i * temp2.i,3277q__5.i = q__6.r * temp2.i + q__6.i *3278temp2.r;3279q__1.r = q__2.r + q__5.r, q__1.i = q__2.i +3280q__5.i;3281c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3282}3283}3284/* L230: */3285}3286/* L240: */3287}3288}3289}32903291return 0;32923293/* End of CHER2K. */32943295} /* cher2k_ */32963297/* Subroutine */ int cherk_(char *uplo, char *trans, integer *n, integer *k,3298real *alpha, singlecomplex *a, integer *lda, real *beta, singlecomplex *c__,3299integer *ldc)3300{3301/* System generated locals */3302integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5,3303i__6;3304real r__1;3305singlecomplex q__1, q__2, q__3;33063307/* Local variables */3308static integer i__, j, l, info;3309static singlecomplex temp;3310extern logical lsame_(char *, char *);3311static integer nrowa;3312static real rtemp;3313static logical upper;3314extern /* Subroutine */ int xerbla_(char *, integer *);331533163317/*3318Purpose3319=======33203321CHERK performs one of the hermitian rank k operations33223323C := alpha*A*conjg( A' ) + beta*C,33243325or33263327C := alpha*conjg( A' )*A + beta*C,33283329where alpha and beta are real scalars, C is an n by n hermitian3330matrix and A is an n by k matrix in the first case and a k by n3331matrix in the second case.33323333Arguments3334==========33353336UPLO - CHARACTER*1.3337On entry, UPLO specifies whether the upper or lower3338triangular part of the array C is to be referenced as3339follows:33403341UPLO = 'U' or 'u' Only the upper triangular part of C3342is to be referenced.33433344UPLO = 'L' or 'l' Only the lower triangular part of C3345is to be referenced.33463347Unchanged on exit.33483349TRANS - CHARACTER*1.3350On entry, TRANS specifies the operation to be performed as3351follows:33523353TRANS = 'N' or 'n' C := alpha*A*conjg( A' ) + beta*C.33543355TRANS = 'C' or 'c' C := alpha*conjg( A' )*A + beta*C.33563357Unchanged on exit.33583359N - INTEGER.3360On entry, N specifies the order of the matrix C. N must be3361at least zero.3362Unchanged on exit.33633364K - INTEGER.3365On entry with TRANS = 'N' or 'n', K specifies the number3366of columns of the matrix A, and on entry with3367TRANS = 'C' or 'c', K specifies the number of rows of the3368matrix A. K must be at least zero.3369Unchanged on exit.33703371ALPHA - REAL .3372On entry, ALPHA specifies the scalar alpha.3373Unchanged on exit.33743375A - COMPLEX array of DIMENSION ( LDA, ka ), where ka is3376k when TRANS = 'N' or 'n', and is n otherwise.3377Before entry with TRANS = 'N' or 'n', the leading n by k3378part of the array A must contain the matrix A, otherwise3379the leading k by n part of the array A must contain the3380matrix A.3381Unchanged on exit.33823383LDA - INTEGER.3384On entry, LDA specifies the first dimension of A as declared3385in the calling (sub) program. When TRANS = 'N' or 'n'3386then LDA must be at least max( 1, n ), otherwise LDA must3387be at least max( 1, k ).3388Unchanged on exit.33893390BETA - REAL .3391On entry, BETA specifies the scalar beta.3392Unchanged on exit.33933394C - COMPLEX array of DIMENSION ( LDC, n ).3395Before entry with UPLO = 'U' or 'u', the leading n by n3396upper triangular part of the array C must contain the upper3397triangular part of the hermitian matrix and the strictly3398lower triangular part of C is not referenced. On exit, the3399upper triangular part of the array C is overwritten by the3400upper triangular part of the updated matrix.3401Before entry with UPLO = 'L' or 'l', the leading n by n3402lower triangular part of the array C must contain the lower3403triangular part of the hermitian matrix and the strictly3404upper triangular part of C is not referenced. On exit, the3405lower triangular part of the array C is overwritten by the3406lower triangular part of the updated matrix.3407Note that the imaginary parts of the diagonal elements need3408not be set, they are assumed to be zero, and on exit they3409are set to zero.34103411LDC - INTEGER.3412On entry, LDC specifies the first dimension of C as declared3413in the calling (sub) program. LDC must be at least3414max( 1, n ).3415Unchanged on exit.34163417Further Details3418===============34193420Level 3 Blas routine.34213422-- Written on 8-February-1989.3423Jack Dongarra, Argonne National Laboratory.3424Iain Duff, AERE Harwell.3425Jeremy Du Croz, Numerical Algorithms Group Ltd.3426Sven Hammarling, Numerical Algorithms Group Ltd.34273428-- Modified 8-Nov-93 to set C(J,J) to REAL( C(J,J) ) when BETA = 1.3429Ed Anderson, Cray Research Inc.34303431=====================================================================343234333434Test the input parameters.3435*/34363437/* Parameter adjustments */3438a_dim1 = *lda;3439a_offset = 1 + a_dim1;3440a -= a_offset;3441c_dim1 = *ldc;3442c_offset = 1 + c_dim1;3443c__ -= c_offset;34443445/* Function Body */3446if (lsame_(trans, "N")) {3447nrowa = *n;3448} else {3449nrowa = *k;3450}3451upper = lsame_(uplo, "U");34523453info = 0;3454if (! upper && ! lsame_(uplo, "L")) {3455info = 1;3456} else if (! lsame_(trans, "N") && ! lsame_(trans,3457"C")) {3458info = 2;3459} else if (*n < 0) {3460info = 3;3461} else if (*k < 0) {3462info = 4;3463} else if (*lda < max(1,nrowa)) {3464info = 7;3465} else if (*ldc < max(1,*n)) {3466info = 10;3467}3468if (info != 0) {3469xerbla_("CHERK ", &info);3470return 0;3471}34723473/* Quick return if possible. */34743475if (*n == 0 || (*alpha == 0.f || *k == 0) && *beta == 1.f) {3476return 0;3477}34783479/* And when alpha.eq.zero. */34803481if (*alpha == 0.f) {3482if (upper) {3483if (*beta == 0.f) {3484i__1 = *n;3485for (j = 1; j <= i__1; ++j) {3486i__2 = j;3487for (i__ = 1; i__ <= i__2; ++i__) {3488i__3 = i__ + j * c_dim1;3489c__[i__3].r = 0.f, c__[i__3].i = 0.f;3490/* L10: */3491}3492/* L20: */3493}3494} else {3495i__1 = *n;3496for (j = 1; j <= i__1; ++j) {3497i__2 = j - 1;3498for (i__ = 1; i__ <= i__2; ++i__) {3499i__3 = i__ + j * c_dim1;3500i__4 = i__ + j * c_dim1;3501q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[3502i__4].i;3503c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3504/* L30: */3505}3506i__2 = j + j * c_dim1;3507i__3 = j + j * c_dim1;3508r__1 = *beta * c__[i__3].r;3509c__[i__2].r = r__1, c__[i__2].i = 0.f;3510/* L40: */3511}3512}3513} else {3514if (*beta == 0.f) {3515i__1 = *n;3516for (j = 1; j <= i__1; ++j) {3517i__2 = *n;3518for (i__ = j; i__ <= i__2; ++i__) {3519i__3 = i__ + j * c_dim1;3520c__[i__3].r = 0.f, c__[i__3].i = 0.f;3521/* L50: */3522}3523/* L60: */3524}3525} else {3526i__1 = *n;3527for (j = 1; j <= i__1; ++j) {3528i__2 = j + j * c_dim1;3529i__3 = j + j * c_dim1;3530r__1 = *beta * c__[i__3].r;3531c__[i__2].r = r__1, c__[i__2].i = 0.f;3532i__2 = *n;3533for (i__ = j + 1; i__ <= i__2; ++i__) {3534i__3 = i__ + j * c_dim1;3535i__4 = i__ + j * c_dim1;3536q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[3537i__4].i;3538c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3539/* L70: */3540}3541/* L80: */3542}3543}3544}3545return 0;3546}35473548/* Start the operations. */35493550if (lsame_(trans, "N")) {35513552/* Form C := alpha*A*conjg( A' ) + beta*C. */35533554if (upper) {3555i__1 = *n;3556for (j = 1; j <= i__1; ++j) {3557if (*beta == 0.f) {3558i__2 = j;3559for (i__ = 1; i__ <= i__2; ++i__) {3560i__3 = i__ + j * c_dim1;3561c__[i__3].r = 0.f, c__[i__3].i = 0.f;3562/* L90: */3563}3564} else if (*beta != 1.f) {3565i__2 = j - 1;3566for (i__ = 1; i__ <= i__2; ++i__) {3567i__3 = i__ + j * c_dim1;3568i__4 = i__ + j * c_dim1;3569q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[3570i__4].i;3571c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3572/* L100: */3573}3574i__2 = j + j * c_dim1;3575i__3 = j + j * c_dim1;3576r__1 = *beta * c__[i__3].r;3577c__[i__2].r = r__1, c__[i__2].i = 0.f;3578} else {3579i__2 = j + j * c_dim1;3580i__3 = j + j * c_dim1;3581r__1 = c__[i__3].r;3582c__[i__2].r = r__1, c__[i__2].i = 0.f;3583}3584i__2 = *k;3585for (l = 1; l <= i__2; ++l) {3586i__3 = j + l * a_dim1;3587if (a[i__3].r != 0.f || a[i__3].i != 0.f) {3588r_cnjg(&q__2, &a[j + l * a_dim1]);3589q__1.r = *alpha * q__2.r, q__1.i = *alpha * q__2.i;3590temp.r = q__1.r, temp.i = q__1.i;3591i__3 = j - 1;3592for (i__ = 1; i__ <= i__3; ++i__) {3593i__4 = i__ + j * c_dim1;3594i__5 = i__ + j * c_dim1;3595i__6 = i__ + l * a_dim1;3596q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,3597q__2.i = temp.r * a[i__6].i + temp.i * a[3598i__6].r;3599q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]3600.i + q__2.i;3601c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;3602/* L110: */3603}3604i__3 = j + j * c_dim1;3605i__4 = j + j * c_dim1;3606i__5 = i__ + l * a_dim1;3607q__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,3608q__1.i = temp.r * a[i__5].i + temp.i * a[i__5]3609.r;3610r__1 = c__[i__4].r + q__1.r;3611c__[i__3].r = r__1, c__[i__3].i = 0.f;3612}3613/* L120: */3614}3615/* L130: */3616}3617} else {3618i__1 = *n;3619for (j = 1; j <= i__1; ++j) {3620if (*beta == 0.f) {3621i__2 = *n;3622for (i__ = j; i__ <= i__2; ++i__) {3623i__3 = i__ + j * c_dim1;3624c__[i__3].r = 0.f, c__[i__3].i = 0.f;3625/* L140: */3626}3627} else if (*beta != 1.f) {3628i__2 = j + j * c_dim1;3629i__3 = j + j * c_dim1;3630r__1 = *beta * c__[i__3].r;3631c__[i__2].r = r__1, c__[i__2].i = 0.f;3632i__2 = *n;3633for (i__ = j + 1; i__ <= i__2; ++i__) {3634i__3 = i__ + j * c_dim1;3635i__4 = i__ + j * c_dim1;3636q__1.r = *beta * c__[i__4].r, q__1.i = *beta * c__[3637i__4].i;3638c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3639/* L150: */3640}3641} else {3642i__2 = j + j * c_dim1;3643i__3 = j + j * c_dim1;3644r__1 = c__[i__3].r;3645c__[i__2].r = r__1, c__[i__2].i = 0.f;3646}3647i__2 = *k;3648for (l = 1; l <= i__2; ++l) {3649i__3 = j + l * a_dim1;3650if (a[i__3].r != 0.f || a[i__3].i != 0.f) {3651r_cnjg(&q__2, &a[j + l * a_dim1]);3652q__1.r = *alpha * q__2.r, q__1.i = *alpha * q__2.i;3653temp.r = q__1.r, temp.i = q__1.i;3654i__3 = j + j * c_dim1;3655i__4 = j + j * c_dim1;3656i__5 = j + l * a_dim1;3657q__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,3658q__1.i = temp.r * a[i__5].i + temp.i * a[i__5]3659.r;3660r__1 = c__[i__4].r + q__1.r;3661c__[i__3].r = r__1, c__[i__3].i = 0.f;3662i__3 = *n;3663for (i__ = j + 1; i__ <= i__3; ++i__) {3664i__4 = i__ + j * c_dim1;3665i__5 = i__ + j * c_dim1;3666i__6 = i__ + l * a_dim1;3667q__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,3668q__2.i = temp.r * a[i__6].i + temp.i * a[3669i__6].r;3670q__1.r = c__[i__5].r + q__2.r, q__1.i = c__[i__5]3671.i + q__2.i;3672c__[i__4].r = q__1.r, c__[i__4].i = q__1.i;3673/* L160: */3674}3675}3676/* L170: */3677}3678/* L180: */3679}3680}3681} else {36823683/* Form C := alpha*conjg( A' )*A + beta*C. */36843685if (upper) {3686i__1 = *n;3687for (j = 1; j <= i__1; ++j) {3688i__2 = j - 1;3689for (i__ = 1; i__ <= i__2; ++i__) {3690temp.r = 0.f, temp.i = 0.f;3691i__3 = *k;3692for (l = 1; l <= i__3; ++l) {3693r_cnjg(&q__3, &a[l + i__ * a_dim1]);3694i__4 = l + j * a_dim1;3695q__2.r = q__3.r * a[i__4].r - q__3.i * a[i__4].i,3696q__2.i = q__3.r * a[i__4].i + q__3.i * a[i__4]3697.r;3698q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;3699temp.r = q__1.r, temp.i = q__1.i;3700/* L190: */3701}3702if (*beta == 0.f) {3703i__3 = i__ + j * c_dim1;3704q__1.r = *alpha * temp.r, q__1.i = *alpha * temp.i;3705c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3706} else {3707i__3 = i__ + j * c_dim1;3708q__2.r = *alpha * temp.r, q__2.i = *alpha * temp.i;3709i__4 = i__ + j * c_dim1;3710q__3.r = *beta * c__[i__4].r, q__3.i = *beta * c__[3711i__4].i;3712q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;3713c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3714}3715/* L200: */3716}3717rtemp = 0.f;3718i__2 = *k;3719for (l = 1; l <= i__2; ++l) {3720r_cnjg(&q__3, &a[l + j * a_dim1]);3721i__3 = l + j * a_dim1;3722q__2.r = q__3.r * a[i__3].r - q__3.i * a[i__3].i, q__2.i =3723q__3.r * a[i__3].i + q__3.i * a[i__3].r;3724q__1.r = rtemp + q__2.r, q__1.i = q__2.i;3725rtemp = q__1.r;3726/* L210: */3727}3728if (*beta == 0.f) {3729i__2 = j + j * c_dim1;3730r__1 = *alpha * rtemp;3731c__[i__2].r = r__1, c__[i__2].i = 0.f;3732} else {3733i__2 = j + j * c_dim1;3734i__3 = j + j * c_dim1;3735r__1 = *alpha * rtemp + *beta * c__[i__3].r;3736c__[i__2].r = r__1, c__[i__2].i = 0.f;3737}3738/* L220: */3739}3740} else {3741i__1 = *n;3742for (j = 1; j <= i__1; ++j) {3743rtemp = 0.f;3744i__2 = *k;3745for (l = 1; l <= i__2; ++l) {3746r_cnjg(&q__3, &a[l + j * a_dim1]);3747i__3 = l + j * a_dim1;3748q__2.r = q__3.r * a[i__3].r - q__3.i * a[i__3].i, q__2.i =3749q__3.r * a[i__3].i + q__3.i * a[i__3].r;3750q__1.r = rtemp + q__2.r, q__1.i = q__2.i;3751rtemp = q__1.r;3752/* L230: */3753}3754if (*beta == 0.f) {3755i__2 = j + j * c_dim1;3756r__1 = *alpha * rtemp;3757c__[i__2].r = r__1, c__[i__2].i = 0.f;3758} else {3759i__2 = j + j * c_dim1;3760i__3 = j + j * c_dim1;3761r__1 = *alpha * rtemp + *beta * c__[i__3].r;3762c__[i__2].r = r__1, c__[i__2].i = 0.f;3763}3764i__2 = *n;3765for (i__ = j + 1; i__ <= i__2; ++i__) {3766temp.r = 0.f, temp.i = 0.f;3767i__3 = *k;3768for (l = 1; l <= i__3; ++l) {3769r_cnjg(&q__3, &a[l + i__ * a_dim1]);3770i__4 = l + j * a_dim1;3771q__2.r = q__3.r * a[i__4].r - q__3.i * a[i__4].i,3772q__2.i = q__3.r * a[i__4].i + q__3.i * a[i__4]3773.r;3774q__1.r = temp.r + q__2.r, q__1.i = temp.i + q__2.i;3775temp.r = q__1.r, temp.i = q__1.i;3776/* L240: */3777}3778if (*beta == 0.f) {3779i__3 = i__ + j * c_dim1;3780q__1.r = *alpha * temp.r, q__1.i = *alpha * temp.i;3781c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3782} else {3783i__3 = i__ + j * c_dim1;3784q__2.r = *alpha * temp.r, q__2.i = *alpha * temp.i;3785i__4 = i__ + j * c_dim1;3786q__3.r = *beta * c__[i__4].r, q__3.i = *beta * c__[3787i__4].i;3788q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;3789c__[i__3].r = q__1.r, c__[i__3].i = q__1.i;3790}3791/* L250: */3792}3793/* L260: */3794}3795}3796}37973798return 0;37993800/* End of CHERK . */38013802} /* cherk_ */38033804/* Subroutine */ int cscal_(integer *n, singlecomplex *ca, singlecomplex *cx, integer *3805incx)3806{3807/* System generated locals */3808integer i__1, i__2, i__3, i__4;3809singlecomplex q__1;38103811/* Local variables */3812static integer i__, nincx;381338143815/*3816Purpose3817=======38183819CSCAL scales a vector by a constant.38203821Further Details3822===============38233824jack dongarra, linpack, 3/11/78.3825modified 3/93 to return if incx .le. 0.3826modified 12/3/93, array(1) declarations changed to array(*)38273828=====================================================================3829*/38303831/* Parameter adjustments */3832--cx;38333834/* Function Body */3835if (*n <= 0 || *incx <= 0) {3836return 0;3837}3838if (*incx == 1) {3839goto L20;3840}38413842/* code for increment not equal to 1 */38433844nincx = *n * *incx;3845i__1 = nincx;3846i__2 = *incx;3847for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {3848i__3 = i__;3849i__4 = i__;3850q__1.r = ca->r * cx[i__4].r - ca->i * cx[i__4].i, q__1.i = ca->r * cx[3851i__4].i + ca->i * cx[i__4].r;3852cx[i__3].r = q__1.r, cx[i__3].i = q__1.i;3853/* L10: */3854}3855return 0;38563857/* code for increment equal to 1 */38583859L20:3860i__2 = *n;3861for (i__ = 1; i__ <= i__2; ++i__) {3862i__1 = i__;3863i__3 = i__;3864q__1.r = ca->r * cx[i__3].r - ca->i * cx[i__3].i, q__1.i = ca->r * cx[3865i__3].i + ca->i * cx[i__3].r;3866cx[i__1].r = q__1.r, cx[i__1].i = q__1.i;3867/* L30: */3868}3869return 0;3870} /* cscal_ */38713872/* Subroutine */ int csrot_(integer *n, singlecomplex *cx, integer *incx, singlecomplex *3873cy, integer *incy, real *c__, real *s)3874{3875/* System generated locals */3876integer i__1, i__2, i__3, i__4;3877singlecomplex q__1, q__2, q__3;38783879/* Local variables */3880static integer i__, ix, iy;3881static singlecomplex ctemp;388238833884/*3885Purpose3886=======38873888CSROT applies a plane rotation, where the cos and sin (c and s) are real3889and the vectors cx and cy are singlecomplex.3890jack dongarra, linpack, 3/11/78.38913892Arguments3893==========38943895N (input) INTEGER3896On entry, N specifies the order of the vectors cx and cy.3897N must be at least zero.3898Unchanged on exit.38993900CX (input) COMPLEX array, dimension at least3901( 1 + ( N - 1 )*abs( INCX ) ).3902Before entry, the incremented array CX must contain the n3903element vector cx. On exit, CX is overwritten by the updated3904vector cx.39053906INCX (input) INTEGER3907On entry, INCX specifies the increment for the elements of3908CX. INCX must not be zero.3909Unchanged on exit.39103911CY (input) COMPLEX array, dimension at least3912( 1 + ( N - 1 )*abs( INCY ) ).3913Before entry, the incremented array CY must contain the n3914element vector cy. On exit, CY is overwritten by the updated3915vector cy.39163917INCY (input) INTEGER3918On entry, INCY specifies the increment for the elements of3919CY. INCY must not be zero.3920Unchanged on exit.39213922C (input) REAL3923On entry, C specifies the cosine, cos.3924Unchanged on exit.39253926S (input) REAL3927On entry, S specifies the sine, sin.3928Unchanged on exit.39293930=====================================================================3931*/393239333934/* Parameter adjustments */3935--cy;3936--cx;39373938/* Function Body */3939if (*n <= 0) {3940return 0;3941}3942if (*incx == 1 && *incy == 1) {3943goto L20;3944}39453946/*3947code for unequal increments or equal increments not equal3948to 13949*/39503951ix = 1;3952iy = 1;3953if (*incx < 0) {3954ix = (-(*n) + 1) * *incx + 1;3955}3956if (*incy < 0) {3957iy = (-(*n) + 1) * *incy + 1;3958}3959i__1 = *n;3960for (i__ = 1; i__ <= i__1; ++i__) {3961i__2 = ix;3962q__2.r = *c__ * cx[i__2].r, q__2.i = *c__ * cx[i__2].i;3963i__3 = iy;3964q__3.r = *s * cy[i__3].r, q__3.i = *s * cy[i__3].i;3965q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;3966ctemp.r = q__1.r, ctemp.i = q__1.i;3967i__2 = iy;3968i__3 = iy;3969q__2.r = *c__ * cy[i__3].r, q__2.i = *c__ * cy[i__3].i;3970i__4 = ix;3971q__3.r = *s * cx[i__4].r, q__3.i = *s * cx[i__4].i;3972q__1.r = q__2.r - q__3.r, q__1.i = q__2.i - q__3.i;3973cy[i__2].r = q__1.r, cy[i__2].i = q__1.i;3974i__2 = ix;3975cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;3976ix += *incx;3977iy += *incy;3978/* L10: */3979}3980return 0;39813982/* code for both increments equal to 1 */39833984L20:3985i__1 = *n;3986for (i__ = 1; i__ <= i__1; ++i__) {3987i__2 = i__;3988q__2.r = *c__ * cx[i__2].r, q__2.i = *c__ * cx[i__2].i;3989i__3 = i__;3990q__3.r = *s * cy[i__3].r, q__3.i = *s * cy[i__3].i;3991q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;3992ctemp.r = q__1.r, ctemp.i = q__1.i;3993i__2 = i__;3994i__3 = i__;3995q__2.r = *c__ * cy[i__3].r, q__2.i = *c__ * cy[i__3].i;3996i__4 = i__;3997q__3.r = *s * cx[i__4].r, q__3.i = *s * cx[i__4].i;3998q__1.r = q__2.r - q__3.r, q__1.i = q__2.i - q__3.i;3999cy[i__2].r = q__1.r, cy[i__2].i = q__1.i;4000i__2 = i__;4001cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;4002/* L30: */4003}4004return 0;4005} /* csrot_ */40064007/* Subroutine */ int csscal_(integer *n, real *sa, singlecomplex *cx, integer *incx)4008{4009/* System generated locals */4010integer i__1, i__2, i__3, i__4;4011real r__1, r__2;4012singlecomplex q__1;40134014/* Local variables */4015static integer i__, nincx;401640174018/*4019Purpose4020=======40214022CSSCAL scales a complex vector by a real constant.40234024Further Details4025===============40264027jack dongarra, linpack, 3/11/78.4028modified 3/93 to return if incx .le. 0.4029modified 12/3/93, array(1) declarations changed to array(*)40304031=====================================================================4032*/40334034/* Parameter adjustments */4035--cx;40364037/* Function Body */4038if (*n <= 0 || *incx <= 0) {4039return 0;4040}4041if (*incx == 1) {4042goto L20;4043}40444045/* code for increment not equal to 1 */40464047nincx = *n * *incx;4048i__1 = nincx;4049i__2 = *incx;4050for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {4051i__3 = i__;4052i__4 = i__;4053r__1 = *sa * cx[i__4].r;4054r__2 = *sa * r_imag(&cx[i__]);4055q__1.r = r__1, q__1.i = r__2;4056cx[i__3].r = q__1.r, cx[i__3].i = q__1.i;4057/* L10: */4058}4059return 0;40604061/* code for increment equal to 1 */40624063L20:4064i__2 = *n;4065for (i__ = 1; i__ <= i__2; ++i__) {4066i__1 = i__;4067i__3 = i__;4068r__1 = *sa * cx[i__3].r;4069r__2 = *sa * r_imag(&cx[i__]);4070q__1.r = r__1, q__1.i = r__2;4071cx[i__1].r = q__1.r, cx[i__1].i = q__1.i;4072/* L30: */4073}4074return 0;4075} /* csscal_ */40764077/* Subroutine */ int cswap_(integer *n, singlecomplex *cx, integer *incx, singlecomplex *4078cy, integer *incy)4079{4080/* System generated locals */4081integer i__1, i__2, i__3;40824083/* Local variables */4084static integer i__, ix, iy;4085static singlecomplex ctemp;408640874088/*4089Purpose4090=======40914092CSWAP interchanges two vectors.40934094Further Details4095===============40964097jack dongarra, linpack, 3/11/78.4098modified 12/3/93, array(1) declarations changed to array(*)40994100=====================================================================4101*/41024103/* Parameter adjustments */4104--cy;4105--cx;41064107/* Function Body */4108if (*n <= 0) {4109return 0;4110}4111if (*incx == 1 && *incy == 1) {4112goto L20;4113}41144115/*4116code for unequal increments or equal increments not equal4117to 14118*/41194120ix = 1;4121iy = 1;4122if (*incx < 0) {4123ix = (-(*n) + 1) * *incx + 1;4124}4125if (*incy < 0) {4126iy = (-(*n) + 1) * *incy + 1;4127}4128i__1 = *n;4129for (i__ = 1; i__ <= i__1; ++i__) {4130i__2 = ix;4131ctemp.r = cx[i__2].r, ctemp.i = cx[i__2].i;4132i__2 = ix;4133i__3 = iy;4134cx[i__2].r = cy[i__3].r, cx[i__2].i = cy[i__3].i;4135i__2 = iy;4136cy[i__2].r = ctemp.r, cy[i__2].i = ctemp.i;4137ix += *incx;4138iy += *incy;4139/* L10: */4140}4141return 0;41424143/* code for both increments equal to 1 */4144L20:4145i__1 = *n;4146for (i__ = 1; i__ <= i__1; ++i__) {4147i__2 = i__;4148ctemp.r = cx[i__2].r, ctemp.i = cx[i__2].i;4149i__2 = i__;4150i__3 = i__;4151cx[i__2].r = cy[i__3].r, cx[i__2].i = cy[i__3].i;4152i__2 = i__;4153cy[i__2].r = ctemp.r, cy[i__2].i = ctemp.i;4154/* L30: */4155}4156return 0;4157} /* cswap_ */41584159/* Subroutine */ int ctrmm_(char *side, char *uplo, char *transa, char *diag,4160integer *m, integer *n, singlecomplex *alpha, singlecomplex *a, integer *lda,4161singlecomplex *b, integer *ldb)4162{4163/* System generated locals */4164integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,4165i__6;4166singlecomplex q__1, q__2, q__3;41674168/* Local variables */4169static integer i__, j, k, info;4170static singlecomplex temp;4171extern logical lsame_(char *, char *);4172static logical lside;4173static integer nrowa;4174static logical upper;4175extern /* Subroutine */ int xerbla_(char *, integer *);4176static logical noconj, nounit;417741784179/*4180Purpose4181=======41824183CTRMM performs one of the matrix-matrix operations41844185B := alpha*op( A )*B, or B := alpha*B*op( A )41864187where alpha is a scalar, B is an m by n matrix, A is a unit, or4188non-unit, upper or lower triangular matrix and op( A ) is one of41894190op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).41914192Arguments4193==========41944195SIDE - CHARACTER*1.4196On entry, SIDE specifies whether op( A ) multiplies B from4197the left or right as follows:41984199SIDE = 'L' or 'l' B := alpha*op( A )*B.42004201SIDE = 'R' or 'r' B := alpha*B*op( A ).42024203Unchanged on exit.42044205UPLO - CHARACTER*1.4206On entry, UPLO specifies whether the matrix A is an upper or4207lower triangular matrix as follows:42084209UPLO = 'U' or 'u' A is an upper triangular matrix.42104211UPLO = 'L' or 'l' A is a lower triangular matrix.42124213Unchanged on exit.42144215TRANSA - CHARACTER*1.4216On entry, TRANSA specifies the form of op( A ) to be used in4217the matrix multiplication as follows:42184219TRANSA = 'N' or 'n' op( A ) = A.42204221TRANSA = 'T' or 't' op( A ) = A'.42224223TRANSA = 'C' or 'c' op( A ) = conjg( A' ).42244225Unchanged on exit.42264227DIAG - CHARACTER*1.4228On entry, DIAG specifies whether or not A is unit triangular4229as follows:42304231DIAG = 'U' or 'u' A is assumed to be unit triangular.42324233DIAG = 'N' or 'n' A is not assumed to be unit4234triangular.42354236Unchanged on exit.42374238M - INTEGER.4239On entry, M specifies the number of rows of B. M must be at4240least zero.4241Unchanged on exit.42424243N - INTEGER.4244On entry, N specifies the number of columns of B. N must be4245at least zero.4246Unchanged on exit.42474248ALPHA - COMPLEX .4249On entry, ALPHA specifies the scalar alpha. When alpha is4250zero then A is not referenced and B need not be set before4251entry.4252Unchanged on exit.42534254A - COMPLEX array of DIMENSION ( LDA, k ), where k is m4255when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.4256Before entry with UPLO = 'U' or 'u', the leading k by k4257upper triangular part of the array A must contain the upper4258triangular matrix and the strictly lower triangular part of4259A is not referenced.4260Before entry with UPLO = 'L' or 'l', the leading k by k4261lower triangular part of the array A must contain the lower4262triangular matrix and the strictly upper triangular part of4263A is not referenced.4264Note that when DIAG = 'U' or 'u', the diagonal elements of4265A are not referenced either, but are assumed to be unity.4266Unchanged on exit.42674268LDA - INTEGER.4269On entry, LDA specifies the first dimension of A as declared4270in the calling (sub) program. When SIDE = 'L' or 'l' then4271LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'4272then LDA must be at least max( 1, n ).4273Unchanged on exit.42744275B - COMPLEX array of DIMENSION ( LDB, n ).4276Before entry, the leading m by n part of the array B must4277contain the matrix B, and on exit is overwritten by the4278transformed matrix.42794280LDB - INTEGER.4281On entry, LDB specifies the first dimension of B as declared4282in the calling (sub) program. LDB must be at least4283max( 1, m ).4284Unchanged on exit.42854286Further Details4287===============42884289Level 3 Blas routine.42904291-- Written on 8-February-1989.4292Jack Dongarra, Argonne National Laboratory.4293Iain Duff, AERE Harwell.4294Jeremy Du Croz, Numerical Algorithms Group Ltd.4295Sven Hammarling, Numerical Algorithms Group Ltd.42964297=====================================================================429842994300Test the input parameters.4301*/43024303/* Parameter adjustments */4304a_dim1 = *lda;4305a_offset = 1 + a_dim1;4306a -= a_offset;4307b_dim1 = *ldb;4308b_offset = 1 + b_dim1;4309b -= b_offset;43104311/* Function Body */4312lside = lsame_(side, "L");4313if (lside) {4314nrowa = *m;4315} else {4316nrowa = *n;4317}4318noconj = lsame_(transa, "T");4319nounit = lsame_(diag, "N");4320upper = lsame_(uplo, "U");43214322info = 0;4323if (! lside && ! lsame_(side, "R")) {4324info = 1;4325} else if (! upper && ! lsame_(uplo, "L")) {4326info = 2;4327} else if (! lsame_(transa, "N") && ! lsame_(transa,4328"T") && ! lsame_(transa, "C")) {4329info = 3;4330} else if (! lsame_(diag, "U") && ! lsame_(diag,4331"N")) {4332info = 4;4333} else if (*m < 0) {4334info = 5;4335} else if (*n < 0) {4336info = 6;4337} else if (*lda < max(1,nrowa)) {4338info = 9;4339} else if (*ldb < max(1,*m)) {4340info = 11;4341}4342if (info != 0) {4343xerbla_("CTRMM ", &info);4344return 0;4345}43464347/* Quick return if possible. */43484349if (*m == 0 || *n == 0) {4350return 0;4351}43524353/* And when alpha.eq.zero. */43544355if (alpha->r == 0.f && alpha->i == 0.f) {4356i__1 = *n;4357for (j = 1; j <= i__1; ++j) {4358i__2 = *m;4359for (i__ = 1; i__ <= i__2; ++i__) {4360i__3 = i__ + j * b_dim1;4361b[i__3].r = 0.f, b[i__3].i = 0.f;4362/* L10: */4363}4364/* L20: */4365}4366return 0;4367}43684369/* Start the operations. */43704371if (lside) {4372if (lsame_(transa, "N")) {43734374/* Form B := alpha*A*B. */43754376if (upper) {4377i__1 = *n;4378for (j = 1; j <= i__1; ++j) {4379i__2 = *m;4380for (k = 1; k <= i__2; ++k) {4381i__3 = k + j * b_dim1;4382if (b[i__3].r != 0.f || b[i__3].i != 0.f) {4383i__3 = k + j * b_dim1;4384q__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]4385.i, q__1.i = alpha->r * b[i__3].i +4386alpha->i * b[i__3].r;4387temp.r = q__1.r, temp.i = q__1.i;4388i__3 = k - 1;4389for (i__ = 1; i__ <= i__3; ++i__) {4390i__4 = i__ + j * b_dim1;4391i__5 = i__ + j * b_dim1;4392i__6 = i__ + k * a_dim1;4393q__2.r = temp.r * a[i__6].r - temp.i * a[i__6]4394.i, q__2.i = temp.r * a[i__6].i +4395temp.i * a[i__6].r;4396q__1.r = b[i__5].r + q__2.r, q__1.i = b[i__5]4397.i + q__2.i;4398b[i__4].r = q__1.r, b[i__4].i = q__1.i;4399/* L30: */4400}4401if (nounit) {4402i__3 = k + k * a_dim1;4403q__1.r = temp.r * a[i__3].r - temp.i * a[i__3]4404.i, q__1.i = temp.r * a[i__3].i +4405temp.i * a[i__3].r;4406temp.r = q__1.r, temp.i = q__1.i;4407}4408i__3 = k + j * b_dim1;4409b[i__3].r = temp.r, b[i__3].i = temp.i;4410}4411/* L40: */4412}4413/* L50: */4414}4415} else {4416i__1 = *n;4417for (j = 1; j <= i__1; ++j) {4418for (k = *m; k >= 1; --k) {4419i__2 = k + j * b_dim1;4420if (b[i__2].r != 0.f || b[i__2].i != 0.f) {4421i__2 = k + j * b_dim1;4422q__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2]4423.i, q__1.i = alpha->r * b[i__2].i +4424alpha->i * b[i__2].r;4425temp.r = q__1.r, temp.i = q__1.i;4426i__2 = k + j * b_dim1;4427b[i__2].r = temp.r, b[i__2].i = temp.i;4428if (nounit) {4429i__2 = k + j * b_dim1;4430i__3 = k + j * b_dim1;4431i__4 = k + k * a_dim1;4432q__1.r = b[i__3].r * a[i__4].r - b[i__3].i *4433a[i__4].i, q__1.i = b[i__3].r * a[4434i__4].i + b[i__3].i * a[i__4].r;4435b[i__2].r = q__1.r, b[i__2].i = q__1.i;4436}4437i__2 = *m;4438for (i__ = k + 1; i__ <= i__2; ++i__) {4439i__3 = i__ + j * b_dim1;4440i__4 = i__ + j * b_dim1;4441i__5 = i__ + k * a_dim1;4442q__2.r = temp.r * a[i__5].r - temp.i * a[i__5]4443.i, q__2.i = temp.r * a[i__5].i +4444temp.i * a[i__5].r;4445q__1.r = b[i__4].r + q__2.r, q__1.i = b[i__4]4446.i + q__2.i;4447b[i__3].r = q__1.r, b[i__3].i = q__1.i;4448/* L60: */4449}4450}4451/* L70: */4452}4453/* L80: */4454}4455}4456} else {44574458/* Form B := alpha*A'*B or B := alpha*conjg( A' )*B. */44594460if (upper) {4461i__1 = *n;4462for (j = 1; j <= i__1; ++j) {4463for (i__ = *m; i__ >= 1; --i__) {4464i__2 = i__ + j * b_dim1;4465temp.r = b[i__2].r, temp.i = b[i__2].i;4466if (noconj) {4467if (nounit) {4468i__2 = i__ + i__ * a_dim1;4469q__1.r = temp.r * a[i__2].r - temp.i * a[i__2]4470.i, q__1.i = temp.r * a[i__2].i +4471temp.i * a[i__2].r;4472temp.r = q__1.r, temp.i = q__1.i;4473}4474i__2 = i__ - 1;4475for (k = 1; k <= i__2; ++k) {4476i__3 = k + i__ * a_dim1;4477i__4 = k + j * b_dim1;4478q__2.r = a[i__3].r * b[i__4].r - a[i__3].i *4479b[i__4].i, q__2.i = a[i__3].r * b[4480i__4].i + a[i__3].i * b[i__4].r;4481q__1.r = temp.r + q__2.r, q__1.i = temp.i +4482q__2.i;4483temp.r = q__1.r, temp.i = q__1.i;4484/* L90: */4485}4486} else {4487if (nounit) {4488r_cnjg(&q__2, &a[i__ + i__ * a_dim1]);4489q__1.r = temp.r * q__2.r - temp.i * q__2.i,4490q__1.i = temp.r * q__2.i + temp.i *4491q__2.r;4492temp.r = q__1.r, temp.i = q__1.i;4493}4494i__2 = i__ - 1;4495for (k = 1; k <= i__2; ++k) {4496r_cnjg(&q__3, &a[k + i__ * a_dim1]);4497i__3 = k + j * b_dim1;4498q__2.r = q__3.r * b[i__3].r - q__3.i * b[i__3]4499.i, q__2.i = q__3.r * b[i__3].i +4500q__3.i * b[i__3].r;4501q__1.r = temp.r + q__2.r, q__1.i = temp.i +4502q__2.i;4503temp.r = q__1.r, temp.i = q__1.i;4504/* L100: */4505}4506}4507i__2 = i__ + j * b_dim1;4508q__1.r = alpha->r * temp.r - alpha->i * temp.i,4509q__1.i = alpha->r * temp.i + alpha->i *4510temp.r;4511b[i__2].r = q__1.r, b[i__2].i = q__1.i;4512/* L110: */4513}4514/* L120: */4515}4516} else {4517i__1 = *n;4518for (j = 1; j <= i__1; ++j) {4519i__2 = *m;4520for (i__ = 1; i__ <= i__2; ++i__) {4521i__3 = i__ + j * b_dim1;4522temp.r = b[i__3].r, temp.i = b[i__3].i;4523if (noconj) {4524if (nounit) {4525i__3 = i__ + i__ * a_dim1;4526q__1.r = temp.r * a[i__3].r - temp.i * a[i__3]4527.i, q__1.i = temp.r * a[i__3].i +4528temp.i * a[i__3].r;4529temp.r = q__1.r, temp.i = q__1.i;4530}4531i__3 = *m;4532for (k = i__ + 1; k <= i__3; ++k) {4533i__4 = k + i__ * a_dim1;4534i__5 = k + j * b_dim1;4535q__2.r = a[i__4].r * b[i__5].r - a[i__4].i *4536b[i__5].i, q__2.i = a[i__4].r * b[4537i__5].i + a[i__4].i * b[i__5].r;4538q__1.r = temp.r + q__2.r, q__1.i = temp.i +4539q__2.i;4540temp.r = q__1.r, temp.i = q__1.i;4541/* L130: */4542}4543} else {4544if (nounit) {4545r_cnjg(&q__2, &a[i__ + i__ * a_dim1]);4546q__1.r = temp.r * q__2.r - temp.i * q__2.i,4547q__1.i = temp.r * q__2.i + temp.i *4548q__2.r;4549temp.r = q__1.r, temp.i = q__1.i;4550}4551i__3 = *m;4552for (k = i__ + 1; k <= i__3; ++k) {4553r_cnjg(&q__3, &a[k + i__ * a_dim1]);4554i__4 = k + j * b_dim1;4555q__2.r = q__3.r * b[i__4].r - q__3.i * b[i__4]4556.i, q__2.i = q__3.r * b[i__4].i +4557q__3.i * b[i__4].r;4558q__1.r = temp.r + q__2.r, q__1.i = temp.i +4559q__2.i;4560temp.r = q__1.r, temp.i = q__1.i;4561/* L140: */4562}4563}4564i__3 = i__ + j * b_dim1;4565q__1.r = alpha->r * temp.r - alpha->i * temp.i,4566q__1.i = alpha->r * temp.i + alpha->i *4567temp.r;4568b[i__3].r = q__1.r, b[i__3].i = q__1.i;4569/* L150: */4570}4571/* L160: */4572}4573}4574}4575} else {4576if (lsame_(transa, "N")) {45774578/* Form B := alpha*B*A. */45794580if (upper) {4581for (j = *n; j >= 1; --j) {4582temp.r = alpha->r, temp.i = alpha->i;4583if (nounit) {4584i__1 = j + j * a_dim1;4585q__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,4586q__1.i = temp.r * a[i__1].i + temp.i * a[i__1]4587.r;4588temp.r = q__1.r, temp.i = q__1.i;4589}4590i__1 = *m;4591for (i__ = 1; i__ <= i__1; ++i__) {4592i__2 = i__ + j * b_dim1;4593i__3 = i__ + j * b_dim1;4594q__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,4595q__1.i = temp.r * b[i__3].i + temp.i * b[i__3]4596.r;4597b[i__2].r = q__1.r, b[i__2].i = q__1.i;4598/* L170: */4599}4600i__1 = j - 1;4601for (k = 1; k <= i__1; ++k) {4602i__2 = k + j * a_dim1;4603if (a[i__2].r != 0.f || a[i__2].i != 0.f) {4604i__2 = k + j * a_dim1;4605q__1.r = alpha->r * a[i__2].r - alpha->i * a[i__2]4606.i, q__1.i = alpha->r * a[i__2].i +4607alpha->i * a[i__2].r;4608temp.r = q__1.r, temp.i = q__1.i;4609i__2 = *m;4610for (i__ = 1; i__ <= i__2; ++i__) {4611i__3 = i__ + j * b_dim1;4612i__4 = i__ + j * b_dim1;4613i__5 = i__ + k * b_dim1;4614q__2.r = temp.r * b[i__5].r - temp.i * b[i__5]4615.i, q__2.i = temp.r * b[i__5].i +4616temp.i * b[i__5].r;4617q__1.r = b[i__4].r + q__2.r, q__1.i = b[i__4]4618.i + q__2.i;4619b[i__3].r = q__1.r, b[i__3].i = q__1.i;4620/* L180: */4621}4622}4623/* L190: */4624}4625/* L200: */4626}4627} else {4628i__1 = *n;4629for (j = 1; j <= i__1; ++j) {4630temp.r = alpha->r, temp.i = alpha->i;4631if (nounit) {4632i__2 = j + j * a_dim1;4633q__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,4634q__1.i = temp.r * a[i__2].i + temp.i * a[i__2]4635.r;4636temp.r = q__1.r, temp.i = q__1.i;4637}4638i__2 = *m;4639for (i__ = 1; i__ <= i__2; ++i__) {4640i__3 = i__ + j * b_dim1;4641i__4 = i__ + j * b_dim1;4642q__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,4643q__1.i = temp.r * b[i__4].i + temp.i * b[i__4]4644.r;4645b[i__3].r = q__1.r, b[i__3].i = q__1.i;4646/* L210: */4647}4648i__2 = *n;4649for (k = j + 1; k <= i__2; ++k) {4650i__3 = k + j * a_dim1;4651if (a[i__3].r != 0.f || a[i__3].i != 0.f) {4652i__3 = k + j * a_dim1;4653q__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3]4654.i, q__1.i = alpha->r * a[i__3].i +4655alpha->i * a[i__3].r;4656temp.r = q__1.r, temp.i = q__1.i;4657i__3 = *m;4658for (i__ = 1; i__ <= i__3; ++i__) {4659i__4 = i__ + j * b_dim1;4660i__5 = i__ + j * b_dim1;4661i__6 = i__ + k * b_dim1;4662q__2.r = temp.r * b[i__6].r - temp.i * b[i__6]4663.i, q__2.i = temp.r * b[i__6].i +4664temp.i * b[i__6].r;4665q__1.r = b[i__5].r + q__2.r, q__1.i = b[i__5]4666.i + q__2.i;4667b[i__4].r = q__1.r, b[i__4].i = q__1.i;4668/* L220: */4669}4670}4671/* L230: */4672}4673/* L240: */4674}4675}4676} else {46774678/* Form B := alpha*B*A' or B := alpha*B*conjg( A' ). */46794680if (upper) {4681i__1 = *n;4682for (k = 1; k <= i__1; ++k) {4683i__2 = k - 1;4684for (j = 1; j <= i__2; ++j) {4685i__3 = j + k * a_dim1;4686if (a[i__3].r != 0.f || a[i__3].i != 0.f) {4687if (noconj) {4688i__3 = j + k * a_dim1;4689q__1.r = alpha->r * a[i__3].r - alpha->i * a[4690i__3].i, q__1.i = alpha->r * a[i__3]4691.i + alpha->i * a[i__3].r;4692temp.r = q__1.r, temp.i = q__1.i;4693} else {4694r_cnjg(&q__2, &a[j + k * a_dim1]);4695q__1.r = alpha->r * q__2.r - alpha->i *4696q__2.i, q__1.i = alpha->r * q__2.i +4697alpha->i * q__2.r;4698temp.r = q__1.r, temp.i = q__1.i;4699}4700i__3 = *m;4701for (i__ = 1; i__ <= i__3; ++i__) {4702i__4 = i__ + j * b_dim1;4703i__5 = i__ + j * b_dim1;4704i__6 = i__ + k * b_dim1;4705q__2.r = temp.r * b[i__6].r - temp.i * b[i__6]4706.i, q__2.i = temp.r * b[i__6].i +4707temp.i * b[i__6].r;4708q__1.r = b[i__5].r + q__2.r, q__1.i = b[i__5]4709.i + q__2.i;4710b[i__4].r = q__1.r, b[i__4].i = q__1.i;4711/* L250: */4712}4713}4714/* L260: */4715}4716temp.r = alpha->r, temp.i = alpha->i;4717if (nounit) {4718if (noconj) {4719i__2 = k + k * a_dim1;4720q__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,4721q__1.i = temp.r * a[i__2].i + temp.i * a[4722i__2].r;4723temp.r = q__1.r, temp.i = q__1.i;4724} else {4725r_cnjg(&q__2, &a[k + k * a_dim1]);4726q__1.r = temp.r * q__2.r - temp.i * q__2.i,4727q__1.i = temp.r * q__2.i + temp.i *4728q__2.r;4729temp.r = q__1.r, temp.i = q__1.i;4730}4731}4732if (temp.r != 1.f || temp.i != 0.f) {4733i__2 = *m;4734for (i__ = 1; i__ <= i__2; ++i__) {4735i__3 = i__ + k * b_dim1;4736i__4 = i__ + k * b_dim1;4737q__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,4738q__1.i = temp.r * b[i__4].i + temp.i * b[4739i__4].r;4740b[i__3].r = q__1.r, b[i__3].i = q__1.i;4741/* L270: */4742}4743}4744/* L280: */4745}4746} else {4747for (k = *n; k >= 1; --k) {4748i__1 = *n;4749for (j = k + 1; j <= i__1; ++j) {4750i__2 = j + k * a_dim1;4751if (a[i__2].r != 0.f || a[i__2].i != 0.f) {4752if (noconj) {4753i__2 = j + k * a_dim1;4754q__1.r = alpha->r * a[i__2].r - alpha->i * a[4755i__2].i, q__1.i = alpha->r * a[i__2]4756.i + alpha->i * a[i__2].r;4757temp.r = q__1.r, temp.i = q__1.i;4758} else {4759r_cnjg(&q__2, &a[j + k * a_dim1]);4760q__1.r = alpha->r * q__2.r - alpha->i *4761q__2.i, q__1.i = alpha->r * q__2.i +4762alpha->i * q__2.r;4763temp.r = q__1.r, temp.i = q__1.i;4764}4765i__2 = *m;4766for (i__ = 1; i__ <= i__2; ++i__) {4767i__3 = i__ + j * b_dim1;4768i__4 = i__ + j * b_dim1;4769i__5 = i__ + k * b_dim1;4770q__2.r = temp.r * b[i__5].r - temp.i * b[i__5]4771.i, q__2.i = temp.r * b[i__5].i +4772temp.i * b[i__5].r;4773q__1.r = b[i__4].r + q__2.r, q__1.i = b[i__4]4774.i + q__2.i;4775b[i__3].r = q__1.r, b[i__3].i = q__1.i;4776/* L290: */4777}4778}4779/* L300: */4780}4781temp.r = alpha->r, temp.i = alpha->i;4782if (nounit) {4783if (noconj) {4784i__1 = k + k * a_dim1;4785q__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,4786q__1.i = temp.r * a[i__1].i + temp.i * a[4787i__1].r;4788temp.r = q__1.r, temp.i = q__1.i;4789} else {4790r_cnjg(&q__2, &a[k + k * a_dim1]);4791q__1.r = temp.r * q__2.r - temp.i * q__2.i,4792q__1.i = temp.r * q__2.i + temp.i *4793q__2.r;4794temp.r = q__1.r, temp.i = q__1.i;4795}4796}4797if (temp.r != 1.f || temp.i != 0.f) {4798i__1 = *m;4799for (i__ = 1; i__ <= i__1; ++i__) {4800i__2 = i__ + k * b_dim1;4801i__3 = i__ + k * b_dim1;4802q__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,4803q__1.i = temp.r * b[i__3].i + temp.i * b[4804i__3].r;4805b[i__2].r = q__1.r, b[i__2].i = q__1.i;4806/* L310: */4807}4808}4809/* L320: */4810}4811}4812}4813}48144815return 0;48164817/* End of CTRMM . */48184819} /* ctrmm_ */48204821/* Subroutine */ int ctrmv_(char *uplo, char *trans, char *diag, integer *n,4822singlecomplex *a, integer *lda, singlecomplex *x, integer *incx)4823{4824/* System generated locals */4825integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;4826singlecomplex q__1, q__2, q__3;48274828/* Local variables */4829static integer i__, j, ix, jx, kx, info;4830static singlecomplex temp;4831extern logical lsame_(char *, char *);4832extern /* Subroutine */ int xerbla_(char *, integer *);4833static logical noconj, nounit;483448354836/*4837Purpose4838=======48394840CTRMV performs one of the matrix-vector operations48414842x := A*x, or x := A'*x, or x := conjg( A' )*x,48434844where x is an n element vector and A is an n by n unit, or non-unit,4845upper or lower triangular matrix.48464847Arguments4848==========48494850UPLO - CHARACTER*1.4851On entry, UPLO specifies whether the matrix is an upper or4852lower triangular matrix as follows:48534854UPLO = 'U' or 'u' A is an upper triangular matrix.48554856UPLO = 'L' or 'l' A is a lower triangular matrix.48574858Unchanged on exit.48594860TRANS - CHARACTER*1.4861On entry, TRANS specifies the operation to be performed as4862follows:48634864TRANS = 'N' or 'n' x := A*x.48654866TRANS = 'T' or 't' x := A'*x.48674868TRANS = 'C' or 'c' x := conjg( A' )*x.48694870Unchanged on exit.48714872DIAG - CHARACTER*1.4873On entry, DIAG specifies whether or not A is unit4874triangular as follows:48754876DIAG = 'U' or 'u' A is assumed to be unit triangular.48774878DIAG = 'N' or 'n' A is not assumed to be unit4879triangular.48804881Unchanged on exit.48824883N - INTEGER.4884On entry, N specifies the order of the matrix A.4885N must be at least zero.4886Unchanged on exit.48874888A - COMPLEX array of DIMENSION ( LDA, n ).4889Before entry with UPLO = 'U' or 'u', the leading n by n4890upper triangular part of the array A must contain the upper4891triangular matrix and the strictly lower triangular part of4892A is not referenced.4893Before entry with UPLO = 'L' or 'l', the leading n by n4894lower triangular part of the array A must contain the lower4895triangular matrix and the strictly upper triangular part of4896A is not referenced.4897Note that when DIAG = 'U' or 'u', the diagonal elements of4898A are not referenced either, but are assumed to be unity.4899Unchanged on exit.49004901LDA - INTEGER.4902On entry, LDA specifies the first dimension of A as declared4903in the calling (sub) program. LDA must be at least4904max( 1, n ).4905Unchanged on exit.49064907X - COMPLEX array of dimension at least4908( 1 + ( n - 1 )*abs( INCX ) ).4909Before entry, the incremented array X must contain the n4910element vector x. On exit, X is overwritten with the4911tranformed vector x.49124913INCX - INTEGER.4914On entry, INCX specifies the increment for the elements of4915X. INCX must not be zero.4916Unchanged on exit.49174918Further Details4919===============49204921Level 2 Blas routine.49224923-- Written on 22-October-1986.4924Jack Dongarra, Argonne National Lab.4925Jeremy Du Croz, Nag Central Office.4926Sven Hammarling, Nag Central Office.4927Richard Hanson, Sandia National Labs.49284929=====================================================================493049314932Test the input parameters.4933*/49344935/* Parameter adjustments */4936a_dim1 = *lda;4937a_offset = 1 + a_dim1;4938a -= a_offset;4939--x;49404941/* Function Body */4942info = 0;4943if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {4944info = 1;4945} else if (! lsame_(trans, "N") && ! lsame_(trans,4946"T") && ! lsame_(trans, "C")) {4947info = 2;4948} else if (! lsame_(diag, "U") && ! lsame_(diag,4949"N")) {4950info = 3;4951} else if (*n < 0) {4952info = 4;4953} else if (*lda < max(1,*n)) {4954info = 6;4955} else if (*incx == 0) {4956info = 8;4957}4958if (info != 0) {4959xerbla_("CTRMV ", &info);4960return 0;4961}49624963/* Quick return if possible. */49644965if (*n == 0) {4966return 0;4967}49684969noconj = lsame_(trans, "T");4970nounit = lsame_(diag, "N");49714972/*4973Set up the start point in X if the increment is not unity. This4974will be ( N - 1 )*INCX too small for descending loops.4975*/49764977if (*incx <= 0) {4978kx = 1 - (*n - 1) * *incx;4979} else if (*incx != 1) {4980kx = 1;4981}49824983/*4984Start the operations. In this version the elements of A are4985accessed sequentially with one pass through A.4986*/49874988if (lsame_(trans, "N")) {49894990/* Form x := A*x. */49914992if (lsame_(uplo, "U")) {4993if (*incx == 1) {4994i__1 = *n;4995for (j = 1; j <= i__1; ++j) {4996i__2 = j;4997if (x[i__2].r != 0.f || x[i__2].i != 0.f) {4998i__2 = j;4999temp.r = x[i__2].r, temp.i = x[i__2].i;5000i__2 = j - 1;5001for (i__ = 1; i__ <= i__2; ++i__) {5002i__3 = i__;5003i__4 = i__;5004i__5 = i__ + j * a_dim1;5005q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,5006q__2.i = temp.r * a[i__5].i + temp.i * a[5007i__5].r;5008q__1.r = x[i__4].r + q__2.r, q__1.i = x[i__4].i +5009q__2.i;5010x[i__3].r = q__1.r, x[i__3].i = q__1.i;5011/* L10: */5012}5013if (nounit) {5014i__2 = j;5015i__3 = j;5016i__4 = j + j * a_dim1;5017q__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[5018i__4].i, q__1.i = x[i__3].r * a[i__4].i +5019x[i__3].i * a[i__4].r;5020x[i__2].r = q__1.r, x[i__2].i = q__1.i;5021}5022}5023/* L20: */5024}5025} else {5026jx = kx;5027i__1 = *n;5028for (j = 1; j <= i__1; ++j) {5029i__2 = jx;5030if (x[i__2].r != 0.f || x[i__2].i != 0.f) {5031i__2 = jx;5032temp.r = x[i__2].r, temp.i = x[i__2].i;5033ix = kx;5034i__2 = j - 1;5035for (i__ = 1; i__ <= i__2; ++i__) {5036i__3 = ix;5037i__4 = ix;5038i__5 = i__ + j * a_dim1;5039q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,5040q__2.i = temp.r * a[i__5].i + temp.i * a[5041i__5].r;5042q__1.r = x[i__4].r + q__2.r, q__1.i = x[i__4].i +5043q__2.i;5044x[i__3].r = q__1.r, x[i__3].i = q__1.i;5045ix += *incx;5046/* L30: */5047}5048if (nounit) {5049i__2 = jx;5050i__3 = jx;5051i__4 = j + j * a_dim1;5052q__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[5053i__4].i, q__1.i = x[i__3].r * a[i__4].i +5054x[i__3].i * a[i__4].r;5055x[i__2].r = q__1.r, x[i__2].i = q__1.i;5056}5057}5058jx += *incx;5059/* L40: */5060}5061}5062} else {5063if (*incx == 1) {5064for (j = *n; j >= 1; --j) {5065i__1 = j;5066if (x[i__1].r != 0.f || x[i__1].i != 0.f) {5067i__1 = j;5068temp.r = x[i__1].r, temp.i = x[i__1].i;5069i__1 = j + 1;5070for (i__ = *n; i__ >= i__1; --i__) {5071i__2 = i__;5072i__3 = i__;5073i__4 = i__ + j * a_dim1;5074q__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,5075q__2.i = temp.r * a[i__4].i + temp.i * a[5076i__4].r;5077q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i +5078q__2.i;5079x[i__2].r = q__1.r, x[i__2].i = q__1.i;5080/* L50: */5081}5082if (nounit) {5083i__1 = j;5084i__2 = j;5085i__3 = j + j * a_dim1;5086q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[5087i__3].i, q__1.i = x[i__2].r * a[i__3].i +5088x[i__2].i * a[i__3].r;5089x[i__1].r = q__1.r, x[i__1].i = q__1.i;5090}5091}5092/* L60: */5093}5094} else {5095kx += (*n - 1) * *incx;5096jx = kx;5097for (j = *n; j >= 1; --j) {5098i__1 = jx;5099if (x[i__1].r != 0.f || x[i__1].i != 0.f) {5100i__1 = jx;5101temp.r = x[i__1].r, temp.i = x[i__1].i;5102ix = kx;5103i__1 = j + 1;5104for (i__ = *n; i__ >= i__1; --i__) {5105i__2 = ix;5106i__3 = ix;5107i__4 = i__ + j * a_dim1;5108q__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,5109q__2.i = temp.r * a[i__4].i + temp.i * a[5110i__4].r;5111q__1.r = x[i__3].r + q__2.r, q__1.i = x[i__3].i +5112q__2.i;5113x[i__2].r = q__1.r, x[i__2].i = q__1.i;5114ix -= *incx;5115/* L70: */5116}5117if (nounit) {5118i__1 = jx;5119i__2 = jx;5120i__3 = j + j * a_dim1;5121q__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[5122i__3].i, q__1.i = x[i__2].r * a[i__3].i +5123x[i__2].i * a[i__3].r;5124x[i__1].r = q__1.r, x[i__1].i = q__1.i;5125}5126}5127jx -= *incx;5128/* L80: */5129}5130}5131}5132} else {51335134/* Form x := A'*x or x := conjg( A' )*x. */51355136if (lsame_(uplo, "U")) {5137if (*incx == 1) {5138for (j = *n; j >= 1; --j) {5139i__1 = j;5140temp.r = x[i__1].r, temp.i = x[i__1].i;5141if (noconj) {5142if (nounit) {5143i__1 = j + j * a_dim1;5144q__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,5145q__1.i = temp.r * a[i__1].i + temp.i * a[5146i__1].r;5147temp.r = q__1.r, temp.i = q__1.i;5148}5149for (i__ = j - 1; i__ >= 1; --i__) {5150i__1 = i__ + j * a_dim1;5151i__2 = i__;5152q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[5153i__2].i, q__2.i = a[i__1].r * x[i__2].i +5154a[i__1].i * x[i__2].r;5155q__1.r = temp.r + q__2.r, q__1.i = temp.i +5156q__2.i;5157temp.r = q__1.r, temp.i = q__1.i;5158/* L90: */5159}5160} else {5161if (nounit) {5162r_cnjg(&q__2, &a[j + j * a_dim1]);5163q__1.r = temp.r * q__2.r - temp.i * q__2.i,5164q__1.i = temp.r * q__2.i + temp.i *5165q__2.r;5166temp.r = q__1.r, temp.i = q__1.i;5167}5168for (i__ = j - 1; i__ >= 1; --i__) {5169r_cnjg(&q__3, &a[i__ + j * a_dim1]);5170i__1 = i__;5171q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i,5172q__2.i = q__3.r * x[i__1].i + q__3.i * x[5173i__1].r;5174q__1.r = temp.r + q__2.r, q__1.i = temp.i +5175q__2.i;5176temp.r = q__1.r, temp.i = q__1.i;5177/* L100: */5178}5179}5180i__1 = j;5181x[i__1].r = temp.r, x[i__1].i = temp.i;5182/* L110: */5183}5184} else {5185jx = kx + (*n - 1) * *incx;5186for (j = *n; j >= 1; --j) {5187i__1 = jx;5188temp.r = x[i__1].r, temp.i = x[i__1].i;5189ix = jx;5190if (noconj) {5191if (nounit) {5192i__1 = j + j * a_dim1;5193q__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,5194q__1.i = temp.r * a[i__1].i + temp.i * a[5195i__1].r;5196temp.r = q__1.r, temp.i = q__1.i;5197}5198for (i__ = j - 1; i__ >= 1; --i__) {5199ix -= *incx;5200i__1 = i__ + j * a_dim1;5201i__2 = ix;5202q__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[5203i__2].i, q__2.i = a[i__1].r * x[i__2].i +5204a[i__1].i * x[i__2].r;5205q__1.r = temp.r + q__2.r, q__1.i = temp.i +5206q__2.i;5207temp.r = q__1.r, temp.i = q__1.i;5208/* L120: */5209}5210} else {5211if (nounit) {5212r_cnjg(&q__2, &a[j + j * a_dim1]);5213q__1.r = temp.r * q__2.r - temp.i * q__2.i,5214q__1.i = temp.r * q__2.i + temp.i *5215q__2.r;5216temp.r = q__1.r, temp.i = q__1.i;5217}5218for (i__ = j - 1; i__ >= 1; --i__) {5219ix -= *incx;5220r_cnjg(&q__3, &a[i__ + j * a_dim1]);5221i__1 = ix;5222q__2.r = q__3.r * x[i__1].r - q__3.i * x[i__1].i,5223q__2.i = q__3.r * x[i__1].i + q__3.i * x[5224i__1].r;5225q__1.r = temp.r + q__2.r, q__1.i = temp.i +5226q__2.i;5227temp.r = q__1.r, temp.i = q__1.i;5228/* L130: */5229}5230}5231i__1 = jx;5232x[i__1].r = temp.r, x[i__1].i = temp.i;5233jx -= *incx;5234/* L140: */5235}5236}5237} else {5238if (*incx == 1) {5239i__1 = *n;5240for (j = 1; j <= i__1; ++j) {5241i__2 = j;5242temp.r = x[i__2].r, temp.i = x[i__2].i;5243if (noconj) {5244if (nounit) {5245i__2 = j + j * a_dim1;5246q__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,5247q__1.i = temp.r * a[i__2].i + temp.i * a[5248i__2].r;5249temp.r = q__1.r, temp.i = q__1.i;5250}5251i__2 = *n;5252for (i__ = j + 1; i__ <= i__2; ++i__) {5253i__3 = i__ + j * a_dim1;5254i__4 = i__;5255q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[5256i__4].i, q__2.i = a[i__3].r * x[i__4].i +5257a[i__3].i * x[i__4].r;5258q__1.r = temp.r + q__2.r, q__1.i = temp.i +5259q__2.i;5260temp.r = q__1.r, temp.i = q__1.i;5261/* L150: */5262}5263} else {5264if (nounit) {5265r_cnjg(&q__2, &a[j + j * a_dim1]);5266q__1.r = temp.r * q__2.r - temp.i * q__2.i,5267q__1.i = temp.r * q__2.i + temp.i *5268q__2.r;5269temp.r = q__1.r, temp.i = q__1.i;5270}5271i__2 = *n;5272for (i__ = j + 1; i__ <= i__2; ++i__) {5273r_cnjg(&q__3, &a[i__ + j * a_dim1]);5274i__3 = i__;5275q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i,5276q__2.i = q__3.r * x[i__3].i + q__3.i * x[5277i__3].r;5278q__1.r = temp.r + q__2.r, q__1.i = temp.i +5279q__2.i;5280temp.r = q__1.r, temp.i = q__1.i;5281/* L160: */5282}5283}5284i__2 = j;5285x[i__2].r = temp.r, x[i__2].i = temp.i;5286/* L170: */5287}5288} else {5289jx = kx;5290i__1 = *n;5291for (j = 1; j <= i__1; ++j) {5292i__2 = jx;5293temp.r = x[i__2].r, temp.i = x[i__2].i;5294ix = jx;5295if (noconj) {5296if (nounit) {5297i__2 = j + j * a_dim1;5298q__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,5299q__1.i = temp.r * a[i__2].i + temp.i * a[5300i__2].r;5301temp.r = q__1.r, temp.i = q__1.i;5302}5303i__2 = *n;5304for (i__ = j + 1; i__ <= i__2; ++i__) {5305ix += *incx;5306i__3 = i__ + j * a_dim1;5307i__4 = ix;5308q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[5309i__4].i, q__2.i = a[i__3].r * x[i__4].i +5310a[i__3].i * x[i__4].r;5311q__1.r = temp.r + q__2.r, q__1.i = temp.i +5312q__2.i;5313temp.r = q__1.r, temp.i = q__1.i;5314/* L180: */5315}5316} else {5317if (nounit) {5318r_cnjg(&q__2, &a[j + j * a_dim1]);5319q__1.r = temp.r * q__2.r - temp.i * q__2.i,5320q__1.i = temp.r * q__2.i + temp.i *5321q__2.r;5322temp.r = q__1.r, temp.i = q__1.i;5323}5324i__2 = *n;5325for (i__ = j + 1; i__ <= i__2; ++i__) {5326ix += *incx;5327r_cnjg(&q__3, &a[i__ + j * a_dim1]);5328i__3 = ix;5329q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i,5330q__2.i = q__3.r * x[i__3].i + q__3.i * x[5331i__3].r;5332q__1.r = temp.r + q__2.r, q__1.i = temp.i +5333q__2.i;5334temp.r = q__1.r, temp.i = q__1.i;5335/* L190: */5336}5337}5338i__2 = jx;5339x[i__2].r = temp.r, x[i__2].i = temp.i;5340jx += *incx;5341/* L200: */5342}5343}5344}5345}53465347return 0;53485349/* End of CTRMV . */53505351} /* ctrmv_ */53525353/* Subroutine */ int ctrsm_(char *side, char *uplo, char *transa, char *diag,5354integer *m, integer *n, singlecomplex *alpha, singlecomplex *a, integer *lda,5355singlecomplex *b, integer *ldb)5356{5357/* System generated locals */5358integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,5359i__6, i__7;5360singlecomplex q__1, q__2, q__3;53615362/* Local variables */5363static integer i__, j, k, info;5364static singlecomplex temp;5365extern logical lsame_(char *, char *);5366static logical lside;5367static integer nrowa;5368static logical upper;5369extern /* Subroutine */ int xerbla_(char *, integer *);5370static logical noconj, nounit;537153725373/*5374Purpose5375=======53765377CTRSM solves one of the matrix equations53785379op( A )*X = alpha*B, or X*op( A ) = alpha*B,53805381where alpha is a scalar, X and B are m by n matrices, A is a unit, or5382non-unit, upper or lower triangular matrix and op( A ) is one of53835384op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).53855386The matrix X is overwritten on B.53875388Arguments5389==========53905391SIDE - CHARACTER*1.5392On entry, SIDE specifies whether op( A ) appears on the left5393or right of X as follows:53945395SIDE = 'L' or 'l' op( A )*X = alpha*B.53965397SIDE = 'R' or 'r' X*op( A ) = alpha*B.53985399Unchanged on exit.54005401UPLO - CHARACTER*1.5402On entry, UPLO specifies whether the matrix A is an upper or5403lower triangular matrix as follows:54045405UPLO = 'U' or 'u' A is an upper triangular matrix.54065407UPLO = 'L' or 'l' A is a lower triangular matrix.54085409Unchanged on exit.54105411TRANSA - CHARACTER*1.5412On entry, TRANSA specifies the form of op( A ) to be used in5413the matrix multiplication as follows:54145415TRANSA = 'N' or 'n' op( A ) = A.54165417TRANSA = 'T' or 't' op( A ) = A'.54185419TRANSA = 'C' or 'c' op( A ) = conjg( A' ).54205421Unchanged on exit.54225423DIAG - CHARACTER*1.5424On entry, DIAG specifies whether or not A is unit triangular5425as follows:54265427DIAG = 'U' or 'u' A is assumed to be unit triangular.54285429DIAG = 'N' or 'n' A is not assumed to be unit5430triangular.54315432Unchanged on exit.54335434M - INTEGER.5435On entry, M specifies the number of rows of B. M must be at5436least zero.5437Unchanged on exit.54385439N - INTEGER.5440On entry, N specifies the number of columns of B. N must be5441at least zero.5442Unchanged on exit.54435444ALPHA - COMPLEX .5445On entry, ALPHA specifies the scalar alpha. When alpha is5446zero then A is not referenced and B need not be set before5447entry.5448Unchanged on exit.54495450A - COMPLEX array of DIMENSION ( LDA, k ), where k is m5451when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.5452Before entry with UPLO = 'U' or 'u', the leading k by k5453upper triangular part of the array A must contain the upper5454triangular matrix and the strictly lower triangular part of5455A is not referenced.5456Before entry with UPLO = 'L' or 'l', the leading k by k5457lower triangular part of the array A must contain the lower5458triangular matrix and the strictly upper triangular part of5459A is not referenced.5460Note that when DIAG = 'U' or 'u', the diagonal elements of5461A are not referenced either, but are assumed to be unity.5462Unchanged on exit.54635464LDA - INTEGER.5465On entry, LDA specifies the first dimension of A as declared5466in the calling (sub) program. When SIDE = 'L' or 'l' then5467LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'5468then LDA must be at least max( 1, n ).5469Unchanged on exit.54705471B - COMPLEX array of DIMENSION ( LDB, n ).5472Before entry, the leading m by n part of the array B must5473contain the right-hand side matrix B, and on exit is5474overwritten by the solution matrix X.54755476LDB - INTEGER.5477On entry, LDB specifies the first dimension of B as declared5478in the calling (sub) program. LDB must be at least5479max( 1, m ).5480Unchanged on exit.54815482Further Details5483===============54845485Level 3 Blas routine.54865487-- Written on 8-February-1989.5488Jack Dongarra, Argonne National Laboratory.5489Iain Duff, AERE Harwell.5490Jeremy Du Croz, Numerical Algorithms Group Ltd.5491Sven Hammarling, Numerical Algorithms Group Ltd.54925493=====================================================================549454955496Test the input parameters.5497*/54985499/* Parameter adjustments */5500a_dim1 = *lda;5501a_offset = 1 + a_dim1;5502a -= a_offset;5503b_dim1 = *ldb;5504b_offset = 1 + b_dim1;5505b -= b_offset;55065507/* Function Body */5508lside = lsame_(side, "L");5509if (lside) {5510nrowa = *m;5511} else {5512nrowa = *n;5513}5514noconj = lsame_(transa, "T");5515nounit = lsame_(diag, "N");5516upper = lsame_(uplo, "U");55175518info = 0;5519if (! lside && ! lsame_(side, "R")) {5520info = 1;5521} else if (! upper && ! lsame_(uplo, "L")) {5522info = 2;5523} else if (! lsame_(transa, "N") && ! lsame_(transa,5524"T") && ! lsame_(transa, "C")) {5525info = 3;5526} else if (! lsame_(diag, "U") && ! lsame_(diag,5527"N")) {5528info = 4;5529} else if (*m < 0) {5530info = 5;5531} else if (*n < 0) {5532info = 6;5533} else if (*lda < max(1,nrowa)) {5534info = 9;5535} else if (*ldb < max(1,*m)) {5536info = 11;5537}5538if (info != 0) {5539xerbla_("CTRSM ", &info);5540return 0;5541}55425543/* Quick return if possible. */55445545if (*m == 0 || *n == 0) {5546return 0;5547}55485549/* And when alpha.eq.zero. */55505551if (alpha->r == 0.f && alpha->i == 0.f) {5552i__1 = *n;5553for (j = 1; j <= i__1; ++j) {5554i__2 = *m;5555for (i__ = 1; i__ <= i__2; ++i__) {5556i__3 = i__ + j * b_dim1;5557b[i__3].r = 0.f, b[i__3].i = 0.f;5558/* L10: */5559}5560/* L20: */5561}5562return 0;5563}55645565/* Start the operations. */55665567if (lside) {5568if (lsame_(transa, "N")) {55695570/* Form B := alpha*inv( A )*B. */55715572if (upper) {5573i__1 = *n;5574for (j = 1; j <= i__1; ++j) {5575if (alpha->r != 1.f || alpha->i != 0.f) {5576i__2 = *m;5577for (i__ = 1; i__ <= i__2; ++i__) {5578i__3 = i__ + j * b_dim1;5579i__4 = i__ + j * b_dim1;5580q__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]5581.i, q__1.i = alpha->r * b[i__4].i +5582alpha->i * b[i__4].r;5583b[i__3].r = q__1.r, b[i__3].i = q__1.i;5584/* L30: */5585}5586}5587for (k = *m; k >= 1; --k) {5588i__2 = k + j * b_dim1;5589if (b[i__2].r != 0.f || b[i__2].i != 0.f) {5590if (nounit) {5591i__2 = k + j * b_dim1;5592c_div(&q__1, &b[k + j * b_dim1], &a[k + k *5593a_dim1]);5594b[i__2].r = q__1.r, b[i__2].i = q__1.i;5595}5596i__2 = k - 1;5597for (i__ = 1; i__ <= i__2; ++i__) {5598i__3 = i__ + j * b_dim1;5599i__4 = i__ + j * b_dim1;5600i__5 = k + j * b_dim1;5601i__6 = i__ + k * a_dim1;5602q__2.r = b[i__5].r * a[i__6].r - b[i__5].i *5603a[i__6].i, q__2.i = b[i__5].r * a[5604i__6].i + b[i__5].i * a[i__6].r;5605q__1.r = b[i__4].r - q__2.r, q__1.i = b[i__4]5606.i - q__2.i;5607b[i__3].r = q__1.r, b[i__3].i = q__1.i;5608/* L40: */5609}5610}5611/* L50: */5612}5613/* L60: */5614}5615} else {5616i__1 = *n;5617for (j = 1; j <= i__1; ++j) {5618if (alpha->r != 1.f || alpha->i != 0.f) {5619i__2 = *m;5620for (i__ = 1; i__ <= i__2; ++i__) {5621i__3 = i__ + j * b_dim1;5622i__4 = i__ + j * b_dim1;5623q__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]5624.i, q__1.i = alpha->r * b[i__4].i +5625alpha->i * b[i__4].r;5626b[i__3].r = q__1.r, b[i__3].i = q__1.i;5627/* L70: */5628}5629}5630i__2 = *m;5631for (k = 1; k <= i__2; ++k) {5632i__3 = k + j * b_dim1;5633if (b[i__3].r != 0.f || b[i__3].i != 0.f) {5634if (nounit) {5635i__3 = k + j * b_dim1;5636c_div(&q__1, &b[k + j * b_dim1], &a[k + k *5637a_dim1]);5638b[i__3].r = q__1.r, b[i__3].i = q__1.i;5639}5640i__3 = *m;5641for (i__ = k + 1; i__ <= i__3; ++i__) {5642i__4 = i__ + j * b_dim1;5643i__5 = i__ + j * b_dim1;5644i__6 = k + j * b_dim1;5645i__7 = i__ + k * a_dim1;5646q__2.r = b[i__6].r * a[i__7].r - b[i__6].i *5647a[i__7].i, q__2.i = b[i__6].r * a[5648i__7].i + b[i__6].i * a[i__7].r;5649q__1.r = b[i__5].r - q__2.r, q__1.i = b[i__5]5650.i - q__2.i;5651b[i__4].r = q__1.r, b[i__4].i = q__1.i;5652/* L80: */5653}5654}5655/* L90: */5656}5657/* L100: */5658}5659}5660} else {56615662/*5663Form B := alpha*inv( A' )*B5664or B := alpha*inv( conjg( A' ) )*B.5665*/56665667if (upper) {5668i__1 = *n;5669for (j = 1; j <= i__1; ++j) {5670i__2 = *m;5671for (i__ = 1; i__ <= i__2; ++i__) {5672i__3 = i__ + j * b_dim1;5673q__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,5674q__1.i = alpha->r * b[i__3].i + alpha->i * b[5675i__3].r;5676temp.r = q__1.r, temp.i = q__1.i;5677if (noconj) {5678i__3 = i__ - 1;5679for (k = 1; k <= i__3; ++k) {5680i__4 = k + i__ * a_dim1;5681i__5 = k + j * b_dim1;5682q__2.r = a[i__4].r * b[i__5].r - a[i__4].i *5683b[i__5].i, q__2.i = a[i__4].r * b[5684i__5].i + a[i__4].i * b[i__5].r;5685q__1.r = temp.r - q__2.r, q__1.i = temp.i -5686q__2.i;5687temp.r = q__1.r, temp.i = q__1.i;5688/* L110: */5689}5690if (nounit) {5691c_div(&q__1, &temp, &a[i__ + i__ * a_dim1]);5692temp.r = q__1.r, temp.i = q__1.i;5693}5694} else {5695i__3 = i__ - 1;5696for (k = 1; k <= i__3; ++k) {5697r_cnjg(&q__3, &a[k + i__ * a_dim1]);5698i__4 = k + j * b_dim1;5699q__2.r = q__3.r * b[i__4].r - q__3.i * b[i__4]5700.i, q__2.i = q__3.r * b[i__4].i +5701q__3.i * b[i__4].r;5702q__1.r = temp.r - q__2.r, q__1.i = temp.i -5703q__2.i;5704temp.r = q__1.r, temp.i = q__1.i;5705/* L120: */5706}5707if (nounit) {5708r_cnjg(&q__2, &a[i__ + i__ * a_dim1]);5709c_div(&q__1, &temp, &q__2);5710temp.r = q__1.r, temp.i = q__1.i;5711}5712}5713i__3 = i__ + j * b_dim1;5714b[i__3].r = temp.r, b[i__3].i = temp.i;5715/* L130: */5716}5717/* L140: */5718}5719} else {5720i__1 = *n;5721for (j = 1; j <= i__1; ++j) {5722for (i__ = *m; i__ >= 1; --i__) {5723i__2 = i__ + j * b_dim1;5724q__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,5725q__1.i = alpha->r * b[i__2].i + alpha->i * b[5726i__2].r;5727temp.r = q__1.r, temp.i = q__1.i;5728if (noconj) {5729i__2 = *m;5730for (k = i__ + 1; k <= i__2; ++k) {5731i__3 = k + i__ * a_dim1;5732i__4 = k + j * b_dim1;5733q__2.r = a[i__3].r * b[i__4].r - a[i__3].i *5734b[i__4].i, q__2.i = a[i__3].r * b[5735i__4].i + a[i__3].i * b[i__4].r;5736q__1.r = temp.r - q__2.r, q__1.i = temp.i -5737q__2.i;5738temp.r = q__1.r, temp.i = q__1.i;5739/* L150: */5740}5741if (nounit) {5742c_div(&q__1, &temp, &a[i__ + i__ * a_dim1]);5743temp.r = q__1.r, temp.i = q__1.i;5744}5745} else {5746i__2 = *m;5747for (k = i__ + 1; k <= i__2; ++k) {5748r_cnjg(&q__3, &a[k + i__ * a_dim1]);5749i__3 = k + j * b_dim1;5750q__2.r = q__3.r * b[i__3].r - q__3.i * b[i__3]5751.i, q__2.i = q__3.r * b[i__3].i +5752q__3.i * b[i__3].r;5753q__1.r = temp.r - q__2.r, q__1.i = temp.i -5754q__2.i;5755temp.r = q__1.r, temp.i = q__1.i;5756/* L160: */5757}5758if (nounit) {5759r_cnjg(&q__2, &a[i__ + i__ * a_dim1]);5760c_div(&q__1, &temp, &q__2);5761temp.r = q__1.r, temp.i = q__1.i;5762}5763}5764i__2 = i__ + j * b_dim1;5765b[i__2].r = temp.r, b[i__2].i = temp.i;5766/* L170: */5767}5768/* L180: */5769}5770}5771}5772} else {5773if (lsame_(transa, "N")) {57745775/* Form B := alpha*B*inv( A ). */57765777if (upper) {5778i__1 = *n;5779for (j = 1; j <= i__1; ++j) {5780if (alpha->r != 1.f || alpha->i != 0.f) {5781i__2 = *m;5782for (i__ = 1; i__ <= i__2; ++i__) {5783i__3 = i__ + j * b_dim1;5784i__4 = i__ + j * b_dim1;5785q__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]5786.i, q__1.i = alpha->r * b[i__4].i +5787alpha->i * b[i__4].r;5788b[i__3].r = q__1.r, b[i__3].i = q__1.i;5789/* L190: */5790}5791}5792i__2 = j - 1;5793for (k = 1; k <= i__2; ++k) {5794i__3 = k + j * a_dim1;5795if (a[i__3].r != 0.f || a[i__3].i != 0.f) {5796i__3 = *m;5797for (i__ = 1; i__ <= i__3; ++i__) {5798i__4 = i__ + j * b_dim1;5799i__5 = i__ + j * b_dim1;5800i__6 = k + j * a_dim1;5801i__7 = i__ + k * b_dim1;5802q__2.r = a[i__6].r * b[i__7].r - a[i__6].i *5803b[i__7].i, q__2.i = a[i__6].r * b[5804i__7].i + a[i__6].i * b[i__7].r;5805q__1.r = b[i__5].r - q__2.r, q__1.i = b[i__5]5806.i - q__2.i;5807b[i__4].r = q__1.r, b[i__4].i = q__1.i;5808/* L200: */5809}5810}5811/* L210: */5812}5813if (nounit) {5814c_div(&q__1, &c_b21, &a[j + j * a_dim1]);5815temp.r = q__1.r, temp.i = q__1.i;5816i__2 = *m;5817for (i__ = 1; i__ <= i__2; ++i__) {5818i__3 = i__ + j * b_dim1;5819i__4 = i__ + j * b_dim1;5820q__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,5821q__1.i = temp.r * b[i__4].i + temp.i * b[5822i__4].r;5823b[i__3].r = q__1.r, b[i__3].i = q__1.i;5824/* L220: */5825}5826}5827/* L230: */5828}5829} else {5830for (j = *n; j >= 1; --j) {5831if (alpha->r != 1.f || alpha->i != 0.f) {5832i__1 = *m;5833for (i__ = 1; i__ <= i__1; ++i__) {5834i__2 = i__ + j * b_dim1;5835i__3 = i__ + j * b_dim1;5836q__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]5837.i, q__1.i = alpha->r * b[i__3].i +5838alpha->i * b[i__3].r;5839b[i__2].r = q__1.r, b[i__2].i = q__1.i;5840/* L240: */5841}5842}5843i__1 = *n;5844for (k = j + 1; k <= i__1; ++k) {5845i__2 = k + j * a_dim1;5846if (a[i__2].r != 0.f || a[i__2].i != 0.f) {5847i__2 = *m;5848for (i__ = 1; i__ <= i__2; ++i__) {5849i__3 = i__ + j * b_dim1;5850i__4 = i__ + j * b_dim1;5851i__5 = k + j * a_dim1;5852i__6 = i__ + k * b_dim1;5853q__2.r = a[i__5].r * b[i__6].r - a[i__5].i *5854b[i__6].i, q__2.i = a[i__5].r * b[5855i__6].i + a[i__5].i * b[i__6].r;5856q__1.r = b[i__4].r - q__2.r, q__1.i = b[i__4]5857.i - q__2.i;5858b[i__3].r = q__1.r, b[i__3].i = q__1.i;5859/* L250: */5860}5861}5862/* L260: */5863}5864if (nounit) {5865c_div(&q__1, &c_b21, &a[j + j * a_dim1]);5866temp.r = q__1.r, temp.i = q__1.i;5867i__1 = *m;5868for (i__ = 1; i__ <= i__1; ++i__) {5869i__2 = i__ + j * b_dim1;5870i__3 = i__ + j * b_dim1;5871q__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,5872q__1.i = temp.r * b[i__3].i + temp.i * b[5873i__3].r;5874b[i__2].r = q__1.r, b[i__2].i = q__1.i;5875/* L270: */5876}5877}5878/* L280: */5879}5880}5881} else {58825883/*5884Form B := alpha*B*inv( A' )5885or B := alpha*B*inv( conjg( A' ) ).5886*/58875888if (upper) {5889for (k = *n; k >= 1; --k) {5890if (nounit) {5891if (noconj) {5892c_div(&q__1, &c_b21, &a[k + k * a_dim1]);5893temp.r = q__1.r, temp.i = q__1.i;5894} else {5895r_cnjg(&q__2, &a[k + k * a_dim1]);5896c_div(&q__1, &c_b21, &q__2);5897temp.r = q__1.r, temp.i = q__1.i;5898}5899i__1 = *m;5900for (i__ = 1; i__ <= i__1; ++i__) {5901i__2 = i__ + k * b_dim1;5902i__3 = i__ + k * b_dim1;5903q__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,5904q__1.i = temp.r * b[i__3].i + temp.i * b[5905i__3].r;5906b[i__2].r = q__1.r, b[i__2].i = q__1.i;5907/* L290: */5908}5909}5910i__1 = k - 1;5911for (j = 1; j <= i__1; ++j) {5912i__2 = j + k * a_dim1;5913if (a[i__2].r != 0.f || a[i__2].i != 0.f) {5914if (noconj) {5915i__2 = j + k * a_dim1;5916temp.r = a[i__2].r, temp.i = a[i__2].i;5917} else {5918r_cnjg(&q__1, &a[j + k * a_dim1]);5919temp.r = q__1.r, temp.i = q__1.i;5920}5921i__2 = *m;5922for (i__ = 1; i__ <= i__2; ++i__) {5923i__3 = i__ + j * b_dim1;5924i__4 = i__ + j * b_dim1;5925i__5 = i__ + k * b_dim1;5926q__2.r = temp.r * b[i__5].r - temp.i * b[i__5]5927.i, q__2.i = temp.r * b[i__5].i +5928temp.i * b[i__5].r;5929q__1.r = b[i__4].r - q__2.r, q__1.i = b[i__4]5930.i - q__2.i;5931b[i__3].r = q__1.r, b[i__3].i = q__1.i;5932/* L300: */5933}5934}5935/* L310: */5936}5937if (alpha->r != 1.f || alpha->i != 0.f) {5938i__1 = *m;5939for (i__ = 1; i__ <= i__1; ++i__) {5940i__2 = i__ + k * b_dim1;5941i__3 = i__ + k * b_dim1;5942q__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]5943.i, q__1.i = alpha->r * b[i__3].i +5944alpha->i * b[i__3].r;5945b[i__2].r = q__1.r, b[i__2].i = q__1.i;5946/* L320: */5947}5948}5949/* L330: */5950}5951} else {5952i__1 = *n;5953for (k = 1; k <= i__1; ++k) {5954if (nounit) {5955if (noconj) {5956c_div(&q__1, &c_b21, &a[k + k * a_dim1]);5957temp.r = q__1.r, temp.i = q__1.i;5958} else {5959r_cnjg(&q__2, &a[k + k * a_dim1]);5960c_div(&q__1, &c_b21, &q__2);5961temp.r = q__1.r, temp.i = q__1.i;5962}5963i__2 = *m;5964for (i__ = 1; i__ <= i__2; ++i__) {5965i__3 = i__ + k * b_dim1;5966i__4 = i__ + k * b_dim1;5967q__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,5968q__1.i = temp.r * b[i__4].i + temp.i * b[5969i__4].r;5970b[i__3].r = q__1.r, b[i__3].i = q__1.i;5971/* L340: */5972}5973}5974i__2 = *n;5975for (j = k + 1; j <= i__2; ++j) {5976i__3 = j + k * a_dim1;5977if (a[i__3].r != 0.f || a[i__3].i != 0.f) {5978if (noconj) {5979i__3 = j + k * a_dim1;5980temp.r = a[i__3].r, temp.i = a[i__3].i;5981} else {5982r_cnjg(&q__1, &a[j + k * a_dim1]);5983temp.r = q__1.r, temp.i = q__1.i;5984}5985i__3 = *m;5986for (i__ = 1; i__ <= i__3; ++i__) {5987i__4 = i__ + j * b_dim1;5988i__5 = i__ + j * b_dim1;5989i__6 = i__ + k * b_dim1;5990q__2.r = temp.r * b[i__6].r - temp.i * b[i__6]5991.i, q__2.i = temp.r * b[i__6].i +5992temp.i * b[i__6].r;5993q__1.r = b[i__5].r - q__2.r, q__1.i = b[i__5]5994.i - q__2.i;5995b[i__4].r = q__1.r, b[i__4].i = q__1.i;5996/* L350: */5997}5998}5999/* L360: */6000}6001if (alpha->r != 1.f || alpha->i != 0.f) {6002i__2 = *m;6003for (i__ = 1; i__ <= i__2; ++i__) {6004i__3 = i__ + k * b_dim1;6005i__4 = i__ + k * b_dim1;6006q__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]6007.i, q__1.i = alpha->r * b[i__4].i +6008alpha->i * b[i__4].r;6009b[i__3].r = q__1.r, b[i__3].i = q__1.i;6010/* L370: */6011}6012}6013/* L380: */6014}6015}6016}6017}60186019return 0;60206021/* End of CTRSM . */60226023} /* ctrsm_ */60246025/* Subroutine */ int ctrsv_(char *uplo, char *trans, char *diag, integer *n,6026singlecomplex *a, integer *lda, singlecomplex *x, integer *incx)6027{6028/* System generated locals */6029integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;6030singlecomplex q__1, q__2, q__3;60316032/* Local variables */6033static integer i__, j, ix, jx, kx, info;6034static singlecomplex temp;6035extern logical lsame_(char *, char *);6036extern /* Subroutine */ int xerbla_(char *, integer *);6037static logical noconj, nounit;603860396040/*6041Purpose6042=======60436044CTRSV solves one of the systems of equations60456046A*x = b, or A'*x = b, or conjg( A' )*x = b,60476048where b and x are n element vectors and A is an n by n unit, or6049non-unit, upper or lower triangular matrix.60506051No test for singularity or near-singularity is included in this6052routine. Such tests must be performed before calling this routine.60536054Arguments6055==========60566057UPLO - CHARACTER*1.6058On entry, UPLO specifies whether the matrix is an upper or6059lower triangular matrix as follows:60606061UPLO = 'U' or 'u' A is an upper triangular matrix.60626063UPLO = 'L' or 'l' A is a lower triangular matrix.60646065Unchanged on exit.60666067TRANS - CHARACTER*1.6068On entry, TRANS specifies the equations to be solved as6069follows:60706071TRANS = 'N' or 'n' A*x = b.60726073TRANS = 'T' or 't' A'*x = b.60746075TRANS = 'C' or 'c' conjg( A' )*x = b.60766077Unchanged on exit.60786079DIAG - CHARACTER*1.6080On entry, DIAG specifies whether or not A is unit6081triangular as follows:60826083DIAG = 'U' or 'u' A is assumed to be unit triangular.60846085DIAG = 'N' or 'n' A is not assumed to be unit6086triangular.60876088Unchanged on exit.60896090N - INTEGER.6091On entry, N specifies the order of the matrix A.6092N must be at least zero.6093Unchanged on exit.60946095A - COMPLEX array of DIMENSION ( LDA, n ).6096Before entry with UPLO = 'U' or 'u', the leading n by n6097upper triangular part of the array A must contain the upper6098triangular matrix and the strictly lower triangular part of6099A is not referenced.6100Before entry with UPLO = 'L' or 'l', the leading n by n6101lower triangular part of the array A must contain the lower6102triangular matrix and the strictly upper triangular part of6103A is not referenced.6104Note that when DIAG = 'U' or 'u', the diagonal elements of6105A are not referenced either, but are assumed to be unity.6106Unchanged on exit.61076108LDA - INTEGER.6109On entry, LDA specifies the first dimension of A as declared6110in the calling (sub) program. LDA must be at least6111max( 1, n ).6112Unchanged on exit.61136114X - COMPLEX array of dimension at least6115( 1 + ( n - 1 )*abs( INCX ) ).6116Before entry, the incremented array X must contain the n6117element right-hand side vector b. On exit, X is overwritten6118with the solution vector x.61196120INCX - INTEGER.6121On entry, INCX specifies the increment for the elements of6122X. INCX must not be zero.6123Unchanged on exit.61246125Further Details6126===============61276128Level 2 Blas routine.61296130-- Written on 22-October-1986.6131Jack Dongarra, Argonne National Lab.6132Jeremy Du Croz, Nag Central Office.6133Sven Hammarling, Nag Central Office.6134Richard Hanson, Sandia National Labs.61356136=====================================================================613761386139Test the input parameters.6140*/61416142/* Parameter adjustments */6143a_dim1 = *lda;6144a_offset = 1 + a_dim1;6145a -= a_offset;6146--x;61476148/* Function Body */6149info = 0;6150if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {6151info = 1;6152} else if (! lsame_(trans, "N") && ! lsame_(trans,6153"T") && ! lsame_(trans, "C")) {6154info = 2;6155} else if (! lsame_(diag, "U") && ! lsame_(diag,6156"N")) {6157info = 3;6158} else if (*n < 0) {6159info = 4;6160} else if (*lda < max(1,*n)) {6161info = 6;6162} else if (*incx == 0) {6163info = 8;6164}6165if (info != 0) {6166xerbla_("CTRSV ", &info);6167return 0;6168}61696170/* Quick return if possible. */61716172if (*n == 0) {6173return 0;6174}61756176noconj = lsame_(trans, "T");6177nounit = lsame_(diag, "N");61786179/*6180Set up the start point in X if the increment is not unity. This6181will be ( N - 1 )*INCX too small for descending loops.6182*/61836184if (*incx <= 0) {6185kx = 1 - (*n - 1) * *incx;6186} else if (*incx != 1) {6187kx = 1;6188}61896190/*6191Start the operations. In this version the elements of A are6192accessed sequentially with one pass through A.6193*/61946195if (lsame_(trans, "N")) {61966197/* Form x := inv( A )*x. */61986199if (lsame_(uplo, "U")) {6200if (*incx == 1) {6201for (j = *n; j >= 1; --j) {6202i__1 = j;6203if (x[i__1].r != 0.f || x[i__1].i != 0.f) {6204if (nounit) {6205i__1 = j;6206c_div(&q__1, &x[j], &a[j + j * a_dim1]);6207x[i__1].r = q__1.r, x[i__1].i = q__1.i;6208}6209i__1 = j;6210temp.r = x[i__1].r, temp.i = x[i__1].i;6211for (i__ = j - 1; i__ >= 1; --i__) {6212i__1 = i__;6213i__2 = i__;6214i__3 = i__ + j * a_dim1;6215q__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,6216q__2.i = temp.r * a[i__3].i + temp.i * a[6217i__3].r;6218q__1.r = x[i__2].r - q__2.r, q__1.i = x[i__2].i -6219q__2.i;6220x[i__1].r = q__1.r, x[i__1].i = q__1.i;6221/* L10: */6222}6223}6224/* L20: */6225}6226} else {6227jx = kx + (*n - 1) * *incx;6228for (j = *n; j >= 1; --j) {6229i__1 = jx;6230if (x[i__1].r != 0.f || x[i__1].i != 0.f) {6231if (nounit) {6232i__1 = jx;6233c_div(&q__1, &x[jx], &a[j + j * a_dim1]);6234x[i__1].r = q__1.r, x[i__1].i = q__1.i;6235}6236i__1 = jx;6237temp.r = x[i__1].r, temp.i = x[i__1].i;6238ix = jx;6239for (i__ = j - 1; i__ >= 1; --i__) {6240ix -= *incx;6241i__1 = ix;6242i__2 = ix;6243i__3 = i__ + j * a_dim1;6244q__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,6245q__2.i = temp.r * a[i__3].i + temp.i * a[6246i__3].r;6247q__1.r = x[i__2].r - q__2.r, q__1.i = x[i__2].i -6248q__2.i;6249x[i__1].r = q__1.r, x[i__1].i = q__1.i;6250/* L30: */6251}6252}6253jx -= *incx;6254/* L40: */6255}6256}6257} else {6258if (*incx == 1) {6259i__1 = *n;6260for (j = 1; j <= i__1; ++j) {6261i__2 = j;6262if (x[i__2].r != 0.f || x[i__2].i != 0.f) {6263if (nounit) {6264i__2 = j;6265c_div(&q__1, &x[j], &a[j + j * a_dim1]);6266x[i__2].r = q__1.r, x[i__2].i = q__1.i;6267}6268i__2 = j;6269temp.r = x[i__2].r, temp.i = x[i__2].i;6270i__2 = *n;6271for (i__ = j + 1; i__ <= i__2; ++i__) {6272i__3 = i__;6273i__4 = i__;6274i__5 = i__ + j * a_dim1;6275q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,6276q__2.i = temp.r * a[i__5].i + temp.i * a[6277i__5].r;6278q__1.r = x[i__4].r - q__2.r, q__1.i = x[i__4].i -6279q__2.i;6280x[i__3].r = q__1.r, x[i__3].i = q__1.i;6281/* L50: */6282}6283}6284/* L60: */6285}6286} else {6287jx = kx;6288i__1 = *n;6289for (j = 1; j <= i__1; ++j) {6290i__2 = jx;6291if (x[i__2].r != 0.f || x[i__2].i != 0.f) {6292if (nounit) {6293i__2 = jx;6294c_div(&q__1, &x[jx], &a[j + j * a_dim1]);6295x[i__2].r = q__1.r, x[i__2].i = q__1.i;6296}6297i__2 = jx;6298temp.r = x[i__2].r, temp.i = x[i__2].i;6299ix = jx;6300i__2 = *n;6301for (i__ = j + 1; i__ <= i__2; ++i__) {6302ix += *incx;6303i__3 = ix;6304i__4 = ix;6305i__5 = i__ + j * a_dim1;6306q__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,6307q__2.i = temp.r * a[i__5].i + temp.i * a[6308i__5].r;6309q__1.r = x[i__4].r - q__2.r, q__1.i = x[i__4].i -6310q__2.i;6311x[i__3].r = q__1.r, x[i__3].i = q__1.i;6312/* L70: */6313}6314}6315jx += *incx;6316/* L80: */6317}6318}6319}6320} else {63216322/* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x. */63236324if (lsame_(uplo, "U")) {6325if (*incx == 1) {6326i__1 = *n;6327for (j = 1; j <= i__1; ++j) {6328i__2 = j;6329temp.r = x[i__2].r, temp.i = x[i__2].i;6330if (noconj) {6331i__2 = j - 1;6332for (i__ = 1; i__ <= i__2; ++i__) {6333i__3 = i__ + j * a_dim1;6334i__4 = i__;6335q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[6336i__4].i, q__2.i = a[i__3].r * x[i__4].i +6337a[i__3].i * x[i__4].r;6338q__1.r = temp.r - q__2.r, q__1.i = temp.i -6339q__2.i;6340temp.r = q__1.r, temp.i = q__1.i;6341/* L90: */6342}6343if (nounit) {6344c_div(&q__1, &temp, &a[j + j * a_dim1]);6345temp.r = q__1.r, temp.i = q__1.i;6346}6347} else {6348i__2 = j - 1;6349for (i__ = 1; i__ <= i__2; ++i__) {6350r_cnjg(&q__3, &a[i__ + j * a_dim1]);6351i__3 = i__;6352q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i,6353q__2.i = q__3.r * x[i__3].i + q__3.i * x[6354i__3].r;6355q__1.r = temp.r - q__2.r, q__1.i = temp.i -6356q__2.i;6357temp.r = q__1.r, temp.i = q__1.i;6358/* L100: */6359}6360if (nounit) {6361r_cnjg(&q__2, &a[j + j * a_dim1]);6362c_div(&q__1, &temp, &q__2);6363temp.r = q__1.r, temp.i = q__1.i;6364}6365}6366i__2 = j;6367x[i__2].r = temp.r, x[i__2].i = temp.i;6368/* L110: */6369}6370} else {6371jx = kx;6372i__1 = *n;6373for (j = 1; j <= i__1; ++j) {6374ix = kx;6375i__2 = jx;6376temp.r = x[i__2].r, temp.i = x[i__2].i;6377if (noconj) {6378i__2 = j - 1;6379for (i__ = 1; i__ <= i__2; ++i__) {6380i__3 = i__ + j * a_dim1;6381i__4 = ix;6382q__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[6383i__4].i, q__2.i = a[i__3].r * x[i__4].i +6384a[i__3].i * x[i__4].r;6385q__1.r = temp.r - q__2.r, q__1.i = temp.i -6386q__2.i;6387temp.r = q__1.r, temp.i = q__1.i;6388ix += *incx;6389/* L120: */6390}6391if (nounit) {6392c_div(&q__1, &temp, &a[j + j * a_dim1]);6393temp.r = q__1.r, temp.i = q__1.i;6394}6395} else {6396i__2 = j - 1;6397for (i__ = 1; i__ <= i__2; ++i__) {6398r_cnjg(&q__3, &a[i__ + j * a_dim1]);6399i__3 = ix;6400q__2.r = q__3.r * x[i__3].r - q__3.i * x[i__3].i,6401q__2.i = q__3.r * x[i__3].i + q__3.i * x[6402i__3].r;6403q__1.r = temp.r - q__2.r, q__1.i = temp.i -6404q__2.i;6405temp.r = q__1.r, temp.i = q__1.i;6406ix += *incx;6407/* L130: */6408}6409if (nounit) {6410r_cnjg(&q__2, &a[j + j * a_dim1]);6411c_div(&q__1, &temp, &q__2);6412temp.r = q__1.r, temp.i = q__1.i;6413}6414}6415i__2 = jx;6416x[i__2].r = temp.r, x[i__2].i = temp.i;6417jx += *incx;6418/* L140: */6419}6420}6421} else {6422if (*incx == 1) {6423for (j = *n; j >= 1; --j) {6424i__1 = j;6425temp.r = x[i__1].r, temp.i = x[i__1].i;6426if (noconj) {6427i__1 = j + 1;6428for (i__ = *n; i__ >= i__1; --i__) {6429i__2 = i__ + j * a_dim1;6430i__3 = i__;6431q__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[6432i__3].i, q__2.i = a[i__2].r * x[i__3].i +6433a[i__2].i * x[i__3].r;6434q__1.r = temp.r - q__2.r, q__1.i = temp.i -6435q__2.i;6436temp.r = q__1.r, temp.i = q__1.i;6437/* L150: */6438}6439if (nounit) {6440c_div(&q__1, &temp, &a[j + j * a_dim1]);6441temp.r = q__1.r, temp.i = q__1.i;6442}6443} else {6444i__1 = j + 1;6445for (i__ = *n; i__ >= i__1; --i__) {6446r_cnjg(&q__3, &a[i__ + j * a_dim1]);6447i__2 = i__;6448q__2.r = q__3.r * x[i__2].r - q__3.i * x[i__2].i,6449q__2.i = q__3.r * x[i__2].i + q__3.i * x[6450i__2].r;6451q__1.r = temp.r - q__2.r, q__1.i = temp.i -6452q__2.i;6453temp.r = q__1.r, temp.i = q__1.i;6454/* L160: */6455}6456if (nounit) {6457r_cnjg(&q__2, &a[j + j * a_dim1]);6458c_div(&q__1, &temp, &q__2);6459temp.r = q__1.r, temp.i = q__1.i;6460}6461}6462i__1 = j;6463x[i__1].r = temp.r, x[i__1].i = temp.i;6464/* L170: */6465}6466} else {6467kx += (*n - 1) * *incx;6468jx = kx;6469for (j = *n; j >= 1; --j) {6470ix = kx;6471i__1 = jx;6472temp.r = x[i__1].r, temp.i = x[i__1].i;6473if (noconj) {6474i__1 = j + 1;6475for (i__ = *n; i__ >= i__1; --i__) {6476i__2 = i__ + j * a_dim1;6477i__3 = ix;6478q__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[6479i__3].i, q__2.i = a[i__2].r * x[i__3].i +6480a[i__2].i * x[i__3].r;6481q__1.r = temp.r - q__2.r, q__1.i = temp.i -6482q__2.i;6483temp.r = q__1.r, temp.i = q__1.i;6484ix -= *incx;6485/* L180: */6486}6487if (nounit) {6488c_div(&q__1, &temp, &a[j + j * a_dim1]);6489temp.r = q__1.r, temp.i = q__1.i;6490}6491} else {6492i__1 = j + 1;6493for (i__ = *n; i__ >= i__1; --i__) {6494r_cnjg(&q__3, &a[i__ + j * a_dim1]);6495i__2 = ix;6496q__2.r = q__3.r * x[i__2].r - q__3.i * x[i__2].i,6497q__2.i = q__3.r * x[i__2].i + q__3.i * x[6498i__2].r;6499q__1.r = temp.r - q__2.r, q__1.i = temp.i -6500q__2.i;6501temp.r = q__1.r, temp.i = q__1.i;6502ix -= *incx;6503/* L190: */6504}6505if (nounit) {6506r_cnjg(&q__2, &a[j + j * a_dim1]);6507c_div(&q__1, &temp, &q__2);6508temp.r = q__1.r, temp.i = q__1.i;6509}6510}6511i__1 = jx;6512x[i__1].r = temp.r, x[i__1].i = temp.i;6513jx -= *incx;6514/* L200: */6515}6516}6517}6518}65196520return 0;65216522/* End of CTRSV . */65236524} /* ctrsv_ */65256526/* Subroutine */ int daxpy_(integer *n, doublereal *da, doublereal *dx,6527integer *incx, doublereal *dy, integer *incy)6528{6529/* System generated locals */6530integer i__1;65316532/* Local variables */6533static integer i__, m, ix, iy, mp1;653465356536/*6537Purpose6538=======65396540DAXPY constant times a vector plus a vector.6541uses unrolled loops for increments equal to one.65426543Further Details6544===============65456546jack dongarra, linpack, 3/11/78.6547modified 12/3/93, array(1) declarations changed to array(*)65486549=====================================================================6550*/65516552/* Parameter adjustments */6553--dy;6554--dx;65556556/* Function Body */6557if (*n <= 0) {6558return 0;6559}6560if (*da == 0.) {6561return 0;6562}6563if (*incx == 1 && *incy == 1) {6564goto L20;6565}65666567/*6568code for unequal increments or equal increments6569not equal to 16570*/65716572ix = 1;6573iy = 1;6574if (*incx < 0) {6575ix = (-(*n) + 1) * *incx + 1;6576}6577if (*incy < 0) {6578iy = (-(*n) + 1) * *incy + 1;6579}6580i__1 = *n;6581for (i__ = 1; i__ <= i__1; ++i__) {6582dy[iy] += *da * dx[ix];6583ix += *incx;6584iy += *incy;6585/* L10: */6586}6587return 0;65886589/*6590code for both increments equal to 1659165926593clean-up loop6594*/65956596L20:6597m = *n % 4;6598if (m == 0) {6599goto L40;6600}6601i__1 = m;6602for (i__ = 1; i__ <= i__1; ++i__) {6603dy[i__] += *da * dx[i__];6604/* L30: */6605}6606if (*n < 4) {6607return 0;6608}6609L40:6610mp1 = m + 1;6611i__1 = *n;6612for (i__ = mp1; i__ <= i__1; i__ += 4) {6613dy[i__] += *da * dx[i__];6614dy[i__ + 1] += *da * dx[i__ + 1];6615dy[i__ + 2] += *da * dx[i__ + 2];6616dy[i__ + 3] += *da * dx[i__ + 3];6617/* L50: */6618}6619return 0;6620} /* daxpy_ */66216622doublereal dcabs1_(doublecomplex *z__)6623{6624/* System generated locals */6625doublereal ret_val, d__1, d__2;66266627/*6628Purpose6629=======66306631DCABS1 computes absolute value of a double singlecomplex number66326633=====================================================================6634*/663566366637ret_val = (d__1 = z__->r, abs(d__1)) + (d__2 = d_imag(z__), abs(d__2));6638return ret_val;6639} /* dcabs1_ */66406641/* Subroutine */ int dcopy_(integer *n, doublereal *dx, integer *incx,6642doublereal *dy, integer *incy)6643{6644/* System generated locals */6645integer i__1;66466647/* Local variables */6648static integer i__, m, ix, iy, mp1;664966506651/*6652Purpose6653=======66546655DCOPY copies a vector, x, to a vector, y.6656uses unrolled loops for increments equal to one.66576658Further Details6659===============66606661jack dongarra, linpack, 3/11/78.6662modified 12/3/93, array(1) declarations changed to array(*)66636664=====================================================================6665*/66666667/* Parameter adjustments */6668--dy;6669--dx;66706671/* Function Body */6672if (*n <= 0) {6673return 0;6674}6675if (*incx == 1 && *incy == 1) {6676goto L20;6677}66786679/*6680code for unequal increments or equal increments6681not equal to 16682*/66836684ix = 1;6685iy = 1;6686if (*incx < 0) {6687ix = (-(*n) + 1) * *incx + 1;6688}6689if (*incy < 0) {6690iy = (-(*n) + 1) * *incy + 1;6691}6692i__1 = *n;6693for (i__ = 1; i__ <= i__1; ++i__) {6694dy[iy] = dx[ix];6695ix += *incx;6696iy += *incy;6697/* L10: */6698}6699return 0;67006701/*6702code for both increments equal to 1670367046705clean-up loop6706*/67076708L20:6709m = *n % 7;6710if (m == 0) {6711goto L40;6712}6713i__1 = m;6714for (i__ = 1; i__ <= i__1; ++i__) {6715dy[i__] = dx[i__];6716/* L30: */6717}6718if (*n < 7) {6719return 0;6720}6721L40:6722mp1 = m + 1;6723i__1 = *n;6724for (i__ = mp1; i__ <= i__1; i__ += 7) {6725dy[i__] = dx[i__];6726dy[i__ + 1] = dx[i__ + 1];6727dy[i__ + 2] = dx[i__ + 2];6728dy[i__ + 3] = dx[i__ + 3];6729dy[i__ + 4] = dx[i__ + 4];6730dy[i__ + 5] = dx[i__ + 5];6731dy[i__ + 6] = dx[i__ + 6];6732/* L50: */6733}6734return 0;6735} /* dcopy_ */67366737doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,6738integer *incy)6739{6740/* System generated locals */6741integer i__1;6742doublereal ret_val;67436744/* Local variables */6745static integer i__, m, ix, iy, mp1;6746static doublereal dtemp;674767486749/*6750Purpose6751=======67526753DDOT forms the dot product of two vectors.6754uses unrolled loops for increments equal to one.67556756Further Details6757===============67586759jack dongarra, linpack, 3/11/78.6760modified 12/3/93, array(1) declarations changed to array(*)67616762=====================================================================6763*/67646765/* Parameter adjustments */6766--dy;6767--dx;67686769/* Function Body */6770ret_val = 0.;6771dtemp = 0.;6772if (*n <= 0) {6773return ret_val;6774}6775if (*incx == 1 && *incy == 1) {6776goto L20;6777}67786779/*6780code for unequal increments or equal increments6781not equal to 16782*/67836784ix = 1;6785iy = 1;6786if (*incx < 0) {6787ix = (-(*n) + 1) * *incx + 1;6788}6789if (*incy < 0) {6790iy = (-(*n) + 1) * *incy + 1;6791}6792i__1 = *n;6793for (i__ = 1; i__ <= i__1; ++i__) {6794dtemp += dx[ix] * dy[iy];6795ix += *incx;6796iy += *incy;6797/* L10: */6798}6799ret_val = dtemp;6800return ret_val;68016802/*6803code for both increments equal to 1680468056806clean-up loop6807*/68086809L20:6810m = *n % 5;6811if (m == 0) {6812goto L40;6813}6814i__1 = m;6815for (i__ = 1; i__ <= i__1; ++i__) {6816dtemp += dx[i__] * dy[i__];6817/* L30: */6818}6819if (*n < 5) {6820goto L60;6821}6822L40:6823mp1 = m + 1;6824i__1 = *n;6825for (i__ = mp1; i__ <= i__1; i__ += 5) {6826dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[6827i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ +68284] * dy[i__ + 4];6829/* L50: */6830}6831L60:6832ret_val = dtemp;6833return ret_val;6834} /* ddot_ */68356836/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *6837n, integer *k, doublereal *alpha, doublereal *a, integer *lda,6838doublereal *b, integer *ldb, doublereal *beta, doublereal *c__,6839integer *ldc)6840{6841/* System generated locals */6842integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,6843i__3;68446845/* Local variables */6846static integer i__, j, l, info;6847static logical nota, notb;6848static doublereal temp;6849extern logical lsame_(char *, char *);6850static integer nrowa, nrowb;6851extern /* Subroutine */ int xerbla_(char *, integer *);685268536854/*6855Purpose6856=======68576858DGEMM performs one of the matrix-matrix operations68596860C := alpha*op( A )*op( B ) + beta*C,68616862where op( X ) is one of68636864op( X ) = X or op( X ) = X',68656866alpha and beta are scalars, and A, B and C are matrices, with op( A )6867an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.68686869Arguments6870==========68716872TRANSA - CHARACTER*1.6873On entry, TRANSA specifies the form of op( A ) to be used in6874the matrix multiplication as follows:68756876TRANSA = 'N' or 'n', op( A ) = A.68776878TRANSA = 'T' or 't', op( A ) = A'.68796880TRANSA = 'C' or 'c', op( A ) = A'.68816882Unchanged on exit.68836884TRANSB - CHARACTER*1.6885On entry, TRANSB specifies the form of op( B ) to be used in6886the matrix multiplication as follows:68876888TRANSB = 'N' or 'n', op( B ) = B.68896890TRANSB = 'T' or 't', op( B ) = B'.68916892TRANSB = 'C' or 'c', op( B ) = B'.68936894Unchanged on exit.68956896M - INTEGER.6897On entry, M specifies the number of rows of the matrix6898op( A ) and of the matrix C. M must be at least zero.6899Unchanged on exit.69006901N - INTEGER.6902On entry, N specifies the number of columns of the matrix6903op( B ) and the number of columns of the matrix C. N must be6904at least zero.6905Unchanged on exit.69066907K - INTEGER.6908On entry, K specifies the number of columns of the matrix6909op( A ) and the number of rows of the matrix op( B ). K must6910be at least zero.6911Unchanged on exit.69126913ALPHA - DOUBLE PRECISION.6914On entry, ALPHA specifies the scalar alpha.6915Unchanged on exit.69166917A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is6918k when TRANSA = 'N' or 'n', and is m otherwise.6919Before entry with TRANSA = 'N' or 'n', the leading m by k6920part of the array A must contain the matrix A, otherwise6921the leading k by m part of the array A must contain the6922matrix A.6923Unchanged on exit.69246925LDA - INTEGER.6926On entry, LDA specifies the first dimension of A as declared6927in the calling (sub) program. When TRANSA = 'N' or 'n' then6928LDA must be at least max( 1, m ), otherwise LDA must be at6929least max( 1, k ).6930Unchanged on exit.69316932B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is6933n when TRANSB = 'N' or 'n', and is k otherwise.6934Before entry with TRANSB = 'N' or 'n', the leading k by n6935part of the array B must contain the matrix B, otherwise6936the leading n by k part of the array B must contain the6937matrix B.6938Unchanged on exit.69396940LDB - INTEGER.6941On entry, LDB specifies the first dimension of B as declared6942in the calling (sub) program. When TRANSB = 'N' or 'n' then6943LDB must be at least max( 1, k ), otherwise LDB must be at6944least max( 1, n ).6945Unchanged on exit.69466947BETA - DOUBLE PRECISION.6948On entry, BETA specifies the scalar beta. When BETA is6949supplied as zero then C need not be set on input.6950Unchanged on exit.69516952C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).6953Before entry, the leading m by n part of the array C must6954contain the matrix C, except when beta is zero, in which6955case C need not be set on entry.6956On exit, the array C is overwritten by the m by n matrix6957( alpha*op( A )*op( B ) + beta*C ).69586959LDC - INTEGER.6960On entry, LDC specifies the first dimension of C as declared6961in the calling (sub) program. LDC must be at least6962max( 1, m ).6963Unchanged on exit.69646965Further Details6966===============69676968Level 3 Blas routine.69696970-- Written on 8-February-1989.6971Jack Dongarra, Argonne National Laboratory.6972Iain Duff, AERE Harwell.6973Jeremy Du Croz, Numerical Algorithms Group Ltd.6974Sven Hammarling, Numerical Algorithms Group Ltd.69756976=====================================================================697769786979Set NOTA and NOTB as true if A and B respectively are not6980transposed and set NROWA and NROWB as the number of rows6981and columns of A and the number of rows of B respectively.6982*/69836984/* Parameter adjustments */6985a_dim1 = *lda;6986a_offset = 1 + a_dim1;6987a -= a_offset;6988b_dim1 = *ldb;6989b_offset = 1 + b_dim1;6990b -= b_offset;6991c_dim1 = *ldc;6992c_offset = 1 + c_dim1;6993c__ -= c_offset;69946995/* Function Body */6996nota = lsame_(transa, "N");6997notb = lsame_(transb, "N");6998if (nota) {6999nrowa = *m;7000} else {7001nrowa = *k;7002}7003if (notb) {7004nrowb = *k;7005} else {7006nrowb = *n;7007}70087009/* Test the input parameters. */70107011info = 0;7012if (! nota && ! lsame_(transa, "C") && ! lsame_(7013transa, "T")) {7014info = 1;7015} else if (! notb && ! lsame_(transb, "C") && !7016lsame_(transb, "T")) {7017info = 2;7018} else if (*m < 0) {7019info = 3;7020} else if (*n < 0) {7021info = 4;7022} else if (*k < 0) {7023info = 5;7024} else if (*lda < max(1,nrowa)) {7025info = 8;7026} else if (*ldb < max(1,nrowb)) {7027info = 10;7028} else if (*ldc < max(1,*m)) {7029info = 13;7030}7031if (info != 0) {7032xerbla_("DGEMM ", &info);7033return 0;7034}70357036/* Quick return if possible. */70377038if (*m == 0 || *n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {7039return 0;7040}70417042/* And if alpha.eq.zero. */70437044if (*alpha == 0.) {7045if (*beta == 0.) {7046i__1 = *n;7047for (j = 1; j <= i__1; ++j) {7048i__2 = *m;7049for (i__ = 1; i__ <= i__2; ++i__) {7050c__[i__ + j * c_dim1] = 0.;7051/* L10: */7052}7053/* L20: */7054}7055} else {7056i__1 = *n;7057for (j = 1; j <= i__1; ++j) {7058i__2 = *m;7059for (i__ = 1; i__ <= i__2; ++i__) {7060c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];7061/* L30: */7062}7063/* L40: */7064}7065}7066return 0;7067}70687069/* Start the operations. */70707071if (notb) {7072if (nota) {70737074/* Form C := alpha*A*B + beta*C. */70757076i__1 = *n;7077for (j = 1; j <= i__1; ++j) {7078if (*beta == 0.) {7079i__2 = *m;7080for (i__ = 1; i__ <= i__2; ++i__) {7081c__[i__ + j * c_dim1] = 0.;7082/* L50: */7083}7084} else if (*beta != 1.) {7085i__2 = *m;7086for (i__ = 1; i__ <= i__2; ++i__) {7087c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];7088/* L60: */7089}7090}7091i__2 = *k;7092for (l = 1; l <= i__2; ++l) {7093if (b[l + j * b_dim1] != 0.) {7094temp = *alpha * b[l + j * b_dim1];7095i__3 = *m;7096for (i__ = 1; i__ <= i__3; ++i__) {7097c__[i__ + j * c_dim1] += temp * a[i__ + l *7098a_dim1];7099/* L70: */7100}7101}7102/* L80: */7103}7104/* L90: */7105}7106} else {71077108/* Form C := alpha*A'*B + beta*C */71097110i__1 = *n;7111for (j = 1; j <= i__1; ++j) {7112i__2 = *m;7113for (i__ = 1; i__ <= i__2; ++i__) {7114temp = 0.;7115i__3 = *k;7116for (l = 1; l <= i__3; ++l) {7117temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];7118/* L100: */7119}7120if (*beta == 0.) {7121c__[i__ + j * c_dim1] = *alpha * temp;7122} else {7123c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[7124i__ + j * c_dim1];7125}7126/* L110: */7127}7128/* L120: */7129}7130}7131} else {7132if (nota) {71337134/* Form C := alpha*A*B' + beta*C */71357136i__1 = *n;7137for (j = 1; j <= i__1; ++j) {7138if (*beta == 0.) {7139i__2 = *m;7140for (i__ = 1; i__ <= i__2; ++i__) {7141c__[i__ + j * c_dim1] = 0.;7142/* L130: */7143}7144} else if (*beta != 1.) {7145i__2 = *m;7146for (i__ = 1; i__ <= i__2; ++i__) {7147c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];7148/* L140: */7149}7150}7151i__2 = *k;7152for (l = 1; l <= i__2; ++l) {7153if (b[j + l * b_dim1] != 0.) {7154temp = *alpha * b[j + l * b_dim1];7155i__3 = *m;7156for (i__ = 1; i__ <= i__3; ++i__) {7157c__[i__ + j * c_dim1] += temp * a[i__ + l *7158a_dim1];7159/* L150: */7160}7161}7162/* L160: */7163}7164/* L170: */7165}7166} else {71677168/* Form C := alpha*A'*B' + beta*C */71697170i__1 = *n;7171for (j = 1; j <= i__1; ++j) {7172i__2 = *m;7173for (i__ = 1; i__ <= i__2; ++i__) {7174temp = 0.;7175i__3 = *k;7176for (l = 1; l <= i__3; ++l) {7177temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];7178/* L180: */7179}7180if (*beta == 0.) {7181c__[i__ + j * c_dim1] = *alpha * temp;7182} else {7183c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[7184i__ + j * c_dim1];7185}7186/* L190: */7187}7188/* L200: */7189}7190}7191}71927193return 0;71947195/* End of DGEMM . */71967197} /* dgemm_ */71987199/* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *7200alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,7201doublereal *beta, doublereal *y, integer *incy)7202{7203/* System generated locals */7204integer a_dim1, a_offset, i__1, i__2;72057206/* Local variables */7207static integer i__, j, ix, iy, jx, jy, kx, ky, info;7208static doublereal temp;7209static integer lenx, leny;7210extern logical lsame_(char *, char *);7211extern /* Subroutine */ int xerbla_(char *, integer *);721272137214/*7215Purpose7216=======72177218DGEMV performs one of the matrix-vector operations72197220y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,72217222where alpha and beta are scalars, x and y are vectors and A is an7223m by n matrix.72247225Arguments7226==========72277228TRANS - CHARACTER*1.7229On entry, TRANS specifies the operation to be performed as7230follows:72317232TRANS = 'N' or 'n' y := alpha*A*x + beta*y.72337234TRANS = 'T' or 't' y := alpha*A'*x + beta*y.72357236TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.72377238Unchanged on exit.72397240M - INTEGER.7241On entry, M specifies the number of rows of the matrix A.7242M must be at least zero.7243Unchanged on exit.72447245N - INTEGER.7246On entry, N specifies the number of columns of the matrix A.7247N must be at least zero.7248Unchanged on exit.72497250ALPHA - DOUBLE PRECISION.7251On entry, ALPHA specifies the scalar alpha.7252Unchanged on exit.72537254A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).7255Before entry, the leading m by n part of the array A must7256contain the matrix of coefficients.7257Unchanged on exit.72587259LDA - INTEGER.7260On entry, LDA specifies the first dimension of A as declared7261in the calling (sub) program. LDA must be at least7262max( 1, m ).7263Unchanged on exit.72647265X - DOUBLE PRECISION array of DIMENSION at least7266( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'7267and at least7268( 1 + ( m - 1 )*abs( INCX ) ) otherwise.7269Before entry, the incremented array X must contain the7270vector x.7271Unchanged on exit.72727273INCX - INTEGER.7274On entry, INCX specifies the increment for the elements of7275X. INCX must not be zero.7276Unchanged on exit.72777278BETA - DOUBLE PRECISION.7279On entry, BETA specifies the scalar beta. When BETA is7280supplied as zero then Y need not be set on input.7281Unchanged on exit.72827283Y - DOUBLE PRECISION array of DIMENSION at least7284( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'7285and at least7286( 1 + ( n - 1 )*abs( INCY ) ) otherwise.7287Before entry with BETA non-zero, the incremented array Y7288must contain the vector y. On exit, Y is overwritten by the7289updated vector y.72907291INCY - INTEGER.7292On entry, INCY specifies the increment for the elements of7293Y. INCY must not be zero.7294Unchanged on exit.72957296Further Details7297===============72987299Level 2 Blas routine.73007301-- Written on 22-October-1986.7302Jack Dongarra, Argonne National Lab.7303Jeremy Du Croz, Nag Central Office.7304Sven Hammarling, Nag Central Office.7305Richard Hanson, Sandia National Labs.73067307=====================================================================730873097310Test the input parameters.7311*/73127313/* Parameter adjustments */7314a_dim1 = *lda;7315a_offset = 1 + a_dim1;7316a -= a_offset;7317--x;7318--y;73197320/* Function Body */7321info = 0;7322if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")7323) {7324info = 1;7325} else if (*m < 0) {7326info = 2;7327} else if (*n < 0) {7328info = 3;7329} else if (*lda < max(1,*m)) {7330info = 6;7331} else if (*incx == 0) {7332info = 8;7333} else if (*incy == 0) {7334info = 11;7335}7336if (info != 0) {7337xerbla_("DGEMV ", &info);7338return 0;7339}73407341/* Quick return if possible. */73427343if (*m == 0 || *n == 0 || *alpha == 0. && *beta == 1.) {7344return 0;7345}73467347/*7348Set LENX and LENY, the lengths of the vectors x and y, and set7349up the start points in X and Y.7350*/73517352if (lsame_(trans, "N")) {7353lenx = *n;7354leny = *m;7355} else {7356lenx = *m;7357leny = *n;7358}7359if (*incx > 0) {7360kx = 1;7361} else {7362kx = 1 - (lenx - 1) * *incx;7363}7364if (*incy > 0) {7365ky = 1;7366} else {7367ky = 1 - (leny - 1) * *incy;7368}73697370/*7371Start the operations. In this version the elements of A are7372accessed sequentially with one pass through A.73737374First form y := beta*y.7375*/73767377if (*beta != 1.) {7378if (*incy == 1) {7379if (*beta == 0.) {7380i__1 = leny;7381for (i__ = 1; i__ <= i__1; ++i__) {7382y[i__] = 0.;7383/* L10: */7384}7385} else {7386i__1 = leny;7387for (i__ = 1; i__ <= i__1; ++i__) {7388y[i__] = *beta * y[i__];7389/* L20: */7390}7391}7392} else {7393iy = ky;7394if (*beta == 0.) {7395i__1 = leny;7396for (i__ = 1; i__ <= i__1; ++i__) {7397y[iy] = 0.;7398iy += *incy;7399/* L30: */7400}7401} else {7402i__1 = leny;7403for (i__ = 1; i__ <= i__1; ++i__) {7404y[iy] = *beta * y[iy];7405iy += *incy;7406/* L40: */7407}7408}7409}7410}7411if (*alpha == 0.) {7412return 0;7413}7414if (lsame_(trans, "N")) {74157416/* Form y := alpha*A*x + y. */74177418jx = kx;7419if (*incy == 1) {7420i__1 = *n;7421for (j = 1; j <= i__1; ++j) {7422if (x[jx] != 0.) {7423temp = *alpha * x[jx];7424i__2 = *m;7425for (i__ = 1; i__ <= i__2; ++i__) {7426y[i__] += temp * a[i__ + j * a_dim1];7427/* L50: */7428}7429}7430jx += *incx;7431/* L60: */7432}7433} else {7434i__1 = *n;7435for (j = 1; j <= i__1; ++j) {7436if (x[jx] != 0.) {7437temp = *alpha * x[jx];7438iy = ky;7439i__2 = *m;7440for (i__ = 1; i__ <= i__2; ++i__) {7441y[iy] += temp * a[i__ + j * a_dim1];7442iy += *incy;7443/* L70: */7444}7445}7446jx += *incx;7447/* L80: */7448}7449}7450} else {74517452/* Form y := alpha*A'*x + y. */74537454jy = ky;7455if (*incx == 1) {7456i__1 = *n;7457for (j = 1; j <= i__1; ++j) {7458temp = 0.;7459i__2 = *m;7460for (i__ = 1; i__ <= i__2; ++i__) {7461temp += a[i__ + j * a_dim1] * x[i__];7462/* L90: */7463}7464y[jy] += *alpha * temp;7465jy += *incy;7466/* L100: */7467}7468} else {7469i__1 = *n;7470for (j = 1; j <= i__1; ++j) {7471temp = 0.;7472ix = kx;7473i__2 = *m;7474for (i__ = 1; i__ <= i__2; ++i__) {7475temp += a[i__ + j * a_dim1] * x[ix];7476ix += *incx;7477/* L110: */7478}7479y[jy] += *alpha * temp;7480jy += *incy;7481/* L120: */7482}7483}7484}74857486return 0;74877488/* End of DGEMV . */74897490} /* dgemv_ */74917492/* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,7493doublereal *x, integer *incx, doublereal *y, integer *incy,7494doublereal *a, integer *lda)7495{7496/* System generated locals */7497integer a_dim1, a_offset, i__1, i__2;74987499/* Local variables */7500static integer i__, j, ix, jy, kx, info;7501static doublereal temp;7502extern /* Subroutine */ int xerbla_(char *, integer *);750375047505/*7506Purpose7507=======75087509DGER performs the rank 1 operation75107511A := alpha*x*y' + A,75127513where alpha is a scalar, x is an m element vector, y is an n element7514vector and A is an m by n matrix.75157516Arguments7517==========75187519M - INTEGER.7520On entry, M specifies the number of rows of the matrix A.7521M must be at least zero.7522Unchanged on exit.75237524N - INTEGER.7525On entry, N specifies the number of columns of the matrix A.7526N must be at least zero.7527Unchanged on exit.75287529ALPHA - DOUBLE PRECISION.7530On entry, ALPHA specifies the scalar alpha.7531Unchanged on exit.75327533X - DOUBLE PRECISION array of dimension at least7534( 1 + ( m - 1 )*abs( INCX ) ).7535Before entry, the incremented array X must contain the m7536element vector x.7537Unchanged on exit.75387539INCX - INTEGER.7540On entry, INCX specifies the increment for the elements of7541X. INCX must not be zero.7542Unchanged on exit.75437544Y - DOUBLE PRECISION array of dimension at least7545( 1 + ( n - 1 )*abs( INCY ) ).7546Before entry, the incremented array Y must contain the n7547element vector y.7548Unchanged on exit.75497550INCY - INTEGER.7551On entry, INCY specifies the increment for the elements of7552Y. INCY must not be zero.7553Unchanged on exit.75547555A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).7556Before entry, the leading m by n part of the array A must7557contain the matrix of coefficients. On exit, A is7558overwritten by the updated matrix.75597560LDA - INTEGER.7561On entry, LDA specifies the first dimension of A as declared7562in the calling (sub) program. LDA must be at least7563max( 1, m ).7564Unchanged on exit.75657566Further Details7567===============75687569Level 2 Blas routine.75707571-- Written on 22-October-1986.7572Jack Dongarra, Argonne National Lab.7573Jeremy Du Croz, Nag Central Office.7574Sven Hammarling, Nag Central Office.7575Richard Hanson, Sandia National Labs.75767577=====================================================================757875797580Test the input parameters.7581*/75827583/* Parameter adjustments */7584--x;7585--y;7586a_dim1 = *lda;7587a_offset = 1 + a_dim1;7588a -= a_offset;75897590/* Function Body */7591info = 0;7592if (*m < 0) {7593info = 1;7594} else if (*n < 0) {7595info = 2;7596} else if (*incx == 0) {7597info = 5;7598} else if (*incy == 0) {7599info = 7;7600} else if (*lda < max(1,*m)) {7601info = 9;7602}7603if (info != 0) {7604xerbla_("DGER ", &info);7605return 0;7606}76077608/* Quick return if possible. */76097610if (*m == 0 || *n == 0 || *alpha == 0.) {7611return 0;7612}76137614/*7615Start the operations. In this version the elements of A are7616accessed sequentially with one pass through A.7617*/76187619if (*incy > 0) {7620jy = 1;7621} else {7622jy = 1 - (*n - 1) * *incy;7623}7624if (*incx == 1) {7625i__1 = *n;7626for (j = 1; j <= i__1; ++j) {7627if (y[jy] != 0.) {7628temp = *alpha * y[jy];7629i__2 = *m;7630for (i__ = 1; i__ <= i__2; ++i__) {7631a[i__ + j * a_dim1] += x[i__] * temp;7632/* L10: */7633}7634}7635jy += *incy;7636/* L20: */7637}7638} else {7639if (*incx > 0) {7640kx = 1;7641} else {7642kx = 1 - (*m - 1) * *incx;7643}7644i__1 = *n;7645for (j = 1; j <= i__1; ++j) {7646if (y[jy] != 0.) {7647temp = *alpha * y[jy];7648ix = kx;7649i__2 = *m;7650for (i__ = 1; i__ <= i__2; ++i__) {7651a[i__ + j * a_dim1] += x[ix] * temp;7652ix += *incx;7653/* L30: */7654}7655}7656jy += *incy;7657/* L40: */7658}7659}76607661return 0;76627663/* End of DGER . */76647665} /* dger_ */76667667doublereal dnrm2_(integer *n, doublereal *x, integer *incx)7668{7669/* System generated locals */7670integer i__1, i__2;7671doublereal ret_val, d__1;76727673/* Local variables */7674static integer ix;7675static doublereal ssq, norm, scale, absxi;767676777678/*7679Purpose7680=======76817682DNRM2 returns the euclidean norm of a vector via the function7683name, so that76847685DNRM2 := sqrt( x'*x )76867687Further Details7688===============76897690-- This version written on 25-October-1982.7691Modified on 14-October-1993 to inline the call to DLASSQ.7692Sven Hammarling, Nag Ltd.76937694=====================================================================7695*/76967697/* Parameter adjustments */7698--x;76997700/* Function Body */7701if (*n < 1 || *incx < 1) {7702norm = 0.;7703} else if (*n == 1) {7704norm = abs(x[1]);7705} else {7706scale = 0.;7707ssq = 1.;7708/*7709The following loop is equivalent to this call to the LAPACK7710auxiliary routine:7711CALL DLASSQ( N, X, INCX, SCALE, SSQ )7712*/77137714i__1 = (*n - 1) * *incx + 1;7715i__2 = *incx;7716for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {7717if (x[ix] != 0.) {7718absxi = (d__1 = x[ix], abs(d__1));7719if (scale < absxi) {7720/* Computing 2nd power */7721d__1 = scale / absxi;7722ssq = ssq * (d__1 * d__1) + 1.;7723scale = absxi;7724} else {7725/* Computing 2nd power */7726d__1 = absxi / scale;7727ssq += d__1 * d__1;7728}7729}7730/* L10: */7731}7732norm = scale * sqrt(ssq);7733}77347735ret_val = norm;7736return ret_val;77377738/* End of DNRM2. */77397740} /* dnrm2_ */77417742/* Subroutine */ int drot_(integer *n, doublereal *dx, integer *incx,7743doublereal *dy, integer *incy, doublereal *c__, doublereal *s)7744{7745/* System generated locals */7746integer i__1;77477748/* Local variables */7749static integer i__, ix, iy;7750static doublereal dtemp;775177527753/*7754Purpose7755=======77567757DROT applies a plane rotation.77587759Further Details7760===============77617762jack dongarra, linpack, 3/11/78.7763modified 12/3/93, array(1) declarations changed to array(*)77647765=====================================================================7766*/77677768/* Parameter adjustments */7769--dy;7770--dx;77717772/* Function Body */7773if (*n <= 0) {7774return 0;7775}7776if (*incx == 1 && *incy == 1) {7777goto L20;7778}77797780/*7781code for unequal increments or equal increments not equal7782to 17783*/77847785ix = 1;7786iy = 1;7787if (*incx < 0) {7788ix = (-(*n) + 1) * *incx + 1;7789}7790if (*incy < 0) {7791iy = (-(*n) + 1) * *incy + 1;7792}7793i__1 = *n;7794for (i__ = 1; i__ <= i__1; ++i__) {7795dtemp = *c__ * dx[ix] + *s * dy[iy];7796dy[iy] = *c__ * dy[iy] - *s * dx[ix];7797dx[ix] = dtemp;7798ix += *incx;7799iy += *incy;7800/* L10: */7801}7802return 0;78037804/* code for both increments equal to 1 */78057806L20:7807i__1 = *n;7808for (i__ = 1; i__ <= i__1; ++i__) {7809dtemp = *c__ * dx[i__] + *s * dy[i__];7810dy[i__] = *c__ * dy[i__] - *s * dx[i__];7811dx[i__] = dtemp;7812/* L30: */7813}7814return 0;7815} /* drot_ */78167817/* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx,7818integer *incx)7819{7820/* System generated locals */7821integer i__1, i__2;78227823/* Local variables */7824static integer i__, m, mp1, nincx;782578267827/*7828Purpose7829=======78307831DSCAL scales a vector by a constant.7832uses unrolled loops for increment equal to one.78337834Further Details7835===============78367837jack dongarra, linpack, 3/11/78.7838modified 3/93 to return if incx .le. 0.7839modified 12/3/93, array(1) declarations changed to array(*)78407841=====================================================================7842*/78437844/* Parameter adjustments */7845--dx;78467847/* Function Body */7848if (*n <= 0 || *incx <= 0) {7849return 0;7850}7851if (*incx == 1) {7852goto L20;7853}78547855/* code for increment not equal to 1 */78567857nincx = *n * *incx;7858i__1 = nincx;7859i__2 = *incx;7860for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {7861dx[i__] = *da * dx[i__];7862/* L10: */7863}7864return 0;78657866/*7867code for increment equal to 1786878697870clean-up loop7871*/78727873L20:7874m = *n % 5;7875if (m == 0) {7876goto L40;7877}7878i__2 = m;7879for (i__ = 1; i__ <= i__2; ++i__) {7880dx[i__] = *da * dx[i__];7881/* L30: */7882}7883if (*n < 5) {7884return 0;7885}7886L40:7887mp1 = m + 1;7888i__2 = *n;7889for (i__ = mp1; i__ <= i__2; i__ += 5) {7890dx[i__] = *da * dx[i__];7891dx[i__ + 1] = *da * dx[i__ + 1];7892dx[i__ + 2] = *da * dx[i__ + 2];7893dx[i__ + 3] = *da * dx[i__ + 3];7894dx[i__ + 4] = *da * dx[i__ + 4];7895/* L50: */7896}7897return 0;7898} /* dscal_ */78997900/* Subroutine */ int dswap_(integer *n, doublereal *dx, integer *incx,7901doublereal *dy, integer *incy)7902{7903/* System generated locals */7904integer i__1;79057906/* Local variables */7907static integer i__, m, ix, iy, mp1;7908static doublereal dtemp;790979107911/*7912Purpose7913=======79147915interchanges two vectors.7916uses unrolled loops for increments equal one.79177918Further Details7919===============79207921jack dongarra, linpack, 3/11/78.7922modified 12/3/93, array(1) declarations changed to array(*)79237924=====================================================================7925*/79267927/* Parameter adjustments */7928--dy;7929--dx;79307931/* Function Body */7932if (*n <= 0) {7933return 0;7934}7935if (*incx == 1 && *incy == 1) {7936goto L20;7937}79387939/*7940code for unequal increments or equal increments not equal7941to 17942*/79437944ix = 1;7945iy = 1;7946if (*incx < 0) {7947ix = (-(*n) + 1) * *incx + 1;7948}7949if (*incy < 0) {7950iy = (-(*n) + 1) * *incy + 1;7951}7952i__1 = *n;7953for (i__ = 1; i__ <= i__1; ++i__) {7954dtemp = dx[ix];7955dx[ix] = dy[iy];7956dy[iy] = dtemp;7957ix += *incx;7958iy += *incy;7959/* L10: */7960}7961return 0;79627963/*7964code for both increments equal to 1796579667967clean-up loop7968*/79697970L20:7971m = *n % 3;7972if (m == 0) {7973goto L40;7974}7975i__1 = m;7976for (i__ = 1; i__ <= i__1; ++i__) {7977dtemp = dx[i__];7978dx[i__] = dy[i__];7979dy[i__] = dtemp;7980/* L30: */7981}7982if (*n < 3) {7983return 0;7984}7985L40:7986mp1 = m + 1;7987i__1 = *n;7988for (i__ = mp1; i__ <= i__1; i__ += 3) {7989dtemp = dx[i__];7990dx[i__] = dy[i__];7991dy[i__] = dtemp;7992dtemp = dx[i__ + 1];7993dx[i__ + 1] = dy[i__ + 1];7994dy[i__ + 1] = dtemp;7995dtemp = dx[i__ + 2];7996dx[i__ + 2] = dy[i__ + 2];7997dy[i__ + 2] = dtemp;7998/* L50: */7999}8000return 0;8001} /* dswap_ */80028003/* Subroutine */ int dsymv_(char *uplo, integer *n, doublereal *alpha,8004doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal8005*beta, doublereal *y, integer *incy)8006{8007/* System generated locals */8008integer a_dim1, a_offset, i__1, i__2;80098010/* Local variables */8011static integer i__, j, ix, iy, jx, jy, kx, ky, info;8012static doublereal temp1, temp2;8013extern logical lsame_(char *, char *);8014extern /* Subroutine */ int xerbla_(char *, integer *);801580168017/*8018Purpose8019=======80208021DSYMV performs the matrix-vector operation80228023y := alpha*A*x + beta*y,80248025where alpha and beta are scalars, x and y are n element vectors and8026A is an n by n symmetric matrix.80278028Arguments8029==========80308031UPLO - CHARACTER*1.8032On entry, UPLO specifies whether the upper or lower8033triangular part of the array A is to be referenced as8034follows:80358036UPLO = 'U' or 'u' Only the upper triangular part of A8037is to be referenced.80388039UPLO = 'L' or 'l' Only the lower triangular part of A8040is to be referenced.80418042Unchanged on exit.80438044N - INTEGER.8045On entry, N specifies the order of the matrix A.8046N must be at least zero.8047Unchanged on exit.80488049ALPHA - DOUBLE PRECISION.8050On entry, ALPHA specifies the scalar alpha.8051Unchanged on exit.80528053A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).8054Before entry with UPLO = 'U' or 'u', the leading n by n8055upper triangular part of the array A must contain the upper8056triangular part of the symmetric matrix and the strictly8057lower triangular part of A is not referenced.8058Before entry with UPLO = 'L' or 'l', the leading n by n8059lower triangular part of the array A must contain the lower8060triangular part of the symmetric matrix and the strictly8061upper triangular part of A is not referenced.8062Unchanged on exit.80638064LDA - INTEGER.8065On entry, LDA specifies the first dimension of A as declared8066in the calling (sub) program. LDA must be at least8067max( 1, n ).8068Unchanged on exit.80698070X - DOUBLE PRECISION array of dimension at least8071( 1 + ( n - 1 )*abs( INCX ) ).8072Before entry, the incremented array X must contain the n8073element vector x.8074Unchanged on exit.80758076INCX - INTEGER.8077On entry, INCX specifies the increment for the elements of8078X. INCX must not be zero.8079Unchanged on exit.80808081BETA - DOUBLE PRECISION.8082On entry, BETA specifies the scalar beta. When BETA is8083supplied as zero then Y need not be set on input.8084Unchanged on exit.80858086Y - DOUBLE PRECISION array of dimension at least8087( 1 + ( n - 1 )*abs( INCY ) ).8088Before entry, the incremented array Y must contain the n8089element vector y. On exit, Y is overwritten by the updated8090vector y.80918092INCY - INTEGER.8093On entry, INCY specifies the increment for the elements of8094Y. INCY must not be zero.8095Unchanged on exit.80968097Further Details8098===============80998100Level 2 Blas routine.81018102-- Written on 22-October-1986.8103Jack Dongarra, Argonne National Lab.8104Jeremy Du Croz, Nag Central Office.8105Sven Hammarling, Nag Central Office.8106Richard Hanson, Sandia National Labs.81078108=====================================================================810981108111Test the input parameters.8112*/81138114/* Parameter adjustments */8115a_dim1 = *lda;8116a_offset = 1 + a_dim1;8117a -= a_offset;8118--x;8119--y;81208121/* Function Body */8122info = 0;8123if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {8124info = 1;8125} else if (*n < 0) {8126info = 2;8127} else if (*lda < max(1,*n)) {8128info = 5;8129} else if (*incx == 0) {8130info = 7;8131} else if (*incy == 0) {8132info = 10;8133}8134if (info != 0) {8135xerbla_("DSYMV ", &info);8136return 0;8137}81388139/* Quick return if possible. */81408141if (*n == 0 || *alpha == 0. && *beta == 1.) {8142return 0;8143}81448145/* Set up the start points in X and Y. */81468147if (*incx > 0) {8148kx = 1;8149} else {8150kx = 1 - (*n - 1) * *incx;8151}8152if (*incy > 0) {8153ky = 1;8154} else {8155ky = 1 - (*n - 1) * *incy;8156}81578158/*8159Start the operations. In this version the elements of A are8160accessed sequentially with one pass through the triangular part8161of A.81628163First form y := beta*y.8164*/81658166if (*beta != 1.) {8167if (*incy == 1) {8168if (*beta == 0.) {8169i__1 = *n;8170for (i__ = 1; i__ <= i__1; ++i__) {8171y[i__] = 0.;8172/* L10: */8173}8174} else {8175i__1 = *n;8176for (i__ = 1; i__ <= i__1; ++i__) {8177y[i__] = *beta * y[i__];8178/* L20: */8179}8180}8181} else {8182iy = ky;8183if (*beta == 0.) {8184i__1 = *n;8185for (i__ = 1; i__ <= i__1; ++i__) {8186y[iy] = 0.;8187iy += *incy;8188/* L30: */8189}8190} else {8191i__1 = *n;8192for (i__ = 1; i__ <= i__1; ++i__) {8193y[iy] = *beta * y[iy];8194iy += *incy;8195/* L40: */8196}8197}8198}8199}8200if (*alpha == 0.) {8201return 0;8202}8203if (lsame_(uplo, "U")) {82048205/* Form y when A is stored in upper triangle. */82068207if (*incx == 1 && *incy == 1) {8208i__1 = *n;8209for (j = 1; j <= i__1; ++j) {8210temp1 = *alpha * x[j];8211temp2 = 0.;8212i__2 = j - 1;8213for (i__ = 1; i__ <= i__2; ++i__) {8214y[i__] += temp1 * a[i__ + j * a_dim1];8215temp2 += a[i__ + j * a_dim1] * x[i__];8216/* L50: */8217}8218y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;8219/* L60: */8220}8221} else {8222jx = kx;8223jy = ky;8224i__1 = *n;8225for (j = 1; j <= i__1; ++j) {8226temp1 = *alpha * x[jx];8227temp2 = 0.;8228ix = kx;8229iy = ky;8230i__2 = j - 1;8231for (i__ = 1; i__ <= i__2; ++i__) {8232y[iy] += temp1 * a[i__ + j * a_dim1];8233temp2 += a[i__ + j * a_dim1] * x[ix];8234ix += *incx;8235iy += *incy;8236/* L70: */8237}8238y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;8239jx += *incx;8240jy += *incy;8241/* L80: */8242}8243}8244} else {82458246/* Form y when A is stored in lower triangle. */82478248if (*incx == 1 && *incy == 1) {8249i__1 = *n;8250for (j = 1; j <= i__1; ++j) {8251temp1 = *alpha * x[j];8252temp2 = 0.;8253y[j] += temp1 * a[j + j * a_dim1];8254i__2 = *n;8255for (i__ = j + 1; i__ <= i__2; ++i__) {8256y[i__] += temp1 * a[i__ + j * a_dim1];8257temp2 += a[i__ + j * a_dim1] * x[i__];8258/* L90: */8259}8260y[j] += *alpha * temp2;8261/* L100: */8262}8263} else {8264jx = kx;8265jy = ky;8266i__1 = *n;8267for (j = 1; j <= i__1; ++j) {8268temp1 = *alpha * x[jx];8269temp2 = 0.;8270y[jy] += temp1 * a[j + j * a_dim1];8271ix = jx;8272iy = jy;8273i__2 = *n;8274for (i__ = j + 1; i__ <= i__2; ++i__) {8275ix += *incx;8276iy += *incy;8277y[iy] += temp1 * a[i__ + j * a_dim1];8278temp2 += a[i__ + j * a_dim1] * x[ix];8279/* L110: */8280}8281y[jy] += *alpha * temp2;8282jx += *incx;8283jy += *incy;8284/* L120: */8285}8286}8287}82888289return 0;82908291/* End of DSYMV . */82928293} /* dsymv_ */82948295/* Subroutine */ int dsyr2_(char *uplo, integer *n, doublereal *alpha,8296doublereal *x, integer *incx, doublereal *y, integer *incy,8297doublereal *a, integer *lda)8298{8299/* System generated locals */8300integer a_dim1, a_offset, i__1, i__2;83018302/* Local variables */8303static integer i__, j, ix, iy, jx, jy, kx, ky, info;8304static doublereal temp1, temp2;8305extern logical lsame_(char *, char *);8306extern /* Subroutine */ int xerbla_(char *, integer *);830783088309/*8310Purpose8311=======83128313DSYR2 performs the symmetric rank 2 operation83148315A := alpha*x*y' + alpha*y*x' + A,83168317where alpha is a scalar, x and y are n element vectors and A is an n8318by n symmetric matrix.83198320Arguments8321==========83228323UPLO - CHARACTER*1.8324On entry, UPLO specifies whether the upper or lower8325triangular part of the array A is to be referenced as8326follows:83278328UPLO = 'U' or 'u' Only the upper triangular part of A8329is to be referenced.83308331UPLO = 'L' or 'l' Only the lower triangular part of A8332is to be referenced.83338334Unchanged on exit.83358336N - INTEGER.8337On entry, N specifies the order of the matrix A.8338N must be at least zero.8339Unchanged on exit.83408341ALPHA - DOUBLE PRECISION.8342On entry, ALPHA specifies the scalar alpha.8343Unchanged on exit.83448345X - DOUBLE PRECISION array of dimension at least8346( 1 + ( n - 1 )*abs( INCX ) ).8347Before entry, the incremented array X must contain the n8348element vector x.8349Unchanged on exit.83508351INCX - INTEGER.8352On entry, INCX specifies the increment for the elements of8353X. INCX must not be zero.8354Unchanged on exit.83558356Y - DOUBLE PRECISION array of dimension at least8357( 1 + ( n - 1 )*abs( INCY ) ).8358Before entry, the incremented array Y must contain the n8359element vector y.8360Unchanged on exit.83618362INCY - INTEGER.8363On entry, INCY specifies the increment for the elements of8364Y. INCY must not be zero.8365Unchanged on exit.83668367A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).8368Before entry with UPLO = 'U' or 'u', the leading n by n8369upper triangular part of the array A must contain the upper8370triangular part of the symmetric matrix and the strictly8371lower triangular part of A is not referenced. On exit, the8372upper triangular part of the array A is overwritten by the8373upper triangular part of the updated matrix.8374Before entry with UPLO = 'L' or 'l', the leading n by n8375lower triangular part of the array A must contain the lower8376triangular part of the symmetric matrix and the strictly8377upper triangular part of A is not referenced. On exit, the8378lower triangular part of the array A is overwritten by the8379lower triangular part of the updated matrix.83808381LDA - INTEGER.8382On entry, LDA specifies the first dimension of A as declared8383in the calling (sub) program. LDA must be at least8384max( 1, n ).8385Unchanged on exit.83868387Further Details8388===============83898390Level 2 Blas routine.83918392-- Written on 22-October-1986.8393Jack Dongarra, Argonne National Lab.8394Jeremy Du Croz, Nag Central Office.8395Sven Hammarling, Nag Central Office.8396Richard Hanson, Sandia National Labs.83978398=====================================================================839984008401Test the input parameters.8402*/84038404/* Parameter adjustments */8405--x;8406--y;8407a_dim1 = *lda;8408a_offset = 1 + a_dim1;8409a -= a_offset;84108411/* Function Body */8412info = 0;8413if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {8414info = 1;8415} else if (*n < 0) {8416info = 2;8417} else if (*incx == 0) {8418info = 5;8419} else if (*incy == 0) {8420info = 7;8421} else if (*lda < max(1,*n)) {8422info = 9;8423}8424if (info != 0) {8425xerbla_("DSYR2 ", &info);8426return 0;8427}84288429/* Quick return if possible. */84308431if (*n == 0 || *alpha == 0.) {8432return 0;8433}84348435/*8436Set up the start points in X and Y if the increments are not both8437unity.8438*/84398440if (*incx != 1 || *incy != 1) {8441if (*incx > 0) {8442kx = 1;8443} else {8444kx = 1 - (*n - 1) * *incx;8445}8446if (*incy > 0) {8447ky = 1;8448} else {8449ky = 1 - (*n - 1) * *incy;8450}8451jx = kx;8452jy = ky;8453}84548455/*8456Start the operations. In this version the elements of A are8457accessed sequentially with one pass through the triangular part8458of A.8459*/84608461if (lsame_(uplo, "U")) {84628463/* Form A when A is stored in the upper triangle. */84648465if (*incx == 1 && *incy == 1) {8466i__1 = *n;8467for (j = 1; j <= i__1; ++j) {8468if (x[j] != 0. || y[j] != 0.) {8469temp1 = *alpha * y[j];8470temp2 = *alpha * x[j];8471i__2 = j;8472for (i__ = 1; i__ <= i__2; ++i__) {8473a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *8474temp1 + y[i__] * temp2;8475/* L10: */8476}8477}8478/* L20: */8479}8480} else {8481i__1 = *n;8482for (j = 1; j <= i__1; ++j) {8483if (x[jx] != 0. || y[jy] != 0.) {8484temp1 = *alpha * y[jy];8485temp2 = *alpha * x[jx];8486ix = kx;8487iy = ky;8488i__2 = j;8489for (i__ = 1; i__ <= i__2; ++i__) {8490a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *8491temp1 + y[iy] * temp2;8492ix += *incx;8493iy += *incy;8494/* L30: */8495}8496}8497jx += *incx;8498jy += *incy;8499/* L40: */8500}8501}8502} else {85038504/* Form A when A is stored in the lower triangle. */85058506if (*incx == 1 && *incy == 1) {8507i__1 = *n;8508for (j = 1; j <= i__1; ++j) {8509if (x[j] != 0. || y[j] != 0.) {8510temp1 = *alpha * y[j];8511temp2 = *alpha * x[j];8512i__2 = *n;8513for (i__ = j; i__ <= i__2; ++i__) {8514a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *8515temp1 + y[i__] * temp2;8516/* L50: */8517}8518}8519/* L60: */8520}8521} else {8522i__1 = *n;8523for (j = 1; j <= i__1; ++j) {8524if (x[jx] != 0. || y[jy] != 0.) {8525temp1 = *alpha * y[jy];8526temp2 = *alpha * x[jx];8527ix = jx;8528iy = jy;8529i__2 = *n;8530for (i__ = j; i__ <= i__2; ++i__) {8531a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *8532temp1 + y[iy] * temp2;8533ix += *incx;8534iy += *incy;8535/* L70: */8536}8537}8538jx += *incx;8539jy += *incy;8540/* L80: */8541}8542}8543}85448545return 0;85468547/* End of DSYR2 . */85488549} /* dsyr2_ */85508551/* Subroutine */ int dsyr2k_(char *uplo, char *trans, integer *n, integer *k,8552doublereal *alpha, doublereal *a, integer *lda, doublereal *b,8553integer *ldb, doublereal *beta, doublereal *c__, integer *ldc)8554{8555/* System generated locals */8556integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,8557i__3;85588559/* Local variables */8560static integer i__, j, l, info;8561static doublereal temp1, temp2;8562extern logical lsame_(char *, char *);8563static integer nrowa;8564static logical upper;8565extern /* Subroutine */ int xerbla_(char *, integer *);856685678568/*8569Purpose8570=======85718572DSYR2K performs one of the symmetric rank 2k operations85738574C := alpha*A*B' + alpha*B*A' + beta*C,85758576or85778578C := alpha*A'*B + alpha*B'*A + beta*C,85798580where alpha and beta are scalars, C is an n by n symmetric matrix8581and A and B are n by k matrices in the first case and k by n8582matrices in the second case.85838584Arguments8585==========85868587UPLO - CHARACTER*1.8588On entry, UPLO specifies whether the upper or lower8589triangular part of the array C is to be referenced as8590follows:85918592UPLO = 'U' or 'u' Only the upper triangular part of C8593is to be referenced.85948595UPLO = 'L' or 'l' Only the lower triangular part of C8596is to be referenced.85978598Unchanged on exit.85998600TRANS - CHARACTER*1.8601On entry, TRANS specifies the operation to be performed as8602follows:86038604TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +8605beta*C.86068607TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +8608beta*C.86098610TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +8611beta*C.86128613Unchanged on exit.86148615N - INTEGER.8616On entry, N specifies the order of the matrix C. N must be8617at least zero.8618Unchanged on exit.86198620K - INTEGER.8621On entry with TRANS = 'N' or 'n', K specifies the number8622of columns of the matrices A and B, and on entry with8623TRANS = 'T' or 't' or 'C' or 'c', K specifies the number8624of rows of the matrices A and B. K must be at least zero.8625Unchanged on exit.86268627ALPHA - DOUBLE PRECISION.8628On entry, ALPHA specifies the scalar alpha.8629Unchanged on exit.86308631A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is8632k when TRANS = 'N' or 'n', and is n otherwise.8633Before entry with TRANS = 'N' or 'n', the leading n by k8634part of the array A must contain the matrix A, otherwise8635the leading k by n part of the array A must contain the8636matrix A.8637Unchanged on exit.86388639LDA - INTEGER.8640On entry, LDA specifies the first dimension of A as declared8641in the calling (sub) program. When TRANS = 'N' or 'n'8642then LDA must be at least max( 1, n ), otherwise LDA must8643be at least max( 1, k ).8644Unchanged on exit.86458646B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is8647k when TRANS = 'N' or 'n', and is n otherwise.8648Before entry with TRANS = 'N' or 'n', the leading n by k8649part of the array B must contain the matrix B, otherwise8650the leading k by n part of the array B must contain the8651matrix B.8652Unchanged on exit.86538654LDB - INTEGER.8655On entry, LDB specifies the first dimension of B as declared8656in the calling (sub) program. When TRANS = 'N' or 'n'8657then LDB must be at least max( 1, n ), otherwise LDB must8658be at least max( 1, k ).8659Unchanged on exit.86608661BETA - DOUBLE PRECISION.8662On entry, BETA specifies the scalar beta.8663Unchanged on exit.86648665C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).8666Before entry with UPLO = 'U' or 'u', the leading n by n8667upper triangular part of the array C must contain the upper8668triangular part of the symmetric matrix and the strictly8669lower triangular part of C is not referenced. On exit, the8670upper triangular part of the array C is overwritten by the8671upper triangular part of the updated matrix.8672Before entry with UPLO = 'L' or 'l', the leading n by n8673lower triangular part of the array C must contain the lower8674triangular part of the symmetric matrix and the strictly8675upper triangular part of C is not referenced. On exit, the8676lower triangular part of the array C is overwritten by the8677lower triangular part of the updated matrix.86788679LDC - INTEGER.8680On entry, LDC specifies the first dimension of C as declared8681in the calling (sub) program. LDC must be at least8682max( 1, n ).8683Unchanged on exit.86848685Further Details8686===============86878688Level 3 Blas routine.868986908691-- Written on 8-February-1989.8692Jack Dongarra, Argonne National Laboratory.8693Iain Duff, AERE Harwell.8694Jeremy Du Croz, Numerical Algorithms Group Ltd.8695Sven Hammarling, Numerical Algorithms Group Ltd.86968697=====================================================================869886998700Test the input parameters.8701*/87028703/* Parameter adjustments */8704a_dim1 = *lda;8705a_offset = 1 + a_dim1;8706a -= a_offset;8707b_dim1 = *ldb;8708b_offset = 1 + b_dim1;8709b -= b_offset;8710c_dim1 = *ldc;8711c_offset = 1 + c_dim1;8712c__ -= c_offset;87138714/* Function Body */8715if (lsame_(trans, "N")) {8716nrowa = *n;8717} else {8718nrowa = *k;8719}8720upper = lsame_(uplo, "U");87218722info = 0;8723if (! upper && ! lsame_(uplo, "L")) {8724info = 1;8725} else if (! lsame_(trans, "N") && ! lsame_(trans,8726"T") && ! lsame_(trans, "C")) {8727info = 2;8728} else if (*n < 0) {8729info = 3;8730} else if (*k < 0) {8731info = 4;8732} else if (*lda < max(1,nrowa)) {8733info = 7;8734} else if (*ldb < max(1,nrowa)) {8735info = 9;8736} else if (*ldc < max(1,*n)) {8737info = 12;8738}8739if (info != 0) {8740xerbla_("DSYR2K", &info);8741return 0;8742}87438744/* Quick return if possible. */87458746if (*n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {8747return 0;8748}87498750/* And when alpha.eq.zero. */87518752if (*alpha == 0.) {8753if (upper) {8754if (*beta == 0.) {8755i__1 = *n;8756for (j = 1; j <= i__1; ++j) {8757i__2 = j;8758for (i__ = 1; i__ <= i__2; ++i__) {8759c__[i__ + j * c_dim1] = 0.;8760/* L10: */8761}8762/* L20: */8763}8764} else {8765i__1 = *n;8766for (j = 1; j <= i__1; ++j) {8767i__2 = j;8768for (i__ = 1; i__ <= i__2; ++i__) {8769c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];8770/* L30: */8771}8772/* L40: */8773}8774}8775} else {8776if (*beta == 0.) {8777i__1 = *n;8778for (j = 1; j <= i__1; ++j) {8779i__2 = *n;8780for (i__ = j; i__ <= i__2; ++i__) {8781c__[i__ + j * c_dim1] = 0.;8782/* L50: */8783}8784/* L60: */8785}8786} else {8787i__1 = *n;8788for (j = 1; j <= i__1; ++j) {8789i__2 = *n;8790for (i__ = j; i__ <= i__2; ++i__) {8791c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];8792/* L70: */8793}8794/* L80: */8795}8796}8797}8798return 0;8799}88008801/* Start the operations. */88028803if (lsame_(trans, "N")) {88048805/* Form C := alpha*A*B' + alpha*B*A' + C. */88068807if (upper) {8808i__1 = *n;8809for (j = 1; j <= i__1; ++j) {8810if (*beta == 0.) {8811i__2 = j;8812for (i__ = 1; i__ <= i__2; ++i__) {8813c__[i__ + j * c_dim1] = 0.;8814/* L90: */8815}8816} else if (*beta != 1.) {8817i__2 = j;8818for (i__ = 1; i__ <= i__2; ++i__) {8819c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];8820/* L100: */8821}8822}8823i__2 = *k;8824for (l = 1; l <= i__2; ++l) {8825if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {8826temp1 = *alpha * b[j + l * b_dim1];8827temp2 = *alpha * a[j + l * a_dim1];8828i__3 = j;8829for (i__ = 1; i__ <= i__3; ++i__) {8830c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[8831i__ + l * a_dim1] * temp1 + b[i__ + l *8832b_dim1] * temp2;8833/* L110: */8834}8835}8836/* L120: */8837}8838/* L130: */8839}8840} else {8841i__1 = *n;8842for (j = 1; j <= i__1; ++j) {8843if (*beta == 0.) {8844i__2 = *n;8845for (i__ = j; i__ <= i__2; ++i__) {8846c__[i__ + j * c_dim1] = 0.;8847/* L140: */8848}8849} else if (*beta != 1.) {8850i__2 = *n;8851for (i__ = j; i__ <= i__2; ++i__) {8852c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];8853/* L150: */8854}8855}8856i__2 = *k;8857for (l = 1; l <= i__2; ++l) {8858if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {8859temp1 = *alpha * b[j + l * b_dim1];8860temp2 = *alpha * a[j + l * a_dim1];8861i__3 = *n;8862for (i__ = j; i__ <= i__3; ++i__) {8863c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[8864i__ + l * a_dim1] * temp1 + b[i__ + l *8865b_dim1] * temp2;8866/* L160: */8867}8868}8869/* L170: */8870}8871/* L180: */8872}8873}8874} else {88758876/* Form C := alpha*A'*B + alpha*B'*A + C. */88778878if (upper) {8879i__1 = *n;8880for (j = 1; j <= i__1; ++j) {8881i__2 = j;8882for (i__ = 1; i__ <= i__2; ++i__) {8883temp1 = 0.;8884temp2 = 0.;8885i__3 = *k;8886for (l = 1; l <= i__3; ++l) {8887temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];8888temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];8889/* L190: */8890}8891if (*beta == 0.) {8892c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *8893temp2;8894} else {8895c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]8896+ *alpha * temp1 + *alpha * temp2;8897}8898/* L200: */8899}8900/* L210: */8901}8902} else {8903i__1 = *n;8904for (j = 1; j <= i__1; ++j) {8905i__2 = *n;8906for (i__ = j; i__ <= i__2; ++i__) {8907temp1 = 0.;8908temp2 = 0.;8909i__3 = *k;8910for (l = 1; l <= i__3; ++l) {8911temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];8912temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];8913/* L220: */8914}8915if (*beta == 0.) {8916c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *8917temp2;8918} else {8919c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]8920+ *alpha * temp1 + *alpha * temp2;8921}8922/* L230: */8923}8924/* L240: */8925}8926}8927}89288929return 0;89308931/* End of DSYR2K. */89328933} /* dsyr2k_ */89348935/* Subroutine */ int dsyrk_(char *uplo, char *trans, integer *n, integer *k,8936doublereal *alpha, doublereal *a, integer *lda, doublereal *beta,8937doublereal *c__, integer *ldc)8938{8939/* System generated locals */8940integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;89418942/* Local variables */8943static integer i__, j, l, info;8944static doublereal temp;8945extern logical lsame_(char *, char *);8946static integer nrowa;8947static logical upper;8948extern /* Subroutine */ int xerbla_(char *, integer *);894989508951/*8952Purpose8953=======89548955DSYRK performs one of the symmetric rank k operations89568957C := alpha*A*A' + beta*C,89588959or89608961C := alpha*A'*A + beta*C,89628963where alpha and beta are scalars, C is an n by n symmetric matrix8964and A is an n by k matrix in the first case and a k by n matrix8965in the second case.89668967Arguments8968==========89698970UPLO - CHARACTER*1.8971On entry, UPLO specifies whether the upper or lower8972triangular part of the array C is to be referenced as8973follows:89748975UPLO = 'U' or 'u' Only the upper triangular part of C8976is to be referenced.89778978UPLO = 'L' or 'l' Only the lower triangular part of C8979is to be referenced.89808981Unchanged on exit.89828983TRANS - CHARACTER*1.8984On entry, TRANS specifies the operation to be performed as8985follows:89868987TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.89888989TRANS = 'T' or 't' C := alpha*A'*A + beta*C.89908991TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.89928993Unchanged on exit.89948995N - INTEGER.8996On entry, N specifies the order of the matrix C. N must be8997at least zero.8998Unchanged on exit.89999000K - INTEGER.9001On entry with TRANS = 'N' or 'n', K specifies the number9002of columns of the matrix A, and on entry with9003TRANS = 'T' or 't' or 'C' or 'c', K specifies the number9004of rows of the matrix A. K must be at least zero.9005Unchanged on exit.90069007ALPHA - DOUBLE PRECISION.9008On entry, ALPHA specifies the scalar alpha.9009Unchanged on exit.90109011A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is9012k when TRANS = 'N' or 'n', and is n otherwise.9013Before entry with TRANS = 'N' or 'n', the leading n by k9014part of the array A must contain the matrix A, otherwise9015the leading k by n part of the array A must contain the9016matrix A.9017Unchanged on exit.90189019LDA - INTEGER.9020On entry, LDA specifies the first dimension of A as declared9021in the calling (sub) program. When TRANS = 'N' or 'n'9022then LDA must be at least max( 1, n ), otherwise LDA must9023be at least max( 1, k ).9024Unchanged on exit.90259026BETA - DOUBLE PRECISION.9027On entry, BETA specifies the scalar beta.9028Unchanged on exit.90299030C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).9031Before entry with UPLO = 'U' or 'u', the leading n by n9032upper triangular part of the array C must contain the upper9033triangular part of the symmetric matrix and the strictly9034lower triangular part of C is not referenced. On exit, the9035upper triangular part of the array C is overwritten by the9036upper triangular part of the updated matrix.9037Before entry with UPLO = 'L' or 'l', the leading n by n9038lower triangular part of the array C must contain the lower9039triangular part of the symmetric matrix and the strictly9040upper triangular part of C is not referenced. On exit, the9041lower triangular part of the array C is overwritten by the9042lower triangular part of the updated matrix.90439044LDC - INTEGER.9045On entry, LDC specifies the first dimension of C as declared9046in the calling (sub) program. LDC must be at least9047max( 1, n ).9048Unchanged on exit.90499050Further Details9051===============90529053Level 3 Blas routine.90549055-- Written on 8-February-1989.9056Jack Dongarra, Argonne National Laboratory.9057Iain Duff, AERE Harwell.9058Jeremy Du Croz, Numerical Algorithms Group Ltd.9059Sven Hammarling, Numerical Algorithms Group Ltd.90609061=====================================================================906290639064Test the input parameters.9065*/90669067/* Parameter adjustments */9068a_dim1 = *lda;9069a_offset = 1 + a_dim1;9070a -= a_offset;9071c_dim1 = *ldc;9072c_offset = 1 + c_dim1;9073c__ -= c_offset;90749075/* Function Body */9076if (lsame_(trans, "N")) {9077nrowa = *n;9078} else {9079nrowa = *k;9080}9081upper = lsame_(uplo, "U");90829083info = 0;9084if (! upper && ! lsame_(uplo, "L")) {9085info = 1;9086} else if (! lsame_(trans, "N") && ! lsame_(trans,9087"T") && ! lsame_(trans, "C")) {9088info = 2;9089} else if (*n < 0) {9090info = 3;9091} else if (*k < 0) {9092info = 4;9093} else if (*lda < max(1,nrowa)) {9094info = 7;9095} else if (*ldc < max(1,*n)) {9096info = 10;9097}9098if (info != 0) {9099xerbla_("DSYRK ", &info);9100return 0;9101}91029103/* Quick return if possible. */91049105if (*n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {9106return 0;9107}91089109/* And when alpha.eq.zero. */91109111if (*alpha == 0.) {9112if (upper) {9113if (*beta == 0.) {9114i__1 = *n;9115for (j = 1; j <= i__1; ++j) {9116i__2 = j;9117for (i__ = 1; i__ <= i__2; ++i__) {9118c__[i__ + j * c_dim1] = 0.;9119/* L10: */9120}9121/* L20: */9122}9123} else {9124i__1 = *n;9125for (j = 1; j <= i__1; ++j) {9126i__2 = j;9127for (i__ = 1; i__ <= i__2; ++i__) {9128c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];9129/* L30: */9130}9131/* L40: */9132}9133}9134} else {9135if (*beta == 0.) {9136i__1 = *n;9137for (j = 1; j <= i__1; ++j) {9138i__2 = *n;9139for (i__ = j; i__ <= i__2; ++i__) {9140c__[i__ + j * c_dim1] = 0.;9141/* L50: */9142}9143/* L60: */9144}9145} else {9146i__1 = *n;9147for (j = 1; j <= i__1; ++j) {9148i__2 = *n;9149for (i__ = j; i__ <= i__2; ++i__) {9150c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];9151/* L70: */9152}9153/* L80: */9154}9155}9156}9157return 0;9158}91599160/* Start the operations. */91619162if (lsame_(trans, "N")) {91639164/* Form C := alpha*A*A' + beta*C. */91659166if (upper) {9167i__1 = *n;9168for (j = 1; j <= i__1; ++j) {9169if (*beta == 0.) {9170i__2 = j;9171for (i__ = 1; i__ <= i__2; ++i__) {9172c__[i__ + j * c_dim1] = 0.;9173/* L90: */9174}9175} else if (*beta != 1.) {9176i__2 = j;9177for (i__ = 1; i__ <= i__2; ++i__) {9178c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];9179/* L100: */9180}9181}9182i__2 = *k;9183for (l = 1; l <= i__2; ++l) {9184if (a[j + l * a_dim1] != 0.) {9185temp = *alpha * a[j + l * a_dim1];9186i__3 = j;9187for (i__ = 1; i__ <= i__3; ++i__) {9188c__[i__ + j * c_dim1] += temp * a[i__ + l *9189a_dim1];9190/* L110: */9191}9192}9193/* L120: */9194}9195/* L130: */9196}9197} else {9198i__1 = *n;9199for (j = 1; j <= i__1; ++j) {9200if (*beta == 0.) {9201i__2 = *n;9202for (i__ = j; i__ <= i__2; ++i__) {9203c__[i__ + j * c_dim1] = 0.;9204/* L140: */9205}9206} else if (*beta != 1.) {9207i__2 = *n;9208for (i__ = j; i__ <= i__2; ++i__) {9209c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];9210/* L150: */9211}9212}9213i__2 = *k;9214for (l = 1; l <= i__2; ++l) {9215if (a[j + l * a_dim1] != 0.) {9216temp = *alpha * a[j + l * a_dim1];9217i__3 = *n;9218for (i__ = j; i__ <= i__3; ++i__) {9219c__[i__ + j * c_dim1] += temp * a[i__ + l *9220a_dim1];9221/* L160: */9222}9223}9224/* L170: */9225}9226/* L180: */9227}9228}9229} else {92309231/* Form C := alpha*A'*A + beta*C. */92329233if (upper) {9234i__1 = *n;9235for (j = 1; j <= i__1; ++j) {9236i__2 = j;9237for (i__ = 1; i__ <= i__2; ++i__) {9238temp = 0.;9239i__3 = *k;9240for (l = 1; l <= i__3; ++l) {9241temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];9242/* L190: */9243}9244if (*beta == 0.) {9245c__[i__ + j * c_dim1] = *alpha * temp;9246} else {9247c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[9248i__ + j * c_dim1];9249}9250/* L200: */9251}9252/* L210: */9253}9254} else {9255i__1 = *n;9256for (j = 1; j <= i__1; ++j) {9257i__2 = *n;9258for (i__ = j; i__ <= i__2; ++i__) {9259temp = 0.;9260i__3 = *k;9261for (l = 1; l <= i__3; ++l) {9262temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];9263/* L220: */9264}9265if (*beta == 0.) {9266c__[i__ + j * c_dim1] = *alpha * temp;9267} else {9268c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[9269i__ + j * c_dim1];9270}9271/* L230: */9272}9273/* L240: */9274}9275}9276}92779278return 0;92799280/* End of DSYRK . */92819282} /* dsyrk_ */92839284/* Subroutine */ int dtrmm_(char *side, char *uplo, char *transa, char *diag,9285integer *m, integer *n, doublereal *alpha, doublereal *a, integer *9286lda, doublereal *b, integer *ldb)9287{9288/* System generated locals */9289integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;92909291/* Local variables */9292static integer i__, j, k, info;9293static doublereal temp;9294static logical lside;9295extern logical lsame_(char *, char *);9296static integer nrowa;9297static logical upper;9298extern /* Subroutine */ int xerbla_(char *, integer *);9299static logical nounit;930093019302/*9303Purpose9304=======93059306DTRMM performs one of the matrix-matrix operations93079308B := alpha*op( A )*B, or B := alpha*B*op( A ),93099310where alpha is a scalar, B is an m by n matrix, A is a unit, or9311non-unit, upper or lower triangular matrix and op( A ) is one of93129313op( A ) = A or op( A ) = A'.93149315Arguments9316==========93179318SIDE - CHARACTER*1.9319On entry, SIDE specifies whether op( A ) multiplies B from9320the left or right as follows:93219322SIDE = 'L' or 'l' B := alpha*op( A )*B.93239324SIDE = 'R' or 'r' B := alpha*B*op( A ).93259326Unchanged on exit.93279328UPLO - CHARACTER*1.9329On entry, UPLO specifies whether the matrix A is an upper or9330lower triangular matrix as follows:93319332UPLO = 'U' or 'u' A is an upper triangular matrix.93339334UPLO = 'L' or 'l' A is a lower triangular matrix.93359336Unchanged on exit.93379338TRANSA - CHARACTER*1.9339On entry, TRANSA specifies the form of op( A ) to be used in9340the matrix multiplication as follows:93419342TRANSA = 'N' or 'n' op( A ) = A.93439344TRANSA = 'T' or 't' op( A ) = A'.93459346TRANSA = 'C' or 'c' op( A ) = A'.93479348Unchanged on exit.93499350DIAG - CHARACTER*1.9351On entry, DIAG specifies whether or not A is unit triangular9352as follows:93539354DIAG = 'U' or 'u' A is assumed to be unit triangular.93559356DIAG = 'N' or 'n' A is not assumed to be unit9357triangular.93589359Unchanged on exit.93609361M - INTEGER.9362On entry, M specifies the number of rows of B. M must be at9363least zero.9364Unchanged on exit.93659366N - INTEGER.9367On entry, N specifies the number of columns of B. N must be9368at least zero.9369Unchanged on exit.93709371ALPHA - DOUBLE PRECISION.9372On entry, ALPHA specifies the scalar alpha. When alpha is9373zero then A is not referenced and B need not be set before9374entry.9375Unchanged on exit.93769377A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m9378when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.9379Before entry with UPLO = 'U' or 'u', the leading k by k9380upper triangular part of the array A must contain the upper9381triangular matrix and the strictly lower triangular part of9382A is not referenced.9383Before entry with UPLO = 'L' or 'l', the leading k by k9384lower triangular part of the array A must contain the lower9385triangular matrix and the strictly upper triangular part of9386A is not referenced.9387Note that when DIAG = 'U' or 'u', the diagonal elements of9388A are not referenced either, but are assumed to be unity.9389Unchanged on exit.93909391LDA - INTEGER.9392On entry, LDA specifies the first dimension of A as declared9393in the calling (sub) program. When SIDE = 'L' or 'l' then9394LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'9395then LDA must be at least max( 1, n ).9396Unchanged on exit.93979398B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).9399Before entry, the leading m by n part of the array B must9400contain the matrix B, and on exit is overwritten by the9401transformed matrix.94029403LDB - INTEGER.9404On entry, LDB specifies the first dimension of B as declared9405in the calling (sub) program. LDB must be at least9406max( 1, m ).9407Unchanged on exit.94089409Further Details9410===============94119412Level 3 Blas routine.94139414-- Written on 8-February-1989.9415Jack Dongarra, Argonne National Laboratory.9416Iain Duff, AERE Harwell.9417Jeremy Du Croz, Numerical Algorithms Group Ltd.9418Sven Hammarling, Numerical Algorithms Group Ltd.94199420=====================================================================942194229423Test the input parameters.9424*/94259426/* Parameter adjustments */9427a_dim1 = *lda;9428a_offset = 1 + a_dim1;9429a -= a_offset;9430b_dim1 = *ldb;9431b_offset = 1 + b_dim1;9432b -= b_offset;94339434/* Function Body */9435lside = lsame_(side, "L");9436if (lside) {9437nrowa = *m;9438} else {9439nrowa = *n;9440}9441nounit = lsame_(diag, "N");9442upper = lsame_(uplo, "U");94439444info = 0;9445if (! lside && ! lsame_(side, "R")) {9446info = 1;9447} else if (! upper && ! lsame_(uplo, "L")) {9448info = 2;9449} else if (! lsame_(transa, "N") && ! lsame_(transa,9450"T") && ! lsame_(transa, "C")) {9451info = 3;9452} else if (! lsame_(diag, "U") && ! lsame_(diag,9453"N")) {9454info = 4;9455} else if (*m < 0) {9456info = 5;9457} else if (*n < 0) {9458info = 6;9459} else if (*lda < max(1,nrowa)) {9460info = 9;9461} else if (*ldb < max(1,*m)) {9462info = 11;9463}9464if (info != 0) {9465xerbla_("DTRMM ", &info);9466return 0;9467}94689469/* Quick return if possible. */94709471if (*m == 0 || *n == 0) {9472return 0;9473}94749475/* And when alpha.eq.zero. */94769477if (*alpha == 0.) {9478i__1 = *n;9479for (j = 1; j <= i__1; ++j) {9480i__2 = *m;9481for (i__ = 1; i__ <= i__2; ++i__) {9482b[i__ + j * b_dim1] = 0.;9483/* L10: */9484}9485/* L20: */9486}9487return 0;9488}94899490/* Start the operations. */94919492if (lside) {9493if (lsame_(transa, "N")) {94949495/* Form B := alpha*A*B. */94969497if (upper) {9498i__1 = *n;9499for (j = 1; j <= i__1; ++j) {9500i__2 = *m;9501for (k = 1; k <= i__2; ++k) {9502if (b[k + j * b_dim1] != 0.) {9503temp = *alpha * b[k + j * b_dim1];9504i__3 = k - 1;9505for (i__ = 1; i__ <= i__3; ++i__) {9506b[i__ + j * b_dim1] += temp * a[i__ + k *9507a_dim1];9508/* L30: */9509}9510if (nounit) {9511temp *= a[k + k * a_dim1];9512}9513b[k + j * b_dim1] = temp;9514}9515/* L40: */9516}9517/* L50: */9518}9519} else {9520i__1 = *n;9521for (j = 1; j <= i__1; ++j) {9522for (k = *m; k >= 1; --k) {9523if (b[k + j * b_dim1] != 0.) {9524temp = *alpha * b[k + j * b_dim1];9525b[k + j * b_dim1] = temp;9526if (nounit) {9527b[k + j * b_dim1] *= a[k + k * a_dim1];9528}9529i__2 = *m;9530for (i__ = k + 1; i__ <= i__2; ++i__) {9531b[i__ + j * b_dim1] += temp * a[i__ + k *9532a_dim1];9533/* L60: */9534}9535}9536/* L70: */9537}9538/* L80: */9539}9540}9541} else {95429543/* Form B := alpha*A'*B. */95449545if (upper) {9546i__1 = *n;9547for (j = 1; j <= i__1; ++j) {9548for (i__ = *m; i__ >= 1; --i__) {9549temp = b[i__ + j * b_dim1];9550if (nounit) {9551temp *= a[i__ + i__ * a_dim1];9552}9553i__2 = i__ - 1;9554for (k = 1; k <= i__2; ++k) {9555temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];9556/* L90: */9557}9558b[i__ + j * b_dim1] = *alpha * temp;9559/* L100: */9560}9561/* L110: */9562}9563} else {9564i__1 = *n;9565for (j = 1; j <= i__1; ++j) {9566i__2 = *m;9567for (i__ = 1; i__ <= i__2; ++i__) {9568temp = b[i__ + j * b_dim1];9569if (nounit) {9570temp *= a[i__ + i__ * a_dim1];9571}9572i__3 = *m;9573for (k = i__ + 1; k <= i__3; ++k) {9574temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];9575/* L120: */9576}9577b[i__ + j * b_dim1] = *alpha * temp;9578/* L130: */9579}9580/* L140: */9581}9582}9583}9584} else {9585if (lsame_(transa, "N")) {95869587/* Form B := alpha*B*A. */95889589if (upper) {9590for (j = *n; j >= 1; --j) {9591temp = *alpha;9592if (nounit) {9593temp *= a[j + j * a_dim1];9594}9595i__1 = *m;9596for (i__ = 1; i__ <= i__1; ++i__) {9597b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];9598/* L150: */9599}9600i__1 = j - 1;9601for (k = 1; k <= i__1; ++k) {9602if (a[k + j * a_dim1] != 0.) {9603temp = *alpha * a[k + j * a_dim1];9604i__2 = *m;9605for (i__ = 1; i__ <= i__2; ++i__) {9606b[i__ + j * b_dim1] += temp * b[i__ + k *9607b_dim1];9608/* L160: */9609}9610}9611/* L170: */9612}9613/* L180: */9614}9615} else {9616i__1 = *n;9617for (j = 1; j <= i__1; ++j) {9618temp = *alpha;9619if (nounit) {9620temp *= a[j + j * a_dim1];9621}9622i__2 = *m;9623for (i__ = 1; i__ <= i__2; ++i__) {9624b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];9625/* L190: */9626}9627i__2 = *n;9628for (k = j + 1; k <= i__2; ++k) {9629if (a[k + j * a_dim1] != 0.) {9630temp = *alpha * a[k + j * a_dim1];9631i__3 = *m;9632for (i__ = 1; i__ <= i__3; ++i__) {9633b[i__ + j * b_dim1] += temp * b[i__ + k *9634b_dim1];9635/* L200: */9636}9637}9638/* L210: */9639}9640/* L220: */9641}9642}9643} else {96449645/* Form B := alpha*B*A'. */96469647if (upper) {9648i__1 = *n;9649for (k = 1; k <= i__1; ++k) {9650i__2 = k - 1;9651for (j = 1; j <= i__2; ++j) {9652if (a[j + k * a_dim1] != 0.) {9653temp = *alpha * a[j + k * a_dim1];9654i__3 = *m;9655for (i__ = 1; i__ <= i__3; ++i__) {9656b[i__ + j * b_dim1] += temp * b[i__ + k *9657b_dim1];9658/* L230: */9659}9660}9661/* L240: */9662}9663temp = *alpha;9664if (nounit) {9665temp *= a[k + k * a_dim1];9666}9667if (temp != 1.) {9668i__2 = *m;9669for (i__ = 1; i__ <= i__2; ++i__) {9670b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];9671/* L250: */9672}9673}9674/* L260: */9675}9676} else {9677for (k = *n; k >= 1; --k) {9678i__1 = *n;9679for (j = k + 1; j <= i__1; ++j) {9680if (a[j + k * a_dim1] != 0.) {9681temp = *alpha * a[j + k * a_dim1];9682i__2 = *m;9683for (i__ = 1; i__ <= i__2; ++i__) {9684b[i__ + j * b_dim1] += temp * b[i__ + k *9685b_dim1];9686/* L270: */9687}9688}9689/* L280: */9690}9691temp = *alpha;9692if (nounit) {9693temp *= a[k + k * a_dim1];9694}9695if (temp != 1.) {9696i__1 = *m;9697for (i__ = 1; i__ <= i__1; ++i__) {9698b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];9699/* L290: */9700}9701}9702/* L300: */9703}9704}9705}9706}97079708return 0;97099710/* End of DTRMM . */97119712} /* dtrmm_ */97139714/* Subroutine */ int dtrmv_(char *uplo, char *trans, char *diag, integer *n,9715doublereal *a, integer *lda, doublereal *x, integer *incx)9716{9717/* System generated locals */9718integer a_dim1, a_offset, i__1, i__2;97199720/* Local variables */9721static integer i__, j, ix, jx, kx, info;9722static doublereal temp;9723extern logical lsame_(char *, char *);9724extern /* Subroutine */ int xerbla_(char *, integer *);9725static logical nounit;972697279728/*9729Purpose9730=======97319732DTRMV performs one of the matrix-vector operations97339734x := A*x, or x := A'*x,97359736where x is an n element vector and A is an n by n unit, or non-unit,9737upper or lower triangular matrix.97389739Arguments9740==========97419742UPLO - CHARACTER*1.9743On entry, UPLO specifies whether the matrix is an upper or9744lower triangular matrix as follows:97459746UPLO = 'U' or 'u' A is an upper triangular matrix.97479748UPLO = 'L' or 'l' A is a lower triangular matrix.97499750Unchanged on exit.97519752TRANS - CHARACTER*1.9753On entry, TRANS specifies the operation to be performed as9754follows:97559756TRANS = 'N' or 'n' x := A*x.97579758TRANS = 'T' or 't' x := A'*x.97599760TRANS = 'C' or 'c' x := A'*x.97619762Unchanged on exit.97639764DIAG - CHARACTER*1.9765On entry, DIAG specifies whether or not A is unit9766triangular as follows:97679768DIAG = 'U' or 'u' A is assumed to be unit triangular.97699770DIAG = 'N' or 'n' A is not assumed to be unit9771triangular.97729773Unchanged on exit.97749775N - INTEGER.9776On entry, N specifies the order of the matrix A.9777N must be at least zero.9778Unchanged on exit.97799780A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).9781Before entry with UPLO = 'U' or 'u', the leading n by n9782upper triangular part of the array A must contain the upper9783triangular matrix and the strictly lower triangular part of9784A is not referenced.9785Before entry with UPLO = 'L' or 'l', the leading n by n9786lower triangular part of the array A must contain the lower9787triangular matrix and the strictly upper triangular part of9788A is not referenced.9789Note that when DIAG = 'U' or 'u', the diagonal elements of9790A are not referenced either, but are assumed to be unity.9791Unchanged on exit.97929793LDA - INTEGER.9794On entry, LDA specifies the first dimension of A as declared9795in the calling (sub) program. LDA must be at least9796max( 1, n ).9797Unchanged on exit.97989799X - DOUBLE PRECISION array of dimension at least9800( 1 + ( n - 1 )*abs( INCX ) ).9801Before entry, the incremented array X must contain the n9802element vector x. On exit, X is overwritten with the9803tranformed vector x.98049805INCX - INTEGER.9806On entry, INCX specifies the increment for the elements of9807X. INCX must not be zero.9808Unchanged on exit.98099810Further Details9811===============98129813Level 2 Blas routine.98149815-- Written on 22-October-1986.9816Jack Dongarra, Argonne National Lab.9817Jeremy Du Croz, Nag Central Office.9818Sven Hammarling, Nag Central Office.9819Richard Hanson, Sandia National Labs.98209821=====================================================================982298239824Test the input parameters.9825*/98269827/* Parameter adjustments */9828a_dim1 = *lda;9829a_offset = 1 + a_dim1;9830a -= a_offset;9831--x;98329833/* Function Body */9834info = 0;9835if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {9836info = 1;9837} else if (! lsame_(trans, "N") && ! lsame_(trans,9838"T") && ! lsame_(trans, "C")) {9839info = 2;9840} else if (! lsame_(diag, "U") && ! lsame_(diag,9841"N")) {9842info = 3;9843} else if (*n < 0) {9844info = 4;9845} else if (*lda < max(1,*n)) {9846info = 6;9847} else if (*incx == 0) {9848info = 8;9849}9850if (info != 0) {9851xerbla_("DTRMV ", &info);9852return 0;9853}98549855/* Quick return if possible. */98569857if (*n == 0) {9858return 0;9859}98609861nounit = lsame_(diag, "N");98629863/*9864Set up the start point in X if the increment is not unity. This9865will be ( N - 1 )*INCX too small for descending loops.9866*/98679868if (*incx <= 0) {9869kx = 1 - (*n - 1) * *incx;9870} else if (*incx != 1) {9871kx = 1;9872}98739874/*9875Start the operations. In this version the elements of A are9876accessed sequentially with one pass through A.9877*/98789879if (lsame_(trans, "N")) {98809881/* Form x := A*x. */98829883if (lsame_(uplo, "U")) {9884if (*incx == 1) {9885i__1 = *n;9886for (j = 1; j <= i__1; ++j) {9887if (x[j] != 0.) {9888temp = x[j];9889i__2 = j - 1;9890for (i__ = 1; i__ <= i__2; ++i__) {9891x[i__] += temp * a[i__ + j * a_dim1];9892/* L10: */9893}9894if (nounit) {9895x[j] *= a[j + j * a_dim1];9896}9897}9898/* L20: */9899}9900} else {9901jx = kx;9902i__1 = *n;9903for (j = 1; j <= i__1; ++j) {9904if (x[jx] != 0.) {9905temp = x[jx];9906ix = kx;9907i__2 = j - 1;9908for (i__ = 1; i__ <= i__2; ++i__) {9909x[ix] += temp * a[i__ + j * a_dim1];9910ix += *incx;9911/* L30: */9912}9913if (nounit) {9914x[jx] *= a[j + j * a_dim1];9915}9916}9917jx += *incx;9918/* L40: */9919}9920}9921} else {9922if (*incx == 1) {9923for (j = *n; j >= 1; --j) {9924if (x[j] != 0.) {9925temp = x[j];9926i__1 = j + 1;9927for (i__ = *n; i__ >= i__1; --i__) {9928x[i__] += temp * a[i__ + j * a_dim1];9929/* L50: */9930}9931if (nounit) {9932x[j] *= a[j + j * a_dim1];9933}9934}9935/* L60: */9936}9937} else {9938kx += (*n - 1) * *incx;9939jx = kx;9940for (j = *n; j >= 1; --j) {9941if (x[jx] != 0.) {9942temp = x[jx];9943ix = kx;9944i__1 = j + 1;9945for (i__ = *n; i__ >= i__1; --i__) {9946x[ix] += temp * a[i__ + j * a_dim1];9947ix -= *incx;9948/* L70: */9949}9950if (nounit) {9951x[jx] *= a[j + j * a_dim1];9952}9953}9954jx -= *incx;9955/* L80: */9956}9957}9958}9959} else {99609961/* Form x := A'*x. */99629963if (lsame_(uplo, "U")) {9964if (*incx == 1) {9965for (j = *n; j >= 1; --j) {9966temp = x[j];9967if (nounit) {9968temp *= a[j + j * a_dim1];9969}9970for (i__ = j - 1; i__ >= 1; --i__) {9971temp += a[i__ + j * a_dim1] * x[i__];9972/* L90: */9973}9974x[j] = temp;9975/* L100: */9976}9977} else {9978jx = kx + (*n - 1) * *incx;9979for (j = *n; j >= 1; --j) {9980temp = x[jx];9981ix = jx;9982if (nounit) {9983temp *= a[j + j * a_dim1];9984}9985for (i__ = j - 1; i__ >= 1; --i__) {9986ix -= *incx;9987temp += a[i__ + j * a_dim1] * x[ix];9988/* L110: */9989}9990x[jx] = temp;9991jx -= *incx;9992/* L120: */9993}9994}9995} else {9996if (*incx == 1) {9997i__1 = *n;9998for (j = 1; j <= i__1; ++j) {9999temp = x[j];10000if (nounit) {10001temp *= a[j + j * a_dim1];10002}10003i__2 = *n;10004for (i__ = j + 1; i__ <= i__2; ++i__) {10005temp += a[i__ + j * a_dim1] * x[i__];10006/* L130: */10007}10008x[j] = temp;10009/* L140: */10010}10011} else {10012jx = kx;10013i__1 = *n;10014for (j = 1; j <= i__1; ++j) {10015temp = x[jx];10016ix = jx;10017if (nounit) {10018temp *= a[j + j * a_dim1];10019}10020i__2 = *n;10021for (i__ = j + 1; i__ <= i__2; ++i__) {10022ix += *incx;10023temp += a[i__ + j * a_dim1] * x[ix];10024/* L150: */10025}10026x[jx] = temp;10027jx += *incx;10028/* L160: */10029}10030}10031}10032}1003310034return 0;1003510036/* End of DTRMV . */1003710038} /* dtrmv_ */1003910040/* Subroutine */ int dtrsm_(char *side, char *uplo, char *transa, char *diag,10041integer *m, integer *n, doublereal *alpha, doublereal *a, integer *10042lda, doublereal *b, integer *ldb)10043{10044/* System generated locals */10045integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;1004610047/* Local variables */10048static integer i__, j, k, info;10049static doublereal temp;10050static logical lside;10051extern logical lsame_(char *, char *);10052static integer nrowa;10053static logical upper;10054extern /* Subroutine */ int xerbla_(char *, integer *);10055static logical nounit;100561005710058/*10059Purpose10060=======1006110062DTRSM solves one of the matrix equations1006310064op( A )*X = alpha*B, or X*op( A ) = alpha*B,1006510066where alpha is a scalar, X and B are m by n matrices, A is a unit, or10067non-unit, upper or lower triangular matrix and op( A ) is one of1006810069op( A ) = A or op( A ) = A'.1007010071The matrix X is overwritten on B.1007210073Arguments10074==========1007510076SIDE - CHARACTER*1.10077On entry, SIDE specifies whether op( A ) appears on the left10078or right of X as follows:1007910080SIDE = 'L' or 'l' op( A )*X = alpha*B.1008110082SIDE = 'R' or 'r' X*op( A ) = alpha*B.1008310084Unchanged on exit.1008510086UPLO - CHARACTER*1.10087On entry, UPLO specifies whether the matrix A is an upper or10088lower triangular matrix as follows:1008910090UPLO = 'U' or 'u' A is an upper triangular matrix.1009110092UPLO = 'L' or 'l' A is a lower triangular matrix.1009310094Unchanged on exit.1009510096TRANSA - CHARACTER*1.10097On entry, TRANSA specifies the form of op( A ) to be used in10098the matrix multiplication as follows:1009910100TRANSA = 'N' or 'n' op( A ) = A.1010110102TRANSA = 'T' or 't' op( A ) = A'.1010310104TRANSA = 'C' or 'c' op( A ) = A'.1010510106Unchanged on exit.1010710108DIAG - CHARACTER*1.10109On entry, DIAG specifies whether or not A is unit triangular10110as follows:1011110112DIAG = 'U' or 'u' A is assumed to be unit triangular.1011310114DIAG = 'N' or 'n' A is not assumed to be unit10115triangular.1011610117Unchanged on exit.1011810119M - INTEGER.10120On entry, M specifies the number of rows of B. M must be at10121least zero.10122Unchanged on exit.1012310124N - INTEGER.10125On entry, N specifies the number of columns of B. N must be10126at least zero.10127Unchanged on exit.1012810129ALPHA - DOUBLE PRECISION.10130On entry, ALPHA specifies the scalar alpha. When alpha is10131zero then A is not referenced and B need not be set before10132entry.10133Unchanged on exit.1013410135A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m10136when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.10137Before entry with UPLO = 'U' or 'u', the leading k by k10138upper triangular part of the array A must contain the upper10139triangular matrix and the strictly lower triangular part of10140A is not referenced.10141Before entry with UPLO = 'L' or 'l', the leading k by k10142lower triangular part of the array A must contain the lower10143triangular matrix and the strictly upper triangular part of10144A is not referenced.10145Note that when DIAG = 'U' or 'u', the diagonal elements of10146A are not referenced either, but are assumed to be unity.10147Unchanged on exit.1014810149LDA - INTEGER.10150On entry, LDA specifies the first dimension of A as declared10151in the calling (sub) program. When SIDE = 'L' or 'l' then10152LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'10153then LDA must be at least max( 1, n ).10154Unchanged on exit.1015510156B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).10157Before entry, the leading m by n part of the array B must10158contain the right-hand side matrix B, and on exit is10159overwritten by the solution matrix X.1016010161LDB - INTEGER.10162On entry, LDB specifies the first dimension of B as declared10163in the calling (sub) program. LDB must be at least10164max( 1, m ).10165Unchanged on exit.1016610167Further Details10168===============1016910170Level 3 Blas routine.101711017210173-- Written on 8-February-1989.10174Jack Dongarra, Argonne National Laboratory.10175Iain Duff, AERE Harwell.10176Jeremy Du Croz, Numerical Algorithms Group Ltd.10177Sven Hammarling, Numerical Algorithms Group Ltd.1017810179=====================================================================101801018110182Test the input parameters.10183*/1018410185/* Parameter adjustments */10186a_dim1 = *lda;10187a_offset = 1 + a_dim1;10188a -= a_offset;10189b_dim1 = *ldb;10190b_offset = 1 + b_dim1;10191b -= b_offset;1019210193/* Function Body */10194lside = lsame_(side, "L");10195if (lside) {10196nrowa = *m;10197} else {10198nrowa = *n;10199}10200nounit = lsame_(diag, "N");10201upper = lsame_(uplo, "U");1020210203info = 0;10204if (! lside && ! lsame_(side, "R")) {10205info = 1;10206} else if (! upper && ! lsame_(uplo, "L")) {10207info = 2;10208} else if (! lsame_(transa, "N") && ! lsame_(transa,10209"T") && ! lsame_(transa, "C")) {10210info = 3;10211} else if (! lsame_(diag, "U") && ! lsame_(diag,10212"N")) {10213info = 4;10214} else if (*m < 0) {10215info = 5;10216} else if (*n < 0) {10217info = 6;10218} else if (*lda < max(1,nrowa)) {10219info = 9;10220} else if (*ldb < max(1,*m)) {10221info = 11;10222}10223if (info != 0) {10224xerbla_("DTRSM ", &info);10225return 0;10226}1022710228/* Quick return if possible. */1022910230if (*m == 0 || *n == 0) {10231return 0;10232}1023310234/* And when alpha.eq.zero. */1023510236if (*alpha == 0.) {10237i__1 = *n;10238for (j = 1; j <= i__1; ++j) {10239i__2 = *m;10240for (i__ = 1; i__ <= i__2; ++i__) {10241b[i__ + j * b_dim1] = 0.;10242/* L10: */10243}10244/* L20: */10245}10246return 0;10247}1024810249/* Start the operations. */1025010251if (lside) {10252if (lsame_(transa, "N")) {1025310254/* Form B := alpha*inv( A )*B. */1025510256if (upper) {10257i__1 = *n;10258for (j = 1; j <= i__1; ++j) {10259if (*alpha != 1.) {10260i__2 = *m;10261for (i__ = 1; i__ <= i__2; ++i__) {10262b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]10263;10264/* L30: */10265}10266}10267for (k = *m; k >= 1; --k) {10268if (b[k + j * b_dim1] != 0.) {10269if (nounit) {10270b[k + j * b_dim1] /= a[k + k * a_dim1];10271}10272i__2 = k - 1;10273for (i__ = 1; i__ <= i__2; ++i__) {10274b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[10275i__ + k * a_dim1];10276/* L40: */10277}10278}10279/* L50: */10280}10281/* L60: */10282}10283} else {10284i__1 = *n;10285for (j = 1; j <= i__1; ++j) {10286if (*alpha != 1.) {10287i__2 = *m;10288for (i__ = 1; i__ <= i__2; ++i__) {10289b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]10290;10291/* L70: */10292}10293}10294i__2 = *m;10295for (k = 1; k <= i__2; ++k) {10296if (b[k + j * b_dim1] != 0.) {10297if (nounit) {10298b[k + j * b_dim1] /= a[k + k * a_dim1];10299}10300i__3 = *m;10301for (i__ = k + 1; i__ <= i__3; ++i__) {10302b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[10303i__ + k * a_dim1];10304/* L80: */10305}10306}10307/* L90: */10308}10309/* L100: */10310}10311}10312} else {1031310314/* Form B := alpha*inv( A' )*B. */1031510316if (upper) {10317i__1 = *n;10318for (j = 1; j <= i__1; ++j) {10319i__2 = *m;10320for (i__ = 1; i__ <= i__2; ++i__) {10321temp = *alpha * b[i__ + j * b_dim1];10322i__3 = i__ - 1;10323for (k = 1; k <= i__3; ++k) {10324temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];10325/* L110: */10326}10327if (nounit) {10328temp /= a[i__ + i__ * a_dim1];10329}10330b[i__ + j * b_dim1] = temp;10331/* L120: */10332}10333/* L130: */10334}10335} else {10336i__1 = *n;10337for (j = 1; j <= i__1; ++j) {10338for (i__ = *m; i__ >= 1; --i__) {10339temp = *alpha * b[i__ + j * b_dim1];10340i__2 = *m;10341for (k = i__ + 1; k <= i__2; ++k) {10342temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];10343/* L140: */10344}10345if (nounit) {10346temp /= a[i__ + i__ * a_dim1];10347}10348b[i__ + j * b_dim1] = temp;10349/* L150: */10350}10351/* L160: */10352}10353}10354}10355} else {10356if (lsame_(transa, "N")) {1035710358/* Form B := alpha*B*inv( A ). */1035910360if (upper) {10361i__1 = *n;10362for (j = 1; j <= i__1; ++j) {10363if (*alpha != 1.) {10364i__2 = *m;10365for (i__ = 1; i__ <= i__2; ++i__) {10366b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]10367;10368/* L170: */10369}10370}10371i__2 = j - 1;10372for (k = 1; k <= i__2; ++k) {10373if (a[k + j * a_dim1] != 0.) {10374i__3 = *m;10375for (i__ = 1; i__ <= i__3; ++i__) {10376b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[10377i__ + k * b_dim1];10378/* L180: */10379}10380}10381/* L190: */10382}10383if (nounit) {10384temp = 1. / a[j + j * a_dim1];10385i__2 = *m;10386for (i__ = 1; i__ <= i__2; ++i__) {10387b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];10388/* L200: */10389}10390}10391/* L210: */10392}10393} else {10394for (j = *n; j >= 1; --j) {10395if (*alpha != 1.) {10396i__1 = *m;10397for (i__ = 1; i__ <= i__1; ++i__) {10398b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]10399;10400/* L220: */10401}10402}10403i__1 = *n;10404for (k = j + 1; k <= i__1; ++k) {10405if (a[k + j * a_dim1] != 0.) {10406i__2 = *m;10407for (i__ = 1; i__ <= i__2; ++i__) {10408b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[10409i__ + k * b_dim1];10410/* L230: */10411}10412}10413/* L240: */10414}10415if (nounit) {10416temp = 1. / a[j + j * a_dim1];10417i__1 = *m;10418for (i__ = 1; i__ <= i__1; ++i__) {10419b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];10420/* L250: */10421}10422}10423/* L260: */10424}10425}10426} else {1042710428/* Form B := alpha*B*inv( A' ). */1042910430if (upper) {10431for (k = *n; k >= 1; --k) {10432if (nounit) {10433temp = 1. / a[k + k * a_dim1];10434i__1 = *m;10435for (i__ = 1; i__ <= i__1; ++i__) {10436b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];10437/* L270: */10438}10439}10440i__1 = k - 1;10441for (j = 1; j <= i__1; ++j) {10442if (a[j + k * a_dim1] != 0.) {10443temp = a[j + k * a_dim1];10444i__2 = *m;10445for (i__ = 1; i__ <= i__2; ++i__) {10446b[i__ + j * b_dim1] -= temp * b[i__ + k *10447b_dim1];10448/* L280: */10449}10450}10451/* L290: */10452}10453if (*alpha != 1.) {10454i__1 = *m;10455for (i__ = 1; i__ <= i__1; ++i__) {10456b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]10457;10458/* L300: */10459}10460}10461/* L310: */10462}10463} else {10464i__1 = *n;10465for (k = 1; k <= i__1; ++k) {10466if (nounit) {10467temp = 1. / a[k + k * a_dim1];10468i__2 = *m;10469for (i__ = 1; i__ <= i__2; ++i__) {10470b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];10471/* L320: */10472}10473}10474i__2 = *n;10475for (j = k + 1; j <= i__2; ++j) {10476if (a[j + k * a_dim1] != 0.) {10477temp = a[j + k * a_dim1];10478i__3 = *m;10479for (i__ = 1; i__ <= i__3; ++i__) {10480b[i__ + j * b_dim1] -= temp * b[i__ + k *10481b_dim1];10482/* L330: */10483}10484}10485/* L340: */10486}10487if (*alpha != 1.) {10488i__2 = *m;10489for (i__ = 1; i__ <= i__2; ++i__) {10490b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]10491;10492/* L350: */10493}10494}10495/* L360: */10496}10497}10498}10499}1050010501return 0;1050210503/* End of DTRSM . */1050410505} /* dtrsm_ */1050610507doublereal dzasum_(integer *n, doublecomplex *zx, integer *incx)10508{10509/* System generated locals */10510integer i__1;10511doublereal ret_val;1051210513/* Local variables */10514static integer i__, ix;10515static doublereal stemp;10516extern doublereal dcabs1_(doublecomplex *);105171051810519/*10520Purpose10521=======1052210523DZASUM takes the sum of the absolute values.1052410525Further Details10526===============1052710528jack dongarra, 3/11/78.10529modified 3/93 to return if incx .le. 0.10530modified 12/3/93, array(1) declarations changed to array(*)1053110532=====================================================================10533*/1053410535/* Parameter adjustments */10536--zx;1053710538/* Function Body */10539ret_val = 0.;10540stemp = 0.;10541if (*n <= 0 || *incx <= 0) {10542return ret_val;10543}10544if (*incx == 1) {10545goto L20;10546}1054710548/* code for increment not equal to 1 */1054910550ix = 1;10551i__1 = *n;10552for (i__ = 1; i__ <= i__1; ++i__) {10553stemp += dcabs1_(&zx[ix]);10554ix += *incx;10555/* L10: */10556}10557ret_val = stemp;10558return ret_val;1055910560/* code for increment equal to 1 */1056110562L20:10563i__1 = *n;10564for (i__ = 1; i__ <= i__1; ++i__) {10565stemp += dcabs1_(&zx[i__]);10566/* L30: */10567}10568ret_val = stemp;10569return ret_val;10570} /* dzasum_ */1057110572doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)10573{10574/* System generated locals */10575integer i__1, i__2, i__3;10576doublereal ret_val, d__1;1057710578/* Local variables */10579static integer ix;10580static doublereal ssq, temp, norm, scale;105811058210583/*10584Purpose10585=======1058610587DZNRM2 returns the euclidean norm of a vector via the function10588name, so that1058910590DZNRM2 := sqrt( conjg( x' )*x )1059110592Further Details10593===============1059410595-- This version written on 25-October-1982.10596Modified on 14-October-1993 to inline the call to ZLASSQ.10597Sven Hammarling, Nag Ltd.1059810599=====================================================================10600*/1060110602/* Parameter adjustments */10603--x;1060410605/* Function Body */10606if (*n < 1 || *incx < 1) {10607norm = 0.;10608} else {10609scale = 0.;10610ssq = 1.;10611/*10612The following loop is equivalent to this call to the LAPACK10613auxiliary routine:10614CALL ZLASSQ( N, X, INCX, SCALE, SSQ )10615*/1061610617i__1 = (*n - 1) * *incx + 1;10618i__2 = *incx;10619for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {10620i__3 = ix;10621if (x[i__3].r != 0.) {10622i__3 = ix;10623temp = (d__1 = x[i__3].r, abs(d__1));10624if (scale < temp) {10625/* Computing 2nd power */10626d__1 = scale / temp;10627ssq = ssq * (d__1 * d__1) + 1.;10628scale = temp;10629} else {10630/* Computing 2nd power */10631d__1 = temp / scale;10632ssq += d__1 * d__1;10633}10634}10635if (d_imag(&x[ix]) != 0.) {10636temp = (d__1 = d_imag(&x[ix]), abs(d__1));10637if (scale < temp) {10638/* Computing 2nd power */10639d__1 = scale / temp;10640ssq = ssq * (d__1 * d__1) + 1.;10641scale = temp;10642} else {10643/* Computing 2nd power */10644d__1 = temp / scale;10645ssq += d__1 * d__1;10646}10647}10648/* L10: */10649}10650norm = scale * sqrt(ssq);10651}1065210653ret_val = norm;10654return ret_val;1065510656/* End of DZNRM2. */1065710658} /* dznrm2_ */1065910660integer icamax_(integer *n, singlecomplex *cx, integer *incx)10661{10662/* System generated locals */10663integer ret_val, i__1;1066410665/* Local variables */10666static integer i__, ix;10667static real smax;10668extern doublereal scabs1_(singlecomplex *);106691067010671/*10672Purpose10673=======1067410675ICAMAX finds the index of element having max. absolute value.1067610677Further Details10678===============1067910680jack dongarra, linpack, 3/11/78.10681modified 3/93 to return if incx .le. 0.10682modified 12/3/93, array(1) declarations changed to array(*)1068310684=====================================================================10685*/1068610687/* Parameter adjustments */10688--cx;1068910690/* Function Body */10691ret_val = 0;10692if (*n < 1 || *incx <= 0) {10693return ret_val;10694}10695ret_val = 1;10696if (*n == 1) {10697return ret_val;10698}10699if (*incx == 1) {10700goto L20;10701}1070210703/* code for increment not equal to 1 */1070410705ix = 1;10706smax = scabs1_(&cx[1]);10707ix += *incx;10708i__1 = *n;10709for (i__ = 2; i__ <= i__1; ++i__) {10710if (scabs1_(&cx[ix]) <= smax) {10711goto L5;10712}10713ret_val = i__;10714smax = scabs1_(&cx[ix]);10715L5:10716ix += *incx;10717/* L10: */10718}10719return ret_val;1072010721/* code for increment equal to 1 */1072210723L20:10724smax = scabs1_(&cx[1]);10725i__1 = *n;10726for (i__ = 2; i__ <= i__1; ++i__) {10727if (scabs1_(&cx[i__]) <= smax) {10728goto L30;10729}10730ret_val = i__;10731smax = scabs1_(&cx[i__]);10732L30:10733;10734}10735return ret_val;10736} /* icamax_ */1073710738integer idamax_(integer *n, doublereal *dx, integer *incx)10739{10740/* System generated locals */10741integer ret_val, i__1;10742doublereal d__1;1074310744/* Local variables */10745static integer i__, ix;10746static doublereal dmax__;107471074810749/*10750Purpose10751=======1075210753IDAMAX finds the index of element having max. absolute value.1075410755Further Details10756===============1075710758jack dongarra, linpack, 3/11/78.10759modified 3/93 to return if incx .le. 0.10760modified 12/3/93, array(1) declarations changed to array(*)1076110762=====================================================================10763*/1076410765/* Parameter adjustments */10766--dx;1076710768/* Function Body */10769ret_val = 0;10770if (*n < 1 || *incx <= 0) {10771return ret_val;10772}10773ret_val = 1;10774if (*n == 1) {10775return ret_val;10776}10777if (*incx == 1) {10778goto L20;10779}1078010781/* code for increment not equal to 1 */1078210783ix = 1;10784dmax__ = abs(dx[1]);10785ix += *incx;10786i__1 = *n;10787for (i__ = 2; i__ <= i__1; ++i__) {10788if ((d__1 = dx[ix], abs(d__1)) <= dmax__) {10789goto L5;10790}10791ret_val = i__;10792dmax__ = (d__1 = dx[ix], abs(d__1));10793L5:10794ix += *incx;10795/* L10: */10796}10797return ret_val;1079810799/* code for increment equal to 1 */1080010801L20:10802dmax__ = abs(dx[1]);10803i__1 = *n;10804for (i__ = 2; i__ <= i__1; ++i__) {10805if ((d__1 = dx[i__], abs(d__1)) <= dmax__) {10806goto L30;10807}10808ret_val = i__;10809dmax__ = (d__1 = dx[i__], abs(d__1));10810L30:10811;10812}10813return ret_val;10814} /* idamax_ */1081510816integer isamax_(integer *n, real *sx, integer *incx)10817{10818/* System generated locals */10819integer ret_val, i__1;10820real r__1;1082110822/* Local variables */10823static integer i__, ix;10824static real smax;108251082610827/*10828Purpose10829=======1083010831ISAMAX finds the index of element having max. absolute value.1083210833Further Details10834===============1083510836jack dongarra, linpack, 3/11/78.10837modified 3/93 to return if incx .le. 0.10838modified 12/3/93, array(1) declarations changed to array(*)1083910840=====================================================================10841*/1084210843/* Parameter adjustments */10844--sx;1084510846/* Function Body */10847ret_val = 0;10848if (*n < 1 || *incx <= 0) {10849return ret_val;10850}10851ret_val = 1;10852if (*n == 1) {10853return ret_val;10854}10855if (*incx == 1) {10856goto L20;10857}1085810859/* code for increment not equal to 1 */1086010861ix = 1;10862smax = dabs(sx[1]);10863ix += *incx;10864i__1 = *n;10865for (i__ = 2; i__ <= i__1; ++i__) {10866if ((r__1 = sx[ix], dabs(r__1)) <= smax) {10867goto L5;10868}10869ret_val = i__;10870smax = (r__1 = sx[ix], dabs(r__1));10871L5:10872ix += *incx;10873/* L10: */10874}10875return ret_val;1087610877/* code for increment equal to 1 */1087810879L20:10880smax = dabs(sx[1]);10881i__1 = *n;10882for (i__ = 2; i__ <= i__1; ++i__) {10883if ((r__1 = sx[i__], dabs(r__1)) <= smax) {10884goto L30;10885}10886ret_val = i__;10887smax = (r__1 = sx[i__], dabs(r__1));10888L30:10889;10890}10891return ret_val;10892} /* isamax_ */1089310894integer izamax_(integer *n, doublecomplex *zx, integer *incx)10895{10896/* System generated locals */10897integer ret_val, i__1;1089810899/* Local variables */10900static integer i__, ix;10901static doublereal smax;10902extern doublereal dcabs1_(doublecomplex *);109031090410905/*10906Purpose10907=======1090810909IZAMAX finds the index of element having max. absolute value.1091010911Further Details10912===============1091310914jack dongarra, 1/15/85.10915modified 3/93 to return if incx .le. 0.10916modified 12/3/93, array(1) declarations changed to array(*)1091710918=====================================================================10919*/1092010921/* Parameter adjustments */10922--zx;1092310924/* Function Body */10925ret_val = 0;10926if (*n < 1 || *incx <= 0) {10927return ret_val;10928}10929ret_val = 1;10930if (*n == 1) {10931return ret_val;10932}10933if (*incx == 1) {10934goto L20;10935}1093610937/* code for increment not equal to 1 */1093810939ix = 1;10940smax = dcabs1_(&zx[1]);10941ix += *incx;10942i__1 = *n;10943for (i__ = 2; i__ <= i__1; ++i__) {10944if (dcabs1_(&zx[ix]) <= smax) {10945goto L5;10946}10947ret_val = i__;10948smax = dcabs1_(&zx[ix]);10949L5:10950ix += *incx;10951/* L10: */10952}10953return ret_val;1095410955/* code for increment equal to 1 */1095610957L20:10958smax = dcabs1_(&zx[1]);10959i__1 = *n;10960for (i__ = 2; i__ <= i__1; ++i__) {10961if (dcabs1_(&zx[i__]) <= smax) {10962goto L30;10963}10964ret_val = i__;10965smax = dcabs1_(&zx[i__]);10966L30:10967;10968}10969return ret_val;10970} /* izamax_ */1097110972/* Subroutine */ int saxpy_(integer *n, real *sa, real *sx, integer *incx,10973real *sy, integer *incy)10974{10975/* System generated locals */10976integer i__1;1097710978/* Local variables */10979static integer i__, m, ix, iy, mp1;109801098110982/*10983Purpose10984=======1098510986SAXPY constant times a vector plus a vector.10987uses unrolled loop for increments equal to one.1098810989Further Details10990===============1099110992jack dongarra, linpack, 3/11/78.10993modified 12/3/93, array(1) declarations changed to array(*)1099410995=====================================================================10996*/1099710998/* Parameter adjustments */10999--sy;11000--sx;1100111002/* Function Body */11003if (*n <= 0) {11004return 0;11005}11006if (*sa == 0.f) {11007return 0;11008}11009if (*incx == 1 && *incy == 1) {11010goto L20;11011}1101211013/*11014code for unequal increments or equal increments11015not equal to 111016*/1101711018ix = 1;11019iy = 1;11020if (*incx < 0) {11021ix = (-(*n) + 1) * *incx + 1;11022}11023if (*incy < 0) {11024iy = (-(*n) + 1) * *incy + 1;11025}11026i__1 = *n;11027for (i__ = 1; i__ <= i__1; ++i__) {11028sy[iy] += *sa * sx[ix];11029ix += *incx;11030iy += *incy;11031/* L10: */11032}11033return 0;1103411035/*11036code for both increments equal to 1110371103811039clean-up loop11040*/1104111042L20:11043m = *n % 4;11044if (m == 0) {11045goto L40;11046}11047i__1 = m;11048for (i__ = 1; i__ <= i__1; ++i__) {11049sy[i__] += *sa * sx[i__];11050/* L30: */11051}11052if (*n < 4) {11053return 0;11054}11055L40:11056mp1 = m + 1;11057i__1 = *n;11058for (i__ = mp1; i__ <= i__1; i__ += 4) {11059sy[i__] += *sa * sx[i__];11060sy[i__ + 1] += *sa * sx[i__ + 1];11061sy[i__ + 2] += *sa * sx[i__ + 2];11062sy[i__ + 3] += *sa * sx[i__ + 3];11063/* L50: */11064}11065return 0;11066} /* saxpy_ */1106711068doublereal scabs1_(singlecomplex *z__)11069{11070/* System generated locals */11071real ret_val, r__1, r__2;110721107311074/*11075Purpose11076=======1107711078SCABS1 computes absolute value of a complex number1107911080=====================================================================11081*/1108211083ret_val = (r__1 = z__->r, dabs(r__1)) + (r__2 = r_imag(z__), dabs(r__2));11084return ret_val;11085} /* scabs1_ */1108611087doublereal scasum_(integer *n, singlecomplex *cx, integer *incx)11088{11089/* System generated locals */11090integer i__1, i__2, i__3;11091real ret_val, r__1, r__2;1109211093/* Local variables */11094static integer i__, nincx;11095static real stemp;110961109711098/*11099Purpose11100=======1110111102SCASUM takes the sum of the absolute values of a complex vector and11103returns a single precision result.1110411105Further Details11106===============1110711108jack dongarra, linpack, 3/11/78.11109modified 3/93 to return if incx .le. 0.11110modified 12/3/93, array(1) declarations changed to array(*)1111111112=====================================================================11113*/1111411115/* Parameter adjustments */11116--cx;1111711118/* Function Body */11119ret_val = 0.f;11120stemp = 0.f;11121if (*n <= 0 || *incx <= 0) {11122return ret_val;11123}11124if (*incx == 1) {11125goto L20;11126}1112711128/* code for increment not equal to 1 */1112911130nincx = *n * *incx;11131i__1 = nincx;11132i__2 = *incx;11133for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {11134i__3 = i__;11135stemp = stemp + (r__1 = cx[i__3].r, dabs(r__1)) + (r__2 = r_imag(&cx[11136i__]), dabs(r__2));11137/* L10: */11138}11139ret_val = stemp;11140return ret_val;1114111142/* code for increment equal to 1 */1114311144L20:11145i__2 = *n;11146for (i__ = 1; i__ <= i__2; ++i__) {11147i__1 = i__;11148stemp = stemp + (r__1 = cx[i__1].r, dabs(r__1)) + (r__2 = r_imag(&cx[11149i__]), dabs(r__2));11150/* L30: */11151}11152ret_val = stemp;11153return ret_val;11154} /* scasum_ */1115511156doublereal scnrm2_(integer *n, singlecomplex *x, integer *incx)11157{11158/* System generated locals */11159integer i__1, i__2, i__3;11160real ret_val, r__1;1116111162/* Local variables */11163static integer ix;11164static real ssq, temp, norm, scale;111651116611167/*11168Purpose11169=======1117011171SCNRM2 returns the euclidean norm of a vector via the function11172name, so that1117311174SCNRM2 := sqrt( conjg( x' )*x )1117511176Further Details11177===============1117811179-- This version written on 25-October-1982.11180Modified on 14-October-1993 to inline the call to CLASSQ.11181Sven Hammarling, Nag Ltd.1118211183=====================================================================11184*/1118511186/* Parameter adjustments */11187--x;1118811189/* Function Body */11190if (*n < 1 || *incx < 1) {11191norm = 0.f;11192} else {11193scale = 0.f;11194ssq = 1.f;11195/*11196The following loop is equivalent to this call to the LAPACK11197auxiliary routine:11198CALL CLASSQ( N, X, INCX, SCALE, SSQ )11199*/1120011201i__1 = (*n - 1) * *incx + 1;11202i__2 = *incx;11203for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {11204i__3 = ix;11205if (x[i__3].r != 0.f) {11206i__3 = ix;11207temp = (r__1 = x[i__3].r, dabs(r__1));11208if (scale < temp) {11209/* Computing 2nd power */11210r__1 = scale / temp;11211ssq = ssq * (r__1 * r__1) + 1.f;11212scale = temp;11213} else {11214/* Computing 2nd power */11215r__1 = temp / scale;11216ssq += r__1 * r__1;11217}11218}11219if (r_imag(&x[ix]) != 0.f) {11220temp = (r__1 = r_imag(&x[ix]), dabs(r__1));11221if (scale < temp) {11222/* Computing 2nd power */11223r__1 = scale / temp;11224ssq = ssq * (r__1 * r__1) + 1.f;11225scale = temp;11226} else {11227/* Computing 2nd power */11228r__1 = temp / scale;11229ssq += r__1 * r__1;11230}11231}11232/* L10: */11233}11234norm = scale * sqrt(ssq);11235}1123611237ret_val = norm;11238return ret_val;1123911240/* End of SCNRM2. */1124111242} /* scnrm2_ */1124311244/* Subroutine */ int scopy_(integer *n, real *sx, integer *incx, real *sy,11245integer *incy)11246{11247/* System generated locals */11248integer i__1;1124911250/* Local variables */11251static integer i__, m, ix, iy, mp1;112521125311254/*11255Purpose11256=======1125711258SCOPY copies a vector, x, to a vector, y.11259uses unrolled loops for increments equal to 1.1126011261Further Details11262===============1126311264jack dongarra, linpack, 3/11/78.11265modified 12/3/93, array(1) declarations changed to array(*)1126611267=====================================================================11268*/1126911270/* Parameter adjustments */11271--sy;11272--sx;1127311274/* Function Body */11275if (*n <= 0) {11276return 0;11277}11278if (*incx == 1 && *incy == 1) {11279goto L20;11280}1128111282/*11283code for unequal increments or equal increments11284not equal to 111285*/1128611287ix = 1;11288iy = 1;11289if (*incx < 0) {11290ix = (-(*n) + 1) * *incx + 1;11291}11292if (*incy < 0) {11293iy = (-(*n) + 1) * *incy + 1;11294}11295i__1 = *n;11296for (i__ = 1; i__ <= i__1; ++i__) {11297sy[iy] = sx[ix];11298ix += *incx;11299iy += *incy;11300/* L10: */11301}11302return 0;1130311304/*11305code for both increments equal to 1113061130711308clean-up loop11309*/1131011311L20:11312m = *n % 7;11313if (m == 0) {11314goto L40;11315}11316i__1 = m;11317for (i__ = 1; i__ <= i__1; ++i__) {11318sy[i__] = sx[i__];11319/* L30: */11320}11321if (*n < 7) {11322return 0;11323}11324L40:11325mp1 = m + 1;11326i__1 = *n;11327for (i__ = mp1; i__ <= i__1; i__ += 7) {11328sy[i__] = sx[i__];11329sy[i__ + 1] = sx[i__ + 1];11330sy[i__ + 2] = sx[i__ + 2];11331sy[i__ + 3] = sx[i__ + 3];11332sy[i__ + 4] = sx[i__ + 4];11333sy[i__ + 5] = sx[i__ + 5];11334sy[i__ + 6] = sx[i__ + 6];11335/* L50: */11336}11337return 0;11338} /* scopy_ */1133911340doublereal sdot_(integer *n, real *sx, integer *incx, real *sy, integer *incy)11341{11342/* System generated locals */11343integer i__1;11344real ret_val;1134511346/* Local variables */11347static integer i__, m, ix, iy, mp1;11348static real stemp;113491135011351/*11352Purpose11353=======1135411355SDOT forms the dot product of two vectors.11356uses unrolled loops for increments equal to one.1135711358Further Details11359===============1136011361jack dongarra, linpack, 3/11/78.11362modified 12/3/93, array(1) declarations changed to array(*)1136311364=====================================================================11365*/1136611367/* Parameter adjustments */11368--sy;11369--sx;1137011371/* Function Body */11372stemp = 0.f;11373ret_val = 0.f;11374if (*n <= 0) {11375return ret_val;11376}11377if (*incx == 1 && *incy == 1) {11378goto L20;11379}1138011381/*11382code for unequal increments or equal increments11383not equal to 111384*/1138511386ix = 1;11387iy = 1;11388if (*incx < 0) {11389ix = (-(*n) + 1) * *incx + 1;11390}11391if (*incy < 0) {11392iy = (-(*n) + 1) * *incy + 1;11393}11394i__1 = *n;11395for (i__ = 1; i__ <= i__1; ++i__) {11396stemp += sx[ix] * sy[iy];11397ix += *incx;11398iy += *incy;11399/* L10: */11400}11401ret_val = stemp;11402return ret_val;1140311404/*11405code for both increments equal to 1114061140711408clean-up loop11409*/1141011411L20:11412m = *n % 5;11413if (m == 0) {11414goto L40;11415}11416i__1 = m;11417for (i__ = 1; i__ <= i__1; ++i__) {11418stemp += sx[i__] * sy[i__];11419/* L30: */11420}11421if (*n < 5) {11422goto L60;11423}11424L40:11425mp1 = m + 1;11426i__1 = *n;11427for (i__ = mp1; i__ <= i__1; i__ += 5) {11428stemp = stemp + sx[i__] * sy[i__] + sx[i__ + 1] * sy[i__ + 1] + sx[11429i__ + 2] * sy[i__ + 2] + sx[i__ + 3] * sy[i__ + 3] + sx[i__ +114304] * sy[i__ + 4];11431/* L50: */11432}11433L60:11434ret_val = stemp;11435return ret_val;11436} /* sdot_ */1143711438/* Subroutine */ int sgemm_(char *transa, char *transb, integer *m, integer *11439n, integer *k, real *alpha, real *a, integer *lda, real *b, integer *11440ldb, real *beta, real *c__, integer *ldc)11441{11442/* System generated locals */11443integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,11444i__3;1144511446/* Local variables */11447static integer i__, j, l, info;11448static logical nota, notb;11449static real temp;11450extern logical lsame_(char *, char *);11451static integer nrowa, nrowb;11452extern /* Subroutine */ int xerbla_(char *, integer *);114531145411455/*11456Purpose11457=======1145811459SGEMM performs one of the matrix-matrix operations1146011461C := alpha*op( A )*op( B ) + beta*C,1146211463where op( X ) is one of1146411465op( X ) = X or op( X ) = X',1146611467alpha and beta are scalars, and A, B and C are matrices, with op( A )11468an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.1146911470Arguments11471==========1147211473TRANSA - CHARACTER*1.11474On entry, TRANSA specifies the form of op( A ) to be used in11475the matrix multiplication as follows:1147611477TRANSA = 'N' or 'n', op( A ) = A.1147811479TRANSA = 'T' or 't', op( A ) = A'.1148011481TRANSA = 'C' or 'c', op( A ) = A'.1148211483Unchanged on exit.1148411485TRANSB - CHARACTER*1.11486On entry, TRANSB specifies the form of op( B ) to be used in11487the matrix multiplication as follows:1148811489TRANSB = 'N' or 'n', op( B ) = B.1149011491TRANSB = 'T' or 't', op( B ) = B'.1149211493TRANSB = 'C' or 'c', op( B ) = B'.1149411495Unchanged on exit.1149611497M - INTEGER.11498On entry, M specifies the number of rows of the matrix11499op( A ) and of the matrix C. M must be at least zero.11500Unchanged on exit.1150111502N - INTEGER.11503On entry, N specifies the number of columns of the matrix11504op( B ) and the number of columns of the matrix C. N must be11505at least zero.11506Unchanged on exit.1150711508K - INTEGER.11509On entry, K specifies the number of columns of the matrix11510op( A ) and the number of rows of the matrix op( B ). K must11511be at least zero.11512Unchanged on exit.1151311514ALPHA - REAL .11515On entry, ALPHA specifies the scalar alpha.11516Unchanged on exit.1151711518A - REAL array of DIMENSION ( LDA, ka ), where ka is11519k when TRANSA = 'N' or 'n', and is m otherwise.11520Before entry with TRANSA = 'N' or 'n', the leading m by k11521part of the array A must contain the matrix A, otherwise11522the leading k by m part of the array A must contain the11523matrix A.11524Unchanged on exit.1152511526LDA - INTEGER.11527On entry, LDA specifies the first dimension of A as declared11528in the calling (sub) program. When TRANSA = 'N' or 'n' then11529LDA must be at least max( 1, m ), otherwise LDA must be at11530least max( 1, k ).11531Unchanged on exit.1153211533B - REAL array of DIMENSION ( LDB, kb ), where kb is11534n when TRANSB = 'N' or 'n', and is k otherwise.11535Before entry with TRANSB = 'N' or 'n', the leading k by n11536part of the array B must contain the matrix B, otherwise11537the leading n by k part of the array B must contain the11538matrix B.11539Unchanged on exit.1154011541LDB - INTEGER.11542On entry, LDB specifies the first dimension of B as declared11543in the calling (sub) program. When TRANSB = 'N' or 'n' then11544LDB must be at least max( 1, k ), otherwise LDB must be at11545least max( 1, n ).11546Unchanged on exit.1154711548BETA - REAL .11549On entry, BETA specifies the scalar beta. When BETA is11550supplied as zero then C need not be set on input.11551Unchanged on exit.1155211553C - REAL array of DIMENSION ( LDC, n ).11554Before entry, the leading m by n part of the array C must11555contain the matrix C, except when beta is zero, in which11556case C need not be set on entry.11557On exit, the array C is overwritten by the m by n matrix11558( alpha*op( A )*op( B ) + beta*C ).1155911560LDC - INTEGER.11561On entry, LDC specifies the first dimension of C as declared11562in the calling (sub) program. LDC must be at least11563max( 1, m ).11564Unchanged on exit.1156511566Further Details11567===============1156811569Level 3 Blas routine.1157011571-- Written on 8-February-1989.11572Jack Dongarra, Argonne National Laboratory.11573Iain Duff, AERE Harwell.11574Jeremy Du Croz, Numerical Algorithms Group Ltd.11575Sven Hammarling, Numerical Algorithms Group Ltd.1157611577=====================================================================115781157911580Set NOTA and NOTB as true if A and B respectively are not11581transposed and set NROWA and NROWB as the number of rows11582and columns of A and the number of rows of B respectively.11583*/1158411585/* Parameter adjustments */11586a_dim1 = *lda;11587a_offset = 1 + a_dim1;11588a -= a_offset;11589b_dim1 = *ldb;11590b_offset = 1 + b_dim1;11591b -= b_offset;11592c_dim1 = *ldc;11593c_offset = 1 + c_dim1;11594c__ -= c_offset;1159511596/* Function Body */11597nota = lsame_(transa, "N");11598notb = lsame_(transb, "N");11599if (nota) {11600nrowa = *m;11601} else {11602nrowa = *k;11603}11604if (notb) {11605nrowb = *k;11606} else {11607nrowb = *n;11608}1160911610/* Test the input parameters. */1161111612info = 0;11613if (! nota && ! lsame_(transa, "C") && ! lsame_(11614transa, "T")) {11615info = 1;11616} else if (! notb && ! lsame_(transb, "C") && !11617lsame_(transb, "T")) {11618info = 2;11619} else if (*m < 0) {11620info = 3;11621} else if (*n < 0) {11622info = 4;11623} else if (*k < 0) {11624info = 5;11625} else if (*lda < max(1,nrowa)) {11626info = 8;11627} else if (*ldb < max(1,nrowb)) {11628info = 10;11629} else if (*ldc < max(1,*m)) {11630info = 13;11631}11632if (info != 0) {11633xerbla_("SGEMM ", &info);11634return 0;11635}1163611637/* Quick return if possible. */1163811639if (*m == 0 || *n == 0 || (*alpha == 0.f || *k == 0) && *beta == 1.f) {11640return 0;11641}1164211643/* And if alpha.eq.zero. */1164411645if (*alpha == 0.f) {11646if (*beta == 0.f) {11647i__1 = *n;11648for (j = 1; j <= i__1; ++j) {11649i__2 = *m;11650for (i__ = 1; i__ <= i__2; ++i__) {11651c__[i__ + j * c_dim1] = 0.f;11652/* L10: */11653}11654/* L20: */11655}11656} else {11657i__1 = *n;11658for (j = 1; j <= i__1; ++j) {11659i__2 = *m;11660for (i__ = 1; i__ <= i__2; ++i__) {11661c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];11662/* L30: */11663}11664/* L40: */11665}11666}11667return 0;11668}1166911670/* Start the operations. */1167111672if (notb) {11673if (nota) {1167411675/* Form C := alpha*A*B + beta*C. */1167611677i__1 = *n;11678for (j = 1; j <= i__1; ++j) {11679if (*beta == 0.f) {11680i__2 = *m;11681for (i__ = 1; i__ <= i__2; ++i__) {11682c__[i__ + j * c_dim1] = 0.f;11683/* L50: */11684}11685} else if (*beta != 1.f) {11686i__2 = *m;11687for (i__ = 1; i__ <= i__2; ++i__) {11688c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];11689/* L60: */11690}11691}11692i__2 = *k;11693for (l = 1; l <= i__2; ++l) {11694if (b[l + j * b_dim1] != 0.f) {11695temp = *alpha * b[l + j * b_dim1];11696i__3 = *m;11697for (i__ = 1; i__ <= i__3; ++i__) {11698c__[i__ + j * c_dim1] += temp * a[i__ + l *11699a_dim1];11700/* L70: */11701}11702}11703/* L80: */11704}11705/* L90: */11706}11707} else {1170811709/* Form C := alpha*A'*B + beta*C */1171011711i__1 = *n;11712for (j = 1; j <= i__1; ++j) {11713i__2 = *m;11714for (i__ = 1; i__ <= i__2; ++i__) {11715temp = 0.f;11716i__3 = *k;11717for (l = 1; l <= i__3; ++l) {11718temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];11719/* L100: */11720}11721if (*beta == 0.f) {11722c__[i__ + j * c_dim1] = *alpha * temp;11723} else {11724c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[11725i__ + j * c_dim1];11726}11727/* L110: */11728}11729/* L120: */11730}11731}11732} else {11733if (nota) {1173411735/* Form C := alpha*A*B' + beta*C */1173611737i__1 = *n;11738for (j = 1; j <= i__1; ++j) {11739if (*beta == 0.f) {11740i__2 = *m;11741for (i__ = 1; i__ <= i__2; ++i__) {11742c__[i__ + j * c_dim1] = 0.f;11743/* L130: */11744}11745} else if (*beta != 1.f) {11746i__2 = *m;11747for (i__ = 1; i__ <= i__2; ++i__) {11748c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];11749/* L140: */11750}11751}11752i__2 = *k;11753for (l = 1; l <= i__2; ++l) {11754if (b[j + l * b_dim1] != 0.f) {11755temp = *alpha * b[j + l * b_dim1];11756i__3 = *m;11757for (i__ = 1; i__ <= i__3; ++i__) {11758c__[i__ + j * c_dim1] += temp * a[i__ + l *11759a_dim1];11760/* L150: */11761}11762}11763/* L160: */11764}11765/* L170: */11766}11767} else {1176811769/* Form C := alpha*A'*B' + beta*C */1177011771i__1 = *n;11772for (j = 1; j <= i__1; ++j) {11773i__2 = *m;11774for (i__ = 1; i__ <= i__2; ++i__) {11775temp = 0.f;11776i__3 = *k;11777for (l = 1; l <= i__3; ++l) {11778temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];11779/* L180: */11780}11781if (*beta == 0.f) {11782c__[i__ + j * c_dim1] = *alpha * temp;11783} else {11784c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[11785i__ + j * c_dim1];11786}11787/* L190: */11788}11789/* L200: */11790}11791}11792}1179311794return 0;1179511796/* End of SGEMM . */1179711798} /* sgemm_ */1179911800/* Subroutine */ int sgemv_(char *trans, integer *m, integer *n, real *alpha,11801real *a, integer *lda, real *x, integer *incx, real *beta, real *y,11802integer *incy)11803{11804/* System generated locals */11805integer a_dim1, a_offset, i__1, i__2;1180611807/* Local variables */11808static integer i__, j, ix, iy, jx, jy, kx, ky, info;11809static real temp;11810static integer lenx, leny;11811extern logical lsame_(char *, char *);11812extern /* Subroutine */ int xerbla_(char *, integer *);118131181411815/*11816Purpose11817=======1181811819SGEMV performs one of the matrix-vector operations1182011821y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,1182211823where alpha and beta are scalars, x and y are vectors and A is an11824m by n matrix.1182511826Arguments11827==========1182811829TRANS - CHARACTER*1.11830On entry, TRANS specifies the operation to be performed as11831follows:1183211833TRANS = 'N' or 'n' y := alpha*A*x + beta*y.1183411835TRANS = 'T' or 't' y := alpha*A'*x + beta*y.1183611837TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.1183811839Unchanged on exit.1184011841M - INTEGER.11842On entry, M specifies the number of rows of the matrix A.11843M must be at least zero.11844Unchanged on exit.1184511846N - INTEGER.11847On entry, N specifies the number of columns of the matrix A.11848N must be at least zero.11849Unchanged on exit.1185011851ALPHA - REAL .11852On entry, ALPHA specifies the scalar alpha.11853Unchanged on exit.1185411855A - REAL array of DIMENSION ( LDA, n ).11856Before entry, the leading m by n part of the array A must11857contain the matrix of coefficients.11858Unchanged on exit.1185911860LDA - INTEGER.11861On entry, LDA specifies the first dimension of A as declared11862in the calling (sub) program. LDA must be at least11863max( 1, m ).11864Unchanged on exit.1186511866X - REAL array of DIMENSION at least11867( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'11868and at least11869( 1 + ( m - 1 )*abs( INCX ) ) otherwise.11870Before entry, the incremented array X must contain the11871vector x.11872Unchanged on exit.1187311874INCX - INTEGER.11875On entry, INCX specifies the increment for the elements of11876X. INCX must not be zero.11877Unchanged on exit.1187811879BETA - REAL .11880On entry, BETA specifies the scalar beta. When BETA is11881supplied as zero then Y need not be set on input.11882Unchanged on exit.1188311884Y - REAL array of DIMENSION at least11885( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'11886and at least11887( 1 + ( n - 1 )*abs( INCY ) ) otherwise.11888Before entry with BETA non-zero, the incremented array Y11889must contain the vector y. On exit, Y is overwritten by the11890updated vector y.1189111892INCY - INTEGER.11893On entry, INCY specifies the increment for the elements of11894Y. INCY must not be zero.11895Unchanged on exit.1189611897Further Details11898===============1189911900Level 2 Blas routine.1190111902-- Written on 22-October-1986.11903Jack Dongarra, Argonne National Lab.11904Jeremy Du Croz, Nag Central Office.11905Sven Hammarling, Nag Central Office.11906Richard Hanson, Sandia National Labs.1190711908=====================================================================119091191011911Test the input parameters.11912*/1191311914/* Parameter adjustments */11915a_dim1 = *lda;11916a_offset = 1 + a_dim1;11917a -= a_offset;11918--x;11919--y;1192011921/* Function Body */11922info = 0;11923if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")11924) {11925info = 1;11926} else if (*m < 0) {11927info = 2;11928} else if (*n < 0) {11929info = 3;11930} else if (*lda < max(1,*m)) {11931info = 6;11932} else if (*incx == 0) {11933info = 8;11934} else if (*incy == 0) {11935info = 11;11936}11937if (info != 0) {11938xerbla_("SGEMV ", &info);11939return 0;11940}1194111942/* Quick return if possible. */1194311944if (*m == 0 || *n == 0 || *alpha == 0.f && *beta == 1.f) {11945return 0;11946}1194711948/*11949Set LENX and LENY, the lengths of the vectors x and y, and set11950up the start points in X and Y.11951*/1195211953if (lsame_(trans, "N")) {11954lenx = *n;11955leny = *m;11956} else {11957lenx = *m;11958leny = *n;11959}11960if (*incx > 0) {11961kx = 1;11962} else {11963kx = 1 - (lenx - 1) * *incx;11964}11965if (*incy > 0) {11966ky = 1;11967} else {11968ky = 1 - (leny - 1) * *incy;11969}1197011971/*11972Start the operations. In this version the elements of A are11973accessed sequentially with one pass through A.1197411975First form y := beta*y.11976*/1197711978if (*beta != 1.f) {11979if (*incy == 1) {11980if (*beta == 0.f) {11981i__1 = leny;11982for (i__ = 1; i__ <= i__1; ++i__) {11983y[i__] = 0.f;11984/* L10: */11985}11986} else {11987i__1 = leny;11988for (i__ = 1; i__ <= i__1; ++i__) {11989y[i__] = *beta * y[i__];11990/* L20: */11991}11992}11993} else {11994iy = ky;11995if (*beta == 0.f) {11996i__1 = leny;11997for (i__ = 1; i__ <= i__1; ++i__) {11998y[iy] = 0.f;11999iy += *incy;12000/* L30: */12001}12002} else {12003i__1 = leny;12004for (i__ = 1; i__ <= i__1; ++i__) {12005y[iy] = *beta * y[iy];12006iy += *incy;12007/* L40: */12008}12009}12010}12011}12012if (*alpha == 0.f) {12013return 0;12014}12015if (lsame_(trans, "N")) {1201612017/* Form y := alpha*A*x + y. */1201812019jx = kx;12020if (*incy == 1) {12021i__1 = *n;12022for (j = 1; j <= i__1; ++j) {12023if (x[jx] != 0.f) {12024temp = *alpha * x[jx];12025i__2 = *m;12026for (i__ = 1; i__ <= i__2; ++i__) {12027y[i__] += temp * a[i__ + j * a_dim1];12028/* L50: */12029}12030}12031jx += *incx;12032/* L60: */12033}12034} else {12035i__1 = *n;12036for (j = 1; j <= i__1; ++j) {12037if (x[jx] != 0.f) {12038temp = *alpha * x[jx];12039iy = ky;12040i__2 = *m;12041for (i__ = 1; i__ <= i__2; ++i__) {12042y[iy] += temp * a[i__ + j * a_dim1];12043iy += *incy;12044/* L70: */12045}12046}12047jx += *incx;12048/* L80: */12049}12050}12051} else {1205212053/* Form y := alpha*A'*x + y. */1205412055jy = ky;12056if (*incx == 1) {12057i__1 = *n;12058for (j = 1; j <= i__1; ++j) {12059temp = 0.f;12060i__2 = *m;12061for (i__ = 1; i__ <= i__2; ++i__) {12062temp += a[i__ + j * a_dim1] * x[i__];12063/* L90: */12064}12065y[jy] += *alpha * temp;12066jy += *incy;12067/* L100: */12068}12069} else {12070i__1 = *n;12071for (j = 1; j <= i__1; ++j) {12072temp = 0.f;12073ix = kx;12074i__2 = *m;12075for (i__ = 1; i__ <= i__2; ++i__) {12076temp += a[i__ + j * a_dim1] * x[ix];12077ix += *incx;12078/* L110: */12079}12080y[jy] += *alpha * temp;12081jy += *incy;12082/* L120: */12083}12084}12085}1208612087return 0;1208812089/* End of SGEMV . */1209012091} /* sgemv_ */1209212093/* Subroutine */ int sger_(integer *m, integer *n, real *alpha, real *x,12094integer *incx, real *y, integer *incy, real *a, integer *lda)12095{12096/* System generated locals */12097integer a_dim1, a_offset, i__1, i__2;1209812099/* Local variables */12100static integer i__, j, ix, jy, kx, info;12101static real temp;12102extern /* Subroutine */ int xerbla_(char *, integer *);121031210412105/*12106Purpose12107=======1210812109SGER performs the rank 1 operation1211012111A := alpha*x*y' + A,1211212113where alpha is a scalar, x is an m element vector, y is an n element12114vector and A is an m by n matrix.1211512116Arguments12117==========1211812119M - INTEGER.12120On entry, M specifies the number of rows of the matrix A.12121M must be at least zero.12122Unchanged on exit.1212312124N - INTEGER.12125On entry, N specifies the number of columns of the matrix A.12126N must be at least zero.12127Unchanged on exit.1212812129ALPHA - REAL .12130On entry, ALPHA specifies the scalar alpha.12131Unchanged on exit.1213212133X - REAL array of dimension at least12134( 1 + ( m - 1 )*abs( INCX ) ).12135Before entry, the incremented array X must contain the m12136element vector x.12137Unchanged on exit.1213812139INCX - INTEGER.12140On entry, INCX specifies the increment for the elements of12141X. INCX must not be zero.12142Unchanged on exit.1214312144Y - REAL array of dimension at least12145( 1 + ( n - 1 )*abs( INCY ) ).12146Before entry, the incremented array Y must contain the n12147element vector y.12148Unchanged on exit.1214912150INCY - INTEGER.12151On entry, INCY specifies the increment for the elements of12152Y. INCY must not be zero.12153Unchanged on exit.1215412155A - REAL array of DIMENSION ( LDA, n ).12156Before entry, the leading m by n part of the array A must12157contain the matrix of coefficients. On exit, A is12158overwritten by the updated matrix.1215912160LDA - INTEGER.12161On entry, LDA specifies the first dimension of A as declared12162in the calling (sub) program. LDA must be at least12163max( 1, m ).12164Unchanged on exit.1216512166Further Details12167===============1216812169Level 2 Blas routine.1217012171-- Written on 22-October-1986.12172Jack Dongarra, Argonne National Lab.12173Jeremy Du Croz, Nag Central Office.12174Sven Hammarling, Nag Central Office.12175Richard Hanson, Sandia National Labs.1217612177=====================================================================121781217912180Test the input parameters.12181*/1218212183/* Parameter adjustments */12184--x;12185--y;12186a_dim1 = *lda;12187a_offset = 1 + a_dim1;12188a -= a_offset;1218912190/* Function Body */12191info = 0;12192if (*m < 0) {12193info = 1;12194} else if (*n < 0) {12195info = 2;12196} else if (*incx == 0) {12197info = 5;12198} else if (*incy == 0) {12199info = 7;12200} else if (*lda < max(1,*m)) {12201info = 9;12202}12203if (info != 0) {12204xerbla_("SGER ", &info);12205return 0;12206}1220712208/* Quick return if possible. */1220912210if (*m == 0 || *n == 0 || *alpha == 0.f) {12211return 0;12212}1221312214/*12215Start the operations. In this version the elements of A are12216accessed sequentially with one pass through A.12217*/1221812219if (*incy > 0) {12220jy = 1;12221} else {12222jy = 1 - (*n - 1) * *incy;12223}12224if (*incx == 1) {12225i__1 = *n;12226for (j = 1; j <= i__1; ++j) {12227if (y[jy] != 0.f) {12228temp = *alpha * y[jy];12229i__2 = *m;12230for (i__ = 1; i__ <= i__2; ++i__) {12231a[i__ + j * a_dim1] += x[i__] * temp;12232/* L10: */12233}12234}12235jy += *incy;12236/* L20: */12237}12238} else {12239if (*incx > 0) {12240kx = 1;12241} else {12242kx = 1 - (*m - 1) * *incx;12243}12244i__1 = *n;12245for (j = 1; j <= i__1; ++j) {12246if (y[jy] != 0.f) {12247temp = *alpha * y[jy];12248ix = kx;12249i__2 = *m;12250for (i__ = 1; i__ <= i__2; ++i__) {12251a[i__ + j * a_dim1] += x[ix] * temp;12252ix += *incx;12253/* L30: */12254}12255}12256jy += *incy;12257/* L40: */12258}12259}1226012261return 0;1226212263/* End of SGER . */1226412265} /* sger_ */1226612267doublereal snrm2_(integer *n, real *x, integer *incx)12268{12269/* System generated locals */12270integer i__1, i__2;12271real ret_val, r__1;1227212273/* Local variables */12274static integer ix;12275static real ssq, norm, scale, absxi;122761227712278/*12279Purpose12280=======1228112282SNRM2 returns the euclidean norm of a vector via the function12283name, so that1228412285SNRM2 := sqrt( x'*x ).1228612287Further Details12288===============1228912290-- This version written on 25-October-1982.12291Modified on 14-October-1993 to inline the call to SLASSQ.12292Sven Hammarling, Nag Ltd.1229312294=====================================================================12295*/1229612297/* Parameter adjustments */12298--x;1229912300/* Function Body */12301if (*n < 1 || *incx < 1) {12302norm = 0.f;12303} else if (*n == 1) {12304norm = dabs(x[1]);12305} else {12306scale = 0.f;12307ssq = 1.f;12308/*12309The following loop is equivalent to this call to the LAPACK12310auxiliary routine:12311CALL SLASSQ( N, X, INCX, SCALE, SSQ )12312*/1231312314i__1 = (*n - 1) * *incx + 1;12315i__2 = *incx;12316for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {12317if (x[ix] != 0.f) {12318absxi = (r__1 = x[ix], dabs(r__1));12319if (scale < absxi) {12320/* Computing 2nd power */12321r__1 = scale / absxi;12322ssq = ssq * (r__1 * r__1) + 1.f;12323scale = absxi;12324} else {12325/* Computing 2nd power */12326r__1 = absxi / scale;12327ssq += r__1 * r__1;12328}12329}12330/* L10: */12331}12332norm = scale * sqrt(ssq);12333}1233412335ret_val = norm;12336return ret_val;1233712338/* End of SNRM2. */1233912340} /* snrm2_ */1234112342/* Subroutine */ int srot_(integer *n, real *sx, integer *incx, real *sy,12343integer *incy, real *c__, real *s)12344{12345/* System generated locals */12346integer i__1;1234712348/* Local variables */12349static integer i__, ix, iy;12350static real stemp;123511235212353/*12354Purpose12355=======1235612357applies a plane rotation.1235812359Further Details12360===============1236112362jack dongarra, linpack, 3/11/78.12363modified 12/3/93, array(1) declarations changed to array(*)1236412365=====================================================================12366*/1236712368/* Parameter adjustments */12369--sy;12370--sx;1237112372/* Function Body */12373if (*n <= 0) {12374return 0;12375}12376if (*incx == 1 && *incy == 1) {12377goto L20;12378}1237912380/*12381code for unequal increments or equal increments not equal12382to 112383*/1238412385ix = 1;12386iy = 1;12387if (*incx < 0) {12388ix = (-(*n) + 1) * *incx + 1;12389}12390if (*incy < 0) {12391iy = (-(*n) + 1) * *incy + 1;12392}12393i__1 = *n;12394for (i__ = 1; i__ <= i__1; ++i__) {12395stemp = *c__ * sx[ix] + *s * sy[iy];12396sy[iy] = *c__ * sy[iy] - *s * sx[ix];12397sx[ix] = stemp;12398ix += *incx;12399iy += *incy;12400/* L10: */12401}12402return 0;1240312404/* code for both increments equal to 1 */1240512406L20:12407i__1 = *n;12408for (i__ = 1; i__ <= i__1; ++i__) {12409stemp = *c__ * sx[i__] + *s * sy[i__];12410sy[i__] = *c__ * sy[i__] - *s * sx[i__];12411sx[i__] = stemp;12412/* L30: */12413}12414return 0;12415} /* srot_ */1241612417/* Subroutine */ int sscal_(integer *n, real *sa, real *sx, integer *incx)12418{12419/* System generated locals */12420integer i__1, i__2;1242112422/* Local variables */12423static integer i__, m, mp1, nincx;124241242512426/*12427Purpose12428=======1242912430scales a vector by a constant.12431uses unrolled loops for increment equal to 1.1243212433Further Details12434===============1243512436jack dongarra, linpack, 3/11/78.12437modified 3/93 to return if incx .le. 0.12438modified 12/3/93, array(1) declarations changed to array(*)1243912440=====================================================================12441*/1244212443/* Parameter adjustments */12444--sx;1244512446/* Function Body */12447if (*n <= 0 || *incx <= 0) {12448return 0;12449}12450if (*incx == 1) {12451goto L20;12452}1245312454/* code for increment not equal to 1 */1245512456nincx = *n * *incx;12457i__1 = nincx;12458i__2 = *incx;12459for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {12460sx[i__] = *sa * sx[i__];12461/* L10: */12462}12463return 0;1246412465/*12466code for increment equal to 1124671246812469clean-up loop12470*/1247112472L20:12473m = *n % 5;12474if (m == 0) {12475goto L40;12476}12477i__2 = m;12478for (i__ = 1; i__ <= i__2; ++i__) {12479sx[i__] = *sa * sx[i__];12480/* L30: */12481}12482if (*n < 5) {12483return 0;12484}12485L40:12486mp1 = m + 1;12487i__2 = *n;12488for (i__ = mp1; i__ <= i__2; i__ += 5) {12489sx[i__] = *sa * sx[i__];12490sx[i__ + 1] = *sa * sx[i__ + 1];12491sx[i__ + 2] = *sa * sx[i__ + 2];12492sx[i__ + 3] = *sa * sx[i__ + 3];12493sx[i__ + 4] = *sa * sx[i__ + 4];12494/* L50: */12495}12496return 0;12497} /* sscal_ */1249812499/* Subroutine */ int sswap_(integer *n, real *sx, integer *incx, real *sy,12500integer *incy)12501{12502/* System generated locals */12503integer i__1;1250412505/* Local variables */12506static integer i__, m, ix, iy, mp1;12507static real stemp;125081250912510/*12511Purpose12512=======1251312514interchanges two vectors.12515uses unrolled loops for increments equal to 1.1251612517Further Details12518===============1251912520jack dongarra, linpack, 3/11/78.12521modified 12/3/93, array(1) declarations changed to array(*)1252212523=====================================================================12524*/1252512526/* Parameter adjustments */12527--sy;12528--sx;1252912530/* Function Body */12531if (*n <= 0) {12532return 0;12533}12534if (*incx == 1 && *incy == 1) {12535goto L20;12536}1253712538/*12539code for unequal increments or equal increments not equal12540to 112541*/1254212543ix = 1;12544iy = 1;12545if (*incx < 0) {12546ix = (-(*n) + 1) * *incx + 1;12547}12548if (*incy < 0) {12549iy = (-(*n) + 1) * *incy + 1;12550}12551i__1 = *n;12552for (i__ = 1; i__ <= i__1; ++i__) {12553stemp = sx[ix];12554sx[ix] = sy[iy];12555sy[iy] = stemp;12556ix += *incx;12557iy += *incy;12558/* L10: */12559}12560return 0;1256112562/*12563code for both increments equal to 1125641256512566clean-up loop12567*/1256812569L20:12570m = *n % 3;12571if (m == 0) {12572goto L40;12573}12574i__1 = m;12575for (i__ = 1; i__ <= i__1; ++i__) {12576stemp = sx[i__];12577sx[i__] = sy[i__];12578sy[i__] = stemp;12579/* L30: */12580}12581if (*n < 3) {12582return 0;12583}12584L40:12585mp1 = m + 1;12586i__1 = *n;12587for (i__ = mp1; i__ <= i__1; i__ += 3) {12588stemp = sx[i__];12589sx[i__] = sy[i__];12590sy[i__] = stemp;12591stemp = sx[i__ + 1];12592sx[i__ + 1] = sy[i__ + 1];12593sy[i__ + 1] = stemp;12594stemp = sx[i__ + 2];12595sx[i__ + 2] = sy[i__ + 2];12596sy[i__ + 2] = stemp;12597/* L50: */12598}12599return 0;12600} /* sswap_ */1260112602/* Subroutine */ int ssymv_(char *uplo, integer *n, real *alpha, real *a,12603integer *lda, real *x, integer *incx, real *beta, real *y, integer *12604incy)12605{12606/* System generated locals */12607integer a_dim1, a_offset, i__1, i__2;1260812609/* Local variables */12610static integer i__, j, ix, iy, jx, jy, kx, ky, info;12611static real temp1, temp2;12612extern logical lsame_(char *, char *);12613extern /* Subroutine */ int xerbla_(char *, integer *);126141261512616/*12617Purpose12618=======1261912620SSYMV performs the matrix-vector operation1262112622y := alpha*A*x + beta*y,1262312624where alpha and beta are scalars, x and y are n element vectors and12625A is an n by n symmetric matrix.1262612627Arguments12628==========1262912630UPLO - CHARACTER*1.12631On entry, UPLO specifies whether the upper or lower12632triangular part of the array A is to be referenced as12633follows:1263412635UPLO = 'U' or 'u' Only the upper triangular part of A12636is to be referenced.1263712638UPLO = 'L' or 'l' Only the lower triangular part of A12639is to be referenced.1264012641Unchanged on exit.1264212643N - INTEGER.12644On entry, N specifies the order of the matrix A.12645N must be at least zero.12646Unchanged on exit.1264712648ALPHA - REAL .12649On entry, ALPHA specifies the scalar alpha.12650Unchanged on exit.1265112652A - REAL array of DIMENSION ( LDA, n ).12653Before entry with UPLO = 'U' or 'u', the leading n by n12654upper triangular part of the array A must contain the upper12655triangular part of the symmetric matrix and the strictly12656lower triangular part of A is not referenced.12657Before entry with UPLO = 'L' or 'l', the leading n by n12658lower triangular part of the array A must contain the lower12659triangular part of the symmetric matrix and the strictly12660upper triangular part of A is not referenced.12661Unchanged on exit.1266212663LDA - INTEGER.12664On entry, LDA specifies the first dimension of A as declared12665in the calling (sub) program. LDA must be at least12666max( 1, n ).12667Unchanged on exit.1266812669X - REAL array of dimension at least12670( 1 + ( n - 1 )*abs( INCX ) ).12671Before entry, the incremented array X must contain the n12672element vector x.12673Unchanged on exit.1267412675INCX - INTEGER.12676On entry, INCX specifies the increment for the elements of12677X. INCX must not be zero.12678Unchanged on exit.1267912680BETA - REAL .12681On entry, BETA specifies the scalar beta. When BETA is12682supplied as zero then Y need not be set on input.12683Unchanged on exit.1268412685Y - REAL array of dimension at least12686( 1 + ( n - 1 )*abs( INCY ) ).12687Before entry, the incremented array Y must contain the n12688element vector y. On exit, Y is overwritten by the updated12689vector y.1269012691INCY - INTEGER.12692On entry, INCY specifies the increment for the elements of12693Y. INCY must not be zero.12694Unchanged on exit.1269512696Further Details12697===============1269812699Level 2 Blas routine.1270012701-- Written on 22-October-1986.12702Jack Dongarra, Argonne National Lab.12703Jeremy Du Croz, Nag Central Office.12704Sven Hammarling, Nag Central Office.12705Richard Hanson, Sandia National Labs.1270612707=====================================================================127081270912710Test the input parameters.12711*/1271212713/* Parameter adjustments */12714a_dim1 = *lda;12715a_offset = 1 + a_dim1;12716a -= a_offset;12717--x;12718--y;1271912720/* Function Body */12721info = 0;12722if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {12723info = 1;12724} else if (*n < 0) {12725info = 2;12726} else if (*lda < max(1,*n)) {12727info = 5;12728} else if (*incx == 0) {12729info = 7;12730} else if (*incy == 0) {12731info = 10;12732}12733if (info != 0) {12734xerbla_("SSYMV ", &info);12735return 0;12736}1273712738/* Quick return if possible. */1273912740if (*n == 0 || *alpha == 0.f && *beta == 1.f) {12741return 0;12742}1274312744/* Set up the start points in X and Y. */1274512746if (*incx > 0) {12747kx = 1;12748} else {12749kx = 1 - (*n - 1) * *incx;12750}12751if (*incy > 0) {12752ky = 1;12753} else {12754ky = 1 - (*n - 1) * *incy;12755}1275612757/*12758Start the operations. In this version the elements of A are12759accessed sequentially with one pass through the triangular part12760of A.1276112762First form y := beta*y.12763*/1276412765if (*beta != 1.f) {12766if (*incy == 1) {12767if (*beta == 0.f) {12768i__1 = *n;12769for (i__ = 1; i__ <= i__1; ++i__) {12770y[i__] = 0.f;12771/* L10: */12772}12773} else {12774i__1 = *n;12775for (i__ = 1; i__ <= i__1; ++i__) {12776y[i__] = *beta * y[i__];12777/* L20: */12778}12779}12780} else {12781iy = ky;12782if (*beta == 0.f) {12783i__1 = *n;12784for (i__ = 1; i__ <= i__1; ++i__) {12785y[iy] = 0.f;12786iy += *incy;12787/* L30: */12788}12789} else {12790i__1 = *n;12791for (i__ = 1; i__ <= i__1; ++i__) {12792y[iy] = *beta * y[iy];12793iy += *incy;12794/* L40: */12795}12796}12797}12798}12799if (*alpha == 0.f) {12800return 0;12801}12802if (lsame_(uplo, "U")) {1280312804/* Form y when A is stored in upper triangle. */1280512806if (*incx == 1 && *incy == 1) {12807i__1 = *n;12808for (j = 1; j <= i__1; ++j) {12809temp1 = *alpha * x[j];12810temp2 = 0.f;12811i__2 = j - 1;12812for (i__ = 1; i__ <= i__2; ++i__) {12813y[i__] += temp1 * a[i__ + j * a_dim1];12814temp2 += a[i__ + j * a_dim1] * x[i__];12815/* L50: */12816}12817y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;12818/* L60: */12819}12820} else {12821jx = kx;12822jy = ky;12823i__1 = *n;12824for (j = 1; j <= i__1; ++j) {12825temp1 = *alpha * x[jx];12826temp2 = 0.f;12827ix = kx;12828iy = ky;12829i__2 = j - 1;12830for (i__ = 1; i__ <= i__2; ++i__) {12831y[iy] += temp1 * a[i__ + j * a_dim1];12832temp2 += a[i__ + j * a_dim1] * x[ix];12833ix += *incx;12834iy += *incy;12835/* L70: */12836}12837y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;12838jx += *incx;12839jy += *incy;12840/* L80: */12841}12842}12843} else {1284412845/* Form y when A is stored in lower triangle. */1284612847if (*incx == 1 && *incy == 1) {12848i__1 = *n;12849for (j = 1; j <= i__1; ++j) {12850temp1 = *alpha * x[j];12851temp2 = 0.f;12852y[j] += temp1 * a[j + j * a_dim1];12853i__2 = *n;12854for (i__ = j + 1; i__ <= i__2; ++i__) {12855y[i__] += temp1 * a[i__ + j * a_dim1];12856temp2 += a[i__ + j * a_dim1] * x[i__];12857/* L90: */12858}12859y[j] += *alpha * temp2;12860/* L100: */12861}12862} else {12863jx = kx;12864jy = ky;12865i__1 = *n;12866for (j = 1; j <= i__1; ++j) {12867temp1 = *alpha * x[jx];12868temp2 = 0.f;12869y[jy] += temp1 * a[j + j * a_dim1];12870ix = jx;12871iy = jy;12872i__2 = *n;12873for (i__ = j + 1; i__ <= i__2; ++i__) {12874ix += *incx;12875iy += *incy;12876y[iy] += temp1 * a[i__ + j * a_dim1];12877temp2 += a[i__ + j * a_dim1] * x[ix];12878/* L110: */12879}12880y[jy] += *alpha * temp2;12881jx += *incx;12882jy += *incy;12883/* L120: */12884}12885}12886}1288712888return 0;1288912890/* End of SSYMV . */1289112892} /* ssymv_ */1289312894/* Subroutine */ int ssyr2_(char *uplo, integer *n, real *alpha, real *x,12895integer *incx, real *y, integer *incy, real *a, integer *lda)12896{12897/* System generated locals */12898integer a_dim1, a_offset, i__1, i__2;1289912900/* Local variables */12901static integer i__, j, ix, iy, jx, jy, kx, ky, info;12902static real temp1, temp2;12903extern logical lsame_(char *, char *);12904extern /* Subroutine */ int xerbla_(char *, integer *);129051290612907/*12908Purpose12909=======1291012911SSYR2 performs the symmetric rank 2 operation1291212913A := alpha*x*y' + alpha*y*x' + A,1291412915where alpha is a scalar, x and y are n element vectors and A is an n12916by n symmetric matrix.1291712918Arguments12919==========1292012921UPLO - CHARACTER*1.12922On entry, UPLO specifies whether the upper or lower12923triangular part of the array A is to be referenced as12924follows:1292512926UPLO = 'U' or 'u' Only the upper triangular part of A12927is to be referenced.1292812929UPLO = 'L' or 'l' Only the lower triangular part of A12930is to be referenced.1293112932Unchanged on exit.1293312934N - INTEGER.12935On entry, N specifies the order of the matrix A.12936N must be at least zero.12937Unchanged on exit.1293812939ALPHA - REAL .12940On entry, ALPHA specifies the scalar alpha.12941Unchanged on exit.1294212943X - REAL array of dimension at least12944( 1 + ( n - 1 )*abs( INCX ) ).12945Before entry, the incremented array X must contain the n12946element vector x.12947Unchanged on exit.1294812949INCX - INTEGER.12950On entry, INCX specifies the increment for the elements of12951X. INCX must not be zero.12952Unchanged on exit.1295312954Y - REAL array of dimension at least12955( 1 + ( n - 1 )*abs( INCY ) ).12956Before entry, the incremented array Y must contain the n12957element vector y.12958Unchanged on exit.1295912960INCY - INTEGER.12961On entry, INCY specifies the increment for the elements of12962Y. INCY must not be zero.12963Unchanged on exit.1296412965A - REAL array of DIMENSION ( LDA, n ).12966Before entry with UPLO = 'U' or 'u', the leading n by n12967upper triangular part of the array A must contain the upper12968triangular part of the symmetric matrix and the strictly12969lower triangular part of A is not referenced. On exit, the12970upper triangular part of the array A is overwritten by the12971upper triangular part of the updated matrix.12972Before entry with UPLO = 'L' or 'l', the leading n by n12973lower triangular part of the array A must contain the lower12974triangular part of the symmetric matrix and the strictly12975upper triangular part of A is not referenced. On exit, the12976lower triangular part of the array A is overwritten by the12977lower triangular part of the updated matrix.1297812979LDA - INTEGER.12980On entry, LDA specifies the first dimension of A as declared12981in the calling (sub) program. LDA must be at least12982max( 1, n ).12983Unchanged on exit.1298412985Further Details12986===============1298712988Level 2 Blas routine.1298912990-- Written on 22-October-1986.12991Jack Dongarra, Argonne National Lab.12992Jeremy Du Croz, Nag Central Office.12993Sven Hammarling, Nag Central Office.12994Richard Hanson, Sandia National Labs.1299512996=====================================================================129971299812999Test the input parameters.13000*/1300113002/* Parameter adjustments */13003--x;13004--y;13005a_dim1 = *lda;13006a_offset = 1 + a_dim1;13007a -= a_offset;1300813009/* Function Body */13010info = 0;13011if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {13012info = 1;13013} else if (*n < 0) {13014info = 2;13015} else if (*incx == 0) {13016info = 5;13017} else if (*incy == 0) {13018info = 7;13019} else if (*lda < max(1,*n)) {13020info = 9;13021}13022if (info != 0) {13023xerbla_("SSYR2 ", &info);13024return 0;13025}1302613027/* Quick return if possible. */1302813029if (*n == 0 || *alpha == 0.f) {13030return 0;13031}1303213033/*13034Set up the start points in X and Y if the increments are not both13035unity.13036*/1303713038if (*incx != 1 || *incy != 1) {13039if (*incx > 0) {13040kx = 1;13041} else {13042kx = 1 - (*n - 1) * *incx;13043}13044if (*incy > 0) {13045ky = 1;13046} else {13047ky = 1 - (*n - 1) * *incy;13048}13049jx = kx;13050jy = ky;13051}1305213053/*13054Start the operations. In this version the elements of A are13055accessed sequentially with one pass through the triangular part13056of A.13057*/1305813059if (lsame_(uplo, "U")) {1306013061/* Form A when A is stored in the upper triangle. */1306213063if (*incx == 1 && *incy == 1) {13064i__1 = *n;13065for (j = 1; j <= i__1; ++j) {13066if (x[j] != 0.f || y[j] != 0.f) {13067temp1 = *alpha * y[j];13068temp2 = *alpha * x[j];13069i__2 = j;13070for (i__ = 1; i__ <= i__2; ++i__) {13071a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *13072temp1 + y[i__] * temp2;13073/* L10: */13074}13075}13076/* L20: */13077}13078} else {13079i__1 = *n;13080for (j = 1; j <= i__1; ++j) {13081if (x[jx] != 0.f || y[jy] != 0.f) {13082temp1 = *alpha * y[jy];13083temp2 = *alpha * x[jx];13084ix = kx;13085iy = ky;13086i__2 = j;13087for (i__ = 1; i__ <= i__2; ++i__) {13088a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *13089temp1 + y[iy] * temp2;13090ix += *incx;13091iy += *incy;13092/* L30: */13093}13094}13095jx += *incx;13096jy += *incy;13097/* L40: */13098}13099}13100} else {1310113102/* Form A when A is stored in the lower triangle. */1310313104if (*incx == 1 && *incy == 1) {13105i__1 = *n;13106for (j = 1; j <= i__1; ++j) {13107if (x[j] != 0.f || y[j] != 0.f) {13108temp1 = *alpha * y[j];13109temp2 = *alpha * x[j];13110i__2 = *n;13111for (i__ = j; i__ <= i__2; ++i__) {13112a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *13113temp1 + y[i__] * temp2;13114/* L50: */13115}13116}13117/* L60: */13118}13119} else {13120i__1 = *n;13121for (j = 1; j <= i__1; ++j) {13122if (x[jx] != 0.f || y[jy] != 0.f) {13123temp1 = *alpha * y[jy];13124temp2 = *alpha * x[jx];13125ix = jx;13126iy = jy;13127i__2 = *n;13128for (i__ = j; i__ <= i__2; ++i__) {13129a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *13130temp1 + y[iy] * temp2;13131ix += *incx;13132iy += *incy;13133/* L70: */13134}13135}13136jx += *incx;13137jy += *incy;13138/* L80: */13139}13140}13141}1314213143return 0;1314413145/* End of SSYR2 . */1314613147} /* ssyr2_ */1314813149/* Subroutine */ int ssyr2k_(char *uplo, char *trans, integer *n, integer *k,13150real *alpha, real *a, integer *lda, real *b, integer *ldb, real *beta,13151real *c__, integer *ldc)13152{13153/* System generated locals */13154integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,13155i__3;1315613157/* Local variables */13158static integer i__, j, l, info;13159static real temp1, temp2;13160extern logical lsame_(char *, char *);13161static integer nrowa;13162static logical upper;13163extern /* Subroutine */ int xerbla_(char *, integer *);131641316513166/*13167Purpose13168=======1316913170SSYR2K performs one of the symmetric rank 2k operations1317113172C := alpha*A*B' + alpha*B*A' + beta*C,1317313174or1317513176C := alpha*A'*B + alpha*B'*A + beta*C,1317713178where alpha and beta are scalars, C is an n by n symmetric matrix13179and A and B are n by k matrices in the first case and k by n13180matrices in the second case.1318113182Arguments13183==========1318413185UPLO - CHARACTER*1.13186On entry, UPLO specifies whether the upper or lower13187triangular part of the array C is to be referenced as13188follows:1318913190UPLO = 'U' or 'u' Only the upper triangular part of C13191is to be referenced.1319213193UPLO = 'L' or 'l' Only the lower triangular part of C13194is to be referenced.1319513196Unchanged on exit.1319713198TRANS - CHARACTER*1.13199On entry, TRANS specifies the operation to be performed as13200follows:1320113202TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +13203beta*C.1320413205TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +13206beta*C.1320713208TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +13209beta*C.1321013211Unchanged on exit.1321213213N - INTEGER.13214On entry, N specifies the order of the matrix C. N must be13215at least zero.13216Unchanged on exit.1321713218K - INTEGER.13219On entry with TRANS = 'N' or 'n', K specifies the number13220of columns of the matrices A and B, and on entry with13221TRANS = 'T' or 't' or 'C' or 'c', K specifies the number13222of rows of the matrices A and B. K must be at least zero.13223Unchanged on exit.1322413225ALPHA - REAL .13226On entry, ALPHA specifies the scalar alpha.13227Unchanged on exit.1322813229A - REAL array of DIMENSION ( LDA, ka ), where ka is13230k when TRANS = 'N' or 'n', and is n otherwise.13231Before entry with TRANS = 'N' or 'n', the leading n by k13232part of the array A must contain the matrix A, otherwise13233the leading k by n part of the array A must contain the13234matrix A.13235Unchanged on exit.1323613237LDA - INTEGER.13238On entry, LDA specifies the first dimension of A as declared13239in the calling (sub) program. When TRANS = 'N' or 'n'13240then LDA must be at least max( 1, n ), otherwise LDA must13241be at least max( 1, k ).13242Unchanged on exit.1324313244B - REAL array of DIMENSION ( LDB, kb ), where kb is13245k when TRANS = 'N' or 'n', and is n otherwise.13246Before entry with TRANS = 'N' or 'n', the leading n by k13247part of the array B must contain the matrix B, otherwise13248the leading k by n part of the array B must contain the13249matrix B.13250Unchanged on exit.1325113252LDB - INTEGER.13253On entry, LDB specifies the first dimension of B as declared13254in the calling (sub) program. When TRANS = 'N' or 'n'13255then LDB must be at least max( 1, n ), otherwise LDB must13256be at least max( 1, k ).13257Unchanged on exit.1325813259BETA - REAL .13260On entry, BETA specifies the scalar beta.13261Unchanged on exit.1326213263C - REAL array of DIMENSION ( LDC, n ).13264Before entry with UPLO = 'U' or 'u', the leading n by n13265upper triangular part of the array C must contain the upper13266triangular part of the symmetric matrix and the strictly13267lower triangular part of C is not referenced. On exit, the13268upper triangular part of the array C is overwritten by the13269upper triangular part of the updated matrix.13270Before entry with UPLO = 'L' or 'l', the leading n by n13271lower triangular part of the array C must contain the lower13272triangular part of the symmetric matrix and the strictly13273upper triangular part of C is not referenced. On exit, the13274lower triangular part of the array C is overwritten by the13275lower triangular part of the updated matrix.1327613277LDC - INTEGER.13278On entry, LDC specifies the first dimension of C as declared13279in the calling (sub) program. LDC must be at least13280max( 1, n ).13281Unchanged on exit.1328213283Further Details13284===============1328513286Level 3 Blas routine.132871328813289-- Written on 8-February-1989.13290Jack Dongarra, Argonne National Laboratory.13291Iain Duff, AERE Harwell.13292Jeremy Du Croz, Numerical Algorithms Group Ltd.13293Sven Hammarling, Numerical Algorithms Group Ltd.1329413295=====================================================================132961329713298Test the input parameters.13299*/1330013301/* Parameter adjustments */13302a_dim1 = *lda;13303a_offset = 1 + a_dim1;13304a -= a_offset;13305b_dim1 = *ldb;13306b_offset = 1 + b_dim1;13307b -= b_offset;13308c_dim1 = *ldc;13309c_offset = 1 + c_dim1;13310c__ -= c_offset;1331113312/* Function Body */13313if (lsame_(trans, "N")) {13314nrowa = *n;13315} else {13316nrowa = *k;13317}13318upper = lsame_(uplo, "U");1331913320info = 0;13321if (! upper && ! lsame_(uplo, "L")) {13322info = 1;13323} else if (! lsame_(trans, "N") && ! lsame_(trans,13324"T") && ! lsame_(trans, "C")) {13325info = 2;13326} else if (*n < 0) {13327info = 3;13328} else if (*k < 0) {13329info = 4;13330} else if (*lda < max(1,nrowa)) {13331info = 7;13332} else if (*ldb < max(1,nrowa)) {13333info = 9;13334} else if (*ldc < max(1,*n)) {13335info = 12;13336}13337if (info != 0) {13338xerbla_("SSYR2K", &info);13339return 0;13340}1334113342/* Quick return if possible. */1334313344if (*n == 0 || (*alpha == 0.f || *k == 0) && *beta == 1.f) {13345return 0;13346}1334713348/* And when alpha.eq.zero. */1334913350if (*alpha == 0.f) {13351if (upper) {13352if (*beta == 0.f) {13353i__1 = *n;13354for (j = 1; j <= i__1; ++j) {13355i__2 = j;13356for (i__ = 1; i__ <= i__2; ++i__) {13357c__[i__ + j * c_dim1] = 0.f;13358/* L10: */13359}13360/* L20: */13361}13362} else {13363i__1 = *n;13364for (j = 1; j <= i__1; ++j) {13365i__2 = j;13366for (i__ = 1; i__ <= i__2; ++i__) {13367c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13368/* L30: */13369}13370/* L40: */13371}13372}13373} else {13374if (*beta == 0.f) {13375i__1 = *n;13376for (j = 1; j <= i__1; ++j) {13377i__2 = *n;13378for (i__ = j; i__ <= i__2; ++i__) {13379c__[i__ + j * c_dim1] = 0.f;13380/* L50: */13381}13382/* L60: */13383}13384} else {13385i__1 = *n;13386for (j = 1; j <= i__1; ++j) {13387i__2 = *n;13388for (i__ = j; i__ <= i__2; ++i__) {13389c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13390/* L70: */13391}13392/* L80: */13393}13394}13395}13396return 0;13397}1339813399/* Start the operations. */1340013401if (lsame_(trans, "N")) {1340213403/* Form C := alpha*A*B' + alpha*B*A' + C. */1340413405if (upper) {13406i__1 = *n;13407for (j = 1; j <= i__1; ++j) {13408if (*beta == 0.f) {13409i__2 = j;13410for (i__ = 1; i__ <= i__2; ++i__) {13411c__[i__ + j * c_dim1] = 0.f;13412/* L90: */13413}13414} else if (*beta != 1.f) {13415i__2 = j;13416for (i__ = 1; i__ <= i__2; ++i__) {13417c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13418/* L100: */13419}13420}13421i__2 = *k;13422for (l = 1; l <= i__2; ++l) {13423if (a[j + l * a_dim1] != 0.f || b[j + l * b_dim1] != 0.f)13424{13425temp1 = *alpha * b[j + l * b_dim1];13426temp2 = *alpha * a[j + l * a_dim1];13427i__3 = j;13428for (i__ = 1; i__ <= i__3; ++i__) {13429c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[13430i__ + l * a_dim1] * temp1 + b[i__ + l *13431b_dim1] * temp2;13432/* L110: */13433}13434}13435/* L120: */13436}13437/* L130: */13438}13439} else {13440i__1 = *n;13441for (j = 1; j <= i__1; ++j) {13442if (*beta == 0.f) {13443i__2 = *n;13444for (i__ = j; i__ <= i__2; ++i__) {13445c__[i__ + j * c_dim1] = 0.f;13446/* L140: */13447}13448} else if (*beta != 1.f) {13449i__2 = *n;13450for (i__ = j; i__ <= i__2; ++i__) {13451c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13452/* L150: */13453}13454}13455i__2 = *k;13456for (l = 1; l <= i__2; ++l) {13457if (a[j + l * a_dim1] != 0.f || b[j + l * b_dim1] != 0.f)13458{13459temp1 = *alpha * b[j + l * b_dim1];13460temp2 = *alpha * a[j + l * a_dim1];13461i__3 = *n;13462for (i__ = j; i__ <= i__3; ++i__) {13463c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[13464i__ + l * a_dim1] * temp1 + b[i__ + l *13465b_dim1] * temp2;13466/* L160: */13467}13468}13469/* L170: */13470}13471/* L180: */13472}13473}13474} else {1347513476/* Form C := alpha*A'*B + alpha*B'*A + C. */1347713478if (upper) {13479i__1 = *n;13480for (j = 1; j <= i__1; ++j) {13481i__2 = j;13482for (i__ = 1; i__ <= i__2; ++i__) {13483temp1 = 0.f;13484temp2 = 0.f;13485i__3 = *k;13486for (l = 1; l <= i__3; ++l) {13487temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];13488temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];13489/* L190: */13490}13491if (*beta == 0.f) {13492c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *13493temp2;13494} else {13495c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]13496+ *alpha * temp1 + *alpha * temp2;13497}13498/* L200: */13499}13500/* L210: */13501}13502} else {13503i__1 = *n;13504for (j = 1; j <= i__1; ++j) {13505i__2 = *n;13506for (i__ = j; i__ <= i__2; ++i__) {13507temp1 = 0.f;13508temp2 = 0.f;13509i__3 = *k;13510for (l = 1; l <= i__3; ++l) {13511temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];13512temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];13513/* L220: */13514}13515if (*beta == 0.f) {13516c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *13517temp2;13518} else {13519c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]13520+ *alpha * temp1 + *alpha * temp2;13521}13522/* L230: */13523}13524/* L240: */13525}13526}13527}1352813529return 0;1353013531/* End of SSYR2K. */1353213533} /* ssyr2k_ */1353413535/* Subroutine */ int ssyrk_(char *uplo, char *trans, integer *n, integer *k,13536real *alpha, real *a, integer *lda, real *beta, real *c__, integer *13537ldc)13538{13539/* System generated locals */13540integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;1354113542/* Local variables */13543static integer i__, j, l, info;13544static real temp;13545extern logical lsame_(char *, char *);13546static integer nrowa;13547static logical upper;13548extern /* Subroutine */ int xerbla_(char *, integer *);135491355013551/*13552Purpose13553=======1355413555SSYRK performs one of the symmetric rank k operations1355613557C := alpha*A*A' + beta*C,1355813559or1356013561C := alpha*A'*A + beta*C,1356213563where alpha and beta are scalars, C is an n by n symmetric matrix13564and A is an n by k matrix in the first case and a k by n matrix13565in the second case.1356613567Arguments13568==========1356913570UPLO - CHARACTER*1.13571On entry, UPLO specifies whether the upper or lower13572triangular part of the array C is to be referenced as13573follows:1357413575UPLO = 'U' or 'u' Only the upper triangular part of C13576is to be referenced.1357713578UPLO = 'L' or 'l' Only the lower triangular part of C13579is to be referenced.1358013581Unchanged on exit.1358213583TRANS - CHARACTER*1.13584On entry, TRANS specifies the operation to be performed as13585follows:1358613587TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.1358813589TRANS = 'T' or 't' C := alpha*A'*A + beta*C.1359013591TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.1359213593Unchanged on exit.1359413595N - INTEGER.13596On entry, N specifies the order of the matrix C. N must be13597at least zero.13598Unchanged on exit.1359913600K - INTEGER.13601On entry with TRANS = 'N' or 'n', K specifies the number13602of columns of the matrix A, and on entry with13603TRANS = 'T' or 't' or 'C' or 'c', K specifies the number13604of rows of the matrix A. K must be at least zero.13605Unchanged on exit.1360613607ALPHA - REAL .13608On entry, ALPHA specifies the scalar alpha.13609Unchanged on exit.1361013611A - REAL array of DIMENSION ( LDA, ka ), where ka is13612k when TRANS = 'N' or 'n', and is n otherwise.13613Before entry with TRANS = 'N' or 'n', the leading n by k13614part of the array A must contain the matrix A, otherwise13615the leading k by n part of the array A must contain the13616matrix A.13617Unchanged on exit.1361813619LDA - INTEGER.13620On entry, LDA specifies the first dimension of A as declared13621in the calling (sub) program. When TRANS = 'N' or 'n'13622then LDA must be at least max( 1, n ), otherwise LDA must13623be at least max( 1, k ).13624Unchanged on exit.1362513626BETA - REAL .13627On entry, BETA specifies the scalar beta.13628Unchanged on exit.1362913630C - REAL array of DIMENSION ( LDC, n ).13631Before entry with UPLO = 'U' or 'u', the leading n by n13632upper triangular part of the array C must contain the upper13633triangular part of the symmetric matrix and the strictly13634lower triangular part of C is not referenced. On exit, the13635upper triangular part of the array C is overwritten by the13636upper triangular part of the updated matrix.13637Before entry with UPLO = 'L' or 'l', the leading n by n13638lower triangular part of the array C must contain the lower13639triangular part of the symmetric matrix and the strictly13640upper triangular part of C is not referenced. On exit, the13641lower triangular part of the array C is overwritten by the13642lower triangular part of the updated matrix.1364313644LDC - INTEGER.13645On entry, LDC specifies the first dimension of C as declared13646in the calling (sub) program. LDC must be at least13647max( 1, n ).13648Unchanged on exit.1364913650Further Details13651===============1365213653Level 3 Blas routine.1365413655-- Written on 8-February-1989.13656Jack Dongarra, Argonne National Laboratory.13657Iain Duff, AERE Harwell.13658Jeremy Du Croz, Numerical Algorithms Group Ltd.13659Sven Hammarling, Numerical Algorithms Group Ltd.1366013661=====================================================================136621366313664Test the input parameters.13665*/1366613667/* Parameter adjustments */13668a_dim1 = *lda;13669a_offset = 1 + a_dim1;13670a -= a_offset;13671c_dim1 = *ldc;13672c_offset = 1 + c_dim1;13673c__ -= c_offset;1367413675/* Function Body */13676if (lsame_(trans, "N")) {13677nrowa = *n;13678} else {13679nrowa = *k;13680}13681upper = lsame_(uplo, "U");1368213683info = 0;13684if (! upper && ! lsame_(uplo, "L")) {13685info = 1;13686} else if (! lsame_(trans, "N") && ! lsame_(trans,13687"T") && ! lsame_(trans, "C")) {13688info = 2;13689} else if (*n < 0) {13690info = 3;13691} else if (*k < 0) {13692info = 4;13693} else if (*lda < max(1,nrowa)) {13694info = 7;13695} else if (*ldc < max(1,*n)) {13696info = 10;13697}13698if (info != 0) {13699xerbla_("SSYRK ", &info);13700return 0;13701}1370213703/* Quick return if possible. */1370413705if (*n == 0 || (*alpha == 0.f || *k == 0) && *beta == 1.f) {13706return 0;13707}1370813709/* And when alpha.eq.zero. */1371013711if (*alpha == 0.f) {13712if (upper) {13713if (*beta == 0.f) {13714i__1 = *n;13715for (j = 1; j <= i__1; ++j) {13716i__2 = j;13717for (i__ = 1; i__ <= i__2; ++i__) {13718c__[i__ + j * c_dim1] = 0.f;13719/* L10: */13720}13721/* L20: */13722}13723} else {13724i__1 = *n;13725for (j = 1; j <= i__1; ++j) {13726i__2 = j;13727for (i__ = 1; i__ <= i__2; ++i__) {13728c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13729/* L30: */13730}13731/* L40: */13732}13733}13734} else {13735if (*beta == 0.f) {13736i__1 = *n;13737for (j = 1; j <= i__1; ++j) {13738i__2 = *n;13739for (i__ = j; i__ <= i__2; ++i__) {13740c__[i__ + j * c_dim1] = 0.f;13741/* L50: */13742}13743/* L60: */13744}13745} else {13746i__1 = *n;13747for (j = 1; j <= i__1; ++j) {13748i__2 = *n;13749for (i__ = j; i__ <= i__2; ++i__) {13750c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13751/* L70: */13752}13753/* L80: */13754}13755}13756}13757return 0;13758}1375913760/* Start the operations. */1376113762if (lsame_(trans, "N")) {1376313764/* Form C := alpha*A*A' + beta*C. */1376513766if (upper) {13767i__1 = *n;13768for (j = 1; j <= i__1; ++j) {13769if (*beta == 0.f) {13770i__2 = j;13771for (i__ = 1; i__ <= i__2; ++i__) {13772c__[i__ + j * c_dim1] = 0.f;13773/* L90: */13774}13775} else if (*beta != 1.f) {13776i__2 = j;13777for (i__ = 1; i__ <= i__2; ++i__) {13778c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13779/* L100: */13780}13781}13782i__2 = *k;13783for (l = 1; l <= i__2; ++l) {13784if (a[j + l * a_dim1] != 0.f) {13785temp = *alpha * a[j + l * a_dim1];13786i__3 = j;13787for (i__ = 1; i__ <= i__3; ++i__) {13788c__[i__ + j * c_dim1] += temp * a[i__ + l *13789a_dim1];13790/* L110: */13791}13792}13793/* L120: */13794}13795/* L130: */13796}13797} else {13798i__1 = *n;13799for (j = 1; j <= i__1; ++j) {13800if (*beta == 0.f) {13801i__2 = *n;13802for (i__ = j; i__ <= i__2; ++i__) {13803c__[i__ + j * c_dim1] = 0.f;13804/* L140: */13805}13806} else if (*beta != 1.f) {13807i__2 = *n;13808for (i__ = j; i__ <= i__2; ++i__) {13809c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];13810/* L150: */13811}13812}13813i__2 = *k;13814for (l = 1; l <= i__2; ++l) {13815if (a[j + l * a_dim1] != 0.f) {13816temp = *alpha * a[j + l * a_dim1];13817i__3 = *n;13818for (i__ = j; i__ <= i__3; ++i__) {13819c__[i__ + j * c_dim1] += temp * a[i__ + l *13820a_dim1];13821/* L160: */13822}13823}13824/* L170: */13825}13826/* L180: */13827}13828}13829} else {1383013831/* Form C := alpha*A'*A + beta*C. */1383213833if (upper) {13834i__1 = *n;13835for (j = 1; j <= i__1; ++j) {13836i__2 = j;13837for (i__ = 1; i__ <= i__2; ++i__) {13838temp = 0.f;13839i__3 = *k;13840for (l = 1; l <= i__3; ++l) {13841temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];13842/* L190: */13843}13844if (*beta == 0.f) {13845c__[i__ + j * c_dim1] = *alpha * temp;13846} else {13847c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[13848i__ + j * c_dim1];13849}13850/* L200: */13851}13852/* L210: */13853}13854} else {13855i__1 = *n;13856for (j = 1; j <= i__1; ++j) {13857i__2 = *n;13858for (i__ = j; i__ <= i__2; ++i__) {13859temp = 0.f;13860i__3 = *k;13861for (l = 1; l <= i__3; ++l) {13862temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];13863/* L220: */13864}13865if (*beta == 0.f) {13866c__[i__ + j * c_dim1] = *alpha * temp;13867} else {13868c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[13869i__ + j * c_dim1];13870}13871/* L230: */13872}13873/* L240: */13874}13875}13876}1387713878return 0;1387913880/* End of SSYRK . */1388113882} /* ssyrk_ */1388313884/* Subroutine */ int strmm_(char *side, char *uplo, char *transa, char *diag,13885integer *m, integer *n, real *alpha, real *a, integer *lda, real *b,13886integer *ldb)13887{13888/* System generated locals */13889integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;1389013891/* Local variables */13892static integer i__, j, k, info;13893static real temp;13894static logical lside;13895extern logical lsame_(char *, char *);13896static integer nrowa;13897static logical upper;13898extern /* Subroutine */ int xerbla_(char *, integer *);13899static logical nounit;139001390113902/*13903Purpose13904=======1390513906STRMM performs one of the matrix-matrix operations1390713908B := alpha*op( A )*B, or B := alpha*B*op( A ),1390913910where alpha is a scalar, B is an m by n matrix, A is a unit, or13911non-unit, upper or lower triangular matrix and op( A ) is one of1391213913op( A ) = A or op( A ) = A'.1391413915Arguments13916==========1391713918SIDE - CHARACTER*1.13919On entry, SIDE specifies whether op( A ) multiplies B from13920the left or right as follows:1392113922SIDE = 'L' or 'l' B := alpha*op( A )*B.1392313924SIDE = 'R' or 'r' B := alpha*B*op( A ).1392513926Unchanged on exit.1392713928UPLO - CHARACTER*1.13929On entry, UPLO specifies whether the matrix A is an upper or13930lower triangular matrix as follows:1393113932UPLO = 'U' or 'u' A is an upper triangular matrix.1393313934UPLO = 'L' or 'l' A is a lower triangular matrix.1393513936Unchanged on exit.1393713938TRANSA - CHARACTER*1.13939On entry, TRANSA specifies the form of op( A ) to be used in13940the matrix multiplication as follows:1394113942TRANSA = 'N' or 'n' op( A ) = A.1394313944TRANSA = 'T' or 't' op( A ) = A'.1394513946TRANSA = 'C' or 'c' op( A ) = A'.1394713948Unchanged on exit.1394913950DIAG - CHARACTER*1.13951On entry, DIAG specifies whether or not A is unit triangular13952as follows:1395313954DIAG = 'U' or 'u' A is assumed to be unit triangular.1395513956DIAG = 'N' or 'n' A is not assumed to be unit13957triangular.1395813959Unchanged on exit.1396013961M - INTEGER.13962On entry, M specifies the number of rows of B. M must be at13963least zero.13964Unchanged on exit.1396513966N - INTEGER.13967On entry, N specifies the number of columns of B. N must be13968at least zero.13969Unchanged on exit.1397013971ALPHA - REAL .13972On entry, ALPHA specifies the scalar alpha. When alpha is13973zero then A is not referenced and B need not be set before13974entry.13975Unchanged on exit.1397613977A - REAL array of DIMENSION ( LDA, k ), where k is m13978when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.13979Before entry with UPLO = 'U' or 'u', the leading k by k13980upper triangular part of the array A must contain the upper13981triangular matrix and the strictly lower triangular part of13982A is not referenced.13983Before entry with UPLO = 'L' or 'l', the leading k by k13984lower triangular part of the array A must contain the lower13985triangular matrix and the strictly upper triangular part of13986A is not referenced.13987Note that when DIAG = 'U' or 'u', the diagonal elements of13988A are not referenced either, but are assumed to be unity.13989Unchanged on exit.1399013991LDA - INTEGER.13992On entry, LDA specifies the first dimension of A as declared13993in the calling (sub) program. When SIDE = 'L' or 'l' then13994LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'13995then LDA must be at least max( 1, n ).13996Unchanged on exit.1399713998B - REAL array of DIMENSION ( LDB, n ).13999Before entry, the leading m by n part of the array B must14000contain the matrix B, and on exit is overwritten by the14001transformed matrix.1400214003LDB - INTEGER.14004On entry, LDB specifies the first dimension of B as declared14005in the calling (sub) program. LDB must be at least14006max( 1, m ).14007Unchanged on exit.1400814009Further Details14010===============1401114012Level 3 Blas routine.1401314014-- Written on 8-February-1989.14015Jack Dongarra, Argonne National Laboratory.14016Iain Duff, AERE Harwell.14017Jeremy Du Croz, Numerical Algorithms Group Ltd.14018Sven Hammarling, Numerical Algorithms Group Ltd.1401914020=====================================================================140211402214023Test the input parameters.14024*/1402514026/* Parameter adjustments */14027a_dim1 = *lda;14028a_offset = 1 + a_dim1;14029a -= a_offset;14030b_dim1 = *ldb;14031b_offset = 1 + b_dim1;14032b -= b_offset;1403314034/* Function Body */14035lside = lsame_(side, "L");14036if (lside) {14037nrowa = *m;14038} else {14039nrowa = *n;14040}14041nounit = lsame_(diag, "N");14042upper = lsame_(uplo, "U");1404314044info = 0;14045if (! lside && ! lsame_(side, "R")) {14046info = 1;14047} else if (! upper && ! lsame_(uplo, "L")) {14048info = 2;14049} else if (! lsame_(transa, "N") && ! lsame_(transa,14050"T") && ! lsame_(transa, "C")) {14051info = 3;14052} else if (! lsame_(diag, "U") && ! lsame_(diag,14053"N")) {14054info = 4;14055} else if (*m < 0) {14056info = 5;14057} else if (*n < 0) {14058info = 6;14059} else if (*lda < max(1,nrowa)) {14060info = 9;14061} else if (*ldb < max(1,*m)) {14062info = 11;14063}14064if (info != 0) {14065xerbla_("STRMM ", &info);14066return 0;14067}1406814069/* Quick return if possible. */1407014071if (*m == 0 || *n == 0) {14072return 0;14073}1407414075/* And when alpha.eq.zero. */1407614077if (*alpha == 0.f) {14078i__1 = *n;14079for (j = 1; j <= i__1; ++j) {14080i__2 = *m;14081for (i__ = 1; i__ <= i__2; ++i__) {14082b[i__ + j * b_dim1] = 0.f;14083/* L10: */14084}14085/* L20: */14086}14087return 0;14088}1408914090/* Start the operations. */1409114092if (lside) {14093if (lsame_(transa, "N")) {1409414095/* Form B := alpha*A*B. */1409614097if (upper) {14098i__1 = *n;14099for (j = 1; j <= i__1; ++j) {14100i__2 = *m;14101for (k = 1; k <= i__2; ++k) {14102if (b[k + j * b_dim1] != 0.f) {14103temp = *alpha * b[k + j * b_dim1];14104i__3 = k - 1;14105for (i__ = 1; i__ <= i__3; ++i__) {14106b[i__ + j * b_dim1] += temp * a[i__ + k *14107a_dim1];14108/* L30: */14109}14110if (nounit) {14111temp *= a[k + k * a_dim1];14112}14113b[k + j * b_dim1] = temp;14114}14115/* L40: */14116}14117/* L50: */14118}14119} else {14120i__1 = *n;14121for (j = 1; j <= i__1; ++j) {14122for (k = *m; k >= 1; --k) {14123if (b[k + j * b_dim1] != 0.f) {14124temp = *alpha * b[k + j * b_dim1];14125b[k + j * b_dim1] = temp;14126if (nounit) {14127b[k + j * b_dim1] *= a[k + k * a_dim1];14128}14129i__2 = *m;14130for (i__ = k + 1; i__ <= i__2; ++i__) {14131b[i__ + j * b_dim1] += temp * a[i__ + k *14132a_dim1];14133/* L60: */14134}14135}14136/* L70: */14137}14138/* L80: */14139}14140}14141} else {1414214143/* Form B := alpha*A'*B. */1414414145if (upper) {14146i__1 = *n;14147for (j = 1; j <= i__1; ++j) {14148for (i__ = *m; i__ >= 1; --i__) {14149temp = b[i__ + j * b_dim1];14150if (nounit) {14151temp *= a[i__ + i__ * a_dim1];14152}14153i__2 = i__ - 1;14154for (k = 1; k <= i__2; ++k) {14155temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];14156/* L90: */14157}14158b[i__ + j * b_dim1] = *alpha * temp;14159/* L100: */14160}14161/* L110: */14162}14163} else {14164i__1 = *n;14165for (j = 1; j <= i__1; ++j) {14166i__2 = *m;14167for (i__ = 1; i__ <= i__2; ++i__) {14168temp = b[i__ + j * b_dim1];14169if (nounit) {14170temp *= a[i__ + i__ * a_dim1];14171}14172i__3 = *m;14173for (k = i__ + 1; k <= i__3; ++k) {14174temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];14175/* L120: */14176}14177b[i__ + j * b_dim1] = *alpha * temp;14178/* L130: */14179}14180/* L140: */14181}14182}14183}14184} else {14185if (lsame_(transa, "N")) {1418614187/* Form B := alpha*B*A. */1418814189if (upper) {14190for (j = *n; j >= 1; --j) {14191temp = *alpha;14192if (nounit) {14193temp *= a[j + j * a_dim1];14194}14195i__1 = *m;14196for (i__ = 1; i__ <= i__1; ++i__) {14197b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];14198/* L150: */14199}14200i__1 = j - 1;14201for (k = 1; k <= i__1; ++k) {14202if (a[k + j * a_dim1] != 0.f) {14203temp = *alpha * a[k + j * a_dim1];14204i__2 = *m;14205for (i__ = 1; i__ <= i__2; ++i__) {14206b[i__ + j * b_dim1] += temp * b[i__ + k *14207b_dim1];14208/* L160: */14209}14210}14211/* L170: */14212}14213/* L180: */14214}14215} else {14216i__1 = *n;14217for (j = 1; j <= i__1; ++j) {14218temp = *alpha;14219if (nounit) {14220temp *= a[j + j * a_dim1];14221}14222i__2 = *m;14223for (i__ = 1; i__ <= i__2; ++i__) {14224b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];14225/* L190: */14226}14227i__2 = *n;14228for (k = j + 1; k <= i__2; ++k) {14229if (a[k + j * a_dim1] != 0.f) {14230temp = *alpha * a[k + j * a_dim1];14231i__3 = *m;14232for (i__ = 1; i__ <= i__3; ++i__) {14233b[i__ + j * b_dim1] += temp * b[i__ + k *14234b_dim1];14235/* L200: */14236}14237}14238/* L210: */14239}14240/* L220: */14241}14242}14243} else {1424414245/* Form B := alpha*B*A'. */1424614247if (upper) {14248i__1 = *n;14249for (k = 1; k <= i__1; ++k) {14250i__2 = k - 1;14251for (j = 1; j <= i__2; ++j) {14252if (a[j + k * a_dim1] != 0.f) {14253temp = *alpha * a[j + k * a_dim1];14254i__3 = *m;14255for (i__ = 1; i__ <= i__3; ++i__) {14256b[i__ + j * b_dim1] += temp * b[i__ + k *14257b_dim1];14258/* L230: */14259}14260}14261/* L240: */14262}14263temp = *alpha;14264if (nounit) {14265temp *= a[k + k * a_dim1];14266}14267if (temp != 1.f) {14268i__2 = *m;14269for (i__ = 1; i__ <= i__2; ++i__) {14270b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];14271/* L250: */14272}14273}14274/* L260: */14275}14276} else {14277for (k = *n; k >= 1; --k) {14278i__1 = *n;14279for (j = k + 1; j <= i__1; ++j) {14280if (a[j + k * a_dim1] != 0.f) {14281temp = *alpha * a[j + k * a_dim1];14282i__2 = *m;14283for (i__ = 1; i__ <= i__2; ++i__) {14284b[i__ + j * b_dim1] += temp * b[i__ + k *14285b_dim1];14286/* L270: */14287}14288}14289/* L280: */14290}14291temp = *alpha;14292if (nounit) {14293temp *= a[k + k * a_dim1];14294}14295if (temp != 1.f) {14296i__1 = *m;14297for (i__ = 1; i__ <= i__1; ++i__) {14298b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];14299/* L290: */14300}14301}14302/* L300: */14303}14304}14305}14306}1430714308return 0;1430914310/* End of STRMM . */1431114312} /* strmm_ */1431314314/* Subroutine */ int strmv_(char *uplo, char *trans, char *diag, integer *n,14315real *a, integer *lda, real *x, integer *incx)14316{14317/* System generated locals */14318integer a_dim1, a_offset, i__1, i__2;1431914320/* Local variables */14321static integer i__, j, ix, jx, kx, info;14322static real temp;14323extern logical lsame_(char *, char *);14324extern /* Subroutine */ int xerbla_(char *, integer *);14325static logical nounit;143261432714328/*14329Purpose14330=======1433114332STRMV performs one of the matrix-vector operations1433314334x := A*x, or x := A'*x,1433514336where x is an n element vector and A is an n by n unit, or non-unit,14337upper or lower triangular matrix.1433814339Arguments14340==========1434114342UPLO - CHARACTER*1.14343On entry, UPLO specifies whether the matrix is an upper or14344lower triangular matrix as follows:1434514346UPLO = 'U' or 'u' A is an upper triangular matrix.1434714348UPLO = 'L' or 'l' A is a lower triangular matrix.1434914350Unchanged on exit.1435114352TRANS - CHARACTER*1.14353On entry, TRANS specifies the operation to be performed as14354follows:1435514356TRANS = 'N' or 'n' x := A*x.1435714358TRANS = 'T' or 't' x := A'*x.1435914360TRANS = 'C' or 'c' x := A'*x.1436114362Unchanged on exit.1436314364DIAG - CHARACTER*1.14365On entry, DIAG specifies whether or not A is unit14366triangular as follows:1436714368DIAG = 'U' or 'u' A is assumed to be unit triangular.1436914370DIAG = 'N' or 'n' A is not assumed to be unit14371triangular.1437214373Unchanged on exit.1437414375N - INTEGER.14376On entry, N specifies the order of the matrix A.14377N must be at least zero.14378Unchanged on exit.1437914380A - REAL array of DIMENSION ( LDA, n ).14381Before entry with UPLO = 'U' or 'u', the leading n by n14382upper triangular part of the array A must contain the upper14383triangular matrix and the strictly lower triangular part of14384A is not referenced.14385Before entry with UPLO = 'L' or 'l', the leading n by n14386lower triangular part of the array A must contain the lower14387triangular matrix and the strictly upper triangular part of14388A is not referenced.14389Note that when DIAG = 'U' or 'u', the diagonal elements of14390A are not referenced either, but are assumed to be unity.14391Unchanged on exit.1439214393LDA - INTEGER.14394On entry, LDA specifies the first dimension of A as declared14395in the calling (sub) program. LDA must be at least14396max( 1, n ).14397Unchanged on exit.1439814399X - REAL array of dimension at least14400( 1 + ( n - 1 )*abs( INCX ) ).14401Before entry, the incremented array X must contain the n14402element vector x. On exit, X is overwritten with the14403tranformed vector x.1440414405INCX - INTEGER.14406On entry, INCX specifies the increment for the elements of14407X. INCX must not be zero.14408Unchanged on exit.1440914410Further Details14411===============1441214413Level 2 Blas routine.1441414415-- Written on 22-October-1986.14416Jack Dongarra, Argonne National Lab.14417Jeremy Du Croz, Nag Central Office.14418Sven Hammarling, Nag Central Office.14419Richard Hanson, Sandia National Labs.1442014421=====================================================================144221442314424Test the input parameters.14425*/1442614427/* Parameter adjustments */14428a_dim1 = *lda;14429a_offset = 1 + a_dim1;14430a -= a_offset;14431--x;1443214433/* Function Body */14434info = 0;14435if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {14436info = 1;14437} else if (! lsame_(trans, "N") && ! lsame_(trans,14438"T") && ! lsame_(trans, "C")) {14439info = 2;14440} else if (! lsame_(diag, "U") && ! lsame_(diag,14441"N")) {14442info = 3;14443} else if (*n < 0) {14444info = 4;14445} else if (*lda < max(1,*n)) {14446info = 6;14447} else if (*incx == 0) {14448info = 8;14449}14450if (info != 0) {14451xerbla_("STRMV ", &info);14452return 0;14453}1445414455/* Quick return if possible. */1445614457if (*n == 0) {14458return 0;14459}1446014461nounit = lsame_(diag, "N");1446214463/*14464Set up the start point in X if the increment is not unity. This14465will be ( N - 1 )*INCX too small for descending loops.14466*/1446714468if (*incx <= 0) {14469kx = 1 - (*n - 1) * *incx;14470} else if (*incx != 1) {14471kx = 1;14472}1447314474/*14475Start the operations. In this version the elements of A are14476accessed sequentially with one pass through A.14477*/1447814479if (lsame_(trans, "N")) {1448014481/* Form x := A*x. */1448214483if (lsame_(uplo, "U")) {14484if (*incx == 1) {14485i__1 = *n;14486for (j = 1; j <= i__1; ++j) {14487if (x[j] != 0.f) {14488temp = x[j];14489i__2 = j - 1;14490for (i__ = 1; i__ <= i__2; ++i__) {14491x[i__] += temp * a[i__ + j * a_dim1];14492/* L10: */14493}14494if (nounit) {14495x[j] *= a[j + j * a_dim1];14496}14497}14498/* L20: */14499}14500} else {14501jx = kx;14502i__1 = *n;14503for (j = 1; j <= i__1; ++j) {14504if (x[jx] != 0.f) {14505temp = x[jx];14506ix = kx;14507i__2 = j - 1;14508for (i__ = 1; i__ <= i__2; ++i__) {14509x[ix] += temp * a[i__ + j * a_dim1];14510ix += *incx;14511/* L30: */14512}14513if (nounit) {14514x[jx] *= a[j + j * a_dim1];14515}14516}14517jx += *incx;14518/* L40: */14519}14520}14521} else {14522if (*incx == 1) {14523for (j = *n; j >= 1; --j) {14524if (x[j] != 0.f) {14525temp = x[j];14526i__1 = j + 1;14527for (i__ = *n; i__ >= i__1; --i__) {14528x[i__] += temp * a[i__ + j * a_dim1];14529/* L50: */14530}14531if (nounit) {14532x[j] *= a[j + j * a_dim1];14533}14534}14535/* L60: */14536}14537} else {14538kx += (*n - 1) * *incx;14539jx = kx;14540for (j = *n; j >= 1; --j) {14541if (x[jx] != 0.f) {14542temp = x[jx];14543ix = kx;14544i__1 = j + 1;14545for (i__ = *n; i__ >= i__1; --i__) {14546x[ix] += temp * a[i__ + j * a_dim1];14547ix -= *incx;14548/* L70: */14549}14550if (nounit) {14551x[jx] *= a[j + j * a_dim1];14552}14553}14554jx -= *incx;14555/* L80: */14556}14557}14558}14559} else {1456014561/* Form x := A'*x. */1456214563if (lsame_(uplo, "U")) {14564if (*incx == 1) {14565for (j = *n; j >= 1; --j) {14566temp = x[j];14567if (nounit) {14568temp *= a[j + j * a_dim1];14569}14570for (i__ = j - 1; i__ >= 1; --i__) {14571temp += a[i__ + j * a_dim1] * x[i__];14572/* L90: */14573}14574x[j] = temp;14575/* L100: */14576}14577} else {14578jx = kx + (*n - 1) * *incx;14579for (j = *n; j >= 1; --j) {14580temp = x[jx];14581ix = jx;14582if (nounit) {14583temp *= a[j + j * a_dim1];14584}14585for (i__ = j - 1; i__ >= 1; --i__) {14586ix -= *incx;14587temp += a[i__ + j * a_dim1] * x[ix];14588/* L110: */14589}14590x[jx] = temp;14591jx -= *incx;14592/* L120: */14593}14594}14595} else {14596if (*incx == 1) {14597i__1 = *n;14598for (j = 1; j <= i__1; ++j) {14599temp = x[j];14600if (nounit) {14601temp *= a[j + j * a_dim1];14602}14603i__2 = *n;14604for (i__ = j + 1; i__ <= i__2; ++i__) {14605temp += a[i__ + j * a_dim1] * x[i__];14606/* L130: */14607}14608x[j] = temp;14609/* L140: */14610}14611} else {14612jx = kx;14613i__1 = *n;14614for (j = 1; j <= i__1; ++j) {14615temp = x[jx];14616ix = jx;14617if (nounit) {14618temp *= a[j + j * a_dim1];14619}14620i__2 = *n;14621for (i__ = j + 1; i__ <= i__2; ++i__) {14622ix += *incx;14623temp += a[i__ + j * a_dim1] * x[ix];14624/* L150: */14625}14626x[jx] = temp;14627jx += *incx;14628/* L160: */14629}14630}14631}14632}1463314634return 0;1463514636/* End of STRMV . */1463714638} /* strmv_ */1463914640/* Subroutine */ int strsm_(char *side, char *uplo, char *transa, char *diag,14641integer *m, integer *n, real *alpha, real *a, integer *lda, real *b,14642integer *ldb)14643{14644/* System generated locals */14645integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;1464614647/* Local variables */14648static integer i__, j, k, info;14649static real temp;14650static logical lside;14651extern logical lsame_(char *, char *);14652static integer nrowa;14653static logical upper;14654extern /* Subroutine */ int xerbla_(char *, integer *);14655static logical nounit;146561465714658/*14659Purpose14660=======1466114662STRSM solves one of the matrix equations1466314664op( A )*X = alpha*B, or X*op( A ) = alpha*B,1466514666where alpha is a scalar, X and B are m by n matrices, A is a unit, or14667non-unit, upper or lower triangular matrix and op( A ) is one of1466814669op( A ) = A or op( A ) = A'.1467014671The matrix X is overwritten on B.1467214673Arguments14674==========1467514676SIDE - CHARACTER*1.14677On entry, SIDE specifies whether op( A ) appears on the left14678or right of X as follows:1467914680SIDE = 'L' or 'l' op( A )*X = alpha*B.1468114682SIDE = 'R' or 'r' X*op( A ) = alpha*B.1468314684Unchanged on exit.1468514686UPLO - CHARACTER*1.14687On entry, UPLO specifies whether the matrix A is an upper or14688lower triangular matrix as follows:1468914690UPLO = 'U' or 'u' A is an upper triangular matrix.1469114692UPLO = 'L' or 'l' A is a lower triangular matrix.1469314694Unchanged on exit.1469514696TRANSA - CHARACTER*1.14697On entry, TRANSA specifies the form of op( A ) to be used in14698the matrix multiplication as follows:1469914700TRANSA = 'N' or 'n' op( A ) = A.1470114702TRANSA = 'T' or 't' op( A ) = A'.1470314704TRANSA = 'C' or 'c' op( A ) = A'.1470514706Unchanged on exit.1470714708DIAG - CHARACTER*1.14709On entry, DIAG specifies whether or not A is unit triangular14710as follows:1471114712DIAG = 'U' or 'u' A is assumed to be unit triangular.1471314714DIAG = 'N' or 'n' A is not assumed to be unit14715triangular.1471614717Unchanged on exit.1471814719M - INTEGER.14720On entry, M specifies the number of rows of B. M must be at14721least zero.14722Unchanged on exit.1472314724N - INTEGER.14725On entry, N specifies the number of columns of B. N must be14726at least zero.14727Unchanged on exit.1472814729ALPHA - REAL .14730On entry, ALPHA specifies the scalar alpha. When alpha is14731zero then A is not referenced and B need not be set before14732entry.14733Unchanged on exit.1473414735A - REAL array of DIMENSION ( LDA, k ), where k is m14736when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.14737Before entry with UPLO = 'U' or 'u', the leading k by k14738upper triangular part of the array A must contain the upper14739triangular matrix and the strictly lower triangular part of14740A is not referenced.14741Before entry with UPLO = 'L' or 'l', the leading k by k14742lower triangular part of the array A must contain the lower14743triangular matrix and the strictly upper triangular part of14744A is not referenced.14745Note that when DIAG = 'U' or 'u', the diagonal elements of14746A are not referenced either, but are assumed to be unity.14747Unchanged on exit.1474814749LDA - INTEGER.14750On entry, LDA specifies the first dimension of A as declared14751in the calling (sub) program. When SIDE = 'L' or 'l' then14752LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'14753then LDA must be at least max( 1, n ).14754Unchanged on exit.1475514756B - REAL array of DIMENSION ( LDB, n ).14757Before entry, the leading m by n part of the array B must14758contain the right-hand side matrix B, and on exit is14759overwritten by the solution matrix X.1476014761LDB - INTEGER.14762On entry, LDB specifies the first dimension of B as declared14763in the calling (sub) program. LDB must be at least14764max( 1, m ).14765Unchanged on exit.1476614767Further Details14768===============1476914770Level 3 Blas routine.147711477214773-- Written on 8-February-1989.14774Jack Dongarra, Argonne National Laboratory.14775Iain Duff, AERE Harwell.14776Jeremy Du Croz, Numerical Algorithms Group Ltd.14777Sven Hammarling, Numerical Algorithms Group Ltd.1477814779=====================================================================147801478114782Test the input parameters.14783*/1478414785/* Parameter adjustments */14786a_dim1 = *lda;14787a_offset = 1 + a_dim1;14788a -= a_offset;14789b_dim1 = *ldb;14790b_offset = 1 + b_dim1;14791b -= b_offset;1479214793/* Function Body */14794lside = lsame_(side, "L");14795if (lside) {14796nrowa = *m;14797} else {14798nrowa = *n;14799}14800nounit = lsame_(diag, "N");14801upper = lsame_(uplo, "U");1480214803info = 0;14804if (! lside && ! lsame_(side, "R")) {14805info = 1;14806} else if (! upper && ! lsame_(uplo, "L")) {14807info = 2;14808} else if (! lsame_(transa, "N") && ! lsame_(transa,14809"T") && ! lsame_(transa, "C")) {14810info = 3;14811} else if (! lsame_(diag, "U") && ! lsame_(diag,14812"N")) {14813info = 4;14814} else if (*m < 0) {14815info = 5;14816} else if (*n < 0) {14817info = 6;14818} else if (*lda < max(1,nrowa)) {14819info = 9;14820} else if (*ldb < max(1,*m)) {14821info = 11;14822}14823if (info != 0) {14824xerbla_("STRSM ", &info);14825return 0;14826}1482714828/* Quick return if possible. */1482914830if (*m == 0 || *n == 0) {14831return 0;14832}1483314834/* And when alpha.eq.zero. */1483514836if (*alpha == 0.f) {14837i__1 = *n;14838for (j = 1; j <= i__1; ++j) {14839i__2 = *m;14840for (i__ = 1; i__ <= i__2; ++i__) {14841b[i__ + j * b_dim1] = 0.f;14842/* L10: */14843}14844/* L20: */14845}14846return 0;14847}1484814849/* Start the operations. */1485014851if (lside) {14852if (lsame_(transa, "N")) {1485314854/* Form B := alpha*inv( A )*B. */1485514856if (upper) {14857i__1 = *n;14858for (j = 1; j <= i__1; ++j) {14859if (*alpha != 1.f) {14860i__2 = *m;14861for (i__ = 1; i__ <= i__2; ++i__) {14862b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]14863;14864/* L30: */14865}14866}14867for (k = *m; k >= 1; --k) {14868if (b[k + j * b_dim1] != 0.f) {14869if (nounit) {14870b[k + j * b_dim1] /= a[k + k * a_dim1];14871}14872i__2 = k - 1;14873for (i__ = 1; i__ <= i__2; ++i__) {14874b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[14875i__ + k * a_dim1];14876/* L40: */14877}14878}14879/* L50: */14880}14881/* L60: */14882}14883} else {14884i__1 = *n;14885for (j = 1; j <= i__1; ++j) {14886if (*alpha != 1.f) {14887i__2 = *m;14888for (i__ = 1; i__ <= i__2; ++i__) {14889b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]14890;14891/* L70: */14892}14893}14894i__2 = *m;14895for (k = 1; k <= i__2; ++k) {14896if (b[k + j * b_dim1] != 0.f) {14897if (nounit) {14898b[k + j * b_dim1] /= a[k + k * a_dim1];14899}14900i__3 = *m;14901for (i__ = k + 1; i__ <= i__3; ++i__) {14902b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[14903i__ + k * a_dim1];14904/* L80: */14905}14906}14907/* L90: */14908}14909/* L100: */14910}14911}14912} else {1491314914/* Form B := alpha*inv( A' )*B. */1491514916if (upper) {14917i__1 = *n;14918for (j = 1; j <= i__1; ++j) {14919i__2 = *m;14920for (i__ = 1; i__ <= i__2; ++i__) {14921temp = *alpha * b[i__ + j * b_dim1];14922i__3 = i__ - 1;14923for (k = 1; k <= i__3; ++k) {14924temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];14925/* L110: */14926}14927if (nounit) {14928temp /= a[i__ + i__ * a_dim1];14929}14930b[i__ + j * b_dim1] = temp;14931/* L120: */14932}14933/* L130: */14934}14935} else {14936i__1 = *n;14937for (j = 1; j <= i__1; ++j) {14938for (i__ = *m; i__ >= 1; --i__) {14939temp = *alpha * b[i__ + j * b_dim1];14940i__2 = *m;14941for (k = i__ + 1; k <= i__2; ++k) {14942temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];14943/* L140: */14944}14945if (nounit) {14946temp /= a[i__ + i__ * a_dim1];14947}14948b[i__ + j * b_dim1] = temp;14949/* L150: */14950}14951/* L160: */14952}14953}14954}14955} else {14956if (lsame_(transa, "N")) {1495714958/* Form B := alpha*B*inv( A ). */1495914960if (upper) {14961i__1 = *n;14962for (j = 1; j <= i__1; ++j) {14963if (*alpha != 1.f) {14964i__2 = *m;14965for (i__ = 1; i__ <= i__2; ++i__) {14966b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]14967;14968/* L170: */14969}14970}14971i__2 = j - 1;14972for (k = 1; k <= i__2; ++k) {14973if (a[k + j * a_dim1] != 0.f) {14974i__3 = *m;14975for (i__ = 1; i__ <= i__3; ++i__) {14976b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[14977i__ + k * b_dim1];14978/* L180: */14979}14980}14981/* L190: */14982}14983if (nounit) {14984temp = 1.f / a[j + j * a_dim1];14985i__2 = *m;14986for (i__ = 1; i__ <= i__2; ++i__) {14987b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];14988/* L200: */14989}14990}14991/* L210: */14992}14993} else {14994for (j = *n; j >= 1; --j) {14995if (*alpha != 1.f) {14996i__1 = *m;14997for (i__ = 1; i__ <= i__1; ++i__) {14998b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]14999;15000/* L220: */15001}15002}15003i__1 = *n;15004for (k = j + 1; k <= i__1; ++k) {15005if (a[k + j * a_dim1] != 0.f) {15006i__2 = *m;15007for (i__ = 1; i__ <= i__2; ++i__) {15008b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[15009i__ + k * b_dim1];15010/* L230: */15011}15012}15013/* L240: */15014}15015if (nounit) {15016temp = 1.f / a[j + j * a_dim1];15017i__1 = *m;15018for (i__ = 1; i__ <= i__1; ++i__) {15019b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];15020/* L250: */15021}15022}15023/* L260: */15024}15025}15026} else {1502715028/* Form B := alpha*B*inv( A' ). */1502915030if (upper) {15031for (k = *n; k >= 1; --k) {15032if (nounit) {15033temp = 1.f / a[k + k * a_dim1];15034i__1 = *m;15035for (i__ = 1; i__ <= i__1; ++i__) {15036b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];15037/* L270: */15038}15039}15040i__1 = k - 1;15041for (j = 1; j <= i__1; ++j) {15042if (a[j + k * a_dim1] != 0.f) {15043temp = a[j + k * a_dim1];15044i__2 = *m;15045for (i__ = 1; i__ <= i__2; ++i__) {15046b[i__ + j * b_dim1] -= temp * b[i__ + k *15047b_dim1];15048/* L280: */15049}15050}15051/* L290: */15052}15053if (*alpha != 1.f) {15054i__1 = *m;15055for (i__ = 1; i__ <= i__1; ++i__) {15056b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]15057;15058/* L300: */15059}15060}15061/* L310: */15062}15063} else {15064i__1 = *n;15065for (k = 1; k <= i__1; ++k) {15066if (nounit) {15067temp = 1.f / a[k + k * a_dim1];15068i__2 = *m;15069for (i__ = 1; i__ <= i__2; ++i__) {15070b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];15071/* L320: */15072}15073}15074i__2 = *n;15075for (j = k + 1; j <= i__2; ++j) {15076if (a[j + k * a_dim1] != 0.f) {15077temp = a[j + k * a_dim1];15078i__3 = *m;15079for (i__ = 1; i__ <= i__3; ++i__) {15080b[i__ + j * b_dim1] -= temp * b[i__ + k *15081b_dim1];15082/* L330: */15083}15084}15085/* L340: */15086}15087if (*alpha != 1.f) {15088i__2 = *m;15089for (i__ = 1; i__ <= i__2; ++i__) {15090b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]15091;15092/* L350: */15093}15094}15095/* L360: */15096}15097}15098}15099}1510015101return 0;1510215103/* End of STRSM . */1510415105} /* strsm_ */1510615107/* Subroutine */ int zaxpy_(integer *n, doublecomplex *za, doublecomplex *zx,15108integer *incx, doublecomplex *zy, integer *incy)15109{15110/* System generated locals */15111integer i__1, i__2, i__3, i__4;15112doublecomplex z__1, z__2;1511315114/* Local variables */15115static integer i__, ix, iy;15116extern doublereal dcabs1_(doublecomplex *);151171511815119/*15120Purpose15121=======1512215123ZAXPY constant times a vector plus a vector.1512415125Further Details15126===============1512715128jack dongarra, 3/11/78.15129modified 12/3/93, array(1) declarations changed to array(*)1513015131=====================================================================15132*/1513315134/* Parameter adjustments */15135--zy;15136--zx;1513715138/* Function Body */15139if (*n <= 0) {15140return 0;15141}15142if (dcabs1_(za) == 0.) {15143return 0;15144}15145if (*incx == 1 && *incy == 1) {15146goto L20;15147}1514815149/*15150code for unequal increments or equal increments15151not equal to 115152*/1515315154ix = 1;15155iy = 1;15156if (*incx < 0) {15157ix = (-(*n) + 1) * *incx + 1;15158}15159if (*incy < 0) {15160iy = (-(*n) + 1) * *incy + 1;15161}15162i__1 = *n;15163for (i__ = 1; i__ <= i__1; ++i__) {15164i__2 = iy;15165i__3 = iy;15166i__4 = ix;15167z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[15168i__4].i + za->i * zx[i__4].r;15169z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;15170zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;15171ix += *incx;15172iy += *incy;15173/* L10: */15174}15175return 0;1517615177/* code for both increments equal to 1 */1517815179L20:15180i__1 = *n;15181for (i__ = 1; i__ <= i__1; ++i__) {15182i__2 = i__;15183i__3 = i__;15184i__4 = i__;15185z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[15186i__4].i + za->i * zx[i__4].r;15187z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;15188zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;15189/* L30: */15190}15191return 0;15192} /* zaxpy_ */1519315194/* Subroutine */ int zcopy_(integer *n, doublecomplex *zx, integer *incx,15195doublecomplex *zy, integer *incy)15196{15197/* System generated locals */15198integer i__1, i__2, i__3;1519915200/* Local variables */15201static integer i__, ix, iy;152021520315204/*15205Purpose15206=======1520715208ZCOPY copies a vector, x, to a vector, y.1520915210Further Details15211===============1521215213jack dongarra, linpack, 4/11/78.15214modified 12/3/93, array(1) declarations changed to array(*)1521515216=====================================================================15217*/1521815219/* Parameter adjustments */15220--zy;15221--zx;1522215223/* Function Body */15224if (*n <= 0) {15225return 0;15226}15227if (*incx == 1 && *incy == 1) {15228goto L20;15229}1523015231/*15232code for unequal increments or equal increments15233not equal to 115234*/1523515236ix = 1;15237iy = 1;15238if (*incx < 0) {15239ix = (-(*n) + 1) * *incx + 1;15240}15241if (*incy < 0) {15242iy = (-(*n) + 1) * *incy + 1;15243}15244i__1 = *n;15245for (i__ = 1; i__ <= i__1; ++i__) {15246i__2 = iy;15247i__3 = ix;15248zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;15249ix += *incx;15250iy += *incy;15251/* L10: */15252}15253return 0;1525415255/* code for both increments equal to 1 */1525615257L20:15258i__1 = *n;15259for (i__ = 1; i__ <= i__1; ++i__) {15260i__2 = i__;15261i__3 = i__;15262zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;15263/* L30: */15264}15265return 0;15266} /* zcopy_ */1526715268/* Double Complex */ VOID zdotc_(doublecomplex * ret_val, integer *n,15269doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)15270{15271/* System generated locals */15272integer i__1, i__2;15273doublecomplex z__1, z__2, z__3;1527415275/* Local variables */15276static integer i__, ix, iy;15277static doublecomplex ztemp;152781527915280/*15281Purpose15282=======1528315284ZDOTC forms the dot product of a vector.1528515286Further Details15287===============1528815289jack dongarra, 3/11/78.15290modified 12/3/93, array(1) declarations changed to array(*)1529115292=====================================================================15293*/1529415295/* Parameter adjustments */15296--zy;15297--zx;1529815299/* Function Body */15300ztemp.r = 0., ztemp.i = 0.;15301ret_val->r = 0., ret_val->i = 0.;15302if (*n <= 0) {15303return ;15304}15305if (*incx == 1 && *incy == 1) {15306goto L20;15307}1530815309/*15310code for unequal increments or equal increments15311not equal to 115312*/1531315314ix = 1;15315iy = 1;15316if (*incx < 0) {15317ix = (-(*n) + 1) * *incx + 1;15318}15319if (*incy < 0) {15320iy = (-(*n) + 1) * *incy + 1;15321}15322i__1 = *n;15323for (i__ = 1; i__ <= i__1; ++i__) {15324d_cnjg(&z__3, &zx[ix]);15325i__2 = iy;15326z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r *15327zy[i__2].i + z__3.i * zy[i__2].r;15328z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;15329ztemp.r = z__1.r, ztemp.i = z__1.i;15330ix += *incx;15331iy += *incy;15332/* L10: */15333}15334ret_val->r = ztemp.r, ret_val->i = ztemp.i;15335return ;1533615337/* code for both increments equal to 1 */1533815339L20:15340i__1 = *n;15341for (i__ = 1; i__ <= i__1; ++i__) {15342d_cnjg(&z__3, &zx[i__]);15343i__2 = i__;15344z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r *15345zy[i__2].i + z__3.i * zy[i__2].r;15346z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;15347ztemp.r = z__1.r, ztemp.i = z__1.i;15348/* L30: */15349}15350ret_val->r = ztemp.r, ret_val->i = ztemp.i;15351return ;15352} /* zdotc_ */1535315354/* Double Complex */ VOID zdotu_(doublecomplex * ret_val, integer *n,15355doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)15356{15357/* System generated locals */15358integer i__1, i__2, i__3;15359doublecomplex z__1, z__2;1536015361/* Local variables */15362static integer i__, ix, iy;15363static doublecomplex ztemp;153641536515366/*15367Purpose15368=======1536915370ZDOTU forms the dot product of two vectors.1537115372Further Details15373===============1537415375jack dongarra, 3/11/78.15376modified 12/3/93, array(1) declarations changed to array(*)1537715378=====================================================================15379*/1538015381/* Parameter adjustments */15382--zy;15383--zx;1538415385/* Function Body */15386ztemp.r = 0., ztemp.i = 0.;15387ret_val->r = 0., ret_val->i = 0.;15388if (*n <= 0) {15389return ;15390}15391if (*incx == 1 && *incy == 1) {15392goto L20;15393}1539415395/*15396code for unequal increments or equal increments15397not equal to 115398*/1539915400ix = 1;15401iy = 1;15402if (*incx < 0) {15403ix = (-(*n) + 1) * *incx + 1;15404}15405if (*incy < 0) {15406iy = (-(*n) + 1) * *incy + 1;15407}15408i__1 = *n;15409for (i__ = 1; i__ <= i__1; ++i__) {15410i__2 = ix;15411i__3 = iy;15412z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i =15413zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;15414z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;15415ztemp.r = z__1.r, ztemp.i = z__1.i;15416ix += *incx;15417iy += *incy;15418/* L10: */15419}15420ret_val->r = ztemp.r, ret_val->i = ztemp.i;15421return ;1542215423/* code for both increments equal to 1 */1542415425L20:15426i__1 = *n;15427for (i__ = 1; i__ <= i__1; ++i__) {15428i__2 = i__;15429i__3 = i__;15430z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i =15431zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;15432z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;15433ztemp.r = z__1.r, ztemp.i = z__1.i;15434/* L30: */15435}15436ret_val->r = ztemp.r, ret_val->i = ztemp.i;15437return ;15438} /* zdotu_ */1543915440/* Subroutine */ int zdrot_(integer *n, doublecomplex *cx, integer *incx,15441doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s)15442{15443/* System generated locals */15444integer i__1, i__2, i__3, i__4;15445doublecomplex z__1, z__2, z__3;1544615447/* Local variables */15448static integer i__, ix, iy;15449static doublecomplex ctemp;154501545115452/*15453Purpose15454=======1545515456Applies a plane rotation, where the cos and sin (c and s) are real15457and the vectors cx and cy are complex.15458jack dongarra, linpack, 3/11/78.1545915460Arguments15461==========1546215463N (input) INTEGER15464On entry, N specifies the order of the vectors cx and cy.15465N must be at least zero.15466Unchanged on exit.1546715468CX (input) COMPLEX*16 array, dimension at least15469( 1 + ( N - 1 )*abs( INCX ) ).15470Before entry, the incremented array CX must contain the n15471element vector cx. On exit, CX is overwritten by the updated15472vector cx.1547315474INCX (input) INTEGER15475On entry, INCX specifies the increment for the elements of15476CX. INCX must not be zero.15477Unchanged on exit.1547815479CY (input) COMPLEX*16 array, dimension at least15480( 1 + ( N - 1 )*abs( INCY ) ).15481Before entry, the incremented array CY must contain the n15482element vector cy. On exit, CY is overwritten by the updated15483vector cy.1548415485INCY (input) INTEGER15486On entry, INCY specifies the increment for the elements of15487CY. INCY must not be zero.15488Unchanged on exit.1548915490C (input) DOUBLE PRECISION15491On entry, C specifies the cosine, cos.15492Unchanged on exit.1549315494S (input) DOUBLE PRECISION15495On entry, S specifies the sine, sin.15496Unchanged on exit.1549715498=====================================================================15499*/155001550115502/* Parameter adjustments */15503--cy;15504--cx;1550515506/* Function Body */15507if (*n <= 0) {15508return 0;15509}15510if (*incx == 1 && *incy == 1) {15511goto L20;15512}1551315514/*15515code for unequal increments or equal increments not equal15516to 115517*/1551815519ix = 1;15520iy = 1;15521if (*incx < 0) {15522ix = (-(*n) + 1) * *incx + 1;15523}15524if (*incy < 0) {15525iy = (-(*n) + 1) * *incy + 1;15526}15527i__1 = *n;15528for (i__ = 1; i__ <= i__1; ++i__) {15529i__2 = ix;15530z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;15531i__3 = iy;15532z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;15533z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;15534ctemp.r = z__1.r, ctemp.i = z__1.i;15535i__2 = iy;15536i__3 = iy;15537z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;15538i__4 = ix;15539z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;15540z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;15541cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;15542i__2 = ix;15543cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;15544ix += *incx;15545iy += *incy;15546/* L10: */15547}15548return 0;1554915550/* code for both increments equal to 1 */1555115552L20:15553i__1 = *n;15554for (i__ = 1; i__ <= i__1; ++i__) {15555i__2 = i__;15556z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;15557i__3 = i__;15558z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;15559z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;15560ctemp.r = z__1.r, ctemp.i = z__1.i;15561i__2 = i__;15562i__3 = i__;15563z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;15564i__4 = i__;15565z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;15566z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;15567cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;15568i__2 = i__;15569cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;15570/* L30: */15571}15572return 0;15573} /* zdrot_ */1557415575/* Subroutine */ int zdscal_(integer *n, doublereal *da, doublecomplex *zx,15576integer *incx)15577{15578/* System generated locals */15579integer i__1, i__2, i__3;15580doublecomplex z__1, z__2;1558115582/* Local variables */15583static integer i__, ix;155841558515586/*15587Purpose15588=======1558915590ZDSCAL scales a vector by a constant.1559115592Further Details15593===============1559415595jack dongarra, 3/11/78.15596modified 3/93 to return if incx .le. 0.15597modified 12/3/93, array(1) declarations changed to array(*)1559815599=====================================================================15600*/1560115602/* Parameter adjustments */15603--zx;1560415605/* Function Body */15606if (*n <= 0 || *incx <= 0) {15607return 0;15608}15609if (*incx == 1) {15610goto L20;15611}1561215613/* code for increment not equal to 1 */1561415615ix = 1;15616i__1 = *n;15617for (i__ = 1; i__ <= i__1; ++i__) {15618i__2 = ix;15619z__2.r = *da, z__2.i = 0.;15620i__3 = ix;15621z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r *15622zx[i__3].i + z__2.i * zx[i__3].r;15623zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;15624ix += *incx;15625/* L10: */15626}15627return 0;1562815629/* code for increment equal to 1 */1563015631L20:15632i__1 = *n;15633for (i__ = 1; i__ <= i__1; ++i__) {15634i__2 = i__;15635z__2.r = *da, z__2.i = 0.;15636i__3 = i__;15637z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r *15638zx[i__3].i + z__2.i * zx[i__3].r;15639zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;15640/* L30: */15641}15642return 0;15643} /* zdscal_ */1564415645/* Subroutine */ int zgemm_(char *transa, char *transb, integer *m, integer *15646n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,15647doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex *15648c__, integer *ldc)15649{15650/* System generated locals */15651integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,15652i__3, i__4, i__5, i__6;15653doublecomplex z__1, z__2, z__3, z__4;1565415655/* Local variables */15656static integer i__, j, l, info;15657static logical nota, notb;15658static doublecomplex temp;15659static logical conja, conjb;15660extern logical lsame_(char *, char *);15661static integer nrowa, nrowb;15662extern /* Subroutine */ int xerbla_(char *, integer *);156631566415665/*15666Purpose15667=======1566815669ZGEMM performs one of the matrix-matrix operations1567015671C := alpha*op( A )*op( B ) + beta*C,1567215673where op( X ) is one of1567415675op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ),1567615677alpha and beta are scalars, and A, B and C are matrices, with op( A )15678an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.1567915680Arguments15681==========1568215683TRANSA - CHARACTER*1.15684On entry, TRANSA specifies the form of op( A ) to be used in15685the matrix multiplication as follows:1568615687TRANSA = 'N' or 'n', op( A ) = A.1568815689TRANSA = 'T' or 't', op( A ) = A'.1569015691TRANSA = 'C' or 'c', op( A ) = conjg( A' ).1569215693Unchanged on exit.1569415695TRANSB - CHARACTER*1.15696On entry, TRANSB specifies the form of op( B ) to be used in15697the matrix multiplication as follows:1569815699TRANSB = 'N' or 'n', op( B ) = B.1570015701TRANSB = 'T' or 't', op( B ) = B'.1570215703TRANSB = 'C' or 'c', op( B ) = conjg( B' ).1570415705Unchanged on exit.1570615707M - INTEGER.15708On entry, M specifies the number of rows of the matrix15709op( A ) and of the matrix C. M must be at least zero.15710Unchanged on exit.1571115712N - INTEGER.15713On entry, N specifies the number of columns of the matrix15714op( B ) and the number of columns of the matrix C. N must be15715at least zero.15716Unchanged on exit.1571715718K - INTEGER.15719On entry, K specifies the number of columns of the matrix15720op( A ) and the number of rows of the matrix op( B ). K must15721be at least zero.15722Unchanged on exit.1572315724ALPHA - COMPLEX*16 .15725On entry, ALPHA specifies the scalar alpha.15726Unchanged on exit.1572715728A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is15729k when TRANSA = 'N' or 'n', and is m otherwise.15730Before entry with TRANSA = 'N' or 'n', the leading m by k15731part of the array A must contain the matrix A, otherwise15732the leading k by m part of the array A must contain the15733matrix A.15734Unchanged on exit.1573515736LDA - INTEGER.15737On entry, LDA specifies the first dimension of A as declared15738in the calling (sub) program. When TRANSA = 'N' or 'n' then15739LDA must be at least max( 1, m ), otherwise LDA must be at15740least max( 1, k ).15741Unchanged on exit.1574215743B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is15744n when TRANSB = 'N' or 'n', and is k otherwise.15745Before entry with TRANSB = 'N' or 'n', the leading k by n15746part of the array B must contain the matrix B, otherwise15747the leading n by k part of the array B must contain the15748matrix B.15749Unchanged on exit.1575015751LDB - INTEGER.15752On entry, LDB specifies the first dimension of B as declared15753in the calling (sub) program. When TRANSB = 'N' or 'n' then15754LDB must be at least max( 1, k ), otherwise LDB must be at15755least max( 1, n ).15756Unchanged on exit.1575715758BETA - COMPLEX*16 .15759On entry, BETA specifies the scalar beta. When BETA is15760supplied as zero then C need not be set on input.15761Unchanged on exit.1576215763C - COMPLEX*16 array of DIMENSION ( LDC, n ).15764Before entry, the leading m by n part of the array C must15765contain the matrix C, except when beta is zero, in which15766case C need not be set on entry.15767On exit, the array C is overwritten by the m by n matrix15768( alpha*op( A )*op( B ) + beta*C ).1576915770LDC - INTEGER.15771On entry, LDC specifies the first dimension of C as declared15772in the calling (sub) program. LDC must be at least15773max( 1, m ).15774Unchanged on exit.1577515776Further Details15777===============1577815779Level 3 Blas routine.1578015781-- Written on 8-February-1989.15782Jack Dongarra, Argonne National Laboratory.15783Iain Duff, AERE Harwell.15784Jeremy Du Croz, Numerical Algorithms Group Ltd.15785Sven Hammarling, Numerical Algorithms Group Ltd.1578615787=====================================================================157881578915790Set NOTA and NOTB as true if A and B respectively are not15791conjugated or transposed, set CONJA and CONJB as true if A and15792B respectively are to be transposed but not conjugated and set15793NROWA and NROWB as the number of rows and columns of A15794and the number of rows of B respectively.15795*/1579615797/* Parameter adjustments */15798a_dim1 = *lda;15799a_offset = 1 + a_dim1;15800a -= a_offset;15801b_dim1 = *ldb;15802b_offset = 1 + b_dim1;15803b -= b_offset;15804c_dim1 = *ldc;15805c_offset = 1 + c_dim1;15806c__ -= c_offset;1580715808/* Function Body */15809nota = lsame_(transa, "N");15810notb = lsame_(transb, "N");15811conja = lsame_(transa, "C");15812conjb = lsame_(transb, "C");15813if (nota) {15814nrowa = *m;15815} else {15816nrowa = *k;15817}15818if (notb) {15819nrowb = *k;15820} else {15821nrowb = *n;15822}1582315824/* Test the input parameters. */1582515826info = 0;15827if (! nota && ! conja && ! lsame_(transa, "T")) {15828info = 1;15829} else if (! notb && ! conjb && ! lsame_(transb, "T")) {15830info = 2;15831} else if (*m < 0) {15832info = 3;15833} else if (*n < 0) {15834info = 4;15835} else if (*k < 0) {15836info = 5;15837} else if (*lda < max(1,nrowa)) {15838info = 8;15839} else if (*ldb < max(1,nrowb)) {15840info = 10;15841} else if (*ldc < max(1,*m)) {15842info = 13;15843}15844if (info != 0) {15845xerbla_("ZGEMM ", &info);15846return 0;15847}1584815849/* Quick return if possible. */1585015851if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0. || *k == 0) &&15852(beta->r == 1. && beta->i == 0.)) {15853return 0;15854}1585515856/* And when alpha.eq.zero. */1585715858if (alpha->r == 0. && alpha->i == 0.) {15859if (beta->r == 0. && beta->i == 0.) {15860i__1 = *n;15861for (j = 1; j <= i__1; ++j) {15862i__2 = *m;15863for (i__ = 1; i__ <= i__2; ++i__) {15864i__3 = i__ + j * c_dim1;15865c__[i__3].r = 0., c__[i__3].i = 0.;15866/* L10: */15867}15868/* L20: */15869}15870} else {15871i__1 = *n;15872for (j = 1; j <= i__1; ++j) {15873i__2 = *m;15874for (i__ = 1; i__ <= i__2; ++i__) {15875i__3 = i__ + j * c_dim1;15876i__4 = i__ + j * c_dim1;15877z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4].i,15878z__1.i = beta->r * c__[i__4].i + beta->i * c__[15879i__4].r;15880c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;15881/* L30: */15882}15883/* L40: */15884}15885}15886return 0;15887}1588815889/* Start the operations. */1589015891if (notb) {15892if (nota) {1589315894/* Form C := alpha*A*B + beta*C. */1589515896i__1 = *n;15897for (j = 1; j <= i__1; ++j) {15898if (beta->r == 0. && beta->i == 0.) {15899i__2 = *m;15900for (i__ = 1; i__ <= i__2; ++i__) {15901i__3 = i__ + j * c_dim1;15902c__[i__3].r = 0., c__[i__3].i = 0.;15903/* L50: */15904}15905} else if (beta->r != 1. || beta->i != 0.) {15906i__2 = *m;15907for (i__ = 1; i__ <= i__2; ++i__) {15908i__3 = i__ + j * c_dim1;15909i__4 = i__ + j * c_dim1;15910z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]15911.i, z__1.i = beta->r * c__[i__4].i + beta->i *15912c__[i__4].r;15913c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;15914/* L60: */15915}15916}15917i__2 = *k;15918for (l = 1; l <= i__2; ++l) {15919i__3 = l + j * b_dim1;15920if (b[i__3].r != 0. || b[i__3].i != 0.) {15921i__3 = l + j * b_dim1;15922z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,15923z__1.i = alpha->r * b[i__3].i + alpha->i * b[15924i__3].r;15925temp.r = z__1.r, temp.i = z__1.i;15926i__3 = *m;15927for (i__ = 1; i__ <= i__3; ++i__) {15928i__4 = i__ + j * c_dim1;15929i__5 = i__ + j * c_dim1;15930i__6 = i__ + l * a_dim1;15931z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,15932z__2.i = temp.r * a[i__6].i + temp.i * a[15933i__6].r;15934z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]15935.i + z__2.i;15936c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;15937/* L70: */15938}15939}15940/* L80: */15941}15942/* L90: */15943}15944} else if (conja) {1594515946/* Form C := alpha*conjg( A' )*B + beta*C. */1594715948i__1 = *n;15949for (j = 1; j <= i__1; ++j) {15950i__2 = *m;15951for (i__ = 1; i__ <= i__2; ++i__) {15952temp.r = 0., temp.i = 0.;15953i__3 = *k;15954for (l = 1; l <= i__3; ++l) {15955d_cnjg(&z__3, &a[l + i__ * a_dim1]);15956i__4 = l + j * b_dim1;15957z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,15958z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]15959.r;15960z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;15961temp.r = z__1.r, temp.i = z__1.i;15962/* L100: */15963}15964if (beta->r == 0. && beta->i == 0.) {15965i__3 = i__ + j * c_dim1;15966z__1.r = alpha->r * temp.r - alpha->i * temp.i,15967z__1.i = alpha->r * temp.i + alpha->i *15968temp.r;15969c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;15970} else {15971i__3 = i__ + j * c_dim1;15972z__2.r = alpha->r * temp.r - alpha->i * temp.i,15973z__2.i = alpha->r * temp.i + alpha->i *15974temp.r;15975i__4 = i__ + j * c_dim1;15976z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]15977.i, z__3.i = beta->r * c__[i__4].i + beta->i *15978c__[i__4].r;15979z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;15980c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;15981}15982/* L110: */15983}15984/* L120: */15985}15986} else {1598715988/* Form C := alpha*A'*B + beta*C */1598915990i__1 = *n;15991for (j = 1; j <= i__1; ++j) {15992i__2 = *m;15993for (i__ = 1; i__ <= i__2; ++i__) {15994temp.r = 0., temp.i = 0.;15995i__3 = *k;15996for (l = 1; l <= i__3; ++l) {15997i__4 = l + i__ * a_dim1;15998i__5 = l + j * b_dim1;15999z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]16000.i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]16001.i * b[i__5].r;16002z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16003temp.r = z__1.r, temp.i = z__1.i;16004/* L130: */16005}16006if (beta->r == 0. && beta->i == 0.) {16007i__3 = i__ + j * c_dim1;16008z__1.r = alpha->r * temp.r - alpha->i * temp.i,16009z__1.i = alpha->r * temp.i + alpha->i *16010temp.r;16011c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16012} else {16013i__3 = i__ + j * c_dim1;16014z__2.r = alpha->r * temp.r - alpha->i * temp.i,16015z__2.i = alpha->r * temp.i + alpha->i *16016temp.r;16017i__4 = i__ + j * c_dim1;16018z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16019.i, z__3.i = beta->r * c__[i__4].i + beta->i *16020c__[i__4].r;16021z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;16022c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16023}16024/* L140: */16025}16026/* L150: */16027}16028}16029} else if (nota) {16030if (conjb) {1603116032/* Form C := alpha*A*conjg( B' ) + beta*C. */1603316034i__1 = *n;16035for (j = 1; j <= i__1; ++j) {16036if (beta->r == 0. && beta->i == 0.) {16037i__2 = *m;16038for (i__ = 1; i__ <= i__2; ++i__) {16039i__3 = i__ + j * c_dim1;16040c__[i__3].r = 0., c__[i__3].i = 0.;16041/* L160: */16042}16043} else if (beta->r != 1. || beta->i != 0.) {16044i__2 = *m;16045for (i__ = 1; i__ <= i__2; ++i__) {16046i__3 = i__ + j * c_dim1;16047i__4 = i__ + j * c_dim1;16048z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16049.i, z__1.i = beta->r * c__[i__4].i + beta->i *16050c__[i__4].r;16051c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16052/* L170: */16053}16054}16055i__2 = *k;16056for (l = 1; l <= i__2; ++l) {16057i__3 = j + l * b_dim1;16058if (b[i__3].r != 0. || b[i__3].i != 0.) {16059d_cnjg(&z__2, &b[j + l * b_dim1]);16060z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,16061z__1.i = alpha->r * z__2.i + alpha->i *16062z__2.r;16063temp.r = z__1.r, temp.i = z__1.i;16064i__3 = *m;16065for (i__ = 1; i__ <= i__3; ++i__) {16066i__4 = i__ + j * c_dim1;16067i__5 = i__ + j * c_dim1;16068i__6 = i__ + l * a_dim1;16069z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,16070z__2.i = temp.r * a[i__6].i + temp.i * a[16071i__6].r;16072z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]16073.i + z__2.i;16074c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;16075/* L180: */16076}16077}16078/* L190: */16079}16080/* L200: */16081}16082} else {1608316084/* Form C := alpha*A*B' + beta*C */1608516086i__1 = *n;16087for (j = 1; j <= i__1; ++j) {16088if (beta->r == 0. && beta->i == 0.) {16089i__2 = *m;16090for (i__ = 1; i__ <= i__2; ++i__) {16091i__3 = i__ + j * c_dim1;16092c__[i__3].r = 0., c__[i__3].i = 0.;16093/* L210: */16094}16095} else if (beta->r != 1. || beta->i != 0.) {16096i__2 = *m;16097for (i__ = 1; i__ <= i__2; ++i__) {16098i__3 = i__ + j * c_dim1;16099i__4 = i__ + j * c_dim1;16100z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16101.i, z__1.i = beta->r * c__[i__4].i + beta->i *16102c__[i__4].r;16103c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16104/* L220: */16105}16106}16107i__2 = *k;16108for (l = 1; l <= i__2; ++l) {16109i__3 = j + l * b_dim1;16110if (b[i__3].r != 0. || b[i__3].i != 0.) {16111i__3 = j + l * b_dim1;16112z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,16113z__1.i = alpha->r * b[i__3].i + alpha->i * b[16114i__3].r;16115temp.r = z__1.r, temp.i = z__1.i;16116i__3 = *m;16117for (i__ = 1; i__ <= i__3; ++i__) {16118i__4 = i__ + j * c_dim1;16119i__5 = i__ + j * c_dim1;16120i__6 = i__ + l * a_dim1;16121z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,16122z__2.i = temp.r * a[i__6].i + temp.i * a[16123i__6].r;16124z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]16125.i + z__2.i;16126c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;16127/* L230: */16128}16129}16130/* L240: */16131}16132/* L250: */16133}16134}16135} else if (conja) {16136if (conjb) {1613716138/* Form C := alpha*conjg( A' )*conjg( B' ) + beta*C. */1613916140i__1 = *n;16141for (j = 1; j <= i__1; ++j) {16142i__2 = *m;16143for (i__ = 1; i__ <= i__2; ++i__) {16144temp.r = 0., temp.i = 0.;16145i__3 = *k;16146for (l = 1; l <= i__3; ++l) {16147d_cnjg(&z__3, &a[l + i__ * a_dim1]);16148d_cnjg(&z__4, &b[j + l * b_dim1]);16149z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i =16150z__3.r * z__4.i + z__3.i * z__4.r;16151z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16152temp.r = z__1.r, temp.i = z__1.i;16153/* L260: */16154}16155if (beta->r == 0. && beta->i == 0.) {16156i__3 = i__ + j * c_dim1;16157z__1.r = alpha->r * temp.r - alpha->i * temp.i,16158z__1.i = alpha->r * temp.i + alpha->i *16159temp.r;16160c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16161} else {16162i__3 = i__ + j * c_dim1;16163z__2.r = alpha->r * temp.r - alpha->i * temp.i,16164z__2.i = alpha->r * temp.i + alpha->i *16165temp.r;16166i__4 = i__ + j * c_dim1;16167z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16168.i, z__3.i = beta->r * c__[i__4].i + beta->i *16169c__[i__4].r;16170z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;16171c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16172}16173/* L270: */16174}16175/* L280: */16176}16177} else {1617816179/* Form C := alpha*conjg( A' )*B' + beta*C */1618016181i__1 = *n;16182for (j = 1; j <= i__1; ++j) {16183i__2 = *m;16184for (i__ = 1; i__ <= i__2; ++i__) {16185temp.r = 0., temp.i = 0.;16186i__3 = *k;16187for (l = 1; l <= i__3; ++l) {16188d_cnjg(&z__3, &a[l + i__ * a_dim1]);16189i__4 = j + l * b_dim1;16190z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,16191z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]16192.r;16193z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16194temp.r = z__1.r, temp.i = z__1.i;16195/* L290: */16196}16197if (beta->r == 0. && beta->i == 0.) {16198i__3 = i__ + j * c_dim1;16199z__1.r = alpha->r * temp.r - alpha->i * temp.i,16200z__1.i = alpha->r * temp.i + alpha->i *16201temp.r;16202c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16203} else {16204i__3 = i__ + j * c_dim1;16205z__2.r = alpha->r * temp.r - alpha->i * temp.i,16206z__2.i = alpha->r * temp.i + alpha->i *16207temp.r;16208i__4 = i__ + j * c_dim1;16209z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16210.i, z__3.i = beta->r * c__[i__4].i + beta->i *16211c__[i__4].r;16212z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;16213c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16214}16215/* L300: */16216}16217/* L310: */16218}16219}16220} else {16221if (conjb) {1622216223/* Form C := alpha*A'*conjg( B' ) + beta*C */1622416225i__1 = *n;16226for (j = 1; j <= i__1; ++j) {16227i__2 = *m;16228for (i__ = 1; i__ <= i__2; ++i__) {16229temp.r = 0., temp.i = 0.;16230i__3 = *k;16231for (l = 1; l <= i__3; ++l) {16232i__4 = l + i__ * a_dim1;16233d_cnjg(&z__3, &b[j + l * b_dim1]);16234z__2.r = a[i__4].r * z__3.r - a[i__4].i * z__3.i,16235z__2.i = a[i__4].r * z__3.i + a[i__4].i *16236z__3.r;16237z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16238temp.r = z__1.r, temp.i = z__1.i;16239/* L320: */16240}16241if (beta->r == 0. && beta->i == 0.) {16242i__3 = i__ + j * c_dim1;16243z__1.r = alpha->r * temp.r - alpha->i * temp.i,16244z__1.i = alpha->r * temp.i + alpha->i *16245temp.r;16246c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16247} else {16248i__3 = i__ + j * c_dim1;16249z__2.r = alpha->r * temp.r - alpha->i * temp.i,16250z__2.i = alpha->r * temp.i + alpha->i *16251temp.r;16252i__4 = i__ + j * c_dim1;16253z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16254.i, z__3.i = beta->r * c__[i__4].i + beta->i *16255c__[i__4].r;16256z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;16257c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16258}16259/* L330: */16260}16261/* L340: */16262}16263} else {1626416265/* Form C := alpha*A'*B' + beta*C */1626616267i__1 = *n;16268for (j = 1; j <= i__1; ++j) {16269i__2 = *m;16270for (i__ = 1; i__ <= i__2; ++i__) {16271temp.r = 0., temp.i = 0.;16272i__3 = *k;16273for (l = 1; l <= i__3; ++l) {16274i__4 = l + i__ * a_dim1;16275i__5 = j + l * b_dim1;16276z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]16277.i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]16278.i * b[i__5].r;16279z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16280temp.r = z__1.r, temp.i = z__1.i;16281/* L350: */16282}16283if (beta->r == 0. && beta->i == 0.) {16284i__3 = i__ + j * c_dim1;16285z__1.r = alpha->r * temp.r - alpha->i * temp.i,16286z__1.i = alpha->r * temp.i + alpha->i *16287temp.r;16288c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16289} else {16290i__3 = i__ + j * c_dim1;16291z__2.r = alpha->r * temp.r - alpha->i * temp.i,16292z__2.i = alpha->r * temp.i + alpha->i *16293temp.r;16294i__4 = i__ + j * c_dim1;16295z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]16296.i, z__3.i = beta->r * c__[i__4].i + beta->i *16297c__[i__4].r;16298z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;16299c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;16300}16301/* L360: */16302}16303/* L370: */16304}16305}16306}1630716308return 0;1630916310/* End of ZGEMM . */1631116312} /* zgemm_ */1631316314/* Subroutine */ int zgemv_(char *trans, integer *m, integer *n,16315doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *16316x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *16317incy)16318{16319/* System generated locals */16320integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;16321doublecomplex z__1, z__2, z__3;1632216323/* Local variables */16324static integer i__, j, ix, iy, jx, jy, kx, ky, info;16325static doublecomplex temp;16326static integer lenx, leny;16327extern logical lsame_(char *, char *);16328extern /* Subroutine */ int xerbla_(char *, integer *);16329static logical noconj;163301633116332/*16333Purpose16334=======1633516336ZGEMV performs one of the matrix-vector operations1633716338y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or1633916340y := alpha*conjg( A' )*x + beta*y,1634116342where alpha and beta are scalars, x and y are vectors and A is an16343m by n matrix.1634416345Arguments16346==========1634716348TRANS - CHARACTER*1.16349On entry, TRANS specifies the operation to be performed as16350follows:1635116352TRANS = 'N' or 'n' y := alpha*A*x + beta*y.1635316354TRANS = 'T' or 't' y := alpha*A'*x + beta*y.1635516356TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + beta*y.1635716358Unchanged on exit.1635916360M - INTEGER.16361On entry, M specifies the number of rows of the matrix A.16362M must be at least zero.16363Unchanged on exit.1636416365N - INTEGER.16366On entry, N specifies the number of columns of the matrix A.16367N must be at least zero.16368Unchanged on exit.1636916370ALPHA - COMPLEX*16 .16371On entry, ALPHA specifies the scalar alpha.16372Unchanged on exit.1637316374A - COMPLEX*16 array of DIMENSION ( LDA, n ).16375Before entry, the leading m by n part of the array A must16376contain the matrix of coefficients.16377Unchanged on exit.1637816379LDA - INTEGER.16380On entry, LDA specifies the first dimension of A as declared16381in the calling (sub) program. LDA must be at least16382max( 1, m ).16383Unchanged on exit.1638416385X - COMPLEX*16 array of DIMENSION at least16386( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'16387and at least16388( 1 + ( m - 1 )*abs( INCX ) ) otherwise.16389Before entry, the incremented array X must contain the16390vector x.16391Unchanged on exit.1639216393INCX - INTEGER.16394On entry, INCX specifies the increment for the elements of16395X. INCX must not be zero.16396Unchanged on exit.1639716398BETA - COMPLEX*16 .16399On entry, BETA specifies the scalar beta. When BETA is16400supplied as zero then Y need not be set on input.16401Unchanged on exit.1640216403Y - COMPLEX*16 array of DIMENSION at least16404( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'16405and at least16406( 1 + ( n - 1 )*abs( INCY ) ) otherwise.16407Before entry with BETA non-zero, the incremented array Y16408must contain the vector y. On exit, Y is overwritten by the16409updated vector y.1641016411INCY - INTEGER.16412On entry, INCY specifies the increment for the elements of16413Y. INCY must not be zero.16414Unchanged on exit.1641516416Further Details16417===============1641816419Level 2 Blas routine.1642016421-- Written on 22-October-1986.16422Jack Dongarra, Argonne National Lab.16423Jeremy Du Croz, Nag Central Office.16424Sven Hammarling, Nag Central Office.16425Richard Hanson, Sandia National Labs.1642616427=====================================================================164281642916430Test the input parameters.16431*/1643216433/* Parameter adjustments */16434a_dim1 = *lda;16435a_offset = 1 + a_dim1;16436a -= a_offset;16437--x;16438--y;1643916440/* Function Body */16441info = 0;16442if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")16443) {16444info = 1;16445} else if (*m < 0) {16446info = 2;16447} else if (*n < 0) {16448info = 3;16449} else if (*lda < max(1,*m)) {16450info = 6;16451} else if (*incx == 0) {16452info = 8;16453} else if (*incy == 0) {16454info = 11;16455}16456if (info != 0) {16457xerbla_("ZGEMV ", &info);16458return 0;16459}1646016461/* Quick return if possible. */1646216463if (*m == 0 || *n == 0 || alpha->r == 0. && alpha->i == 0. && (beta->r ==164641. && beta->i == 0.)) {16465return 0;16466}1646716468noconj = lsame_(trans, "T");1646916470/*16471Set LENX and LENY, the lengths of the vectors x and y, and set16472up the start points in X and Y.16473*/1647416475if (lsame_(trans, "N")) {16476lenx = *n;16477leny = *m;16478} else {16479lenx = *m;16480leny = *n;16481}16482if (*incx > 0) {16483kx = 1;16484} else {16485kx = 1 - (lenx - 1) * *incx;16486}16487if (*incy > 0) {16488ky = 1;16489} else {16490ky = 1 - (leny - 1) * *incy;16491}1649216493/*16494Start the operations. In this version the elements of A are16495accessed sequentially with one pass through A.1649616497First form y := beta*y.16498*/1649916500if (beta->r != 1. || beta->i != 0.) {16501if (*incy == 1) {16502if (beta->r == 0. && beta->i == 0.) {16503i__1 = leny;16504for (i__ = 1; i__ <= i__1; ++i__) {16505i__2 = i__;16506y[i__2].r = 0., y[i__2].i = 0.;16507/* L10: */16508}16509} else {16510i__1 = leny;16511for (i__ = 1; i__ <= i__1; ++i__) {16512i__2 = i__;16513i__3 = i__;16514z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,16515z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]16516.r;16517y[i__2].r = z__1.r, y[i__2].i = z__1.i;16518/* L20: */16519}16520}16521} else {16522iy = ky;16523if (beta->r == 0. && beta->i == 0.) {16524i__1 = leny;16525for (i__ = 1; i__ <= i__1; ++i__) {16526i__2 = iy;16527y[i__2].r = 0., y[i__2].i = 0.;16528iy += *incy;16529/* L30: */16530}16531} else {16532i__1 = leny;16533for (i__ = 1; i__ <= i__1; ++i__) {16534i__2 = iy;16535i__3 = iy;16536z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,16537z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]16538.r;16539y[i__2].r = z__1.r, y[i__2].i = z__1.i;16540iy += *incy;16541/* L40: */16542}16543}16544}16545}16546if (alpha->r == 0. && alpha->i == 0.) {16547return 0;16548}16549if (lsame_(trans, "N")) {1655016551/* Form y := alpha*A*x + y. */1655216553jx = kx;16554if (*incy == 1) {16555i__1 = *n;16556for (j = 1; j <= i__1; ++j) {16557i__2 = jx;16558if (x[i__2].r != 0. || x[i__2].i != 0.) {16559i__2 = jx;16560z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,16561z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]16562.r;16563temp.r = z__1.r, temp.i = z__1.i;16564i__2 = *m;16565for (i__ = 1; i__ <= i__2; ++i__) {16566i__3 = i__;16567i__4 = i__;16568i__5 = i__ + j * a_dim1;16569z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,16570z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]16571.r;16572z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i +16573z__2.i;16574y[i__3].r = z__1.r, y[i__3].i = z__1.i;16575/* L50: */16576}16577}16578jx += *incx;16579/* L60: */16580}16581} else {16582i__1 = *n;16583for (j = 1; j <= i__1; ++j) {16584i__2 = jx;16585if (x[i__2].r != 0. || x[i__2].i != 0.) {16586i__2 = jx;16587z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,16588z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]16589.r;16590temp.r = z__1.r, temp.i = z__1.i;16591iy = ky;16592i__2 = *m;16593for (i__ = 1; i__ <= i__2; ++i__) {16594i__3 = iy;16595i__4 = iy;16596i__5 = i__ + j * a_dim1;16597z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,16598z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]16599.r;16600z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i +16601z__2.i;16602y[i__3].r = z__1.r, y[i__3].i = z__1.i;16603iy += *incy;16604/* L70: */16605}16606}16607jx += *incx;16608/* L80: */16609}16610}16611} else {1661216613/* Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y. */1661416615jy = ky;16616if (*incx == 1) {16617i__1 = *n;16618for (j = 1; j <= i__1; ++j) {16619temp.r = 0., temp.i = 0.;16620if (noconj) {16621i__2 = *m;16622for (i__ = 1; i__ <= i__2; ++i__) {16623i__3 = i__ + j * a_dim1;16624i__4 = i__;16625z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]16626.i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]16627.i * x[i__4].r;16628z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16629temp.r = z__1.r, temp.i = z__1.i;16630/* L90: */16631}16632} else {16633i__2 = *m;16634for (i__ = 1; i__ <= i__2; ++i__) {16635d_cnjg(&z__3, &a[i__ + j * a_dim1]);16636i__3 = i__;16637z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,16638z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]16639.r;16640z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16641temp.r = z__1.r, temp.i = z__1.i;16642/* L100: */16643}16644}16645i__2 = jy;16646i__3 = jy;16647z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i =16648alpha->r * temp.i + alpha->i * temp.r;16649z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;16650y[i__2].r = z__1.r, y[i__2].i = z__1.i;16651jy += *incy;16652/* L110: */16653}16654} else {16655i__1 = *n;16656for (j = 1; j <= i__1; ++j) {16657temp.r = 0., temp.i = 0.;16658ix = kx;16659if (noconj) {16660i__2 = *m;16661for (i__ = 1; i__ <= i__2; ++i__) {16662i__3 = i__ + j * a_dim1;16663i__4 = ix;16664z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]16665.i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]16666.i * x[i__4].r;16667z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16668temp.r = z__1.r, temp.i = z__1.i;16669ix += *incx;16670/* L120: */16671}16672} else {16673i__2 = *m;16674for (i__ = 1; i__ <= i__2; ++i__) {16675d_cnjg(&z__3, &a[i__ + j * a_dim1]);16676i__3 = ix;16677z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,16678z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]16679.r;16680z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;16681temp.r = z__1.r, temp.i = z__1.i;16682ix += *incx;16683/* L130: */16684}16685}16686i__2 = jy;16687i__3 = jy;16688z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i =16689alpha->r * temp.i + alpha->i * temp.r;16690z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;16691y[i__2].r = z__1.r, y[i__2].i = z__1.i;16692jy += *incy;16693/* L140: */16694}16695}16696}1669716698return 0;1669916700/* End of ZGEMV . */1670116702} /* zgemv_ */1670316704/* Subroutine */ int zgerc_(integer *m, integer *n, doublecomplex *alpha,16705doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,16706doublecomplex *a, integer *lda)16707{16708/* System generated locals */16709integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;16710doublecomplex z__1, z__2;1671116712/* Local variables */16713static integer i__, j, ix, jy, kx, info;16714static doublecomplex temp;16715extern /* Subroutine */ int xerbla_(char *, integer *);167161671716718/*16719Purpose16720=======1672116722ZGERC performs the rank 1 operation1672316724A := alpha*x*conjg( y' ) + A,1672516726where alpha is a scalar, x is an m element vector, y is an n element16727vector and A is an m by n matrix.1672816729Arguments16730==========1673116732M - INTEGER.16733On entry, M specifies the number of rows of the matrix A.16734M must be at least zero.16735Unchanged on exit.1673616737N - INTEGER.16738On entry, N specifies the number of columns of the matrix A.16739N must be at least zero.16740Unchanged on exit.1674116742ALPHA - COMPLEX*16 .16743On entry, ALPHA specifies the scalar alpha.16744Unchanged on exit.1674516746X - COMPLEX*16 array of dimension at least16747( 1 + ( m - 1 )*abs( INCX ) ).16748Before entry, the incremented array X must contain the m16749element vector x.16750Unchanged on exit.1675116752INCX - INTEGER.16753On entry, INCX specifies the increment for the elements of16754X. INCX must not be zero.16755Unchanged on exit.1675616757Y - COMPLEX*16 array of dimension at least16758( 1 + ( n - 1 )*abs( INCY ) ).16759Before entry, the incremented array Y must contain the n16760element vector y.16761Unchanged on exit.1676216763INCY - INTEGER.16764On entry, INCY specifies the increment for the elements of16765Y. INCY must not be zero.16766Unchanged on exit.1676716768A - COMPLEX*16 array of DIMENSION ( LDA, n ).16769Before entry, the leading m by n part of the array A must16770contain the matrix of coefficients. On exit, A is16771overwritten by the updated matrix.1677216773LDA - INTEGER.16774On entry, LDA specifies the first dimension of A as declared16775in the calling (sub) program. LDA must be at least16776max( 1, m ).16777Unchanged on exit.1677816779Further Details16780===============1678116782Level 2 Blas routine.1678316784-- Written on 22-October-1986.16785Jack Dongarra, Argonne National Lab.16786Jeremy Du Croz, Nag Central Office.16787Sven Hammarling, Nag Central Office.16788Richard Hanson, Sandia National Labs.1678916790=====================================================================167911679216793Test the input parameters.16794*/1679516796/* Parameter adjustments */16797--x;16798--y;16799a_dim1 = *lda;16800a_offset = 1 + a_dim1;16801a -= a_offset;1680216803/* Function Body */16804info = 0;16805if (*m < 0) {16806info = 1;16807} else if (*n < 0) {16808info = 2;16809} else if (*incx == 0) {16810info = 5;16811} else if (*incy == 0) {16812info = 7;16813} else if (*lda < max(1,*m)) {16814info = 9;16815}16816if (info != 0) {16817xerbla_("ZGERC ", &info);16818return 0;16819}1682016821/* Quick return if possible. */1682216823if (*m == 0 || *n == 0 || alpha->r == 0. && alpha->i == 0.) {16824return 0;16825}1682616827/*16828Start the operations. In this version the elements of A are16829accessed sequentially with one pass through A.16830*/1683116832if (*incy > 0) {16833jy = 1;16834} else {16835jy = 1 - (*n - 1) * *incy;16836}16837if (*incx == 1) {16838i__1 = *n;16839for (j = 1; j <= i__1; ++j) {16840i__2 = jy;16841if (y[i__2].r != 0. || y[i__2].i != 0.) {16842d_cnjg(&z__2, &y[jy]);16843z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =16844alpha->r * z__2.i + alpha->i * z__2.r;16845temp.r = z__1.r, temp.i = z__1.i;16846i__2 = *m;16847for (i__ = 1; i__ <= i__2; ++i__) {16848i__3 = i__ + j * a_dim1;16849i__4 = i__ + j * a_dim1;16850i__5 = i__;16851z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =16852x[i__5].r * temp.i + x[i__5].i * temp.r;16853z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;16854a[i__3].r = z__1.r, a[i__3].i = z__1.i;16855/* L10: */16856}16857}16858jy += *incy;16859/* L20: */16860}16861} else {16862if (*incx > 0) {16863kx = 1;16864} else {16865kx = 1 - (*m - 1) * *incx;16866}16867i__1 = *n;16868for (j = 1; j <= i__1; ++j) {16869i__2 = jy;16870if (y[i__2].r != 0. || y[i__2].i != 0.) {16871d_cnjg(&z__2, &y[jy]);16872z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =16873alpha->r * z__2.i + alpha->i * z__2.r;16874temp.r = z__1.r, temp.i = z__1.i;16875ix = kx;16876i__2 = *m;16877for (i__ = 1; i__ <= i__2; ++i__) {16878i__3 = i__ + j * a_dim1;16879i__4 = i__ + j * a_dim1;16880i__5 = ix;16881z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =16882x[i__5].r * temp.i + x[i__5].i * temp.r;16883z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;16884a[i__3].r = z__1.r, a[i__3].i = z__1.i;16885ix += *incx;16886/* L30: */16887}16888}16889jy += *incy;16890/* L40: */16891}16892}1689316894return 0;1689516896/* End of ZGERC . */1689716898} /* zgerc_ */1689916900/* Subroutine */ int zgeru_(integer *m, integer *n, doublecomplex *alpha,16901doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,16902doublecomplex *a, integer *lda)16903{16904/* System generated locals */16905integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;16906doublecomplex z__1, z__2;1690716908/* Local variables */16909static integer i__, j, ix, jy, kx, info;16910static doublecomplex temp;16911extern /* Subroutine */ int xerbla_(char *, integer *);169121691316914/*16915Purpose16916=======1691716918ZGERU performs the rank 1 operation1691916920A := alpha*x*y' + A,1692116922where alpha is a scalar, x is an m element vector, y is an n element16923vector and A is an m by n matrix.1692416925Arguments16926==========1692716928M - INTEGER.16929On entry, M specifies the number of rows of the matrix A.16930M must be at least zero.16931Unchanged on exit.1693216933N - INTEGER.16934On entry, N specifies the number of columns of the matrix A.16935N must be at least zero.16936Unchanged on exit.1693716938ALPHA - COMPLEX*16 .16939On entry, ALPHA specifies the scalar alpha.16940Unchanged on exit.1694116942X - COMPLEX*16 array of dimension at least16943( 1 + ( m - 1 )*abs( INCX ) ).16944Before entry, the incremented array X must contain the m16945element vector x.16946Unchanged on exit.1694716948INCX - INTEGER.16949On entry, INCX specifies the increment for the elements of16950X. INCX must not be zero.16951Unchanged on exit.1695216953Y - COMPLEX*16 array of dimension at least16954( 1 + ( n - 1 )*abs( INCY ) ).16955Before entry, the incremented array Y must contain the n16956element vector y.16957Unchanged on exit.1695816959INCY - INTEGER.16960On entry, INCY specifies the increment for the elements of16961Y. INCY must not be zero.16962Unchanged on exit.1696316964A - COMPLEX*16 array of DIMENSION ( LDA, n ).16965Before entry, the leading m by n part of the array A must16966contain the matrix of coefficients. On exit, A is16967overwritten by the updated matrix.1696816969LDA - INTEGER.16970On entry, LDA specifies the first dimension of A as declared16971in the calling (sub) program. LDA must be at least16972max( 1, m ).16973Unchanged on exit.1697416975Further Details16976===============1697716978Level 2 Blas routine.1697916980-- Written on 22-October-1986.16981Jack Dongarra, Argonne National Lab.16982Jeremy Du Croz, Nag Central Office.16983Sven Hammarling, Nag Central Office.16984Richard Hanson, Sandia National Labs.1698516986=====================================================================169871698816989Test the input parameters.16990*/1699116992/* Parameter adjustments */16993--x;16994--y;16995a_dim1 = *lda;16996a_offset = 1 + a_dim1;16997a -= a_offset;1699816999/* Function Body */17000info = 0;17001if (*m < 0) {17002info = 1;17003} else if (*n < 0) {17004info = 2;17005} else if (*incx == 0) {17006info = 5;17007} else if (*incy == 0) {17008info = 7;17009} else if (*lda < max(1,*m)) {17010info = 9;17011}17012if (info != 0) {17013xerbla_("ZGERU ", &info);17014return 0;17015}1701617017/* Quick return if possible. */1701817019if (*m == 0 || *n == 0 || alpha->r == 0. && alpha->i == 0.) {17020return 0;17021}1702217023/*17024Start the operations. In this version the elements of A are17025accessed sequentially with one pass through A.17026*/1702717028if (*incy > 0) {17029jy = 1;17030} else {17031jy = 1 - (*n - 1) * *incy;17032}17033if (*incx == 1) {17034i__1 = *n;17035for (j = 1; j <= i__1; ++j) {17036i__2 = jy;17037if (y[i__2].r != 0. || y[i__2].i != 0.) {17038i__2 = jy;17039z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =17040alpha->r * y[i__2].i + alpha->i * y[i__2].r;17041temp.r = z__1.r, temp.i = z__1.i;17042i__2 = *m;17043for (i__ = 1; i__ <= i__2; ++i__) {17044i__3 = i__ + j * a_dim1;17045i__4 = i__ + j * a_dim1;17046i__5 = i__;17047z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =17048x[i__5].r * temp.i + x[i__5].i * temp.r;17049z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;17050a[i__3].r = z__1.r, a[i__3].i = z__1.i;17051/* L10: */17052}17053}17054jy += *incy;17055/* L20: */17056}17057} else {17058if (*incx > 0) {17059kx = 1;17060} else {17061kx = 1 - (*m - 1) * *incx;17062}17063i__1 = *n;17064for (j = 1; j <= i__1; ++j) {17065i__2 = jy;17066if (y[i__2].r != 0. || y[i__2].i != 0.) {17067i__2 = jy;17068z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =17069alpha->r * y[i__2].i + alpha->i * y[i__2].r;17070temp.r = z__1.r, temp.i = z__1.i;17071ix = kx;17072i__2 = *m;17073for (i__ = 1; i__ <= i__2; ++i__) {17074i__3 = i__ + j * a_dim1;17075i__4 = i__ + j * a_dim1;17076i__5 = ix;17077z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =17078x[i__5].r * temp.i + x[i__5].i * temp.r;17079z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;17080a[i__3].r = z__1.r, a[i__3].i = z__1.i;17081ix += *incx;17082/* L30: */17083}17084}17085jy += *incy;17086/* L40: */17087}17088}1708917090return 0;1709117092/* End of ZGERU . */1709317094} /* zgeru_ */1709517096/* Subroutine */ int zhemv_(char *uplo, integer *n, doublecomplex *alpha,17097doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,17098doublecomplex *beta, doublecomplex *y, integer *incy)17099{17100/* System generated locals */17101integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;17102doublereal d__1;17103doublecomplex z__1, z__2, z__3, z__4;1710417105/* Local variables */17106static integer i__, j, ix, iy, jx, jy, kx, ky, info;17107static doublecomplex temp1, temp2;17108extern logical lsame_(char *, char *);17109extern /* Subroutine */ int xerbla_(char *, integer *);171101711117112/*17113Purpose17114=======1711517116ZHEMV performs the matrix-vector operation1711717118y := alpha*A*x + beta*y,1711917120where alpha and beta are scalars, x and y are n element vectors and17121A is an n by n hermitian matrix.1712217123Arguments17124==========1712517126UPLO - CHARACTER*1.17127On entry, UPLO specifies whether the upper or lower17128triangular part of the array A is to be referenced as17129follows:1713017131UPLO = 'U' or 'u' Only the upper triangular part of A17132is to be referenced.1713317134UPLO = 'L' or 'l' Only the lower triangular part of A17135is to be referenced.1713617137Unchanged on exit.1713817139N - INTEGER.17140On entry, N specifies the order of the matrix A.17141N must be at least zero.17142Unchanged on exit.1714317144ALPHA - COMPLEX*16 .17145On entry, ALPHA specifies the scalar alpha.17146Unchanged on exit.1714717148A - COMPLEX*16 array of DIMENSION ( LDA, n ).17149Before entry with UPLO = 'U' or 'u', the leading n by n17150upper triangular part of the array A must contain the upper17151triangular part of the hermitian matrix and the strictly17152lower triangular part of A is not referenced.17153Before entry with UPLO = 'L' or 'l', the leading n by n17154lower triangular part of the array A must contain the lower17155triangular part of the hermitian matrix and the strictly17156upper triangular part of A is not referenced.17157Note that the imaginary parts of the diagonal elements need17158not be set and are assumed to be zero.17159Unchanged on exit.1716017161LDA - INTEGER.17162On entry, LDA specifies the first dimension of A as declared17163in the calling (sub) program. LDA must be at least17164max( 1, n ).17165Unchanged on exit.1716617167X - COMPLEX*16 array of dimension at least17168( 1 + ( n - 1 )*abs( INCX ) ).17169Before entry, the incremented array X must contain the n17170element vector x.17171Unchanged on exit.1717217173INCX - INTEGER.17174On entry, INCX specifies the increment for the elements of17175X. INCX must not be zero.17176Unchanged on exit.1717717178BETA - COMPLEX*16 .17179On entry, BETA specifies the scalar beta. When BETA is17180supplied as zero then Y need not be set on input.17181Unchanged on exit.1718217183Y - COMPLEX*16 array of dimension at least17184( 1 + ( n - 1 )*abs( INCY ) ).17185Before entry, the incremented array Y must contain the n17186element vector y. On exit, Y is overwritten by the updated17187vector y.1718817189INCY - INTEGER.17190On entry, INCY specifies the increment for the elements of17191Y. INCY must not be zero.17192Unchanged on exit.1719317194Further Details17195===============1719617197Level 2 Blas routine.1719817199-- Written on 22-October-1986.17200Jack Dongarra, Argonne National Lab.17201Jeremy Du Croz, Nag Central Office.17202Sven Hammarling, Nag Central Office.17203Richard Hanson, Sandia National Labs.1720417205=====================================================================172061720717208Test the input parameters.17209*/1721017211/* Parameter adjustments */17212a_dim1 = *lda;17213a_offset = 1 + a_dim1;17214a -= a_offset;17215--x;17216--y;1721717218/* Function Body */17219info = 0;17220if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {17221info = 1;17222} else if (*n < 0) {17223info = 2;17224} else if (*lda < max(1,*n)) {17225info = 5;17226} else if (*incx == 0) {17227info = 7;17228} else if (*incy == 0) {17229info = 10;17230}17231if (info != 0) {17232xerbla_("ZHEMV ", &info);17233return 0;17234}1723517236/* Quick return if possible. */1723717238if (*n == 0 || alpha->r == 0. && alpha->i == 0. && (beta->r == 1. &&17239beta->i == 0.)) {17240return 0;17241}1724217243/* Set up the start points in X and Y. */1724417245if (*incx > 0) {17246kx = 1;17247} else {17248kx = 1 - (*n - 1) * *incx;17249}17250if (*incy > 0) {17251ky = 1;17252} else {17253ky = 1 - (*n - 1) * *incy;17254}1725517256/*17257Start the operations. In this version the elements of A are17258accessed sequentially with one pass through the triangular part17259of A.1726017261First form y := beta*y.17262*/1726317264if (beta->r != 1. || beta->i != 0.) {17265if (*incy == 1) {17266if (beta->r == 0. && beta->i == 0.) {17267i__1 = *n;17268for (i__ = 1; i__ <= i__1; ++i__) {17269i__2 = i__;17270y[i__2].r = 0., y[i__2].i = 0.;17271/* L10: */17272}17273} else {17274i__1 = *n;17275for (i__ = 1; i__ <= i__1; ++i__) {17276i__2 = i__;17277i__3 = i__;17278z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,17279z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]17280.r;17281y[i__2].r = z__1.r, y[i__2].i = z__1.i;17282/* L20: */17283}17284}17285} else {17286iy = ky;17287if (beta->r == 0. && beta->i == 0.) {17288i__1 = *n;17289for (i__ = 1; i__ <= i__1; ++i__) {17290i__2 = iy;17291y[i__2].r = 0., y[i__2].i = 0.;17292iy += *incy;17293/* L30: */17294}17295} else {17296i__1 = *n;17297for (i__ = 1; i__ <= i__1; ++i__) {17298i__2 = iy;17299i__3 = iy;17300z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,17301z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]17302.r;17303y[i__2].r = z__1.r, y[i__2].i = z__1.i;17304iy += *incy;17305/* L40: */17306}17307}17308}17309}17310if (alpha->r == 0. && alpha->i == 0.) {17311return 0;17312}17313if (lsame_(uplo, "U")) {1731417315/* Form y when A is stored in upper triangle. */1731617317if (*incx == 1 && *incy == 1) {17318i__1 = *n;17319for (j = 1; j <= i__1; ++j) {17320i__2 = j;17321z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =17322alpha->r * x[i__2].i + alpha->i * x[i__2].r;17323temp1.r = z__1.r, temp1.i = z__1.i;17324temp2.r = 0., temp2.i = 0.;17325i__2 = j - 1;17326for (i__ = 1; i__ <= i__2; ++i__) {17327i__3 = i__;17328i__4 = i__;17329i__5 = i__ + j * a_dim1;17330z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,17331z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]17332.r;17333z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;17334y[i__3].r = z__1.r, y[i__3].i = z__1.i;17335d_cnjg(&z__3, &a[i__ + j * a_dim1]);17336i__3 = i__;17337z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =17338z__3.r * x[i__3].i + z__3.i * x[i__3].r;17339z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;17340temp2.r = z__1.r, temp2.i = z__1.i;17341/* L50: */17342}17343i__2 = j;17344i__3 = j;17345i__4 = j + j * a_dim1;17346d__1 = a[i__4].r;17347z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;17348z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;17349z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =17350alpha->r * temp2.i + alpha->i * temp2.r;17351z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;17352y[i__2].r = z__1.r, y[i__2].i = z__1.i;17353/* L60: */17354}17355} else {17356jx = kx;17357jy = ky;17358i__1 = *n;17359for (j = 1; j <= i__1; ++j) {17360i__2 = jx;17361z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =17362alpha->r * x[i__2].i + alpha->i * x[i__2].r;17363temp1.r = z__1.r, temp1.i = z__1.i;17364temp2.r = 0., temp2.i = 0.;17365ix = kx;17366iy = ky;17367i__2 = j - 1;17368for (i__ = 1; i__ <= i__2; ++i__) {17369i__3 = iy;17370i__4 = iy;17371i__5 = i__ + j * a_dim1;17372z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,17373z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]17374.r;17375z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;17376y[i__3].r = z__1.r, y[i__3].i = z__1.i;17377d_cnjg(&z__3, &a[i__ + j * a_dim1]);17378i__3 = ix;17379z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =17380z__3.r * x[i__3].i + z__3.i * x[i__3].r;17381z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;17382temp2.r = z__1.r, temp2.i = z__1.i;17383ix += *incx;17384iy += *incy;17385/* L70: */17386}17387i__2 = jy;17388i__3 = jy;17389i__4 = j + j * a_dim1;17390d__1 = a[i__4].r;17391z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;17392z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;17393z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =17394alpha->r * temp2.i + alpha->i * temp2.r;17395z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;17396y[i__2].r = z__1.r, y[i__2].i = z__1.i;17397jx += *incx;17398jy += *incy;17399/* L80: */17400}17401}17402} else {1740317404/* Form y when A is stored in lower triangle. */1740517406if (*incx == 1 && *incy == 1) {17407i__1 = *n;17408for (j = 1; j <= i__1; ++j) {17409i__2 = j;17410z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =17411alpha->r * x[i__2].i + alpha->i * x[i__2].r;17412temp1.r = z__1.r, temp1.i = z__1.i;17413temp2.r = 0., temp2.i = 0.;17414i__2 = j;17415i__3 = j;17416i__4 = j + j * a_dim1;17417d__1 = a[i__4].r;17418z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;17419z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;17420y[i__2].r = z__1.r, y[i__2].i = z__1.i;17421i__2 = *n;17422for (i__ = j + 1; i__ <= i__2; ++i__) {17423i__3 = i__;17424i__4 = i__;17425i__5 = i__ + j * a_dim1;17426z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,17427z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]17428.r;17429z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;17430y[i__3].r = z__1.r, y[i__3].i = z__1.i;17431d_cnjg(&z__3, &a[i__ + j * a_dim1]);17432i__3 = i__;17433z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =17434z__3.r * x[i__3].i + z__3.i * x[i__3].r;17435z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;17436temp2.r = z__1.r, temp2.i = z__1.i;17437/* L90: */17438}17439i__2 = j;17440i__3 = j;17441z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =17442alpha->r * temp2.i + alpha->i * temp2.r;17443z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;17444y[i__2].r = z__1.r, y[i__2].i = z__1.i;17445/* L100: */17446}17447} else {17448jx = kx;17449jy = ky;17450i__1 = *n;17451for (j = 1; j <= i__1; ++j) {17452i__2 = jx;17453z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =17454alpha->r * x[i__2].i + alpha->i * x[i__2].r;17455temp1.r = z__1.r, temp1.i = z__1.i;17456temp2.r = 0., temp2.i = 0.;17457i__2 = jy;17458i__3 = jy;17459i__4 = j + j * a_dim1;17460d__1 = a[i__4].r;17461z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;17462z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;17463y[i__2].r = z__1.r, y[i__2].i = z__1.i;17464ix = jx;17465iy = jy;17466i__2 = *n;17467for (i__ = j + 1; i__ <= i__2; ++i__) {17468ix += *incx;17469iy += *incy;17470i__3 = iy;17471i__4 = iy;17472i__5 = i__ + j * a_dim1;17473z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,17474z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]17475.r;17476z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;17477y[i__3].r = z__1.r, y[i__3].i = z__1.i;17478d_cnjg(&z__3, &a[i__ + j * a_dim1]);17479i__3 = ix;17480z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =17481z__3.r * x[i__3].i + z__3.i * x[i__3].r;17482z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;17483temp2.r = z__1.r, temp2.i = z__1.i;17484/* L110: */17485}17486i__2 = jy;17487i__3 = jy;17488z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =17489alpha->r * temp2.i + alpha->i * temp2.r;17490z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;17491y[i__2].r = z__1.r, y[i__2].i = z__1.i;17492jx += *incx;17493jy += *incy;17494/* L120: */17495}17496}17497}1749817499return 0;1750017501/* End of ZHEMV . */1750217503} /* zhemv_ */1750417505/* Subroutine */ int zher2_(char *uplo, integer *n, doublecomplex *alpha,17506doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,17507doublecomplex *a, integer *lda)17508{17509/* System generated locals */17510integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;17511doublereal d__1;17512doublecomplex z__1, z__2, z__3, z__4;1751317514/* Local variables */17515static integer i__, j, ix, iy, jx, jy, kx, ky, info;17516static doublecomplex temp1, temp2;17517extern logical lsame_(char *, char *);17518extern /* Subroutine */ int xerbla_(char *, integer *);175191752017521/*17522Purpose17523=======1752417525ZHER2 performs the hermitian rank 2 operation1752617527A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,1752817529where alpha is a scalar, x and y are n element vectors and A is an n17530by n hermitian matrix.1753117532Arguments17533==========1753417535UPLO - CHARACTER*1.17536On entry, UPLO specifies whether the upper or lower17537triangular part of the array A is to be referenced as17538follows:1753917540UPLO = 'U' or 'u' Only the upper triangular part of A17541is to be referenced.1754217543UPLO = 'L' or 'l' Only the lower triangular part of A17544is to be referenced.1754517546Unchanged on exit.1754717548N - INTEGER.17549On entry, N specifies the order of the matrix A.17550N must be at least zero.17551Unchanged on exit.1755217553ALPHA - COMPLEX*16 .17554On entry, ALPHA specifies the scalar alpha.17555Unchanged on exit.1755617557X - COMPLEX*16 array of dimension at least17558( 1 + ( n - 1 )*abs( INCX ) ).17559Before entry, the incremented array X must contain the n17560element vector x.17561Unchanged on exit.1756217563INCX - INTEGER.17564On entry, INCX specifies the increment for the elements of17565X. INCX must not be zero.17566Unchanged on exit.1756717568Y - COMPLEX*16 array of dimension at least17569( 1 + ( n - 1 )*abs( INCY ) ).17570Before entry, the incremented array Y must contain the n17571element vector y.17572Unchanged on exit.1757317574INCY - INTEGER.17575On entry, INCY specifies the increment for the elements of17576Y. INCY must not be zero.17577Unchanged on exit.1757817579A - COMPLEX*16 array of DIMENSION ( LDA, n ).17580Before entry with UPLO = 'U' or 'u', the leading n by n17581upper triangular part of the array A must contain the upper17582triangular part of the hermitian matrix and the strictly17583lower triangular part of A is not referenced. On exit, the17584upper triangular part of the array A is overwritten by the17585upper triangular part of the updated matrix.17586Before entry with UPLO = 'L' or 'l', the leading n by n17587lower triangular part of the array A must contain the lower17588triangular part of the hermitian matrix and the strictly17589upper triangular part of A is not referenced. On exit, the17590lower triangular part of the array A is overwritten by the17591lower triangular part of the updated matrix.17592Note that the imaginary parts of the diagonal elements need17593not be set, they are assumed to be zero, and on exit they17594are set to zero.1759517596LDA - INTEGER.17597On entry, LDA specifies the first dimension of A as declared17598in the calling (sub) program. LDA must be at least17599max( 1, n ).17600Unchanged on exit.1760117602Further Details17603===============1760417605Level 2 Blas routine.1760617607-- Written on 22-October-1986.17608Jack Dongarra, Argonne National Lab.17609Jeremy Du Croz, Nag Central Office.17610Sven Hammarling, Nag Central Office.17611Richard Hanson, Sandia National Labs.1761217613=====================================================================176141761517616Test the input parameters.17617*/1761817619/* Parameter adjustments */17620--x;17621--y;17622a_dim1 = *lda;17623a_offset = 1 + a_dim1;17624a -= a_offset;1762517626/* Function Body */17627info = 0;17628if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {17629info = 1;17630} else if (*n < 0) {17631info = 2;17632} else if (*incx == 0) {17633info = 5;17634} else if (*incy == 0) {17635info = 7;17636} else if (*lda < max(1,*n)) {17637info = 9;17638}17639if (info != 0) {17640xerbla_("ZHER2 ", &info);17641return 0;17642}1764317644/* Quick return if possible. */1764517646if (*n == 0 || alpha->r == 0. && alpha->i == 0.) {17647return 0;17648}1764917650/*17651Set up the start points in X and Y if the increments are not both17652unity.17653*/1765417655if (*incx != 1 || *incy != 1) {17656if (*incx > 0) {17657kx = 1;17658} else {17659kx = 1 - (*n - 1) * *incx;17660}17661if (*incy > 0) {17662ky = 1;17663} else {17664ky = 1 - (*n - 1) * *incy;17665}17666jx = kx;17667jy = ky;17668}1766917670/*17671Start the operations. In this version the elements of A are17672accessed sequentially with one pass through the triangular part17673of A.17674*/1767517676if (lsame_(uplo, "U")) {1767717678/* Form A when A is stored in the upper triangle. */1767917680if (*incx == 1 && *incy == 1) {17681i__1 = *n;17682for (j = 1; j <= i__1; ++j) {17683i__2 = j;17684i__3 = j;17685if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||17686y[i__3].i != 0.)) {17687d_cnjg(&z__2, &y[j]);17688z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =17689alpha->r * z__2.i + alpha->i * z__2.r;17690temp1.r = z__1.r, temp1.i = z__1.i;17691i__2 = j;17692z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,17693z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]17694.r;17695d_cnjg(&z__1, &z__2);17696temp2.r = z__1.r, temp2.i = z__1.i;17697i__2 = j - 1;17698for (i__ = 1; i__ <= i__2; ++i__) {17699i__3 = i__ + j * a_dim1;17700i__4 = i__ + j * a_dim1;17701i__5 = i__;17702z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,17703z__3.i = x[i__5].r * temp1.i + x[i__5].i *17704temp1.r;17705z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +17706z__3.i;17707i__6 = i__;17708z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,17709z__4.i = y[i__6].r * temp2.i + y[i__6].i *17710temp2.r;17711z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;17712a[i__3].r = z__1.r, a[i__3].i = z__1.i;17713/* L10: */17714}17715i__2 = j + j * a_dim1;17716i__3 = j + j * a_dim1;17717i__4 = j;17718z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,17719z__2.i = x[i__4].r * temp1.i + x[i__4].i *17720temp1.r;17721i__5 = j;17722z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,17723z__3.i = y[i__5].r * temp2.i + y[i__5].i *17724temp2.r;17725z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;17726d__1 = a[i__3].r + z__1.r;17727a[i__2].r = d__1, a[i__2].i = 0.;17728} else {17729i__2 = j + j * a_dim1;17730i__3 = j + j * a_dim1;17731d__1 = a[i__3].r;17732a[i__2].r = d__1, a[i__2].i = 0.;17733}17734/* L20: */17735}17736} else {17737i__1 = *n;17738for (j = 1; j <= i__1; ++j) {17739i__2 = jx;17740i__3 = jy;17741if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||17742y[i__3].i != 0.)) {17743d_cnjg(&z__2, &y[jy]);17744z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =17745alpha->r * z__2.i + alpha->i * z__2.r;17746temp1.r = z__1.r, temp1.i = z__1.i;17747i__2 = jx;17748z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,17749z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]17750.r;17751d_cnjg(&z__1, &z__2);17752temp2.r = z__1.r, temp2.i = z__1.i;17753ix = kx;17754iy = ky;17755i__2 = j - 1;17756for (i__ = 1; i__ <= i__2; ++i__) {17757i__3 = i__ + j * a_dim1;17758i__4 = i__ + j * a_dim1;17759i__5 = ix;17760z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,17761z__3.i = x[i__5].r * temp1.i + x[i__5].i *17762temp1.r;17763z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +17764z__3.i;17765i__6 = iy;17766z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,17767z__4.i = y[i__6].r * temp2.i + y[i__6].i *17768temp2.r;17769z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;17770a[i__3].r = z__1.r, a[i__3].i = z__1.i;17771ix += *incx;17772iy += *incy;17773/* L30: */17774}17775i__2 = j + j * a_dim1;17776i__3 = j + j * a_dim1;17777i__4 = jx;17778z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,17779z__2.i = x[i__4].r * temp1.i + x[i__4].i *17780temp1.r;17781i__5 = jy;17782z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,17783z__3.i = y[i__5].r * temp2.i + y[i__5].i *17784temp2.r;17785z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;17786d__1 = a[i__3].r + z__1.r;17787a[i__2].r = d__1, a[i__2].i = 0.;17788} else {17789i__2 = j + j * a_dim1;17790i__3 = j + j * a_dim1;17791d__1 = a[i__3].r;17792a[i__2].r = d__1, a[i__2].i = 0.;17793}17794jx += *incx;17795jy += *incy;17796/* L40: */17797}17798}17799} else {1780017801/* Form A when A is stored in the lower triangle. */1780217803if (*incx == 1 && *incy == 1) {17804i__1 = *n;17805for (j = 1; j <= i__1; ++j) {17806i__2 = j;17807i__3 = j;17808if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||17809y[i__3].i != 0.)) {17810d_cnjg(&z__2, &y[j]);17811z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =17812alpha->r * z__2.i + alpha->i * z__2.r;17813temp1.r = z__1.r, temp1.i = z__1.i;17814i__2 = j;17815z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,17816z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]17817.r;17818d_cnjg(&z__1, &z__2);17819temp2.r = z__1.r, temp2.i = z__1.i;17820i__2 = j + j * a_dim1;17821i__3 = j + j * a_dim1;17822i__4 = j;17823z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,17824z__2.i = x[i__4].r * temp1.i + x[i__4].i *17825temp1.r;17826i__5 = j;17827z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,17828z__3.i = y[i__5].r * temp2.i + y[i__5].i *17829temp2.r;17830z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;17831d__1 = a[i__3].r + z__1.r;17832a[i__2].r = d__1, a[i__2].i = 0.;17833i__2 = *n;17834for (i__ = j + 1; i__ <= i__2; ++i__) {17835i__3 = i__ + j * a_dim1;17836i__4 = i__ + j * a_dim1;17837i__5 = i__;17838z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,17839z__3.i = x[i__5].r * temp1.i + x[i__5].i *17840temp1.r;17841z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +17842z__3.i;17843i__6 = i__;17844z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,17845z__4.i = y[i__6].r * temp2.i + y[i__6].i *17846temp2.r;17847z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;17848a[i__3].r = z__1.r, a[i__3].i = z__1.i;17849/* L50: */17850}17851} else {17852i__2 = j + j * a_dim1;17853i__3 = j + j * a_dim1;17854d__1 = a[i__3].r;17855a[i__2].r = d__1, a[i__2].i = 0.;17856}17857/* L60: */17858}17859} else {17860i__1 = *n;17861for (j = 1; j <= i__1; ++j) {17862i__2 = jx;17863i__3 = jy;17864if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||17865y[i__3].i != 0.)) {17866d_cnjg(&z__2, &y[jy]);17867z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =17868alpha->r * z__2.i + alpha->i * z__2.r;17869temp1.r = z__1.r, temp1.i = z__1.i;17870i__2 = jx;17871z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,17872z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]17873.r;17874d_cnjg(&z__1, &z__2);17875temp2.r = z__1.r, temp2.i = z__1.i;17876i__2 = j + j * a_dim1;17877i__3 = j + j * a_dim1;17878i__4 = jx;17879z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,17880z__2.i = x[i__4].r * temp1.i + x[i__4].i *17881temp1.r;17882i__5 = jy;17883z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,17884z__3.i = y[i__5].r * temp2.i + y[i__5].i *17885temp2.r;17886z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;17887d__1 = a[i__3].r + z__1.r;17888a[i__2].r = d__1, a[i__2].i = 0.;17889ix = jx;17890iy = jy;17891i__2 = *n;17892for (i__ = j + 1; i__ <= i__2; ++i__) {17893ix += *incx;17894iy += *incy;17895i__3 = i__ + j * a_dim1;17896i__4 = i__ + j * a_dim1;17897i__5 = ix;17898z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,17899z__3.i = x[i__5].r * temp1.i + x[i__5].i *17900temp1.r;17901z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +17902z__3.i;17903i__6 = iy;17904z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,17905z__4.i = y[i__6].r * temp2.i + y[i__6].i *17906temp2.r;17907z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;17908a[i__3].r = z__1.r, a[i__3].i = z__1.i;17909/* L70: */17910}17911} else {17912i__2 = j + j * a_dim1;17913i__3 = j + j * a_dim1;17914d__1 = a[i__3].r;17915a[i__2].r = d__1, a[i__2].i = 0.;17916}17917jx += *incx;17918jy += *incy;17919/* L80: */17920}17921}17922}1792317924return 0;1792517926/* End of ZHER2 . */1792717928} /* zher2_ */1792917930/* Subroutine */ int zher2k_(char *uplo, char *trans, integer *n, integer *k,17931doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *17932b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc)17933{17934/* System generated locals */17935integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,17936i__3, i__4, i__5, i__6, i__7;17937doublereal d__1;17938doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;1793917940/* Local variables */17941static integer i__, j, l, info;17942static doublecomplex temp1, temp2;17943extern logical lsame_(char *, char *);17944static integer nrowa;17945static logical upper;17946extern /* Subroutine */ int xerbla_(char *, integer *);179471794817949/*17950Purpose17951=======1795217953ZHER2K performs one of the hermitian rank 2k operations1795417955C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + beta*C,1795617957or1795817959C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + beta*C,1796017961where alpha and beta are scalars with beta real, C is an n by n17962hermitian matrix and A and B are n by k matrices in the first case17963and k by n matrices in the second case.1796417965Arguments17966==========1796717968UPLO - CHARACTER*1.17969On entry, UPLO specifies whether the upper or lower17970triangular part of the array C is to be referenced as17971follows:1797217973UPLO = 'U' or 'u' Only the upper triangular part of C17974is to be referenced.1797517976UPLO = 'L' or 'l' Only the lower triangular part of C17977is to be referenced.1797817979Unchanged on exit.1798017981TRANS - CHARACTER*1.17982On entry, TRANS specifies the operation to be performed as17983follows:1798417985TRANS = 'N' or 'n' C := alpha*A*conjg( B' ) +17986conjg( alpha )*B*conjg( A' ) +17987beta*C.1798817989TRANS = 'C' or 'c' C := alpha*conjg( A' )*B +17990conjg( alpha )*conjg( B' )*A +17991beta*C.1799217993Unchanged on exit.1799417995N - INTEGER.17996On entry, N specifies the order of the matrix C. N must be17997at least zero.17998Unchanged on exit.1799918000K - INTEGER.18001On entry with TRANS = 'N' or 'n', K specifies the number18002of columns of the matrices A and B, and on entry with18003TRANS = 'C' or 'c', K specifies the number of rows of the18004matrices A and B. K must be at least zero.18005Unchanged on exit.1800618007ALPHA - COMPLEX*16 .18008On entry, ALPHA specifies the scalar alpha.18009Unchanged on exit.1801018011A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is18012k when TRANS = 'N' or 'n', and is n otherwise.18013Before entry with TRANS = 'N' or 'n', the leading n by k18014part of the array A must contain the matrix A, otherwise18015the leading k by n part of the array A must contain the18016matrix A.18017Unchanged on exit.1801818019LDA - INTEGER.18020On entry, LDA specifies the first dimension of A as declared18021in the calling (sub) program. When TRANS = 'N' or 'n'18022then LDA must be at least max( 1, n ), otherwise LDA must18023be at least max( 1, k ).18024Unchanged on exit.1802518026B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is18027k when TRANS = 'N' or 'n', and is n otherwise.18028Before entry with TRANS = 'N' or 'n', the leading n by k18029part of the array B must contain the matrix B, otherwise18030the leading k by n part of the array B must contain the18031matrix B.18032Unchanged on exit.1803318034LDB - INTEGER.18035On entry, LDB specifies the first dimension of B as declared18036in the calling (sub) program. When TRANS = 'N' or 'n'18037then LDB must be at least max( 1, n ), otherwise LDB must18038be at least max( 1, k ).18039Unchanged on exit.1804018041BETA - DOUBLE PRECISION .18042On entry, BETA specifies the scalar beta.18043Unchanged on exit.1804418045C - COMPLEX*16 array of DIMENSION ( LDC, n ).18046Before entry with UPLO = 'U' or 'u', the leading n by n18047upper triangular part of the array C must contain the upper18048triangular part of the hermitian matrix and the strictly18049lower triangular part of C is not referenced. On exit, the18050upper triangular part of the array C is overwritten by the18051upper triangular part of the updated matrix.18052Before entry with UPLO = 'L' or 'l', the leading n by n18053lower triangular part of the array C must contain the lower18054triangular part of the hermitian matrix and the strictly18055upper triangular part of C is not referenced. On exit, the18056lower triangular part of the array C is overwritten by the18057lower triangular part of the updated matrix.18058Note that the imaginary parts of the diagonal elements need18059not be set, they are assumed to be zero, and on exit they18060are set to zero.1806118062LDC - INTEGER.18063On entry, LDC specifies the first dimension of C as declared18064in the calling (sub) program. LDC must be at least18065max( 1, n ).18066Unchanged on exit.1806718068Further Details18069===============1807018071Level 3 Blas routine.1807218073-- Written on 8-February-1989.18074Jack Dongarra, Argonne National Laboratory.18075Iain Duff, AERE Harwell.18076Jeremy Du Croz, Numerical Algorithms Group Ltd.18077Sven Hammarling, Numerical Algorithms Group Ltd.1807818079-- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.18080Ed Anderson, Cray Research Inc.1808118082=====================================================================180831808418085Test the input parameters.18086*/1808718088/* Parameter adjustments */18089a_dim1 = *lda;18090a_offset = 1 + a_dim1;18091a -= a_offset;18092b_dim1 = *ldb;18093b_offset = 1 + b_dim1;18094b -= b_offset;18095c_dim1 = *ldc;18096c_offset = 1 + c_dim1;18097c__ -= c_offset;1809818099/* Function Body */18100if (lsame_(trans, "N")) {18101nrowa = *n;18102} else {18103nrowa = *k;18104}18105upper = lsame_(uplo, "U");1810618107info = 0;18108if (! upper && ! lsame_(uplo, "L")) {18109info = 1;18110} else if (! lsame_(trans, "N") && ! lsame_(trans,18111"C")) {18112info = 2;18113} else if (*n < 0) {18114info = 3;18115} else if (*k < 0) {18116info = 4;18117} else if (*lda < max(1,nrowa)) {18118info = 7;18119} else if (*ldb < max(1,nrowa)) {18120info = 9;18121} else if (*ldc < max(1,*n)) {18122info = 12;18123}18124if (info != 0) {18125xerbla_("ZHER2K", &info);18126return 0;18127}1812818129/* Quick return if possible. */1813018131if (*n == 0 || (alpha->r == 0. && alpha->i == 0. || *k == 0) && *beta ==181321.) {18133return 0;18134}1813518136/* And when alpha.eq.zero. */1813718138if (alpha->r == 0. && alpha->i == 0.) {18139if (upper) {18140if (*beta == 0.) {18141i__1 = *n;18142for (j = 1; j <= i__1; ++j) {18143i__2 = j;18144for (i__ = 1; i__ <= i__2; ++i__) {18145i__3 = i__ + j * c_dim1;18146c__[i__3].r = 0., c__[i__3].i = 0.;18147/* L10: */18148}18149/* L20: */18150}18151} else {18152i__1 = *n;18153for (j = 1; j <= i__1; ++j) {18154i__2 = j - 1;18155for (i__ = 1; i__ <= i__2; ++i__) {18156i__3 = i__ + j * c_dim1;18157i__4 = i__ + j * c_dim1;18158z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18159i__4].i;18160c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18161/* L30: */18162}18163i__2 = j + j * c_dim1;18164i__3 = j + j * c_dim1;18165d__1 = *beta * c__[i__3].r;18166c__[i__2].r = d__1, c__[i__2].i = 0.;18167/* L40: */18168}18169}18170} else {18171if (*beta == 0.) {18172i__1 = *n;18173for (j = 1; j <= i__1; ++j) {18174i__2 = *n;18175for (i__ = j; i__ <= i__2; ++i__) {18176i__3 = i__ + j * c_dim1;18177c__[i__3].r = 0., c__[i__3].i = 0.;18178/* L50: */18179}18180/* L60: */18181}18182} else {18183i__1 = *n;18184for (j = 1; j <= i__1; ++j) {18185i__2 = j + j * c_dim1;18186i__3 = j + j * c_dim1;18187d__1 = *beta * c__[i__3].r;18188c__[i__2].r = d__1, c__[i__2].i = 0.;18189i__2 = *n;18190for (i__ = j + 1; i__ <= i__2; ++i__) {18191i__3 = i__ + j * c_dim1;18192i__4 = i__ + j * c_dim1;18193z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18194i__4].i;18195c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18196/* L70: */18197}18198/* L80: */18199}18200}18201}18202return 0;18203}1820418205/* Start the operations. */1820618207if (lsame_(trans, "N")) {1820818209/*18210Form C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) +18211C.18212*/1821318214if (upper) {18215i__1 = *n;18216for (j = 1; j <= i__1; ++j) {18217if (*beta == 0.) {18218i__2 = j;18219for (i__ = 1; i__ <= i__2; ++i__) {18220i__3 = i__ + j * c_dim1;18221c__[i__3].r = 0., c__[i__3].i = 0.;18222/* L90: */18223}18224} else if (*beta != 1.) {18225i__2 = j - 1;18226for (i__ = 1; i__ <= i__2; ++i__) {18227i__3 = i__ + j * c_dim1;18228i__4 = i__ + j * c_dim1;18229z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18230i__4].i;18231c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18232/* L100: */18233}18234i__2 = j + j * c_dim1;18235i__3 = j + j * c_dim1;18236d__1 = *beta * c__[i__3].r;18237c__[i__2].r = d__1, c__[i__2].i = 0.;18238} else {18239i__2 = j + j * c_dim1;18240i__3 = j + j * c_dim1;18241d__1 = c__[i__3].r;18242c__[i__2].r = d__1, c__[i__2].i = 0.;18243}18244i__2 = *k;18245for (l = 1; l <= i__2; ++l) {18246i__3 = j + l * a_dim1;18247i__4 = j + l * b_dim1;18248if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=182490. || b[i__4].i != 0.)) {18250d_cnjg(&z__2, &b[j + l * b_dim1]);18251z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,18252z__1.i = alpha->r * z__2.i + alpha->i *18253z__2.r;18254temp1.r = z__1.r, temp1.i = z__1.i;18255i__3 = j + l * a_dim1;18256z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,18257z__2.i = alpha->r * a[i__3].i + alpha->i * a[18258i__3].r;18259d_cnjg(&z__1, &z__2);18260temp2.r = z__1.r, temp2.i = z__1.i;18261i__3 = j - 1;18262for (i__ = 1; i__ <= i__3; ++i__) {18263i__4 = i__ + j * c_dim1;18264i__5 = i__ + j * c_dim1;18265i__6 = i__ + l * a_dim1;18266z__3.r = a[i__6].r * temp1.r - a[i__6].i *18267temp1.i, z__3.i = a[i__6].r * temp1.i + a[18268i__6].i * temp1.r;18269z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]18270.i + z__3.i;18271i__7 = i__ + l * b_dim1;18272z__4.r = b[i__7].r * temp2.r - b[i__7].i *18273temp2.i, z__4.i = b[i__7].r * temp2.i + b[18274i__7].i * temp2.r;18275z__1.r = z__2.r + z__4.r, z__1.i = z__2.i +18276z__4.i;18277c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;18278/* L110: */18279}18280i__3 = j + j * c_dim1;18281i__4 = j + j * c_dim1;18282i__5 = j + l * a_dim1;18283z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,18284z__2.i = a[i__5].r * temp1.i + a[i__5].i *18285temp1.r;18286i__6 = j + l * b_dim1;18287z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,18288z__3.i = b[i__6].r * temp2.i + b[i__6].i *18289temp2.r;18290z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;18291d__1 = c__[i__4].r + z__1.r;18292c__[i__3].r = d__1, c__[i__3].i = 0.;18293}18294/* L120: */18295}18296/* L130: */18297}18298} else {18299i__1 = *n;18300for (j = 1; j <= i__1; ++j) {18301if (*beta == 0.) {18302i__2 = *n;18303for (i__ = j; i__ <= i__2; ++i__) {18304i__3 = i__ + j * c_dim1;18305c__[i__3].r = 0., c__[i__3].i = 0.;18306/* L140: */18307}18308} else if (*beta != 1.) {18309i__2 = *n;18310for (i__ = j + 1; i__ <= i__2; ++i__) {18311i__3 = i__ + j * c_dim1;18312i__4 = i__ + j * c_dim1;18313z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18314i__4].i;18315c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18316/* L150: */18317}18318i__2 = j + j * c_dim1;18319i__3 = j + j * c_dim1;18320d__1 = *beta * c__[i__3].r;18321c__[i__2].r = d__1, c__[i__2].i = 0.;18322} else {18323i__2 = j + j * c_dim1;18324i__3 = j + j * c_dim1;18325d__1 = c__[i__3].r;18326c__[i__2].r = d__1, c__[i__2].i = 0.;18327}18328i__2 = *k;18329for (l = 1; l <= i__2; ++l) {18330i__3 = j + l * a_dim1;18331i__4 = j + l * b_dim1;18332if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=183330. || b[i__4].i != 0.)) {18334d_cnjg(&z__2, &b[j + l * b_dim1]);18335z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,18336z__1.i = alpha->r * z__2.i + alpha->i *18337z__2.r;18338temp1.r = z__1.r, temp1.i = z__1.i;18339i__3 = j + l * a_dim1;18340z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,18341z__2.i = alpha->r * a[i__3].i + alpha->i * a[18342i__3].r;18343d_cnjg(&z__1, &z__2);18344temp2.r = z__1.r, temp2.i = z__1.i;18345i__3 = *n;18346for (i__ = j + 1; i__ <= i__3; ++i__) {18347i__4 = i__ + j * c_dim1;18348i__5 = i__ + j * c_dim1;18349i__6 = i__ + l * a_dim1;18350z__3.r = a[i__6].r * temp1.r - a[i__6].i *18351temp1.i, z__3.i = a[i__6].r * temp1.i + a[18352i__6].i * temp1.r;18353z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]18354.i + z__3.i;18355i__7 = i__ + l * b_dim1;18356z__4.r = b[i__7].r * temp2.r - b[i__7].i *18357temp2.i, z__4.i = b[i__7].r * temp2.i + b[18358i__7].i * temp2.r;18359z__1.r = z__2.r + z__4.r, z__1.i = z__2.i +18360z__4.i;18361c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;18362/* L160: */18363}18364i__3 = j + j * c_dim1;18365i__4 = j + j * c_dim1;18366i__5 = j + l * a_dim1;18367z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,18368z__2.i = a[i__5].r * temp1.i + a[i__5].i *18369temp1.r;18370i__6 = j + l * b_dim1;18371z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,18372z__3.i = b[i__6].r * temp2.i + b[i__6].i *18373temp2.r;18374z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;18375d__1 = c__[i__4].r + z__1.r;18376c__[i__3].r = d__1, c__[i__3].i = 0.;18377}18378/* L170: */18379}18380/* L180: */18381}18382}18383} else {1838418385/*18386Form C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A +18387C.18388*/1838918390if (upper) {18391i__1 = *n;18392for (j = 1; j <= i__1; ++j) {18393i__2 = j;18394for (i__ = 1; i__ <= i__2; ++i__) {18395temp1.r = 0., temp1.i = 0.;18396temp2.r = 0., temp2.i = 0.;18397i__3 = *k;18398for (l = 1; l <= i__3; ++l) {18399d_cnjg(&z__3, &a[l + i__ * a_dim1]);18400i__4 = l + j * b_dim1;18401z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,18402z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]18403.r;18404z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;18405temp1.r = z__1.r, temp1.i = z__1.i;18406d_cnjg(&z__3, &b[l + i__ * b_dim1]);18407i__4 = l + j * a_dim1;18408z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,18409z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]18410.r;18411z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;18412temp2.r = z__1.r, temp2.i = z__1.i;18413/* L190: */18414}18415if (i__ == j) {18416if (*beta == 0.) {18417i__3 = j + j * c_dim1;18418z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,18419z__2.i = alpha->r * temp1.i + alpha->i *18420temp1.r;18421d_cnjg(&z__4, alpha);18422z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,18423z__3.i = z__4.r * temp2.i + z__4.i *18424temp2.r;18425z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +18426z__3.i;18427d__1 = z__1.r;18428c__[i__3].r = d__1, c__[i__3].i = 0.;18429} else {18430i__3 = j + j * c_dim1;18431i__4 = j + j * c_dim1;18432z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,18433z__2.i = alpha->r * temp1.i + alpha->i *18434temp1.r;18435d_cnjg(&z__4, alpha);18436z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,18437z__3.i = z__4.r * temp2.i + z__4.i *18438temp2.r;18439z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +18440z__3.i;18441d__1 = *beta * c__[i__4].r + z__1.r;18442c__[i__3].r = d__1, c__[i__3].i = 0.;18443}18444} else {18445if (*beta == 0.) {18446i__3 = i__ + j * c_dim1;18447z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,18448z__2.i = alpha->r * temp1.i + alpha->i *18449temp1.r;18450d_cnjg(&z__4, alpha);18451z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,18452z__3.i = z__4.r * temp2.i + z__4.i *18453temp2.r;18454z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +18455z__3.i;18456c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18457} else {18458i__3 = i__ + j * c_dim1;18459i__4 = i__ + j * c_dim1;18460z__3.r = *beta * c__[i__4].r, z__3.i = *beta *18461c__[i__4].i;18462z__4.r = alpha->r * temp1.r - alpha->i * temp1.i,18463z__4.i = alpha->r * temp1.i + alpha->i *18464temp1.r;18465z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +18466z__4.i;18467d_cnjg(&z__6, alpha);18468z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,18469z__5.i = z__6.r * temp2.i + z__6.i *18470temp2.r;18471z__1.r = z__2.r + z__5.r, z__1.i = z__2.i +18472z__5.i;18473c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18474}18475}18476/* L200: */18477}18478/* L210: */18479}18480} else {18481i__1 = *n;18482for (j = 1; j <= i__1; ++j) {18483i__2 = *n;18484for (i__ = j; i__ <= i__2; ++i__) {18485temp1.r = 0., temp1.i = 0.;18486temp2.r = 0., temp2.i = 0.;18487i__3 = *k;18488for (l = 1; l <= i__3; ++l) {18489d_cnjg(&z__3, &a[l + i__ * a_dim1]);18490i__4 = l + j * b_dim1;18491z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,18492z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]18493.r;18494z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;18495temp1.r = z__1.r, temp1.i = z__1.i;18496d_cnjg(&z__3, &b[l + i__ * b_dim1]);18497i__4 = l + j * a_dim1;18498z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,18499z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]18500.r;18501z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;18502temp2.r = z__1.r, temp2.i = z__1.i;18503/* L220: */18504}18505if (i__ == j) {18506if (*beta == 0.) {18507i__3 = j + j * c_dim1;18508z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,18509z__2.i = alpha->r * temp1.i + alpha->i *18510temp1.r;18511d_cnjg(&z__4, alpha);18512z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,18513z__3.i = z__4.r * temp2.i + z__4.i *18514temp2.r;18515z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +18516z__3.i;18517d__1 = z__1.r;18518c__[i__3].r = d__1, c__[i__3].i = 0.;18519} else {18520i__3 = j + j * c_dim1;18521i__4 = j + j * c_dim1;18522z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,18523z__2.i = alpha->r * temp1.i + alpha->i *18524temp1.r;18525d_cnjg(&z__4, alpha);18526z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,18527z__3.i = z__4.r * temp2.i + z__4.i *18528temp2.r;18529z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +18530z__3.i;18531d__1 = *beta * c__[i__4].r + z__1.r;18532c__[i__3].r = d__1, c__[i__3].i = 0.;18533}18534} else {18535if (*beta == 0.) {18536i__3 = i__ + j * c_dim1;18537z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,18538z__2.i = alpha->r * temp1.i + alpha->i *18539temp1.r;18540d_cnjg(&z__4, alpha);18541z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,18542z__3.i = z__4.r * temp2.i + z__4.i *18543temp2.r;18544z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +18545z__3.i;18546c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18547} else {18548i__3 = i__ + j * c_dim1;18549i__4 = i__ + j * c_dim1;18550z__3.r = *beta * c__[i__4].r, z__3.i = *beta *18551c__[i__4].i;18552z__4.r = alpha->r * temp1.r - alpha->i * temp1.i,18553z__4.i = alpha->r * temp1.i + alpha->i *18554temp1.r;18555z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +18556z__4.i;18557d_cnjg(&z__6, alpha);18558z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,18559z__5.i = z__6.r * temp2.i + z__6.i *18560temp2.r;18561z__1.r = z__2.r + z__5.r, z__1.i = z__2.i +18562z__5.i;18563c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18564}18565}18566/* L230: */18567}18568/* L240: */18569}18570}18571}1857218573return 0;1857418575/* End of ZHER2K. */1857618577} /* zher2k_ */1857818579/* Subroutine */ int zherk_(char *uplo, char *trans, integer *n, integer *k,18580doublereal *alpha, doublecomplex *a, integer *lda, doublereal *beta,18581doublecomplex *c__, integer *ldc)18582{18583/* System generated locals */18584integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5,18585i__6;18586doublereal d__1;18587doublecomplex z__1, z__2, z__3;1858818589/* Local variables */18590static integer i__, j, l, info;18591static doublecomplex temp;18592extern logical lsame_(char *, char *);18593static integer nrowa;18594static doublereal rtemp;18595static logical upper;18596extern /* Subroutine */ int xerbla_(char *, integer *);185971859818599/*18600Purpose18601=======1860218603ZHERK performs one of the hermitian rank k operations1860418605C := alpha*A*conjg( A' ) + beta*C,1860618607or1860818609C := alpha*conjg( A' )*A + beta*C,1861018611where alpha and beta are real scalars, C is an n by n hermitian18612matrix and A is an n by k matrix in the first case and a k by n18613matrix in the second case.1861418615Arguments18616==========1861718618UPLO - CHARACTER*1.18619On entry, UPLO specifies whether the upper or lower18620triangular part of the array C is to be referenced as18621follows:1862218623UPLO = 'U' or 'u' Only the upper triangular part of C18624is to be referenced.1862518626UPLO = 'L' or 'l' Only the lower triangular part of C18627is to be referenced.1862818629Unchanged on exit.1863018631TRANS - CHARACTER*1.18632On entry, TRANS specifies the operation to be performed as18633follows:1863418635TRANS = 'N' or 'n' C := alpha*A*conjg( A' ) + beta*C.1863618637TRANS = 'C' or 'c' C := alpha*conjg( A' )*A + beta*C.1863818639Unchanged on exit.1864018641N - INTEGER.18642On entry, N specifies the order of the matrix C. N must be18643at least zero.18644Unchanged on exit.1864518646K - INTEGER.18647On entry with TRANS = 'N' or 'n', K specifies the number18648of columns of the matrix A, and on entry with18649TRANS = 'C' or 'c', K specifies the number of rows of the18650matrix A. K must be at least zero.18651Unchanged on exit.1865218653ALPHA - DOUBLE PRECISION .18654On entry, ALPHA specifies the scalar alpha.18655Unchanged on exit.1865618657A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is18658k when TRANS = 'N' or 'n', and is n otherwise.18659Before entry with TRANS = 'N' or 'n', the leading n by k18660part of the array A must contain the matrix A, otherwise18661the leading k by n part of the array A must contain the18662matrix A.18663Unchanged on exit.1866418665LDA - INTEGER.18666On entry, LDA specifies the first dimension of A as declared18667in the calling (sub) program. When TRANS = 'N' or 'n'18668then LDA must be at least max( 1, n ), otherwise LDA must18669be at least max( 1, k ).18670Unchanged on exit.1867118672BETA - DOUBLE PRECISION.18673On entry, BETA specifies the scalar beta.18674Unchanged on exit.1867518676C - COMPLEX*16 array of DIMENSION ( LDC, n ).18677Before entry with UPLO = 'U' or 'u', the leading n by n18678upper triangular part of the array C must contain the upper18679triangular part of the hermitian matrix and the strictly18680lower triangular part of C is not referenced. On exit, the18681upper triangular part of the array C is overwritten by the18682upper triangular part of the updated matrix.18683Before entry with UPLO = 'L' or 'l', the leading n by n18684lower triangular part of the array C must contain the lower18685triangular part of the hermitian matrix and the strictly18686upper triangular part of C is not referenced. On exit, the18687lower triangular part of the array C is overwritten by the18688lower triangular part of the updated matrix.18689Note that the imaginary parts of the diagonal elements need18690not be set, they are assumed to be zero, and on exit they18691are set to zero.1869218693LDC - INTEGER.18694On entry, LDC specifies the first dimension of C as declared18695in the calling (sub) program. LDC must be at least18696max( 1, n ).18697Unchanged on exit.1869818699Further Details18700===============1870118702Level 3 Blas routine.1870318704-- Written on 8-February-1989.18705Jack Dongarra, Argonne National Laboratory.18706Iain Duff, AERE Harwell.18707Jeremy Du Croz, Numerical Algorithms Group Ltd.18708Sven Hammarling, Numerical Algorithms Group Ltd.1870918710-- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.18711Ed Anderson, Cray Research Inc.1871218713=====================================================================187141871518716Test the input parameters.18717*/1871818719/* Parameter adjustments */18720a_dim1 = *lda;18721a_offset = 1 + a_dim1;18722a -= a_offset;18723c_dim1 = *ldc;18724c_offset = 1 + c_dim1;18725c__ -= c_offset;1872618727/* Function Body */18728if (lsame_(trans, "N")) {18729nrowa = *n;18730} else {18731nrowa = *k;18732}18733upper = lsame_(uplo, "U");1873418735info = 0;18736if (! upper && ! lsame_(uplo, "L")) {18737info = 1;18738} else if (! lsame_(trans, "N") && ! lsame_(trans,18739"C")) {18740info = 2;18741} else if (*n < 0) {18742info = 3;18743} else if (*k < 0) {18744info = 4;18745} else if (*lda < max(1,nrowa)) {18746info = 7;18747} else if (*ldc < max(1,*n)) {18748info = 10;18749}18750if (info != 0) {18751xerbla_("ZHERK ", &info);18752return 0;18753}1875418755/* Quick return if possible. */1875618757if (*n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {18758return 0;18759}1876018761/* And when alpha.eq.zero. */1876218763if (*alpha == 0.) {18764if (upper) {18765if (*beta == 0.) {18766i__1 = *n;18767for (j = 1; j <= i__1; ++j) {18768i__2 = j;18769for (i__ = 1; i__ <= i__2; ++i__) {18770i__3 = i__ + j * c_dim1;18771c__[i__3].r = 0., c__[i__3].i = 0.;18772/* L10: */18773}18774/* L20: */18775}18776} else {18777i__1 = *n;18778for (j = 1; j <= i__1; ++j) {18779i__2 = j - 1;18780for (i__ = 1; i__ <= i__2; ++i__) {18781i__3 = i__ + j * c_dim1;18782i__4 = i__ + j * c_dim1;18783z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18784i__4].i;18785c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18786/* L30: */18787}18788i__2 = j + j * c_dim1;18789i__3 = j + j * c_dim1;18790d__1 = *beta * c__[i__3].r;18791c__[i__2].r = d__1, c__[i__2].i = 0.;18792/* L40: */18793}18794}18795} else {18796if (*beta == 0.) {18797i__1 = *n;18798for (j = 1; j <= i__1; ++j) {18799i__2 = *n;18800for (i__ = j; i__ <= i__2; ++i__) {18801i__3 = i__ + j * c_dim1;18802c__[i__3].r = 0., c__[i__3].i = 0.;18803/* L50: */18804}18805/* L60: */18806}18807} else {18808i__1 = *n;18809for (j = 1; j <= i__1; ++j) {18810i__2 = j + j * c_dim1;18811i__3 = j + j * c_dim1;18812d__1 = *beta * c__[i__3].r;18813c__[i__2].r = d__1, c__[i__2].i = 0.;18814i__2 = *n;18815for (i__ = j + 1; i__ <= i__2; ++i__) {18816i__3 = i__ + j * c_dim1;18817i__4 = i__ + j * c_dim1;18818z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18819i__4].i;18820c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18821/* L70: */18822}18823/* L80: */18824}18825}18826}18827return 0;18828}1882918830/* Start the operations. */1883118832if (lsame_(trans, "N")) {1883318834/* Form C := alpha*A*conjg( A' ) + beta*C. */1883518836if (upper) {18837i__1 = *n;18838for (j = 1; j <= i__1; ++j) {18839if (*beta == 0.) {18840i__2 = j;18841for (i__ = 1; i__ <= i__2; ++i__) {18842i__3 = i__ + j * c_dim1;18843c__[i__3].r = 0., c__[i__3].i = 0.;18844/* L90: */18845}18846} else if (*beta != 1.) {18847i__2 = j - 1;18848for (i__ = 1; i__ <= i__2; ++i__) {18849i__3 = i__ + j * c_dim1;18850i__4 = i__ + j * c_dim1;18851z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18852i__4].i;18853c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18854/* L100: */18855}18856i__2 = j + j * c_dim1;18857i__3 = j + j * c_dim1;18858d__1 = *beta * c__[i__3].r;18859c__[i__2].r = d__1, c__[i__2].i = 0.;18860} else {18861i__2 = j + j * c_dim1;18862i__3 = j + j * c_dim1;18863d__1 = c__[i__3].r;18864c__[i__2].r = d__1, c__[i__2].i = 0.;18865}18866i__2 = *k;18867for (l = 1; l <= i__2; ++l) {18868i__3 = j + l * a_dim1;18869if (a[i__3].r != 0. || a[i__3].i != 0.) {18870d_cnjg(&z__2, &a[j + l * a_dim1]);18871z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;18872temp.r = z__1.r, temp.i = z__1.i;18873i__3 = j - 1;18874for (i__ = 1; i__ <= i__3; ++i__) {18875i__4 = i__ + j * c_dim1;18876i__5 = i__ + j * c_dim1;18877i__6 = i__ + l * a_dim1;18878z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,18879z__2.i = temp.r * a[i__6].i + temp.i * a[18880i__6].r;18881z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]18882.i + z__2.i;18883c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;18884/* L110: */18885}18886i__3 = j + j * c_dim1;18887i__4 = j + j * c_dim1;18888i__5 = i__ + l * a_dim1;18889z__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,18890z__1.i = temp.r * a[i__5].i + temp.i * a[i__5]18891.r;18892d__1 = c__[i__4].r + z__1.r;18893c__[i__3].r = d__1, c__[i__3].i = 0.;18894}18895/* L120: */18896}18897/* L130: */18898}18899} else {18900i__1 = *n;18901for (j = 1; j <= i__1; ++j) {18902if (*beta == 0.) {18903i__2 = *n;18904for (i__ = j; i__ <= i__2; ++i__) {18905i__3 = i__ + j * c_dim1;18906c__[i__3].r = 0., c__[i__3].i = 0.;18907/* L140: */18908}18909} else if (*beta != 1.) {18910i__2 = j + j * c_dim1;18911i__3 = j + j * c_dim1;18912d__1 = *beta * c__[i__3].r;18913c__[i__2].r = d__1, c__[i__2].i = 0.;18914i__2 = *n;18915for (i__ = j + 1; i__ <= i__2; ++i__) {18916i__3 = i__ + j * c_dim1;18917i__4 = i__ + j * c_dim1;18918z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[18919i__4].i;18920c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18921/* L150: */18922}18923} else {18924i__2 = j + j * c_dim1;18925i__3 = j + j * c_dim1;18926d__1 = c__[i__3].r;18927c__[i__2].r = d__1, c__[i__2].i = 0.;18928}18929i__2 = *k;18930for (l = 1; l <= i__2; ++l) {18931i__3 = j + l * a_dim1;18932if (a[i__3].r != 0. || a[i__3].i != 0.) {18933d_cnjg(&z__2, &a[j + l * a_dim1]);18934z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;18935temp.r = z__1.r, temp.i = z__1.i;18936i__3 = j + j * c_dim1;18937i__4 = j + j * c_dim1;18938i__5 = j + l * a_dim1;18939z__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,18940z__1.i = temp.r * a[i__5].i + temp.i * a[i__5]18941.r;18942d__1 = c__[i__4].r + z__1.r;18943c__[i__3].r = d__1, c__[i__3].i = 0.;18944i__3 = *n;18945for (i__ = j + 1; i__ <= i__3; ++i__) {18946i__4 = i__ + j * c_dim1;18947i__5 = i__ + j * c_dim1;18948i__6 = i__ + l * a_dim1;18949z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,18950z__2.i = temp.r * a[i__6].i + temp.i * a[18951i__6].r;18952z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]18953.i + z__2.i;18954c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;18955/* L160: */18956}18957}18958/* L170: */18959}18960/* L180: */18961}18962}18963} else {1896418965/* Form C := alpha*conjg( A' )*A + beta*C. */1896618967if (upper) {18968i__1 = *n;18969for (j = 1; j <= i__1; ++j) {18970i__2 = j - 1;18971for (i__ = 1; i__ <= i__2; ++i__) {18972temp.r = 0., temp.i = 0.;18973i__3 = *k;18974for (l = 1; l <= i__3; ++l) {18975d_cnjg(&z__3, &a[l + i__ * a_dim1]);18976i__4 = l + j * a_dim1;18977z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,18978z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]18979.r;18980z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;18981temp.r = z__1.r, temp.i = z__1.i;18982/* L190: */18983}18984if (*beta == 0.) {18985i__3 = i__ + j * c_dim1;18986z__1.r = *alpha * temp.r, z__1.i = *alpha * temp.i;18987c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18988} else {18989i__3 = i__ + j * c_dim1;18990z__2.r = *alpha * temp.r, z__2.i = *alpha * temp.i;18991i__4 = i__ + j * c_dim1;18992z__3.r = *beta * c__[i__4].r, z__3.i = *beta * c__[18993i__4].i;18994z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;18995c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;18996}18997/* L200: */18998}18999rtemp = 0.;19000i__2 = *k;19001for (l = 1; l <= i__2; ++l) {19002d_cnjg(&z__3, &a[l + j * a_dim1]);19003i__3 = l + j * a_dim1;19004z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i =19005z__3.r * a[i__3].i + z__3.i * a[i__3].r;19006z__1.r = rtemp + z__2.r, z__1.i = z__2.i;19007rtemp = z__1.r;19008/* L210: */19009}19010if (*beta == 0.) {19011i__2 = j + j * c_dim1;19012d__1 = *alpha * rtemp;19013c__[i__2].r = d__1, c__[i__2].i = 0.;19014} else {19015i__2 = j + j * c_dim1;19016i__3 = j + j * c_dim1;19017d__1 = *alpha * rtemp + *beta * c__[i__3].r;19018c__[i__2].r = d__1, c__[i__2].i = 0.;19019}19020/* L220: */19021}19022} else {19023i__1 = *n;19024for (j = 1; j <= i__1; ++j) {19025rtemp = 0.;19026i__2 = *k;19027for (l = 1; l <= i__2; ++l) {19028d_cnjg(&z__3, &a[l + j * a_dim1]);19029i__3 = l + j * a_dim1;19030z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i =19031z__3.r * a[i__3].i + z__3.i * a[i__3].r;19032z__1.r = rtemp + z__2.r, z__1.i = z__2.i;19033rtemp = z__1.r;19034/* L230: */19035}19036if (*beta == 0.) {19037i__2 = j + j * c_dim1;19038d__1 = *alpha * rtemp;19039c__[i__2].r = d__1, c__[i__2].i = 0.;19040} else {19041i__2 = j + j * c_dim1;19042i__3 = j + j * c_dim1;19043d__1 = *alpha * rtemp + *beta * c__[i__3].r;19044c__[i__2].r = d__1, c__[i__2].i = 0.;19045}19046i__2 = *n;19047for (i__ = j + 1; i__ <= i__2; ++i__) {19048temp.r = 0., temp.i = 0.;19049i__3 = *k;19050for (l = 1; l <= i__3; ++l) {19051d_cnjg(&z__3, &a[l + i__ * a_dim1]);19052i__4 = l + j * a_dim1;19053z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,19054z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]19055.r;19056z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;19057temp.r = z__1.r, temp.i = z__1.i;19058/* L240: */19059}19060if (*beta == 0.) {19061i__3 = i__ + j * c_dim1;19062z__1.r = *alpha * temp.r, z__1.i = *alpha * temp.i;19063c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;19064} else {19065i__3 = i__ + j * c_dim1;19066z__2.r = *alpha * temp.r, z__2.i = *alpha * temp.i;19067i__4 = i__ + j * c_dim1;19068z__3.r = *beta * c__[i__4].r, z__3.i = *beta * c__[19069i__4].i;19070z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;19071c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;19072}19073/* L250: */19074}19075/* L260: */19076}19077}19078}1907919080return 0;1908119082/* End of ZHERK . */1908319084} /* zherk_ */1908519086/* Subroutine */ int zscal_(integer *n, doublecomplex *za, doublecomplex *zx,19087integer *incx)19088{19089/* System generated locals */19090integer i__1, i__2, i__3;19091doublecomplex z__1;1909219093/* Local variables */19094static integer i__, ix;190951909619097/*19098Purpose19099=======1910019101ZSCAL scales a vector by a constant.1910219103Further Details19104===============1910519106jack dongarra, 3/11/78.19107modified 3/93 to return if incx .le. 0.19108modified 12/3/93, array(1) declarations changed to array(*)1910919110=====================================================================19111*/1911219113/* Parameter adjustments */19114--zx;1911519116/* Function Body */19117if (*n <= 0 || *incx <= 0) {19118return 0;19119}19120if (*incx == 1) {19121goto L20;19122}1912319124/* code for increment not equal to 1 */1912519126ix = 1;19127i__1 = *n;19128for (i__ = 1; i__ <= i__1; ++i__) {19129i__2 = ix;19130i__3 = ix;19131z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[19132i__3].i + za->i * zx[i__3].r;19133zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;19134ix += *incx;19135/* L10: */19136}19137return 0;1913819139/* code for increment equal to 1 */1914019141L20:19142i__1 = *n;19143for (i__ = 1; i__ <= i__1; ++i__) {19144i__2 = i__;19145i__3 = i__;19146z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[19147i__3].i + za->i * zx[i__3].r;19148zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;19149/* L30: */19150}19151return 0;19152} /* zscal_ */1915319154/* Subroutine */ int zswap_(integer *n, doublecomplex *zx, integer *incx,19155doublecomplex *zy, integer *incy)19156{19157/* System generated locals */19158integer i__1, i__2, i__3;1915919160/* Local variables */19161static integer i__, ix, iy;19162static doublecomplex ztemp;191631916419165/*19166Purpose19167=======1916819169ZSWAP interchanges two vectors.1917019171Further Details19172===============1917319174jack dongarra, 3/11/78.19175modified 12/3/93, array(1) declarations changed to array(*)1917619177=====================================================================19178*/1917919180/* Parameter adjustments */19181--zy;19182--zx;1918319184/* Function Body */19185if (*n <= 0) {19186return 0;19187}19188if (*incx == 1 && *incy == 1) {19189goto L20;19190}1919119192/*19193code for unequal increments or equal increments not equal19194to 119195*/1919619197ix = 1;19198iy = 1;19199if (*incx < 0) {19200ix = (-(*n) + 1) * *incx + 1;19201}19202if (*incy < 0) {19203iy = (-(*n) + 1) * *incy + 1;19204}19205i__1 = *n;19206for (i__ = 1; i__ <= i__1; ++i__) {19207i__2 = ix;19208ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;19209i__2 = ix;19210i__3 = iy;19211zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;19212i__2 = iy;19213zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;19214ix += *incx;19215iy += *incy;19216/* L10: */19217}19218return 0;1921919220/* code for both increments equal to 1 */19221L20:19222i__1 = *n;19223for (i__ = 1; i__ <= i__1; ++i__) {19224i__2 = i__;19225ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;19226i__2 = i__;19227i__3 = i__;19228zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;19229i__2 = i__;19230zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;19231/* L30: */19232}19233return 0;19234} /* zswap_ */1923519236/* Subroutine */ int ztrmm_(char *side, char *uplo, char *transa, char *diag,19237integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,19238integer *lda, doublecomplex *b, integer *ldb)19239{19240/* System generated locals */19241integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,19242i__6;19243doublecomplex z__1, z__2, z__3;1924419245/* Local variables */19246static integer i__, j, k, info;19247static doublecomplex temp;19248static logical lside;19249extern logical lsame_(char *, char *);19250static integer nrowa;19251static logical upper;19252extern /* Subroutine */ int xerbla_(char *, integer *);19253static logical noconj, nounit;192541925519256/*19257Purpose19258=======1925919260ZTRMM performs one of the matrix-matrix operations1926119262B := alpha*op( A )*B, or B := alpha*B*op( A )1926319264where alpha is a scalar, B is an m by n matrix, A is a unit, or19265non-unit, upper or lower triangular matrix and op( A ) is one of1926619267op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).1926819269Arguments19270==========1927119272SIDE - CHARACTER*1.19273On entry, SIDE specifies whether op( A ) multiplies B from19274the left or right as follows:1927519276SIDE = 'L' or 'l' B := alpha*op( A )*B.1927719278SIDE = 'R' or 'r' B := alpha*B*op( A ).1927919280Unchanged on exit.1928119282UPLO - CHARACTER*1.19283On entry, UPLO specifies whether the matrix A is an upper or19284lower triangular matrix as follows:1928519286UPLO = 'U' or 'u' A is an upper triangular matrix.1928719288UPLO = 'L' or 'l' A is a lower triangular matrix.1928919290Unchanged on exit.1929119292TRANSA - CHARACTER*1.19293On entry, TRANSA specifies the form of op( A ) to be used in19294the matrix multiplication as follows:1929519296TRANSA = 'N' or 'n' op( A ) = A.1929719298TRANSA = 'T' or 't' op( A ) = A'.1929919300TRANSA = 'C' or 'c' op( A ) = conjg( A' ).1930119302Unchanged on exit.1930319304DIAG - CHARACTER*1.19305On entry, DIAG specifies whether or not A is unit triangular19306as follows:1930719308DIAG = 'U' or 'u' A is assumed to be unit triangular.1930919310DIAG = 'N' or 'n' A is not assumed to be unit19311triangular.1931219313Unchanged on exit.1931419315M - INTEGER.19316On entry, M specifies the number of rows of B. M must be at19317least zero.19318Unchanged on exit.1931919320N - INTEGER.19321On entry, N specifies the number of columns of B. N must be19322at least zero.19323Unchanged on exit.1932419325ALPHA - COMPLEX*16 .19326On entry, ALPHA specifies the scalar alpha. When alpha is19327zero then A is not referenced and B need not be set before19328entry.19329Unchanged on exit.1933019331A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m19332when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.19333Before entry with UPLO = 'U' or 'u', the leading k by k19334upper triangular part of the array A must contain the upper19335triangular matrix and the strictly lower triangular part of19336A is not referenced.19337Before entry with UPLO = 'L' or 'l', the leading k by k19338lower triangular part of the array A must contain the lower19339triangular matrix and the strictly upper triangular part of19340A is not referenced.19341Note that when DIAG = 'U' or 'u', the diagonal elements of19342A are not referenced either, but are assumed to be unity.19343Unchanged on exit.1934419345LDA - INTEGER.19346On entry, LDA specifies the first dimension of A as declared19347in the calling (sub) program. When SIDE = 'L' or 'l' then19348LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'19349then LDA must be at least max( 1, n ).19350Unchanged on exit.1935119352B - COMPLEX*16 array of DIMENSION ( LDB, n ).19353Before entry, the leading m by n part of the array B must19354contain the matrix B, and on exit is overwritten by the19355transformed matrix.1935619357LDB - INTEGER.19358On entry, LDB specifies the first dimension of B as declared19359in the calling (sub) program. LDB must be at least19360max( 1, m ).19361Unchanged on exit.1936219363Further Details19364===============1936519366Level 3 Blas routine.1936719368-- Written on 8-February-1989.19369Jack Dongarra, Argonne National Laboratory.19370Iain Duff, AERE Harwell.19371Jeremy Du Croz, Numerical Algorithms Group Ltd.19372Sven Hammarling, Numerical Algorithms Group Ltd.1937319374=====================================================================193751937619377Test the input parameters.19378*/1937919380/* Parameter adjustments */19381a_dim1 = *lda;19382a_offset = 1 + a_dim1;19383a -= a_offset;19384b_dim1 = *ldb;19385b_offset = 1 + b_dim1;19386b -= b_offset;1938719388/* Function Body */19389lside = lsame_(side, "L");19390if (lside) {19391nrowa = *m;19392} else {19393nrowa = *n;19394}19395noconj = lsame_(transa, "T");19396nounit = lsame_(diag, "N");19397upper = lsame_(uplo, "U");1939819399info = 0;19400if (! lside && ! lsame_(side, "R")) {19401info = 1;19402} else if (! upper && ! lsame_(uplo, "L")) {19403info = 2;19404} else if (! lsame_(transa, "N") && ! lsame_(transa,19405"T") && ! lsame_(transa, "C")) {19406info = 3;19407} else if (! lsame_(diag, "U") && ! lsame_(diag,19408"N")) {19409info = 4;19410} else if (*m < 0) {19411info = 5;19412} else if (*n < 0) {19413info = 6;19414} else if (*lda < max(1,nrowa)) {19415info = 9;19416} else if (*ldb < max(1,*m)) {19417info = 11;19418}19419if (info != 0) {19420xerbla_("ZTRMM ", &info);19421return 0;19422}1942319424/* Quick return if possible. */1942519426if (*m == 0 || *n == 0) {19427return 0;19428}1942919430/* And when alpha.eq.zero. */1943119432if (alpha->r == 0. && alpha->i == 0.) {19433i__1 = *n;19434for (j = 1; j <= i__1; ++j) {19435i__2 = *m;19436for (i__ = 1; i__ <= i__2; ++i__) {19437i__3 = i__ + j * b_dim1;19438b[i__3].r = 0., b[i__3].i = 0.;19439/* L10: */19440}19441/* L20: */19442}19443return 0;19444}1944519446/* Start the operations. */1944719448if (lside) {19449if (lsame_(transa, "N")) {1945019451/* Form B := alpha*A*B. */1945219453if (upper) {19454i__1 = *n;19455for (j = 1; j <= i__1; ++j) {19456i__2 = *m;19457for (k = 1; k <= i__2; ++k) {19458i__3 = k + j * b_dim1;19459if (b[i__3].r != 0. || b[i__3].i != 0.) {19460i__3 = k + j * b_dim1;19461z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]19462.i, z__1.i = alpha->r * b[i__3].i +19463alpha->i * b[i__3].r;19464temp.r = z__1.r, temp.i = z__1.i;19465i__3 = k - 1;19466for (i__ = 1; i__ <= i__3; ++i__) {19467i__4 = i__ + j * b_dim1;19468i__5 = i__ + j * b_dim1;19469i__6 = i__ + k * a_dim1;19470z__2.r = temp.r * a[i__6].r - temp.i * a[i__6]19471.i, z__2.i = temp.r * a[i__6].i +19472temp.i * a[i__6].r;19473z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]19474.i + z__2.i;19475b[i__4].r = z__1.r, b[i__4].i = z__1.i;19476/* L30: */19477}19478if (nounit) {19479i__3 = k + k * a_dim1;19480z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]19481.i, z__1.i = temp.r * a[i__3].i +19482temp.i * a[i__3].r;19483temp.r = z__1.r, temp.i = z__1.i;19484}19485i__3 = k + j * b_dim1;19486b[i__3].r = temp.r, b[i__3].i = temp.i;19487}19488/* L40: */19489}19490/* L50: */19491}19492} else {19493i__1 = *n;19494for (j = 1; j <= i__1; ++j) {19495for (k = *m; k >= 1; --k) {19496i__2 = k + j * b_dim1;19497if (b[i__2].r != 0. || b[i__2].i != 0.) {19498i__2 = k + j * b_dim1;19499z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2]19500.i, z__1.i = alpha->r * b[i__2].i +19501alpha->i * b[i__2].r;19502temp.r = z__1.r, temp.i = z__1.i;19503i__2 = k + j * b_dim1;19504b[i__2].r = temp.r, b[i__2].i = temp.i;19505if (nounit) {19506i__2 = k + j * b_dim1;19507i__3 = k + j * b_dim1;19508i__4 = k + k * a_dim1;19509z__1.r = b[i__3].r * a[i__4].r - b[i__3].i *19510a[i__4].i, z__1.i = b[i__3].r * a[19511i__4].i + b[i__3].i * a[i__4].r;19512b[i__2].r = z__1.r, b[i__2].i = z__1.i;19513}19514i__2 = *m;19515for (i__ = k + 1; i__ <= i__2; ++i__) {19516i__3 = i__ + j * b_dim1;19517i__4 = i__ + j * b_dim1;19518i__5 = i__ + k * a_dim1;19519z__2.r = temp.r * a[i__5].r - temp.i * a[i__5]19520.i, z__2.i = temp.r * a[i__5].i +19521temp.i * a[i__5].r;19522z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]19523.i + z__2.i;19524b[i__3].r = z__1.r, b[i__3].i = z__1.i;19525/* L60: */19526}19527}19528/* L70: */19529}19530/* L80: */19531}19532}19533} else {1953419535/* Form B := alpha*A'*B or B := alpha*conjg( A' )*B. */1953619537if (upper) {19538i__1 = *n;19539for (j = 1; j <= i__1; ++j) {19540for (i__ = *m; i__ >= 1; --i__) {19541i__2 = i__ + j * b_dim1;19542temp.r = b[i__2].r, temp.i = b[i__2].i;19543if (noconj) {19544if (nounit) {19545i__2 = i__ + i__ * a_dim1;19546z__1.r = temp.r * a[i__2].r - temp.i * a[i__2]19547.i, z__1.i = temp.r * a[i__2].i +19548temp.i * a[i__2].r;19549temp.r = z__1.r, temp.i = z__1.i;19550}19551i__2 = i__ - 1;19552for (k = 1; k <= i__2; ++k) {19553i__3 = k + i__ * a_dim1;19554i__4 = k + j * b_dim1;19555z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *19556b[i__4].i, z__2.i = a[i__3].r * b[19557i__4].i + a[i__3].i * b[i__4].r;19558z__1.r = temp.r + z__2.r, z__1.i = temp.i +19559z__2.i;19560temp.r = z__1.r, temp.i = z__1.i;19561/* L90: */19562}19563} else {19564if (nounit) {19565d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);19566z__1.r = temp.r * z__2.r - temp.i * z__2.i,19567z__1.i = temp.r * z__2.i + temp.i *19568z__2.r;19569temp.r = z__1.r, temp.i = z__1.i;19570}19571i__2 = i__ - 1;19572for (k = 1; k <= i__2; ++k) {19573d_cnjg(&z__3, &a[k + i__ * a_dim1]);19574i__3 = k + j * b_dim1;19575z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]19576.i, z__2.i = z__3.r * b[i__3].i +19577z__3.i * b[i__3].r;19578z__1.r = temp.r + z__2.r, z__1.i = temp.i +19579z__2.i;19580temp.r = z__1.r, temp.i = z__1.i;19581/* L100: */19582}19583}19584i__2 = i__ + j * b_dim1;19585z__1.r = alpha->r * temp.r - alpha->i * temp.i,19586z__1.i = alpha->r * temp.i + alpha->i *19587temp.r;19588b[i__2].r = z__1.r, b[i__2].i = z__1.i;19589/* L110: */19590}19591/* L120: */19592}19593} else {19594i__1 = *n;19595for (j = 1; j <= i__1; ++j) {19596i__2 = *m;19597for (i__ = 1; i__ <= i__2; ++i__) {19598i__3 = i__ + j * b_dim1;19599temp.r = b[i__3].r, temp.i = b[i__3].i;19600if (noconj) {19601if (nounit) {19602i__3 = i__ + i__ * a_dim1;19603z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]19604.i, z__1.i = temp.r * a[i__3].i +19605temp.i * a[i__3].r;19606temp.r = z__1.r, temp.i = z__1.i;19607}19608i__3 = *m;19609for (k = i__ + 1; k <= i__3; ++k) {19610i__4 = k + i__ * a_dim1;19611i__5 = k + j * b_dim1;19612z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *19613b[i__5].i, z__2.i = a[i__4].r * b[19614i__5].i + a[i__4].i * b[i__5].r;19615z__1.r = temp.r + z__2.r, z__1.i = temp.i +19616z__2.i;19617temp.r = z__1.r, temp.i = z__1.i;19618/* L130: */19619}19620} else {19621if (nounit) {19622d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);19623z__1.r = temp.r * z__2.r - temp.i * z__2.i,19624z__1.i = temp.r * z__2.i + temp.i *19625z__2.r;19626temp.r = z__1.r, temp.i = z__1.i;19627}19628i__3 = *m;19629for (k = i__ + 1; k <= i__3; ++k) {19630d_cnjg(&z__3, &a[k + i__ * a_dim1]);19631i__4 = k + j * b_dim1;19632z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]19633.i, z__2.i = z__3.r * b[i__4].i +19634z__3.i * b[i__4].r;19635z__1.r = temp.r + z__2.r, z__1.i = temp.i +19636z__2.i;19637temp.r = z__1.r, temp.i = z__1.i;19638/* L140: */19639}19640}19641i__3 = i__ + j * b_dim1;19642z__1.r = alpha->r * temp.r - alpha->i * temp.i,19643z__1.i = alpha->r * temp.i + alpha->i *19644temp.r;19645b[i__3].r = z__1.r, b[i__3].i = z__1.i;19646/* L150: */19647}19648/* L160: */19649}19650}19651}19652} else {19653if (lsame_(transa, "N")) {1965419655/* Form B := alpha*B*A. */1965619657if (upper) {19658for (j = *n; j >= 1; --j) {19659temp.r = alpha->r, temp.i = alpha->i;19660if (nounit) {19661i__1 = j + j * a_dim1;19662z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,19663z__1.i = temp.r * a[i__1].i + temp.i * a[i__1]19664.r;19665temp.r = z__1.r, temp.i = z__1.i;19666}19667i__1 = *m;19668for (i__ = 1; i__ <= i__1; ++i__) {19669i__2 = i__ + j * b_dim1;19670i__3 = i__ + j * b_dim1;19671z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,19672z__1.i = temp.r * b[i__3].i + temp.i * b[i__3]19673.r;19674b[i__2].r = z__1.r, b[i__2].i = z__1.i;19675/* L170: */19676}19677i__1 = j - 1;19678for (k = 1; k <= i__1; ++k) {19679i__2 = k + j * a_dim1;19680if (a[i__2].r != 0. || a[i__2].i != 0.) {19681i__2 = k + j * a_dim1;19682z__1.r = alpha->r * a[i__2].r - alpha->i * a[i__2]19683.i, z__1.i = alpha->r * a[i__2].i +19684alpha->i * a[i__2].r;19685temp.r = z__1.r, temp.i = z__1.i;19686i__2 = *m;19687for (i__ = 1; i__ <= i__2; ++i__) {19688i__3 = i__ + j * b_dim1;19689i__4 = i__ + j * b_dim1;19690i__5 = i__ + k * b_dim1;19691z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]19692.i, z__2.i = temp.r * b[i__5].i +19693temp.i * b[i__5].r;19694z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]19695.i + z__2.i;19696b[i__3].r = z__1.r, b[i__3].i = z__1.i;19697/* L180: */19698}19699}19700/* L190: */19701}19702/* L200: */19703}19704} else {19705i__1 = *n;19706for (j = 1; j <= i__1; ++j) {19707temp.r = alpha->r, temp.i = alpha->i;19708if (nounit) {19709i__2 = j + j * a_dim1;19710z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,19711z__1.i = temp.r * a[i__2].i + temp.i * a[i__2]19712.r;19713temp.r = z__1.r, temp.i = z__1.i;19714}19715i__2 = *m;19716for (i__ = 1; i__ <= i__2; ++i__) {19717i__3 = i__ + j * b_dim1;19718i__4 = i__ + j * b_dim1;19719z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,19720z__1.i = temp.r * b[i__4].i + temp.i * b[i__4]19721.r;19722b[i__3].r = z__1.r, b[i__3].i = z__1.i;19723/* L210: */19724}19725i__2 = *n;19726for (k = j + 1; k <= i__2; ++k) {19727i__3 = k + j * a_dim1;19728if (a[i__3].r != 0. || a[i__3].i != 0.) {19729i__3 = k + j * a_dim1;19730z__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3]19731.i, z__1.i = alpha->r * a[i__3].i +19732alpha->i * a[i__3].r;19733temp.r = z__1.r, temp.i = z__1.i;19734i__3 = *m;19735for (i__ = 1; i__ <= i__3; ++i__) {19736i__4 = i__ + j * b_dim1;19737i__5 = i__ + j * b_dim1;19738i__6 = i__ + k * b_dim1;19739z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]19740.i, z__2.i = temp.r * b[i__6].i +19741temp.i * b[i__6].r;19742z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]19743.i + z__2.i;19744b[i__4].r = z__1.r, b[i__4].i = z__1.i;19745/* L220: */19746}19747}19748/* L230: */19749}19750/* L240: */19751}19752}19753} else {1975419755/* Form B := alpha*B*A' or B := alpha*B*conjg( A' ). */1975619757if (upper) {19758i__1 = *n;19759for (k = 1; k <= i__1; ++k) {19760i__2 = k - 1;19761for (j = 1; j <= i__2; ++j) {19762i__3 = j + k * a_dim1;19763if (a[i__3].r != 0. || a[i__3].i != 0.) {19764if (noconj) {19765i__3 = j + k * a_dim1;19766z__1.r = alpha->r * a[i__3].r - alpha->i * a[19767i__3].i, z__1.i = alpha->r * a[i__3]19768.i + alpha->i * a[i__3].r;19769temp.r = z__1.r, temp.i = z__1.i;19770} else {19771d_cnjg(&z__2, &a[j + k * a_dim1]);19772z__1.r = alpha->r * z__2.r - alpha->i *19773z__2.i, z__1.i = alpha->r * z__2.i +19774alpha->i * z__2.r;19775temp.r = z__1.r, temp.i = z__1.i;19776}19777i__3 = *m;19778for (i__ = 1; i__ <= i__3; ++i__) {19779i__4 = i__ + j * b_dim1;19780i__5 = i__ + j * b_dim1;19781i__6 = i__ + k * b_dim1;19782z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]19783.i, z__2.i = temp.r * b[i__6].i +19784temp.i * b[i__6].r;19785z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]19786.i + z__2.i;19787b[i__4].r = z__1.r, b[i__4].i = z__1.i;19788/* L250: */19789}19790}19791/* L260: */19792}19793temp.r = alpha->r, temp.i = alpha->i;19794if (nounit) {19795if (noconj) {19796i__2 = k + k * a_dim1;19797z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,19798z__1.i = temp.r * a[i__2].i + temp.i * a[19799i__2].r;19800temp.r = z__1.r, temp.i = z__1.i;19801} else {19802d_cnjg(&z__2, &a[k + k * a_dim1]);19803z__1.r = temp.r * z__2.r - temp.i * z__2.i,19804z__1.i = temp.r * z__2.i + temp.i *19805z__2.r;19806temp.r = z__1.r, temp.i = z__1.i;19807}19808}19809if (temp.r != 1. || temp.i != 0.) {19810i__2 = *m;19811for (i__ = 1; i__ <= i__2; ++i__) {19812i__3 = i__ + k * b_dim1;19813i__4 = i__ + k * b_dim1;19814z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,19815z__1.i = temp.r * b[i__4].i + temp.i * b[19816i__4].r;19817b[i__3].r = z__1.r, b[i__3].i = z__1.i;19818/* L270: */19819}19820}19821/* L280: */19822}19823} else {19824for (k = *n; k >= 1; --k) {19825i__1 = *n;19826for (j = k + 1; j <= i__1; ++j) {19827i__2 = j + k * a_dim1;19828if (a[i__2].r != 0. || a[i__2].i != 0.) {19829if (noconj) {19830i__2 = j + k * a_dim1;19831z__1.r = alpha->r * a[i__2].r - alpha->i * a[19832i__2].i, z__1.i = alpha->r * a[i__2]19833.i + alpha->i * a[i__2].r;19834temp.r = z__1.r, temp.i = z__1.i;19835} else {19836d_cnjg(&z__2, &a[j + k * a_dim1]);19837z__1.r = alpha->r * z__2.r - alpha->i *19838z__2.i, z__1.i = alpha->r * z__2.i +19839alpha->i * z__2.r;19840temp.r = z__1.r, temp.i = z__1.i;19841}19842i__2 = *m;19843for (i__ = 1; i__ <= i__2; ++i__) {19844i__3 = i__ + j * b_dim1;19845i__4 = i__ + j * b_dim1;19846i__5 = i__ + k * b_dim1;19847z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]19848.i, z__2.i = temp.r * b[i__5].i +19849temp.i * b[i__5].r;19850z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]19851.i + z__2.i;19852b[i__3].r = z__1.r, b[i__3].i = z__1.i;19853/* L290: */19854}19855}19856/* L300: */19857}19858temp.r = alpha->r, temp.i = alpha->i;19859if (nounit) {19860if (noconj) {19861i__1 = k + k * a_dim1;19862z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,19863z__1.i = temp.r * a[i__1].i + temp.i * a[19864i__1].r;19865temp.r = z__1.r, temp.i = z__1.i;19866} else {19867d_cnjg(&z__2, &a[k + k * a_dim1]);19868z__1.r = temp.r * z__2.r - temp.i * z__2.i,19869z__1.i = temp.r * z__2.i + temp.i *19870z__2.r;19871temp.r = z__1.r, temp.i = z__1.i;19872}19873}19874if (temp.r != 1. || temp.i != 0.) {19875i__1 = *m;19876for (i__ = 1; i__ <= i__1; ++i__) {19877i__2 = i__ + k * b_dim1;19878i__3 = i__ + k * b_dim1;19879z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,19880z__1.i = temp.r * b[i__3].i + temp.i * b[19881i__3].r;19882b[i__2].r = z__1.r, b[i__2].i = z__1.i;19883/* L310: */19884}19885}19886/* L320: */19887}19888}19889}19890}1989119892return 0;1989319894/* End of ZTRMM . */1989519896} /* ztrmm_ */1989719898/* Subroutine */ int ztrmv_(char *uplo, char *trans, char *diag, integer *n,19899doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)19900{19901/* System generated locals */19902integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;19903doublecomplex z__1, z__2, z__3;1990419905/* Local variables */19906static integer i__, j, ix, jx, kx, info;19907static doublecomplex temp;19908extern logical lsame_(char *, char *);19909extern /* Subroutine */ int xerbla_(char *, integer *);19910static logical noconj, nounit;199111991219913/*19914Purpose19915=======1991619917ZTRMV performs one of the matrix-vector operations1991819919x := A*x, or x := A'*x, or x := conjg( A' )*x,1992019921where x is an n element vector and A is an n by n unit, or non-unit,19922upper or lower triangular matrix.1992319924Arguments19925==========1992619927UPLO - CHARACTER*1.19928On entry, UPLO specifies whether the matrix is an upper or19929lower triangular matrix as follows:1993019931UPLO = 'U' or 'u' A is an upper triangular matrix.1993219933UPLO = 'L' or 'l' A is a lower triangular matrix.1993419935Unchanged on exit.1993619937TRANS - CHARACTER*1.19938On entry, TRANS specifies the operation to be performed as19939follows:1994019941TRANS = 'N' or 'n' x := A*x.1994219943TRANS = 'T' or 't' x := A'*x.1994419945TRANS = 'C' or 'c' x := conjg( A' )*x.1994619947Unchanged on exit.1994819949DIAG - CHARACTER*1.19950On entry, DIAG specifies whether or not A is unit19951triangular as follows:1995219953DIAG = 'U' or 'u' A is assumed to be unit triangular.1995419955DIAG = 'N' or 'n' A is not assumed to be unit19956triangular.1995719958Unchanged on exit.1995919960N - INTEGER.19961On entry, N specifies the order of the matrix A.19962N must be at least zero.19963Unchanged on exit.1996419965A - COMPLEX*16 array of DIMENSION ( LDA, n ).19966Before entry with UPLO = 'U' or 'u', the leading n by n19967upper triangular part of the array A must contain the upper19968triangular matrix and the strictly lower triangular part of19969A is not referenced.19970Before entry with UPLO = 'L' or 'l', the leading n by n19971lower triangular part of the array A must contain the lower19972triangular matrix and the strictly upper triangular part of19973A is not referenced.19974Note that when DIAG = 'U' or 'u', the diagonal elements of19975A are not referenced either, but are assumed to be unity.19976Unchanged on exit.1997719978LDA - INTEGER.19979On entry, LDA specifies the first dimension of A as declared19980in the calling (sub) program. LDA must be at least19981max( 1, n ).19982Unchanged on exit.1998319984X - COMPLEX*16 array of dimension at least19985( 1 + ( n - 1 )*abs( INCX ) ).19986Before entry, the incremented array X must contain the n19987element vector x. On exit, X is overwritten with the19988tranformed vector x.1998919990INCX - INTEGER.19991On entry, INCX specifies the increment for the elements of19992X. INCX must not be zero.19993Unchanged on exit.1999419995Further Details19996===============1999719998Level 2 Blas routine.1999920000-- Written on 22-October-1986.20001Jack Dongarra, Argonne National Lab.20002Jeremy Du Croz, Nag Central Office.20003Sven Hammarling, Nag Central Office.20004Richard Hanson, Sandia National Labs.2000520006=====================================================================200072000820009Test the input parameters.20010*/2001120012/* Parameter adjustments */20013a_dim1 = *lda;20014a_offset = 1 + a_dim1;20015a -= a_offset;20016--x;2001720018/* Function Body */20019info = 0;20020if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {20021info = 1;20022} else if (! lsame_(trans, "N") && ! lsame_(trans,20023"T") && ! lsame_(trans, "C")) {20024info = 2;20025} else if (! lsame_(diag, "U") && ! lsame_(diag,20026"N")) {20027info = 3;20028} else if (*n < 0) {20029info = 4;20030} else if (*lda < max(1,*n)) {20031info = 6;20032} else if (*incx == 0) {20033info = 8;20034}20035if (info != 0) {20036xerbla_("ZTRMV ", &info);20037return 0;20038}2003920040/* Quick return if possible. */2004120042if (*n == 0) {20043return 0;20044}2004520046noconj = lsame_(trans, "T");20047nounit = lsame_(diag, "N");2004820049/*20050Set up the start point in X if the increment is not unity. This20051will be ( N - 1 )*INCX too small for descending loops.20052*/2005320054if (*incx <= 0) {20055kx = 1 - (*n - 1) * *incx;20056} else if (*incx != 1) {20057kx = 1;20058}2005920060/*20061Start the operations. In this version the elements of A are20062accessed sequentially with one pass through A.20063*/2006420065if (lsame_(trans, "N")) {2006620067/* Form x := A*x. */2006820069if (lsame_(uplo, "U")) {20070if (*incx == 1) {20071i__1 = *n;20072for (j = 1; j <= i__1; ++j) {20073i__2 = j;20074if (x[i__2].r != 0. || x[i__2].i != 0.) {20075i__2 = j;20076temp.r = x[i__2].r, temp.i = x[i__2].i;20077i__2 = j - 1;20078for (i__ = 1; i__ <= i__2; ++i__) {20079i__3 = i__;20080i__4 = i__;20081i__5 = i__ + j * a_dim1;20082z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,20083z__2.i = temp.r * a[i__5].i + temp.i * a[20084i__5].r;20085z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i +20086z__2.i;20087x[i__3].r = z__1.r, x[i__3].i = z__1.i;20088/* L10: */20089}20090if (nounit) {20091i__2 = j;20092i__3 = j;20093i__4 = j + j * a_dim1;20094z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[20095i__4].i, z__1.i = x[i__3].r * a[i__4].i +20096x[i__3].i * a[i__4].r;20097x[i__2].r = z__1.r, x[i__2].i = z__1.i;20098}20099}20100/* L20: */20101}20102} else {20103jx = kx;20104i__1 = *n;20105for (j = 1; j <= i__1; ++j) {20106i__2 = jx;20107if (x[i__2].r != 0. || x[i__2].i != 0.) {20108i__2 = jx;20109temp.r = x[i__2].r, temp.i = x[i__2].i;20110ix = kx;20111i__2 = j - 1;20112for (i__ = 1; i__ <= i__2; ++i__) {20113i__3 = ix;20114i__4 = ix;20115i__5 = i__ + j * a_dim1;20116z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,20117z__2.i = temp.r * a[i__5].i + temp.i * a[20118i__5].r;20119z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i +20120z__2.i;20121x[i__3].r = z__1.r, x[i__3].i = z__1.i;20122ix += *incx;20123/* L30: */20124}20125if (nounit) {20126i__2 = jx;20127i__3 = jx;20128i__4 = j + j * a_dim1;20129z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[20130i__4].i, z__1.i = x[i__3].r * a[i__4].i +20131x[i__3].i * a[i__4].r;20132x[i__2].r = z__1.r, x[i__2].i = z__1.i;20133}20134}20135jx += *incx;20136/* L40: */20137}20138}20139} else {20140if (*incx == 1) {20141for (j = *n; j >= 1; --j) {20142i__1 = j;20143if (x[i__1].r != 0. || x[i__1].i != 0.) {20144i__1 = j;20145temp.r = x[i__1].r, temp.i = x[i__1].i;20146i__1 = j + 1;20147for (i__ = *n; i__ >= i__1; --i__) {20148i__2 = i__;20149i__3 = i__;20150i__4 = i__ + j * a_dim1;20151z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,20152z__2.i = temp.r * a[i__4].i + temp.i * a[20153i__4].r;20154z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +20155z__2.i;20156x[i__2].r = z__1.r, x[i__2].i = z__1.i;20157/* L50: */20158}20159if (nounit) {20160i__1 = j;20161i__2 = j;20162i__3 = j + j * a_dim1;20163z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[20164i__3].i, z__1.i = x[i__2].r * a[i__3].i +20165x[i__2].i * a[i__3].r;20166x[i__1].r = z__1.r, x[i__1].i = z__1.i;20167}20168}20169/* L60: */20170}20171} else {20172kx += (*n - 1) * *incx;20173jx = kx;20174for (j = *n; j >= 1; --j) {20175i__1 = jx;20176if (x[i__1].r != 0. || x[i__1].i != 0.) {20177i__1 = jx;20178temp.r = x[i__1].r, temp.i = x[i__1].i;20179ix = kx;20180i__1 = j + 1;20181for (i__ = *n; i__ >= i__1; --i__) {20182i__2 = ix;20183i__3 = ix;20184i__4 = i__ + j * a_dim1;20185z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,20186z__2.i = temp.r * a[i__4].i + temp.i * a[20187i__4].r;20188z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +20189z__2.i;20190x[i__2].r = z__1.r, x[i__2].i = z__1.i;20191ix -= *incx;20192/* L70: */20193}20194if (nounit) {20195i__1 = jx;20196i__2 = jx;20197i__3 = j + j * a_dim1;20198z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[20199i__3].i, z__1.i = x[i__2].r * a[i__3].i +20200x[i__2].i * a[i__3].r;20201x[i__1].r = z__1.r, x[i__1].i = z__1.i;20202}20203}20204jx -= *incx;20205/* L80: */20206}20207}20208}20209} else {2021020211/* Form x := A'*x or x := conjg( A' )*x. */2021220213if (lsame_(uplo, "U")) {20214if (*incx == 1) {20215for (j = *n; j >= 1; --j) {20216i__1 = j;20217temp.r = x[i__1].r, temp.i = x[i__1].i;20218if (noconj) {20219if (nounit) {20220i__1 = j + j * a_dim1;20221z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,20222z__1.i = temp.r * a[i__1].i + temp.i * a[20223i__1].r;20224temp.r = z__1.r, temp.i = z__1.i;20225}20226for (i__ = j - 1; i__ >= 1; --i__) {20227i__1 = i__ + j * a_dim1;20228i__2 = i__;20229z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[20230i__2].i, z__2.i = a[i__1].r * x[i__2].i +20231a[i__1].i * x[i__2].r;20232z__1.r = temp.r + z__2.r, z__1.i = temp.i +20233z__2.i;20234temp.r = z__1.r, temp.i = z__1.i;20235/* L90: */20236}20237} else {20238if (nounit) {20239d_cnjg(&z__2, &a[j + j * a_dim1]);20240z__1.r = temp.r * z__2.r - temp.i * z__2.i,20241z__1.i = temp.r * z__2.i + temp.i *20242z__2.r;20243temp.r = z__1.r, temp.i = z__1.i;20244}20245for (i__ = j - 1; i__ >= 1; --i__) {20246d_cnjg(&z__3, &a[i__ + j * a_dim1]);20247i__1 = i__;20248z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,20249z__2.i = z__3.r * x[i__1].i + z__3.i * x[20250i__1].r;20251z__1.r = temp.r + z__2.r, z__1.i = temp.i +20252z__2.i;20253temp.r = z__1.r, temp.i = z__1.i;20254/* L100: */20255}20256}20257i__1 = j;20258x[i__1].r = temp.r, x[i__1].i = temp.i;20259/* L110: */20260}20261} else {20262jx = kx + (*n - 1) * *incx;20263for (j = *n; j >= 1; --j) {20264i__1 = jx;20265temp.r = x[i__1].r, temp.i = x[i__1].i;20266ix = jx;20267if (noconj) {20268if (nounit) {20269i__1 = j + j * a_dim1;20270z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,20271z__1.i = temp.r * a[i__1].i + temp.i * a[20272i__1].r;20273temp.r = z__1.r, temp.i = z__1.i;20274}20275for (i__ = j - 1; i__ >= 1; --i__) {20276ix -= *incx;20277i__1 = i__ + j * a_dim1;20278i__2 = ix;20279z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[20280i__2].i, z__2.i = a[i__1].r * x[i__2].i +20281a[i__1].i * x[i__2].r;20282z__1.r = temp.r + z__2.r, z__1.i = temp.i +20283z__2.i;20284temp.r = z__1.r, temp.i = z__1.i;20285/* L120: */20286}20287} else {20288if (nounit) {20289d_cnjg(&z__2, &a[j + j * a_dim1]);20290z__1.r = temp.r * z__2.r - temp.i * z__2.i,20291z__1.i = temp.r * z__2.i + temp.i *20292z__2.r;20293temp.r = z__1.r, temp.i = z__1.i;20294}20295for (i__ = j - 1; i__ >= 1; --i__) {20296ix -= *incx;20297d_cnjg(&z__3, &a[i__ + j * a_dim1]);20298i__1 = ix;20299z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,20300z__2.i = z__3.r * x[i__1].i + z__3.i * x[20301i__1].r;20302z__1.r = temp.r + z__2.r, z__1.i = temp.i +20303z__2.i;20304temp.r = z__1.r, temp.i = z__1.i;20305/* L130: */20306}20307}20308i__1 = jx;20309x[i__1].r = temp.r, x[i__1].i = temp.i;20310jx -= *incx;20311/* L140: */20312}20313}20314} else {20315if (*incx == 1) {20316i__1 = *n;20317for (j = 1; j <= i__1; ++j) {20318i__2 = j;20319temp.r = x[i__2].r, temp.i = x[i__2].i;20320if (noconj) {20321if (nounit) {20322i__2 = j + j * a_dim1;20323z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,20324z__1.i = temp.r * a[i__2].i + temp.i * a[20325i__2].r;20326temp.r = z__1.r, temp.i = z__1.i;20327}20328i__2 = *n;20329for (i__ = j + 1; i__ <= i__2; ++i__) {20330i__3 = i__ + j * a_dim1;20331i__4 = i__;20332z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[20333i__4].i, z__2.i = a[i__3].r * x[i__4].i +20334a[i__3].i * x[i__4].r;20335z__1.r = temp.r + z__2.r, z__1.i = temp.i +20336z__2.i;20337temp.r = z__1.r, temp.i = z__1.i;20338/* L150: */20339}20340} else {20341if (nounit) {20342d_cnjg(&z__2, &a[j + j * a_dim1]);20343z__1.r = temp.r * z__2.r - temp.i * z__2.i,20344z__1.i = temp.r * z__2.i + temp.i *20345z__2.r;20346temp.r = z__1.r, temp.i = z__1.i;20347}20348i__2 = *n;20349for (i__ = j + 1; i__ <= i__2; ++i__) {20350d_cnjg(&z__3, &a[i__ + j * a_dim1]);20351i__3 = i__;20352z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,20353z__2.i = z__3.r * x[i__3].i + z__3.i * x[20354i__3].r;20355z__1.r = temp.r + z__2.r, z__1.i = temp.i +20356z__2.i;20357temp.r = z__1.r, temp.i = z__1.i;20358/* L160: */20359}20360}20361i__2 = j;20362x[i__2].r = temp.r, x[i__2].i = temp.i;20363/* L170: */20364}20365} else {20366jx = kx;20367i__1 = *n;20368for (j = 1; j <= i__1; ++j) {20369i__2 = jx;20370temp.r = x[i__2].r, temp.i = x[i__2].i;20371ix = jx;20372if (noconj) {20373if (nounit) {20374i__2 = j + j * a_dim1;20375z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,20376z__1.i = temp.r * a[i__2].i + temp.i * a[20377i__2].r;20378temp.r = z__1.r, temp.i = z__1.i;20379}20380i__2 = *n;20381for (i__ = j + 1; i__ <= i__2; ++i__) {20382ix += *incx;20383i__3 = i__ + j * a_dim1;20384i__4 = ix;20385z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[20386i__4].i, z__2.i = a[i__3].r * x[i__4].i +20387a[i__3].i * x[i__4].r;20388z__1.r = temp.r + z__2.r, z__1.i = temp.i +20389z__2.i;20390temp.r = z__1.r, temp.i = z__1.i;20391/* L180: */20392}20393} else {20394if (nounit) {20395d_cnjg(&z__2, &a[j + j * a_dim1]);20396z__1.r = temp.r * z__2.r - temp.i * z__2.i,20397z__1.i = temp.r * z__2.i + temp.i *20398z__2.r;20399temp.r = z__1.r, temp.i = z__1.i;20400}20401i__2 = *n;20402for (i__ = j + 1; i__ <= i__2; ++i__) {20403ix += *incx;20404d_cnjg(&z__3, &a[i__ + j * a_dim1]);20405i__3 = ix;20406z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,20407z__2.i = z__3.r * x[i__3].i + z__3.i * x[20408i__3].r;20409z__1.r = temp.r + z__2.r, z__1.i = temp.i +20410z__2.i;20411temp.r = z__1.r, temp.i = z__1.i;20412/* L190: */20413}20414}20415i__2 = jx;20416x[i__2].r = temp.r, x[i__2].i = temp.i;20417jx += *incx;20418/* L200: */20419}20420}20421}20422}2042320424return 0;2042520426/* End of ZTRMV . */2042720428} /* ztrmv_ */2042920430/* Subroutine */ int ztrsm_(char *side, char *uplo, char *transa, char *diag,20431integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,20432integer *lda, doublecomplex *b, integer *ldb)20433{20434/* System generated locals */20435integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,20436i__6, i__7;20437doublecomplex z__1, z__2, z__3;2043820439/* Local variables */20440static integer i__, j, k, info;20441static doublecomplex temp;20442static logical lside;20443extern logical lsame_(char *, char *);20444static integer nrowa;20445static logical upper;20446extern /* Subroutine */ int xerbla_(char *, integer *);20447static logical noconj, nounit;204482044920450/*20451Purpose20452=======2045320454ZTRSM solves one of the matrix equations2045520456op( A )*X = alpha*B, or X*op( A ) = alpha*B,2045720458where alpha is a scalar, X and B are m by n matrices, A is a unit, or20459non-unit, upper or lower triangular matrix and op( A ) is one of2046020461op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).2046220463The matrix X is overwritten on B.2046420465Arguments20466==========2046720468SIDE - CHARACTER*1.20469On entry, SIDE specifies whether op( A ) appears on the left20470or right of X as follows:2047120472SIDE = 'L' or 'l' op( A )*X = alpha*B.2047320474SIDE = 'R' or 'r' X*op( A ) = alpha*B.2047520476Unchanged on exit.2047720478UPLO - CHARACTER*1.20479On entry, UPLO specifies whether the matrix A is an upper or20480lower triangular matrix as follows:2048120482UPLO = 'U' or 'u' A is an upper triangular matrix.2048320484UPLO = 'L' or 'l' A is a lower triangular matrix.2048520486Unchanged on exit.2048720488TRANSA - CHARACTER*1.20489On entry, TRANSA specifies the form of op( A ) to be used in20490the matrix multiplication as follows:2049120492TRANSA = 'N' or 'n' op( A ) = A.2049320494TRANSA = 'T' or 't' op( A ) = A'.2049520496TRANSA = 'C' or 'c' op( A ) = conjg( A' ).2049720498Unchanged on exit.2049920500DIAG - CHARACTER*1.20501On entry, DIAG specifies whether or not A is unit triangular20502as follows:2050320504DIAG = 'U' or 'u' A is assumed to be unit triangular.2050520506DIAG = 'N' or 'n' A is not assumed to be unit20507triangular.2050820509Unchanged on exit.2051020511M - INTEGER.20512On entry, M specifies the number of rows of B. M must be at20513least zero.20514Unchanged on exit.2051520516N - INTEGER.20517On entry, N specifies the number of columns of B. N must be20518at least zero.20519Unchanged on exit.2052020521ALPHA - COMPLEX*16 .20522On entry, ALPHA specifies the scalar alpha. When alpha is20523zero then A is not referenced and B need not be set before20524entry.20525Unchanged on exit.2052620527A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m20528when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.20529Before entry with UPLO = 'U' or 'u', the leading k by k20530upper triangular part of the array A must contain the upper20531triangular matrix and the strictly lower triangular part of20532A is not referenced.20533Before entry with UPLO = 'L' or 'l', the leading k by k20534lower triangular part of the array A must contain the lower20535triangular matrix and the strictly upper triangular part of20536A is not referenced.20537Note that when DIAG = 'U' or 'u', the diagonal elements of20538A are not referenced either, but are assumed to be unity.20539Unchanged on exit.2054020541LDA - INTEGER.20542On entry, LDA specifies the first dimension of A as declared20543in the calling (sub) program. When SIDE = 'L' or 'l' then20544LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'20545then LDA must be at least max( 1, n ).20546Unchanged on exit.2054720548B - COMPLEX*16 array of DIMENSION ( LDB, n ).20549Before entry, the leading m by n part of the array B must20550contain the right-hand side matrix B, and on exit is20551overwritten by the solution matrix X.2055220553LDB - INTEGER.20554On entry, LDB specifies the first dimension of B as declared20555in the calling (sub) program. LDB must be at least20556max( 1, m ).20557Unchanged on exit.2055820559Further Details20560===============2056120562Level 3 Blas routine.2056320564-- Written on 8-February-1989.20565Jack Dongarra, Argonne National Laboratory.20566Iain Duff, AERE Harwell.20567Jeremy Du Croz, Numerical Algorithms Group Ltd.20568Sven Hammarling, Numerical Algorithms Group Ltd.2056920570=====================================================================205712057220573Test the input parameters.20574*/2057520576/* Parameter adjustments */20577a_dim1 = *lda;20578a_offset = 1 + a_dim1;20579a -= a_offset;20580b_dim1 = *ldb;20581b_offset = 1 + b_dim1;20582b -= b_offset;2058320584/* Function Body */20585lside = lsame_(side, "L");20586if (lside) {20587nrowa = *m;20588} else {20589nrowa = *n;20590}20591noconj = lsame_(transa, "T");20592nounit = lsame_(diag, "N");20593upper = lsame_(uplo, "U");2059420595info = 0;20596if (! lside && ! lsame_(side, "R")) {20597info = 1;20598} else if (! upper && ! lsame_(uplo, "L")) {20599info = 2;20600} else if (! lsame_(transa, "N") && ! lsame_(transa,20601"T") && ! lsame_(transa, "C")) {20602info = 3;20603} else if (! lsame_(diag, "U") && ! lsame_(diag,20604"N")) {20605info = 4;20606} else if (*m < 0) {20607info = 5;20608} else if (*n < 0) {20609info = 6;20610} else if (*lda < max(1,nrowa)) {20611info = 9;20612} else if (*ldb < max(1,*m)) {20613info = 11;20614}20615if (info != 0) {20616xerbla_("ZTRSM ", &info);20617return 0;20618}2061920620/* Quick return if possible. */2062120622if (*m == 0 || *n == 0) {20623return 0;20624}2062520626/* And when alpha.eq.zero. */2062720628if (alpha->r == 0. && alpha->i == 0.) {20629i__1 = *n;20630for (j = 1; j <= i__1; ++j) {20631i__2 = *m;20632for (i__ = 1; i__ <= i__2; ++i__) {20633i__3 = i__ + j * b_dim1;20634b[i__3].r = 0., b[i__3].i = 0.;20635/* L10: */20636}20637/* L20: */20638}20639return 0;20640}2064120642/* Start the operations. */2064320644if (lside) {20645if (lsame_(transa, "N")) {2064620647/* Form B := alpha*inv( A )*B. */2064820649if (upper) {20650i__1 = *n;20651for (j = 1; j <= i__1; ++j) {20652if (alpha->r != 1. || alpha->i != 0.) {20653i__2 = *m;20654for (i__ = 1; i__ <= i__2; ++i__) {20655i__3 = i__ + j * b_dim1;20656i__4 = i__ + j * b_dim1;20657z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]20658.i, z__1.i = alpha->r * b[i__4].i +20659alpha->i * b[i__4].r;20660b[i__3].r = z__1.r, b[i__3].i = z__1.i;20661/* L30: */20662}20663}20664for (k = *m; k >= 1; --k) {20665i__2 = k + j * b_dim1;20666if (b[i__2].r != 0. || b[i__2].i != 0.) {20667if (nounit) {20668i__2 = k + j * b_dim1;20669z_div(&z__1, &b[k + j * b_dim1], &a[k + k *20670a_dim1]);20671b[i__2].r = z__1.r, b[i__2].i = z__1.i;20672}20673i__2 = k - 1;20674for (i__ = 1; i__ <= i__2; ++i__) {20675i__3 = i__ + j * b_dim1;20676i__4 = i__ + j * b_dim1;20677i__5 = k + j * b_dim1;20678i__6 = i__ + k * a_dim1;20679z__2.r = b[i__5].r * a[i__6].r - b[i__5].i *20680a[i__6].i, z__2.i = b[i__5].r * a[20681i__6].i + b[i__5].i * a[i__6].r;20682z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]20683.i - z__2.i;20684b[i__3].r = z__1.r, b[i__3].i = z__1.i;20685/* L40: */20686}20687}20688/* L50: */20689}20690/* L60: */20691}20692} else {20693i__1 = *n;20694for (j = 1; j <= i__1; ++j) {20695if (alpha->r != 1. || alpha->i != 0.) {20696i__2 = *m;20697for (i__ = 1; i__ <= i__2; ++i__) {20698i__3 = i__ + j * b_dim1;20699i__4 = i__ + j * b_dim1;20700z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]20701.i, z__1.i = alpha->r * b[i__4].i +20702alpha->i * b[i__4].r;20703b[i__3].r = z__1.r, b[i__3].i = z__1.i;20704/* L70: */20705}20706}20707i__2 = *m;20708for (k = 1; k <= i__2; ++k) {20709i__3 = k + j * b_dim1;20710if (b[i__3].r != 0. || b[i__3].i != 0.) {20711if (nounit) {20712i__3 = k + j * b_dim1;20713z_div(&z__1, &b[k + j * b_dim1], &a[k + k *20714a_dim1]);20715b[i__3].r = z__1.r, b[i__3].i = z__1.i;20716}20717i__3 = *m;20718for (i__ = k + 1; i__ <= i__3; ++i__) {20719i__4 = i__ + j * b_dim1;20720i__5 = i__ + j * b_dim1;20721i__6 = k + j * b_dim1;20722i__7 = i__ + k * a_dim1;20723z__2.r = b[i__6].r * a[i__7].r - b[i__6].i *20724a[i__7].i, z__2.i = b[i__6].r * a[20725i__7].i + b[i__6].i * a[i__7].r;20726z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]20727.i - z__2.i;20728b[i__4].r = z__1.r, b[i__4].i = z__1.i;20729/* L80: */20730}20731}20732/* L90: */20733}20734/* L100: */20735}20736}20737} else {2073820739/*20740Form B := alpha*inv( A' )*B20741or B := alpha*inv( conjg( A' ) )*B.20742*/2074320744if (upper) {20745i__1 = *n;20746for (j = 1; j <= i__1; ++j) {20747i__2 = *m;20748for (i__ = 1; i__ <= i__2; ++i__) {20749i__3 = i__ + j * b_dim1;20750z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,20751z__1.i = alpha->r * b[i__3].i + alpha->i * b[20752i__3].r;20753temp.r = z__1.r, temp.i = z__1.i;20754if (noconj) {20755i__3 = i__ - 1;20756for (k = 1; k <= i__3; ++k) {20757i__4 = k + i__ * a_dim1;20758i__5 = k + j * b_dim1;20759z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *20760b[i__5].i, z__2.i = a[i__4].r * b[20761i__5].i + a[i__4].i * b[i__5].r;20762z__1.r = temp.r - z__2.r, z__1.i = temp.i -20763z__2.i;20764temp.r = z__1.r, temp.i = z__1.i;20765/* L110: */20766}20767if (nounit) {20768z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);20769temp.r = z__1.r, temp.i = z__1.i;20770}20771} else {20772i__3 = i__ - 1;20773for (k = 1; k <= i__3; ++k) {20774d_cnjg(&z__3, &a[k + i__ * a_dim1]);20775i__4 = k + j * b_dim1;20776z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]20777.i, z__2.i = z__3.r * b[i__4].i +20778z__3.i * b[i__4].r;20779z__1.r = temp.r - z__2.r, z__1.i = temp.i -20780z__2.i;20781temp.r = z__1.r, temp.i = z__1.i;20782/* L120: */20783}20784if (nounit) {20785d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);20786z_div(&z__1, &temp, &z__2);20787temp.r = z__1.r, temp.i = z__1.i;20788}20789}20790i__3 = i__ + j * b_dim1;20791b[i__3].r = temp.r, b[i__3].i = temp.i;20792/* L130: */20793}20794/* L140: */20795}20796} else {20797i__1 = *n;20798for (j = 1; j <= i__1; ++j) {20799for (i__ = *m; i__ >= 1; --i__) {20800i__2 = i__ + j * b_dim1;20801z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,20802z__1.i = alpha->r * b[i__2].i + alpha->i * b[20803i__2].r;20804temp.r = z__1.r, temp.i = z__1.i;20805if (noconj) {20806i__2 = *m;20807for (k = i__ + 1; k <= i__2; ++k) {20808i__3 = k + i__ * a_dim1;20809i__4 = k + j * b_dim1;20810z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *20811b[i__4].i, z__2.i = a[i__3].r * b[20812i__4].i + a[i__3].i * b[i__4].r;20813z__1.r = temp.r - z__2.r, z__1.i = temp.i -20814z__2.i;20815temp.r = z__1.r, temp.i = z__1.i;20816/* L150: */20817}20818if (nounit) {20819z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);20820temp.r = z__1.r, temp.i = z__1.i;20821}20822} else {20823i__2 = *m;20824for (k = i__ + 1; k <= i__2; ++k) {20825d_cnjg(&z__3, &a[k + i__ * a_dim1]);20826i__3 = k + j * b_dim1;20827z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]20828.i, z__2.i = z__3.r * b[i__3].i +20829z__3.i * b[i__3].r;20830z__1.r = temp.r - z__2.r, z__1.i = temp.i -20831z__2.i;20832temp.r = z__1.r, temp.i = z__1.i;20833/* L160: */20834}20835if (nounit) {20836d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);20837z_div(&z__1, &temp, &z__2);20838temp.r = z__1.r, temp.i = z__1.i;20839}20840}20841i__2 = i__ + j * b_dim1;20842b[i__2].r = temp.r, b[i__2].i = temp.i;20843/* L170: */20844}20845/* L180: */20846}20847}20848}20849} else {20850if (lsame_(transa, "N")) {2085120852/* Form B := alpha*B*inv( A ). */2085320854if (upper) {20855i__1 = *n;20856for (j = 1; j <= i__1; ++j) {20857if (alpha->r != 1. || alpha->i != 0.) {20858i__2 = *m;20859for (i__ = 1; i__ <= i__2; ++i__) {20860i__3 = i__ + j * b_dim1;20861i__4 = i__ + j * b_dim1;20862z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]20863.i, z__1.i = alpha->r * b[i__4].i +20864alpha->i * b[i__4].r;20865b[i__3].r = z__1.r, b[i__3].i = z__1.i;20866/* L190: */20867}20868}20869i__2 = j - 1;20870for (k = 1; k <= i__2; ++k) {20871i__3 = k + j * a_dim1;20872if (a[i__3].r != 0. || a[i__3].i != 0.) {20873i__3 = *m;20874for (i__ = 1; i__ <= i__3; ++i__) {20875i__4 = i__ + j * b_dim1;20876i__5 = i__ + j * b_dim1;20877i__6 = k + j * a_dim1;20878i__7 = i__ + k * b_dim1;20879z__2.r = a[i__6].r * b[i__7].r - a[i__6].i *20880b[i__7].i, z__2.i = a[i__6].r * b[20881i__7].i + a[i__6].i * b[i__7].r;20882z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]20883.i - z__2.i;20884b[i__4].r = z__1.r, b[i__4].i = z__1.i;20885/* L200: */20886}20887}20888/* L210: */20889}20890if (nounit) {20891z_div(&z__1, &c_b1078, &a[j + j * a_dim1]);20892temp.r = z__1.r, temp.i = z__1.i;20893i__2 = *m;20894for (i__ = 1; i__ <= i__2; ++i__) {20895i__3 = i__ + j * b_dim1;20896i__4 = i__ + j * b_dim1;20897z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,20898z__1.i = temp.r * b[i__4].i + temp.i * b[20899i__4].r;20900b[i__3].r = z__1.r, b[i__3].i = z__1.i;20901/* L220: */20902}20903}20904/* L230: */20905}20906} else {20907for (j = *n; j >= 1; --j) {20908if (alpha->r != 1. || alpha->i != 0.) {20909i__1 = *m;20910for (i__ = 1; i__ <= i__1; ++i__) {20911i__2 = i__ + j * b_dim1;20912i__3 = i__ + j * b_dim1;20913z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]20914.i, z__1.i = alpha->r * b[i__3].i +20915alpha->i * b[i__3].r;20916b[i__2].r = z__1.r, b[i__2].i = z__1.i;20917/* L240: */20918}20919}20920i__1 = *n;20921for (k = j + 1; k <= i__1; ++k) {20922i__2 = k + j * a_dim1;20923if (a[i__2].r != 0. || a[i__2].i != 0.) {20924i__2 = *m;20925for (i__ = 1; i__ <= i__2; ++i__) {20926i__3 = i__ + j * b_dim1;20927i__4 = i__ + j * b_dim1;20928i__5 = k + j * a_dim1;20929i__6 = i__ + k * b_dim1;20930z__2.r = a[i__5].r * b[i__6].r - a[i__5].i *20931b[i__6].i, z__2.i = a[i__5].r * b[20932i__6].i + a[i__5].i * b[i__6].r;20933z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]20934.i - z__2.i;20935b[i__3].r = z__1.r, b[i__3].i = z__1.i;20936/* L250: */20937}20938}20939/* L260: */20940}20941if (nounit) {20942z_div(&z__1, &c_b1078, &a[j + j * a_dim1]);20943temp.r = z__1.r, temp.i = z__1.i;20944i__1 = *m;20945for (i__ = 1; i__ <= i__1; ++i__) {20946i__2 = i__ + j * b_dim1;20947i__3 = i__ + j * b_dim1;20948z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,20949z__1.i = temp.r * b[i__3].i + temp.i * b[20950i__3].r;20951b[i__2].r = z__1.r, b[i__2].i = z__1.i;20952/* L270: */20953}20954}20955/* L280: */20956}20957}20958} else {2095920960/*20961Form B := alpha*B*inv( A' )20962or B := alpha*B*inv( conjg( A' ) ).20963*/2096420965if (upper) {20966for (k = *n; k >= 1; --k) {20967if (nounit) {20968if (noconj) {20969z_div(&z__1, &c_b1078, &a[k + k * a_dim1]);20970temp.r = z__1.r, temp.i = z__1.i;20971} else {20972d_cnjg(&z__2, &a[k + k * a_dim1]);20973z_div(&z__1, &c_b1078, &z__2);20974temp.r = z__1.r, temp.i = z__1.i;20975}20976i__1 = *m;20977for (i__ = 1; i__ <= i__1; ++i__) {20978i__2 = i__ + k * b_dim1;20979i__3 = i__ + k * b_dim1;20980z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,20981z__1.i = temp.r * b[i__3].i + temp.i * b[20982i__3].r;20983b[i__2].r = z__1.r, b[i__2].i = z__1.i;20984/* L290: */20985}20986}20987i__1 = k - 1;20988for (j = 1; j <= i__1; ++j) {20989i__2 = j + k * a_dim1;20990if (a[i__2].r != 0. || a[i__2].i != 0.) {20991if (noconj) {20992i__2 = j + k * a_dim1;20993temp.r = a[i__2].r, temp.i = a[i__2].i;20994} else {20995d_cnjg(&z__1, &a[j + k * a_dim1]);20996temp.r = z__1.r, temp.i = z__1.i;20997}20998i__2 = *m;20999for (i__ = 1; i__ <= i__2; ++i__) {21000i__3 = i__ + j * b_dim1;21001i__4 = i__ + j * b_dim1;21002i__5 = i__ + k * b_dim1;21003z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]21004.i, z__2.i = temp.r * b[i__5].i +21005temp.i * b[i__5].r;21006z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]21007.i - z__2.i;21008b[i__3].r = z__1.r, b[i__3].i = z__1.i;21009/* L300: */21010}21011}21012/* L310: */21013}21014if (alpha->r != 1. || alpha->i != 0.) {21015i__1 = *m;21016for (i__ = 1; i__ <= i__1; ++i__) {21017i__2 = i__ + k * b_dim1;21018i__3 = i__ + k * b_dim1;21019z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]21020.i, z__1.i = alpha->r * b[i__3].i +21021alpha->i * b[i__3].r;21022b[i__2].r = z__1.r, b[i__2].i = z__1.i;21023/* L320: */21024}21025}21026/* L330: */21027}21028} else {21029i__1 = *n;21030for (k = 1; k <= i__1; ++k) {21031if (nounit) {21032if (noconj) {21033z_div(&z__1, &c_b1078, &a[k + k * a_dim1]);21034temp.r = z__1.r, temp.i = z__1.i;21035} else {21036d_cnjg(&z__2, &a[k + k * a_dim1]);21037z_div(&z__1, &c_b1078, &z__2);21038temp.r = z__1.r, temp.i = z__1.i;21039}21040i__2 = *m;21041for (i__ = 1; i__ <= i__2; ++i__) {21042i__3 = i__ + k * b_dim1;21043i__4 = i__ + k * b_dim1;21044z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,21045z__1.i = temp.r * b[i__4].i + temp.i * b[21046i__4].r;21047b[i__3].r = z__1.r, b[i__3].i = z__1.i;21048/* L340: */21049}21050}21051i__2 = *n;21052for (j = k + 1; j <= i__2; ++j) {21053i__3 = j + k * a_dim1;21054if (a[i__3].r != 0. || a[i__3].i != 0.) {21055if (noconj) {21056i__3 = j + k * a_dim1;21057temp.r = a[i__3].r, temp.i = a[i__3].i;21058} else {21059d_cnjg(&z__1, &a[j + k * a_dim1]);21060temp.r = z__1.r, temp.i = z__1.i;21061}21062i__3 = *m;21063for (i__ = 1; i__ <= i__3; ++i__) {21064i__4 = i__ + j * b_dim1;21065i__5 = i__ + j * b_dim1;21066i__6 = i__ + k * b_dim1;21067z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]21068.i, z__2.i = temp.r * b[i__6].i +21069temp.i * b[i__6].r;21070z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]21071.i - z__2.i;21072b[i__4].r = z__1.r, b[i__4].i = z__1.i;21073/* L350: */21074}21075}21076/* L360: */21077}21078if (alpha->r != 1. || alpha->i != 0.) {21079i__2 = *m;21080for (i__ = 1; i__ <= i__2; ++i__) {21081i__3 = i__ + k * b_dim1;21082i__4 = i__ + k * b_dim1;21083z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]21084.i, z__1.i = alpha->r * b[i__4].i +21085alpha->i * b[i__4].r;21086b[i__3].r = z__1.r, b[i__3].i = z__1.i;21087/* L370: */21088}21089}21090/* L380: */21091}21092}21093}21094}2109521096return 0;2109721098/* End of ZTRSM . */2109921100} /* ztrsm_ */2110121102/* Subroutine */ int ztrsv_(char *uplo, char *trans, char *diag, integer *n,21103doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)21104{21105/* System generated locals */21106integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;21107doublecomplex z__1, z__2, z__3;2110821109/* Local variables */21110static integer i__, j, ix, jx, kx, info;21111static doublecomplex temp;21112extern logical lsame_(char *, char *);21113extern /* Subroutine */ int xerbla_(char *, integer *);21114static logical noconj, nounit;211152111621117/*21118Purpose21119=======2112021121ZTRSV solves one of the systems of equations2112221123A*x = b, or A'*x = b, or conjg( A' )*x = b,2112421125where b and x are n element vectors and A is an n by n unit, or21126non-unit, upper or lower triangular matrix.2112721128No test for singularity or near-singularity is included in this21129routine. Such tests must be performed before calling this routine.2113021131Arguments21132==========2113321134UPLO - CHARACTER*1.21135On entry, UPLO specifies whether the matrix is an upper or21136lower triangular matrix as follows:2113721138UPLO = 'U' or 'u' A is an upper triangular matrix.2113921140UPLO = 'L' or 'l' A is a lower triangular matrix.2114121142Unchanged on exit.2114321144TRANS - CHARACTER*1.21145On entry, TRANS specifies the equations to be solved as21146follows:2114721148TRANS = 'N' or 'n' A*x = b.2114921150TRANS = 'T' or 't' A'*x = b.2115121152TRANS = 'C' or 'c' conjg( A' )*x = b.2115321154Unchanged on exit.2115521156DIAG - CHARACTER*1.21157On entry, DIAG specifies whether or not A is unit21158triangular as follows:2115921160DIAG = 'U' or 'u' A is assumed to be unit triangular.2116121162DIAG = 'N' or 'n' A is not assumed to be unit21163triangular.2116421165Unchanged on exit.2116621167N - INTEGER.21168On entry, N specifies the order of the matrix A.21169N must be at least zero.21170Unchanged on exit.2117121172A - COMPLEX*16 array of DIMENSION ( LDA, n ).21173Before entry with UPLO = 'U' or 'u', the leading n by n21174upper triangular part of the array A must contain the upper21175triangular matrix and the strictly lower triangular part of21176A is not referenced.21177Before entry with UPLO = 'L' or 'l', the leading n by n21178lower triangular part of the array A must contain the lower21179triangular matrix and the strictly upper triangular part of21180A is not referenced.21181Note that when DIAG = 'U' or 'u', the diagonal elements of21182A are not referenced either, but are assumed to be unity.21183Unchanged on exit.2118421185LDA - INTEGER.21186On entry, LDA specifies the first dimension of A as declared21187in the calling (sub) program. LDA must be at least21188max( 1, n ).21189Unchanged on exit.2119021191X - COMPLEX*16 array of dimension at least21192( 1 + ( n - 1 )*abs( INCX ) ).21193Before entry, the incremented array X must contain the n21194element right-hand side vector b. On exit, X is overwritten21195with the solution vector x.2119621197INCX - INTEGER.21198On entry, INCX specifies the increment for the elements of21199X. INCX must not be zero.21200Unchanged on exit.2120121202Further Details21203===============2120421205Level 2 Blas routine.2120621207-- Written on 22-October-1986.21208Jack Dongarra, Argonne National Lab.21209Jeremy Du Croz, Nag Central Office.21210Sven Hammarling, Nag Central Office.21211Richard Hanson, Sandia National Labs.2121221213=====================================================================212142121521216Test the input parameters.21217*/2121821219/* Parameter adjustments */21220a_dim1 = *lda;21221a_offset = 1 + a_dim1;21222a -= a_offset;21223--x;2122421225/* Function Body */21226info = 0;21227if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {21228info = 1;21229} else if (! lsame_(trans, "N") && ! lsame_(trans,21230"T") && ! lsame_(trans, "C")) {21231info = 2;21232} else if (! lsame_(diag, "U") && ! lsame_(diag,21233"N")) {21234info = 3;21235} else if (*n < 0) {21236info = 4;21237} else if (*lda < max(1,*n)) {21238info = 6;21239} else if (*incx == 0) {21240info = 8;21241}21242if (info != 0) {21243xerbla_("ZTRSV ", &info);21244return 0;21245}2124621247/* Quick return if possible. */2124821249if (*n == 0) {21250return 0;21251}2125221253noconj = lsame_(trans, "T");21254nounit = lsame_(diag, "N");2125521256/*21257Set up the start point in X if the increment is not unity. This21258will be ( N - 1 )*INCX too small for descending loops.21259*/2126021261if (*incx <= 0) {21262kx = 1 - (*n - 1) * *incx;21263} else if (*incx != 1) {21264kx = 1;21265}2126621267/*21268Start the operations. In this version the elements of A are21269accessed sequentially with one pass through A.21270*/2127121272if (lsame_(trans, "N")) {2127321274/* Form x := inv( A )*x. */2127521276if (lsame_(uplo, "U")) {21277if (*incx == 1) {21278for (j = *n; j >= 1; --j) {21279i__1 = j;21280if (x[i__1].r != 0. || x[i__1].i != 0.) {21281if (nounit) {21282i__1 = j;21283z_div(&z__1, &x[j], &a[j + j * a_dim1]);21284x[i__1].r = z__1.r, x[i__1].i = z__1.i;21285}21286i__1 = j;21287temp.r = x[i__1].r, temp.i = x[i__1].i;21288for (i__ = j - 1; i__ >= 1; --i__) {21289i__1 = i__;21290i__2 = i__;21291i__3 = i__ + j * a_dim1;21292z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,21293z__2.i = temp.r * a[i__3].i + temp.i * a[21294i__3].r;21295z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i -21296z__2.i;21297x[i__1].r = z__1.r, x[i__1].i = z__1.i;21298/* L10: */21299}21300}21301/* L20: */21302}21303} else {21304jx = kx + (*n - 1) * *incx;21305for (j = *n; j >= 1; --j) {21306i__1 = jx;21307if (x[i__1].r != 0. || x[i__1].i != 0.) {21308if (nounit) {21309i__1 = jx;21310z_div(&z__1, &x[jx], &a[j + j * a_dim1]);21311x[i__1].r = z__1.r, x[i__1].i = z__1.i;21312}21313i__1 = jx;21314temp.r = x[i__1].r, temp.i = x[i__1].i;21315ix = jx;21316for (i__ = j - 1; i__ >= 1; --i__) {21317ix -= *incx;21318i__1 = ix;21319i__2 = ix;21320i__3 = i__ + j * a_dim1;21321z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,21322z__2.i = temp.r * a[i__3].i + temp.i * a[21323i__3].r;21324z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i -21325z__2.i;21326x[i__1].r = z__1.r, x[i__1].i = z__1.i;21327/* L30: */21328}21329}21330jx -= *incx;21331/* L40: */21332}21333}21334} else {21335if (*incx == 1) {21336i__1 = *n;21337for (j = 1; j <= i__1; ++j) {21338i__2 = j;21339if (x[i__2].r != 0. || x[i__2].i != 0.) {21340if (nounit) {21341i__2 = j;21342z_div(&z__1, &x[j], &a[j + j * a_dim1]);21343x[i__2].r = z__1.r, x[i__2].i = z__1.i;21344}21345i__2 = j;21346temp.r = x[i__2].r, temp.i = x[i__2].i;21347i__2 = *n;21348for (i__ = j + 1; i__ <= i__2; ++i__) {21349i__3 = i__;21350i__4 = i__;21351i__5 = i__ + j * a_dim1;21352z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,21353z__2.i = temp.r * a[i__5].i + temp.i * a[21354i__5].r;21355z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i -21356z__2.i;21357x[i__3].r = z__1.r, x[i__3].i = z__1.i;21358/* L50: */21359}21360}21361/* L60: */21362}21363} else {21364jx = kx;21365i__1 = *n;21366for (j = 1; j <= i__1; ++j) {21367i__2 = jx;21368if (x[i__2].r != 0. || x[i__2].i != 0.) {21369if (nounit) {21370i__2 = jx;21371z_div(&z__1, &x[jx], &a[j + j * a_dim1]);21372x[i__2].r = z__1.r, x[i__2].i = z__1.i;21373}21374i__2 = jx;21375temp.r = x[i__2].r, temp.i = x[i__2].i;21376ix = jx;21377i__2 = *n;21378for (i__ = j + 1; i__ <= i__2; ++i__) {21379ix += *incx;21380i__3 = ix;21381i__4 = ix;21382i__5 = i__ + j * a_dim1;21383z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,21384z__2.i = temp.r * a[i__5].i + temp.i * a[21385i__5].r;21386z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i -21387z__2.i;21388x[i__3].r = z__1.r, x[i__3].i = z__1.i;21389/* L70: */21390}21391}21392jx += *incx;21393/* L80: */21394}21395}21396}21397} else {2139821399/* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x. */2140021401if (lsame_(uplo, "U")) {21402if (*incx == 1) {21403i__1 = *n;21404for (j = 1; j <= i__1; ++j) {21405i__2 = j;21406temp.r = x[i__2].r, temp.i = x[i__2].i;21407if (noconj) {21408i__2 = j - 1;21409for (i__ = 1; i__ <= i__2; ++i__) {21410i__3 = i__ + j * a_dim1;21411i__4 = i__;21412z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[21413i__4].i, z__2.i = a[i__3].r * x[i__4].i +21414a[i__3].i * x[i__4].r;21415z__1.r = temp.r - z__2.r, z__1.i = temp.i -21416z__2.i;21417temp.r = z__1.r, temp.i = z__1.i;21418/* L90: */21419}21420if (nounit) {21421z_div(&z__1, &temp, &a[j + j * a_dim1]);21422temp.r = z__1.r, temp.i = z__1.i;21423}21424} else {21425i__2 = j - 1;21426for (i__ = 1; i__ <= i__2; ++i__) {21427d_cnjg(&z__3, &a[i__ + j * a_dim1]);21428i__3 = i__;21429z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,21430z__2.i = z__3.r * x[i__3].i + z__3.i * x[21431i__3].r;21432z__1.r = temp.r - z__2.r, z__1.i = temp.i -21433z__2.i;21434temp.r = z__1.r, temp.i = z__1.i;21435/* L100: */21436}21437if (nounit) {21438d_cnjg(&z__2, &a[j + j * a_dim1]);21439z_div(&z__1, &temp, &z__2);21440temp.r = z__1.r, temp.i = z__1.i;21441}21442}21443i__2 = j;21444x[i__2].r = temp.r, x[i__2].i = temp.i;21445/* L110: */21446}21447} else {21448jx = kx;21449i__1 = *n;21450for (j = 1; j <= i__1; ++j) {21451ix = kx;21452i__2 = jx;21453temp.r = x[i__2].r, temp.i = x[i__2].i;21454if (noconj) {21455i__2 = j - 1;21456for (i__ = 1; i__ <= i__2; ++i__) {21457i__3 = i__ + j * a_dim1;21458i__4 = ix;21459z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[21460i__4].i, z__2.i = a[i__3].r * x[i__4].i +21461a[i__3].i * x[i__4].r;21462z__1.r = temp.r - z__2.r, z__1.i = temp.i -21463z__2.i;21464temp.r = z__1.r, temp.i = z__1.i;21465ix += *incx;21466/* L120: */21467}21468if (nounit) {21469z_div(&z__1, &temp, &a[j + j * a_dim1]);21470temp.r = z__1.r, temp.i = z__1.i;21471}21472} else {21473i__2 = j - 1;21474for (i__ = 1; i__ <= i__2; ++i__) {21475d_cnjg(&z__3, &a[i__ + j * a_dim1]);21476i__3 = ix;21477z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,21478z__2.i = z__3.r * x[i__3].i + z__3.i * x[21479i__3].r;21480z__1.r = temp.r - z__2.r, z__1.i = temp.i -21481z__2.i;21482temp.r = z__1.r, temp.i = z__1.i;21483ix += *incx;21484/* L130: */21485}21486if (nounit) {21487d_cnjg(&z__2, &a[j + j * a_dim1]);21488z_div(&z__1, &temp, &z__2);21489temp.r = z__1.r, temp.i = z__1.i;21490}21491}21492i__2 = jx;21493x[i__2].r = temp.r, x[i__2].i = temp.i;21494jx += *incx;21495/* L140: */21496}21497}21498} else {21499if (*incx == 1) {21500for (j = *n; j >= 1; --j) {21501i__1 = j;21502temp.r = x[i__1].r, temp.i = x[i__1].i;21503if (noconj) {21504i__1 = j + 1;21505for (i__ = *n; i__ >= i__1; --i__) {21506i__2 = i__ + j * a_dim1;21507i__3 = i__;21508z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[21509i__3].i, z__2.i = a[i__2].r * x[i__3].i +21510a[i__2].i * x[i__3].r;21511z__1.r = temp.r - z__2.r, z__1.i = temp.i -21512z__2.i;21513temp.r = z__1.r, temp.i = z__1.i;21514/* L150: */21515}21516if (nounit) {21517z_div(&z__1, &temp, &a[j + j * a_dim1]);21518temp.r = z__1.r, temp.i = z__1.i;21519}21520} else {21521i__1 = j + 1;21522for (i__ = *n; i__ >= i__1; --i__) {21523d_cnjg(&z__3, &a[i__ + j * a_dim1]);21524i__2 = i__;21525z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,21526z__2.i = z__3.r * x[i__2].i + z__3.i * x[21527i__2].r;21528z__1.r = temp.r - z__2.r, z__1.i = temp.i -21529z__2.i;21530temp.r = z__1.r, temp.i = z__1.i;21531/* L160: */21532}21533if (nounit) {21534d_cnjg(&z__2, &a[j + j * a_dim1]);21535z_div(&z__1, &temp, &z__2);21536temp.r = z__1.r, temp.i = z__1.i;21537}21538}21539i__1 = j;21540x[i__1].r = temp.r, x[i__1].i = temp.i;21541/* L170: */21542}21543} else {21544kx += (*n - 1) * *incx;21545jx = kx;21546for (j = *n; j >= 1; --j) {21547ix = kx;21548i__1 = jx;21549temp.r = x[i__1].r, temp.i = x[i__1].i;21550if (noconj) {21551i__1 = j + 1;21552for (i__ = *n; i__ >= i__1; --i__) {21553i__2 = i__ + j * a_dim1;21554i__3 = ix;21555z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[21556i__3].i, z__2.i = a[i__2].r * x[i__3].i +21557a[i__2].i * x[i__3].r;21558z__1.r = temp.r - z__2.r, z__1.i = temp.i -21559z__2.i;21560temp.r = z__1.r, temp.i = z__1.i;21561ix -= *incx;21562/* L180: */21563}21564if (nounit) {21565z_div(&z__1, &temp, &a[j + j * a_dim1]);21566temp.r = z__1.r, temp.i = z__1.i;21567}21568} else {21569i__1 = j + 1;21570for (i__ = *n; i__ >= i__1; --i__) {21571d_cnjg(&z__3, &a[i__ + j * a_dim1]);21572i__2 = ix;21573z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,21574z__2.i = z__3.r * x[i__2].i + z__3.i * x[21575i__2].r;21576z__1.r = temp.r - z__2.r, z__1.i = temp.i -21577z__2.i;21578temp.r = z__1.r, temp.i = z__1.i;21579ix -= *incx;21580/* L190: */21581}21582if (nounit) {21583d_cnjg(&z__2, &a[j + j * a_dim1]);21584z_div(&z__1, &temp, &z__2);21585temp.r = z__1.r, temp.i = z__1.i;21586}21587}21588i__1 = jx;21589x[i__1].r = temp.r, x[i__1].i = temp.i;21590jx -= *incx;21591/* L200: */21592}21593}21594}21595}2159621597return 0;2159821599/* End of ZTRSV . */2160021601} /* ztrsv_ */21602216032160421605