1 /* ../netlib/zsytrs_rook.f -- translated by f2c (version 20100827). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib;
2  on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */
3 #include "FLA_f2c.h" /* Table of constant values */
4 static doublecomplex c_b1 =
5 {
6     1.,0.
7 }
8 ;
9 static integer c__1 = 1;
10 /* > \brief \b ZSYTRS_ROOK */
11 /* =========== DOCUMENTATION =========== */
12 /* Online html documentation available at */
13 /* http://www.netlib.org/lapack/explore-html/ */
14 /* > \htmlonly */
15 /* > Download ZSYTRS_ROOK + dependencies */
16 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsytrs_ rook.f"> */
17 /* > [TGZ]</a> */
18 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsytrs_ rook.f"> */
19 /* > [ZIP]</a> */
20 /* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsytrs_ rook.f"> */
21 /* > [TXT]</a> */
22 /* > \endhtmlonly */
23 /* Definition: */
24 /* =========== */
25 /* SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) */
26 /* .. Scalar Arguments .. */
27 /* CHARACTER UPLO */
28 /* INTEGER INFO, LDA, LDB, N, NRHS */
29 /* .. */
30 /* .. Array Arguments .. */
31 /* INTEGER IPIV( * ) */
32 /* COMPLEX*16 A( LDA, * ), B( LDB, * ) */
33 /* .. */
34 /* > \par Purpose: */
35 /* ============= */
36 /* > */
37 /* > \verbatim */
38 /* > */
39 /* > ZSYTRS_ROOK solves a system of linear equations A*X = B with */
40 /* > a complex symmetric matrix A using the factorization A = U*D*U**T or */
41 /* > A = L*D*L**T computed by ZSYTRF_ROOK. */
42 /* > \endverbatim */
43 /* Arguments: */
44 /* ========== */
45 /* > \param[in] UPLO */
46 /* > \verbatim */
47 /* > UPLO is CHARACTER*1 */
48 /* > Specifies whether the details of the factorization are stored */
49 /* > as an upper or lower triangular matrix. */
50 /* > = 'U': Upper triangular, form is A = U*D*U**T;
51 */
52 /* > = 'L': Lower triangular, form is A = L*D*L**T. */
53 /* > \endverbatim */
54 /* > */
55 /* > \param[in] N */
56 /* > \verbatim */
57 /* > N is INTEGER */
58 /* > The order of the matrix A. N >= 0. */
59 /* > \endverbatim */
60 /* > */
61 /* > \param[in] NRHS */
62 /* > \verbatim */
63 /* > NRHS is INTEGER */
64 /* > The number of right hand sides, i.e., the number of columns */
65 /* > of the matrix B. NRHS >= 0. */
66 /* > \endverbatim */
67 /* > */
68 /* > \param[in] A */
69 /* > \verbatim */
70 /* > A is COMPLEX*16 array, dimension (LDA,N) */
71 /* > The block diagonal matrix D and the multipliers used to */
72 /* > obtain the factor U or L as computed by ZSYTRF_ROOK. */
73 /* > \endverbatim */
74 /* > */
75 /* > \param[in] LDA */
76 /* > \verbatim */
77 /* > LDA is INTEGER */
78 /* > The leading dimension of the array A. LDA >= max(1,N). */
79 /* > \endverbatim */
80 /* > */
81 /* > \param[in] IPIV */
82 /* > \verbatim */
83 /* > IPIV is INTEGER array, dimension (N) */
84 /* > Details of the interchanges and the block structure of D */
85 /* > as determined by ZSYTRF_ROOK. */
86 /* > \endverbatim */
87 /* > */
88 /* > \param[in,out] B */
89 /* > \verbatim */
90 /* > B is COMPLEX*16 array, dimension (LDB,NRHS) */
91 /* > On entry, the right hand side matrix B. */
92 /* > On exit, the solution matrix X. */
93 /* > \endverbatim */
94 /* > */
95 /* > \param[in] LDB */
96 /* > \verbatim */
97 /* > LDB is INTEGER */
98 /* > The leading dimension of the array B. LDB >= max(1,N). */
99 /* > \endverbatim */
100 /* > */
101 /* > \param[out] INFO */
102 /* > \verbatim */
103 /* > INFO is INTEGER */
104 /* > = 0: successful exit */
105 /* > < 0: if INFO = -i, the i-th argument had an illegal value */
106 /* > \endverbatim */
107 /* Authors: */
108 /* ======== */
109 /* > \author Univ. of Tennessee */
110 /* > \author Univ. of California Berkeley */
111 /* > \author Univ. of Colorado Denver */
112 /* > \author NAG Ltd. */
113 /* > \date November 2011 */
114 /* > \ingroup complex16SYcomputational */
115 /* > \par Contributors: */
116 /* ================== */
117 /* > */
118 /* > \verbatim */
119 /* > */
120 /* > November 2011, Igor Kozachenko, */
121 /* > Computer Science Division, */
122 /* > University of California, Berkeley */
123 /* > */
124 /* > September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas, */
125 /* > School of Mathematics, */
126 /* > University of Manchester */
127 /* > */
128 /* > \endverbatim */
129 /* ===================================================================== */
130 /* Subroutine */
zsytrs_rook_(char * uplo,integer * n,integer * nrhs,doublecomplex * a,integer * lda,integer * ipiv,doublecomplex * b,integer * ldb,integer * info)131 int zsytrs_rook_(char *uplo, integer *n, integer *nrhs, doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer *info)
132 {
133     /* System generated locals */
134     integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
135     doublecomplex z__1, z__2, z__3;
136     /* Builtin functions */
137     void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
138     /* Local variables */
139     integer j, k;
140     doublecomplex ak, bk;
141     integer kp;
142     doublecomplex akm1, bkm1, akm1k;
143     extern logical lsame_(char *, char *);
144     doublecomplex denom;
145     extern /* Subroutine */
146     int zscal_(integer *, doublecomplex *, doublecomplex *, integer *), zgemv_(char *, integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *);
147     logical upper;
148     extern /* Subroutine */
149     int zgeru_(integer *, integer *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *);
150     /* -- LAPACK computational routine (version 3.4.0) -- */
151     /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
152     /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
153     /* November 2011 */
154     /* .. Scalar Arguments .. */
155     /* .. */
156     /* .. Array Arguments .. */
157     /* .. */
158     /* ===================================================================== */
159     /* .. Parameters .. */
160     /* .. */
161     /* .. Local Scalars .. */
162     /* .. */
163     /* .. External Functions .. */
164     /* .. */
165     /* .. External Subroutines .. */
166     /* .. */
167     /* .. Intrinsic Functions .. */
168     /* .. */
169     /* .. Executable Statements .. */
170     /* Parameter adjustments */
171     a_dim1 = *lda;
172     a_offset = 1 + a_dim1;
173     a -= a_offset;
174     --ipiv;
175     b_dim1 = *ldb;
176     b_offset = 1 + b_dim1;
177     b -= b_offset;
178     /* Function Body */
179     *info = 0;
180     upper = lsame_(uplo, "U");
181     if (! upper && ! lsame_(uplo, "L"))
182     {
183         *info = -1;
184     }
185     else if (*n < 0)
186     {
187         *info = -2;
188     }
189     else if (*nrhs < 0)
190     {
191         *info = -3;
192     }
193     else if (*lda < max(1,*n))
194     {
195         *info = -5;
196     }
197     else if (*ldb < max(1,*n))
198     {
199         *info = -8;
200     }
201     if (*info != 0)
202     {
203         i__1 = -(*info);
204         xerbla_("ZSYTRS_ROOK", &i__1);
205         return 0;
206     }
207     /* Quick return if possible */
208     if (*n == 0 || *nrhs == 0)
209     {
210         return 0;
211     }
212     if (upper)
213     {
214         /* Solve A*X = B, where A = U*D*U**T. */
215         /* First solve U*D*X = B, overwriting B with X. */
216         /* K is the main loop index, decreasing from N to 1 in steps of */
217         /* 1 or 2, depending on the size of the diagonal blocks. */
218         k = *n;
219 L10: /* If K < 1, exit from loop. */
220         if (k < 1)
221         {
222             goto L30;
223         }
224         if (ipiv[k] > 0)
225         {
226             /* 1 x 1 diagonal block */
227             /* Interchange rows K and IPIV(K). */
228             kp = ipiv[k];
229             if (kp != k)
230             {
231                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
232             }
233             /* Multiply by inv(U(K)), where U(K) is the transformation */
234             /* stored in column K of A. */
235             i__1 = k - 1;
236             z__1.r = -1.;
237             z__1.i = -0.; // , expr subst
238             zgeru_(&i__1, nrhs, &z__1, &a[k * a_dim1 + 1], &c__1, &b[k + b_dim1], ldb, &b[b_dim1 + 1], ldb);
239             /* Multiply by the inverse of the diagonal block. */
240             z_div(&z__1, &c_b1, &a[k + k * a_dim1]);
241             zscal_(nrhs, &z__1, &b[k + b_dim1], ldb);
242             --k;
243         }
244         else
245         {
246             /* 2 x 2 diagonal block */
247             /* Interchange rows K and -IPIV(K) THEN K-1 and -IPIV(K-1) */
248             kp = -ipiv[k];
249             if (kp != k)
250             {
251                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
252             }
253             kp = -ipiv[k - 1];
254             if (kp != k - 1)
255             {
256                 zswap_(nrhs, &b[k - 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
257             }
258             /* Multiply by inv(U(K)), where U(K) is the transformation */
259             /* stored in columns K-1 and K of A. */
260             if (k > 2)
261             {
262                 i__1 = k - 2;
263                 z__1.r = -1.;
264                 z__1.i = -0.; // , expr subst
265                 zgeru_(&i__1, nrhs, &z__1, &a[k * a_dim1 + 1], &c__1, &b[k + b_dim1], ldb, &b[b_dim1 + 1], ldb);
266                 i__1 = k - 2;
267                 z__1.r = -1.;
268                 z__1.i = -0.; // , expr subst
269                 zgeru_(&i__1, nrhs, &z__1, &a[(k - 1) * a_dim1 + 1], &c__1, & b[k - 1 + b_dim1], ldb, &b[b_dim1 + 1], ldb);
270             }
271             /* Multiply by the inverse of the diagonal block. */
272             i__1 = k - 1 + k * a_dim1;
273             akm1k.r = a[i__1].r;
274             akm1k.i = a[i__1].i; // , expr subst
275             z_div(&z__1, &a[k - 1 + (k - 1) * a_dim1], &akm1k);
276             akm1.r = z__1.r;
277             akm1.i = z__1.i; // , expr subst
278             z_div(&z__1, &a[k + k * a_dim1], &akm1k);
279             ak.r = z__1.r;
280             ak.i = z__1.i; // , expr subst
281             z__2.r = akm1.r * ak.r - akm1.i * ak.i;
282             z__2.i = akm1.r * ak.i + akm1.i * ak.r; // , expr subst
283             z__1.r = z__2.r - 1.;
284             z__1.i = z__2.i - 0.; // , expr subst
285             denom.r = z__1.r;
286             denom.i = z__1.i; // , expr subst
287             i__1 = *nrhs;
288             for (j = 1;
289                     j <= i__1;
290                     ++j)
291             {
292                 z_div(&z__1, &b[k - 1 + j * b_dim1], &akm1k);
293                 bkm1.r = z__1.r;
294                 bkm1.i = z__1.i; // , expr subst
295                 z_div(&z__1, &b[k + j * b_dim1], &akm1k);
296                 bk.r = z__1.r;
297                 bk.i = z__1.i; // , expr subst
298                 i__2 = k - 1 + j * b_dim1;
299                 z__3.r = ak.r * bkm1.r - ak.i * bkm1.i;
300                 z__3.i = ak.r * bkm1.i + ak.i * bkm1.r; // , expr subst
301                 z__2.r = z__3.r - bk.r;
302                 z__2.i = z__3.i - bk.i; // , expr subst
303                 z_div(&z__1, &z__2, &denom);
304                 b[i__2].r = z__1.r;
305                 b[i__2].i = z__1.i; // , expr subst
306                 i__2 = k + j * b_dim1;
307                 z__3.r = akm1.r * bk.r - akm1.i * bk.i;
308                 z__3.i = akm1.r * bk.i + akm1.i * bk.r; // , expr subst
309                 z__2.r = z__3.r - bkm1.r;
310                 z__2.i = z__3.i - bkm1.i; // , expr subst
311                 z_div(&z__1, &z__2, &denom);
312                 b[i__2].r = z__1.r;
313                 b[i__2].i = z__1.i; // , expr subst
314                 /* L20: */
315             }
316             k += -2;
317         }
318         goto L10;
319 L30: /* Next solve U**T *X = B, overwriting B with X. */
320         /* K is the main loop index, increasing from 1 to N in steps of */
321         /* 1 or 2, depending on the size of the diagonal blocks. */
322         k = 1;
323 L40: /* If K > N, exit from loop. */
324         if (k > *n)
325         {
326             goto L50;
327         }
328         if (ipiv[k] > 0)
329         {
330             /* 1 x 1 diagonal block */
331             /* Multiply by inv(U**T(K)), where U(K) is the transformation */
332             /* stored in column K of A. */
333             if (k > 1)
334             {
335                 i__1 = k - 1;
336                 z__1.r = -1.;
337                 z__1.i = -0.; // , expr subst
338                 zgemv_("Transpose", &i__1, nrhs, &z__1, &b[b_offset], ldb, &a[ k * a_dim1 + 1], &c__1, &c_b1, &b[k + b_dim1], ldb);
339             }
340             /* Interchange rows K and IPIV(K). */
341             kp = ipiv[k];
342             if (kp != k)
343             {
344                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
345             }
346             ++k;
347         }
348         else
349         {
350             /* 2 x 2 diagonal block */
351             /* Multiply by inv(U**T(K+1)), where U(K+1) is the transformation */
352             /* stored in columns K and K+1 of A. */
353             if (k > 1)
354             {
355                 i__1 = k - 1;
356                 z__1.r = -1.;
357                 z__1.i = -0.; // , expr subst
358                 zgemv_("Transpose", &i__1, nrhs, &z__1, &b[b_offset], ldb, &a[ k * a_dim1 + 1], &c__1, &c_b1, &b[k + b_dim1], ldb);
359                 i__1 = k - 1;
360                 z__1.r = -1.;
361                 z__1.i = -0.; // , expr subst
362                 zgemv_("Transpose", &i__1, nrhs, &z__1, &b[b_offset], ldb, &a[ (k + 1) * a_dim1 + 1], &c__1, &c_b1, &b[k + 1 + b_dim1], ldb);
363             }
364             /* Interchange rows K and -IPIV(K) THEN K+1 and -IPIV(K+1). */
365             kp = -ipiv[k];
366             if (kp != k)
367             {
368                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
369             }
370             kp = -ipiv[k + 1];
371             if (kp != k + 1)
372             {
373                 zswap_(nrhs, &b[k + 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
374             }
375             k += 2;
376         }
377         goto L40;
378 L50:
379         ;
380     }
381     else
382     {
383         /* Solve A*X = B, where A = L*D*L**T. */
384         /* First solve L*D*X = B, overwriting B with X. */
385         /* K is the main loop index, increasing from 1 to N in steps of */
386         /* 1 or 2, depending on the size of the diagonal blocks. */
387         k = 1;
388 L60: /* If K > N, exit from loop. */
389         if (k > *n)
390         {
391             goto L80;
392         }
393         if (ipiv[k] > 0)
394         {
395             /* 1 x 1 diagonal block */
396             /* Interchange rows K and IPIV(K). */
397             kp = ipiv[k];
398             if (kp != k)
399             {
400                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
401             }
402             /* Multiply by inv(L(K)), where L(K) is the transformation */
403             /* stored in column K of A. */
404             if (k < *n)
405             {
406                 i__1 = *n - k;
407                 z__1.r = -1.;
408                 z__1.i = -0.; // , expr subst
409                 zgeru_(&i__1, nrhs, &z__1, &a[k + 1 + k * a_dim1], &c__1, &b[ k + b_dim1], ldb, &b[k + 1 + b_dim1], ldb);
410             }
411             /* Multiply by the inverse of the diagonal block. */
412             z_div(&z__1, &c_b1, &a[k + k * a_dim1]);
413             zscal_(nrhs, &z__1, &b[k + b_dim1], ldb);
414             ++k;
415         }
416         else
417         {
418             /* 2 x 2 diagonal block */
419             /* Interchange rows K and -IPIV(K) THEN K+1 and -IPIV(K+1) */
420             kp = -ipiv[k];
421             if (kp != k)
422             {
423                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
424             }
425             kp = -ipiv[k + 1];
426             if (kp != k + 1)
427             {
428                 zswap_(nrhs, &b[k + 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
429             }
430             /* Multiply by inv(L(K)), where L(K) is the transformation */
431             /* stored in columns K and K+1 of A. */
432             if (k < *n - 1)
433             {
434                 i__1 = *n - k - 1;
435                 z__1.r = -1.;
436                 z__1.i = -0.; // , expr subst
437                 zgeru_(&i__1, nrhs, &z__1, &a[k + 2 + k * a_dim1], &c__1, &b[ k + b_dim1], ldb, &b[k + 2 + b_dim1], ldb);
438                 i__1 = *n - k - 1;
439                 z__1.r = -1.;
440                 z__1.i = -0.; // , expr subst
441                 zgeru_(&i__1, nrhs, &z__1, &a[k + 2 + (k + 1) * a_dim1], & c__1, &b[k + 1 + b_dim1], ldb, &b[k + 2 + b_dim1], ldb);
442             }
443             /* Multiply by the inverse of the diagonal block. */
444             i__1 = k + 1 + k * a_dim1;
445             akm1k.r = a[i__1].r;
446             akm1k.i = a[i__1].i; // , expr subst
447             z_div(&z__1, &a[k + k * a_dim1], &akm1k);
448             akm1.r = z__1.r;
449             akm1.i = z__1.i; // , expr subst
450             z_div(&z__1, &a[k + 1 + (k + 1) * a_dim1], &akm1k);
451             ak.r = z__1.r;
452             ak.i = z__1.i; // , expr subst
453             z__2.r = akm1.r * ak.r - akm1.i * ak.i;
454             z__2.i = akm1.r * ak.i + akm1.i * ak.r; // , expr subst
455             z__1.r = z__2.r - 1.;
456             z__1.i = z__2.i - 0.; // , expr subst
457             denom.r = z__1.r;
458             denom.i = z__1.i; // , expr subst
459             i__1 = *nrhs;
460             for (j = 1;
461                     j <= i__1;
462                     ++j)
463             {
464                 z_div(&z__1, &b[k + j * b_dim1], &akm1k);
465                 bkm1.r = z__1.r;
466                 bkm1.i = z__1.i; // , expr subst
467                 z_div(&z__1, &b[k + 1 + j * b_dim1], &akm1k);
468                 bk.r = z__1.r;
469                 bk.i = z__1.i; // , expr subst
470                 i__2 = k + j * b_dim1;
471                 z__3.r = ak.r * bkm1.r - ak.i * bkm1.i;
472                 z__3.i = ak.r * bkm1.i + ak.i * bkm1.r; // , expr subst
473                 z__2.r = z__3.r - bk.r;
474                 z__2.i = z__3.i - bk.i; // , expr subst
475                 z_div(&z__1, &z__2, &denom);
476                 b[i__2].r = z__1.r;
477                 b[i__2].i = z__1.i; // , expr subst
478                 i__2 = k + 1 + j * b_dim1;
479                 z__3.r = akm1.r * bk.r - akm1.i * bk.i;
480                 z__3.i = akm1.r * bk.i + akm1.i * bk.r; // , expr subst
481                 z__2.r = z__3.r - bkm1.r;
482                 z__2.i = z__3.i - bkm1.i; // , expr subst
483                 z_div(&z__1, &z__2, &denom);
484                 b[i__2].r = z__1.r;
485                 b[i__2].i = z__1.i; // , expr subst
486                 /* L70: */
487             }
488             k += 2;
489         }
490         goto L60;
491 L80: /* Next solve L**T *X = B, overwriting B with X. */
492         /* K is the main loop index, decreasing from N to 1 in steps of */
493         /* 1 or 2, depending on the size of the diagonal blocks. */
494         k = *n;
495 L90: /* If K < 1, exit from loop. */
496         if (k < 1)
497         {
498             goto L100;
499         }
500         if (ipiv[k] > 0)
501         {
502             /* 1 x 1 diagonal block */
503             /* Multiply by inv(L**T(K)), where L(K) is the transformation */
504             /* stored in column K of A. */
505             if (k < *n)
506             {
507                 i__1 = *n - k;
508                 z__1.r = -1.;
509                 z__1.i = -0.; // , expr subst
510                 zgemv_("Transpose", &i__1, nrhs, &z__1, &b[k + 1 + b_dim1], ldb, &a[k + 1 + k * a_dim1], &c__1, &c_b1, &b[k + b_dim1], ldb);
511             }
512             /* Interchange rows K and IPIV(K). */
513             kp = ipiv[k];
514             if (kp != k)
515             {
516                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
517             }
518             --k;
519         }
520         else
521         {
522             /* 2 x 2 diagonal block */
523             /* Multiply by inv(L**T(K-1)), where L(K-1) is the transformation */
524             /* stored in columns K-1 and K of A. */
525             if (k < *n)
526             {
527                 i__1 = *n - k;
528                 z__1.r = -1.;
529                 z__1.i = -0.; // , expr subst
530                 zgemv_("Transpose", &i__1, nrhs, &z__1, &b[k + 1 + b_dim1], ldb, &a[k + 1 + k * a_dim1], &c__1, &c_b1, &b[k + b_dim1], ldb);
531                 i__1 = *n - k;
532                 z__1.r = -1.;
533                 z__1.i = -0.; // , expr subst
534                 zgemv_("Transpose", &i__1, nrhs, &z__1, &b[k + 1 + b_dim1], ldb, &a[k + 1 + (k - 1) * a_dim1], &c__1, &c_b1, &b[k - 1 + b_dim1], ldb);
535             }
536             /* Interchange rows K and -IPIV(K) THEN K-1 and -IPIV(K-1) */
537             kp = -ipiv[k];
538             if (kp != k)
539             {
540                 zswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
541             }
542             kp = -ipiv[k - 1];
543             if (kp != k - 1)
544             {
545                 zswap_(nrhs, &b[k - 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
546             }
547             k += -2;
548         }
549         goto L90;
550 L100:
551         ;
552     }
553     return 0;
554     /* End of ZSYTRS_ROOK */
555 }
556 /* zsytrs_rook__ */
557