1: *> \brief \b ZTRSM
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: * Definition:
9: * ===========
10: *
11: * SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
12: *
13: * .. Scalar Arguments ..
14: * COMPLEX*16 ALPHA
15: * INTEGER LDA,LDB,M,N
16: * CHARACTER DIAG,SIDE,TRANSA,UPLO
17: * ..
18: * .. Array Arguments ..
19: * COMPLEX*16 A(LDA,*),B(LDB,*)
20: * ..
21: *
22: *
23: *> \par Purpose:
24: * =============
25: *>
26: *> \verbatim
27: *>
28: *> ZTRSM solves one of the matrix equations
29: *>
30: *> op( A )*X = alpha*B, or X*op( A ) = alpha*B,
31: *>
32: *> where alpha is a scalar, X and B are m by n matrices, A is a unit, or
33: *> non-unit, upper or lower triangular matrix and op( A ) is one of
34: *>
35: *> op( A ) = A or op( A ) = A**T or op( A ) = A**H.
36: *>
37: *> The matrix X is overwritten on B.
38: *> \endverbatim
39: *
40: * Arguments:
41: * ==========
42: *
43: *> \param[in] SIDE
44: *> \verbatim
45: *> SIDE is CHARACTER*1
46: *> On entry, SIDE specifies whether op( A ) appears on the left
47: *> or right of X as follows:
48: *>
49: *> SIDE = 'L' or 'l' op( A )*X = alpha*B.
50: *>
51: *> SIDE = 'R' or 'r' X*op( A ) = alpha*B.
52: *> \endverbatim
53: *>
54: *> \param[in] UPLO
55: *> \verbatim
56: *> UPLO is CHARACTER*1
57: *> On entry, UPLO specifies whether the matrix A is an upper or
58: *> lower triangular matrix as follows:
59: *>
60: *> UPLO = 'U' or 'u' A is an upper triangular matrix.
61: *>
62: *> UPLO = 'L' or 'l' A is a lower triangular matrix.
63: *> \endverbatim
64: *>
65: *> \param[in] TRANSA
66: *> \verbatim
67: *> TRANSA is CHARACTER*1
68: *> On entry, TRANSA specifies the form of op( A ) to be used in
69: *> the matrix multiplication as follows:
70: *>
71: *> TRANSA = 'N' or 'n' op( A ) = A.
72: *>
73: *> TRANSA = 'T' or 't' op( A ) = A**T.
74: *>
75: *> TRANSA = 'C' or 'c' op( A ) = A**H.
76: *> \endverbatim
77: *>
78: *> \param[in] DIAG
79: *> \verbatim
80: *> DIAG is CHARACTER*1
81: *> On entry, DIAG specifies whether or not A is unit triangular
82: *> as follows:
83: *>
84: *> DIAG = 'U' or 'u' A is assumed to be unit triangular.
85: *>
86: *> DIAG = 'N' or 'n' A is not assumed to be unit
87: *> triangular.
88: *> \endverbatim
89: *>
90: *> \param[in] M
91: *> \verbatim
92: *> M is INTEGER
93: *> On entry, M specifies the number of rows of B. M must be at
94: *> least zero.
95: *> \endverbatim
96: *>
97: *> \param[in] N
98: *> \verbatim
99: *> N is INTEGER
100: *> On entry, N specifies the number of columns of B. N must be
101: *> at least zero.
102: *> \endverbatim
103: *>
104: *> \param[in] ALPHA
105: *> \verbatim
106: *> ALPHA is COMPLEX*16
107: *> On entry, ALPHA specifies the scalar alpha. When alpha is
108: *> zero then A is not referenced and B need not be set before
109: *> entry.
110: *> \endverbatim
111: *>
112: *> \param[in] A
113: *> \verbatim
114: *> A is COMPLEX*16 array, dimension ( LDA, k ),
115: *> where k is m when SIDE = 'L' or 'l'
116: *> and k is n when SIDE = 'R' or 'r'.
117: *> Before entry with UPLO = 'U' or 'u', the leading k by k
118: *> upper triangular part of the array A must contain the upper
119: *> triangular matrix and the strictly lower triangular part of
120: *> A is not referenced.
121: *> Before entry with UPLO = 'L' or 'l', the leading k by k
122: *> lower triangular part of the array A must contain the lower
123: *> triangular matrix and the strictly upper triangular part of
124: *> A is not referenced.
125: *> Note that when DIAG = 'U' or 'u', the diagonal elements of
126: *> A are not referenced either, but are assumed to be unity.
127: *> \endverbatim
128: *>
129: *> \param[in] LDA
130: *> \verbatim
131: *> LDA is INTEGER
132: *> On entry, LDA specifies the first dimension of A as declared
133: *> in the calling (sub) program. When SIDE = 'L' or 'l' then
134: *> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
135: *> then LDA must be at least max( 1, n ).
136: *> \endverbatim
137: *>
138: *> \param[in,out] B
139: *> \verbatim
140: *> B is COMPLEX*16 array, dimension ( LDB, N )
141: *> Before entry, the leading m by n part of the array B must
142: *> contain the right-hand side matrix B, and on exit is
143: *> overwritten by the solution matrix X.
144: *> \endverbatim
145: *>
146: *> \param[in] LDB
147: *> \verbatim
148: *> LDB is INTEGER
149: *> On entry, LDB specifies the first dimension of B as declared
150: *> in the calling (sub) program. LDB must be at least
151: *> max( 1, m ).
152: *> \endverbatim
153: *
154: * Authors:
155: * ========
156: *
157: *> \author Univ. of Tennessee
158: *> \author Univ. of California Berkeley
159: *> \author Univ. of Colorado Denver
160: *> \author NAG Ltd.
161: *
162: *> \ingroup complex16_blas_level3
163: *
164: *> \par Further Details:
165: * =====================
166: *>
167: *> \verbatim
168: *>
169: *> Level 3 Blas routine.
170: *>
171: *> -- Written on 8-February-1989.
172: *> Jack Dongarra, Argonne National Laboratory.
173: *> Iain Duff, AERE Harwell.
174: *> Jeremy Du Croz, Numerical Algorithms Group Ltd.
175: *> Sven Hammarling, Numerical Algorithms Group Ltd.
176: *> \endverbatim
177: *>
178: * =====================================================================
179: SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
180: *
181: * -- Reference BLAS level3 routine --
182: * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
183: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
184: *
185: * .. Scalar Arguments ..
186: COMPLEX*16 ALPHA
187: INTEGER LDA,LDB,M,N
188: CHARACTER DIAG,SIDE,TRANSA,UPLO
189: * ..
190: * .. Array Arguments ..
191: COMPLEX*16 A(LDA,*),B(LDB,*)
192: * ..
193: *
194: * =====================================================================
195: *
196: * .. External Functions ..
197: LOGICAL LSAME
198: EXTERNAL LSAME
199: * ..
200: * .. External Subroutines ..
201: EXTERNAL XERBLA
202: * ..
203: * .. Intrinsic Functions ..
204: INTRINSIC DCONJG,MAX
205: * ..
206: * .. Local Scalars ..
207: COMPLEX*16 TEMP
208: INTEGER I,INFO,J,K,NROWA
209: LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
210: * ..
211: * .. Parameters ..
212: COMPLEX*16 ONE
213: PARAMETER (ONE= (1.0D+0,0.0D+0))
214: COMPLEX*16 ZERO
215: PARAMETER (ZERO= (0.0D+0,0.0D+0))
216: * ..
217: *
218: * Test the input parameters.
219: *
220: LSIDE = LSAME(SIDE,'L')
221: IF (LSIDE) THEN
222: NROWA = M
223: ELSE
224: NROWA = N
225: END IF
226: NOCONJ = LSAME(TRANSA,'T')
227: NOUNIT = LSAME(DIAG,'N')
228: UPPER = LSAME(UPLO,'U')
229: *
230: INFO = 0
231: IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
232: INFO = 1
233: ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
234: INFO = 2
235: ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
236: + (.NOT.LSAME(TRANSA,'T')) .AND.
237: + (.NOT.LSAME(TRANSA,'C'))) THEN
238: INFO = 3
239: ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
240: INFO = 4
241: ELSE IF (M.LT.0) THEN
242: INFO = 5
243: ELSE IF (N.LT.0) THEN
244: INFO = 6
245: ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
246: INFO = 9
247: ELSE IF (LDB.LT.MAX(1,M)) THEN
248: INFO = 11
249: END IF
250: IF (INFO.NE.0) THEN
251: CALL XERBLA('ZTRSM ',INFO)
252: RETURN
253: END IF
254: *
255: * Quick return if possible.
256: *
257: IF (M.EQ.0 .OR. N.EQ.0) RETURN
258: *
259: * And when alpha.eq.zero.
260: *
261: IF (ALPHA.EQ.ZERO) THEN
262: DO 20 J = 1,N
263: DO 10 I = 1,M
264: B(I,J) = ZERO
265: 10 CONTINUE
266: 20 CONTINUE
267: RETURN
268: END IF
269: *
270: * Start the operations.
271: *
272: IF (LSIDE) THEN
273: IF (LSAME(TRANSA,'N')) THEN
274: *
275: * Form B := alpha*inv( A )*B.
276: *
277: IF (UPPER) THEN
278: DO 60 J = 1,N
279: IF (ALPHA.NE.ONE) THEN
280: DO 30 I = 1,M
281: B(I,J) = ALPHA*B(I,J)
282: 30 CONTINUE
283: END IF
284: DO 50 K = M,1,-1
285: IF (B(K,J).NE.ZERO) THEN
286: IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
287: DO 40 I = 1,K - 1
288: B(I,J) = B(I,J) - B(K,J)*A(I,K)
289: 40 CONTINUE
290: END IF
291: 50 CONTINUE
292: 60 CONTINUE
293: ELSE
294: DO 100 J = 1,N
295: IF (ALPHA.NE.ONE) THEN
296: DO 70 I = 1,M
297: B(I,J) = ALPHA*B(I,J)
298: 70 CONTINUE
299: END IF
300: DO 90 K = 1,M
301: IF (B(K,J).NE.ZERO) THEN
302: IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
303: DO 80 I = K + 1,M
304: B(I,J) = B(I,J) - B(K,J)*A(I,K)
305: 80 CONTINUE
306: END IF
307: 90 CONTINUE
308: 100 CONTINUE
309: END IF
310: ELSE
311: *
312: * Form B := alpha*inv( A**T )*B
313: * or B := alpha*inv( A**H )*B.
314: *
315: IF (UPPER) THEN
316: DO 140 J = 1,N
317: DO 130 I = 1,M
318: TEMP = ALPHA*B(I,J)
319: IF (NOCONJ) THEN
320: DO 110 K = 1,I - 1
321: TEMP = TEMP - A(K,I)*B(K,J)
322: 110 CONTINUE
323: IF (NOUNIT) TEMP = TEMP/A(I,I)
324: ELSE
325: DO 120 K = 1,I - 1
326: TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
327: 120 CONTINUE
328: IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
329: END IF
330: B(I,J) = TEMP
331: 130 CONTINUE
332: 140 CONTINUE
333: ELSE
334: DO 180 J = 1,N
335: DO 170 I = M,1,-1
336: TEMP = ALPHA*B(I,J)
337: IF (NOCONJ) THEN
338: DO 150 K = I + 1,M
339: TEMP = TEMP - A(K,I)*B(K,J)
340: 150 CONTINUE
341: IF (NOUNIT) TEMP = TEMP/A(I,I)
342: ELSE
343: DO 160 K = I + 1,M
344: TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
345: 160 CONTINUE
346: IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
347: END IF
348: B(I,J) = TEMP
349: 170 CONTINUE
350: 180 CONTINUE
351: END IF
352: END IF
353: ELSE
354: IF (LSAME(TRANSA,'N')) THEN
355: *
356: * Form B := alpha*B*inv( A ).
357: *
358: IF (UPPER) THEN
359: DO 230 J = 1,N
360: IF (ALPHA.NE.ONE) THEN
361: DO 190 I = 1,M
362: B(I,J) = ALPHA*B(I,J)
363: 190 CONTINUE
364: END IF
365: DO 210 K = 1,J - 1
366: IF (A(K,J).NE.ZERO) THEN
367: DO 200 I = 1,M
368: B(I,J) = B(I,J) - A(K,J)*B(I,K)
369: 200 CONTINUE
370: END IF
371: 210 CONTINUE
372: IF (NOUNIT) THEN
373: TEMP = ONE/A(J,J)
374: DO 220 I = 1,M
375: B(I,J) = TEMP*B(I,J)
376: 220 CONTINUE
377: END IF
378: 230 CONTINUE
379: ELSE
380: DO 280 J = N,1,-1
381: IF (ALPHA.NE.ONE) THEN
382: DO 240 I = 1,M
383: B(I,J) = ALPHA*B(I,J)
384: 240 CONTINUE
385: END IF
386: DO 260 K = J + 1,N
387: IF (A(K,J).NE.ZERO) THEN
388: DO 250 I = 1,M
389: B(I,J) = B(I,J) - A(K,J)*B(I,K)
390: 250 CONTINUE
391: END IF
392: 260 CONTINUE
393: IF (NOUNIT) THEN
394: TEMP = ONE/A(J,J)
395: DO 270 I = 1,M
396: B(I,J) = TEMP*B(I,J)
397: 270 CONTINUE
398: END IF
399: 280 CONTINUE
400: END IF
401: ELSE
402: *
403: * Form B := alpha*B*inv( A**T )
404: * or B := alpha*B*inv( A**H ).
405: *
406: IF (UPPER) THEN
407: DO 330 K = N,1,-1
408: IF (NOUNIT) THEN
409: IF (NOCONJ) THEN
410: TEMP = ONE/A(K,K)
411: ELSE
412: TEMP = ONE/DCONJG(A(K,K))
413: END IF
414: DO 290 I = 1,M
415: B(I,K) = TEMP*B(I,K)
416: 290 CONTINUE
417: END IF
418: DO 310 J = 1,K - 1
419: IF (A(J,K).NE.ZERO) THEN
420: IF (NOCONJ) THEN
421: TEMP = A(J,K)
422: ELSE
423: TEMP = DCONJG(A(J,K))
424: END IF
425: DO 300 I = 1,M
426: B(I,J) = B(I,J) - TEMP*B(I,K)
427: 300 CONTINUE
428: END IF
429: 310 CONTINUE
430: IF (ALPHA.NE.ONE) THEN
431: DO 320 I = 1,M
432: B(I,K) = ALPHA*B(I,K)
433: 320 CONTINUE
434: END IF
435: 330 CONTINUE
436: ELSE
437: DO 380 K = 1,N
438: IF (NOUNIT) THEN
439: IF (NOCONJ) THEN
440: TEMP = ONE/A(K,K)
441: ELSE
442: TEMP = ONE/DCONJG(A(K,K))
443: END IF
444: DO 340 I = 1,M
445: B(I,K) = TEMP*B(I,K)
446: 340 CONTINUE
447: END IF
448: DO 360 J = K + 1,N
449: IF (A(J,K).NE.ZERO) THEN
450: IF (NOCONJ) THEN
451: TEMP = A(J,K)
452: ELSE
453: TEMP = DCONJG(A(J,K))
454: END IF
455: DO 350 I = 1,M
456: B(I,J) = B(I,J) - TEMP*B(I,K)
457: 350 CONTINUE
458: END IF
459: 360 CONTINUE
460: IF (ALPHA.NE.ONE) THEN
461: DO 370 I = 1,M
462: B(I,K) = ALPHA*B(I,K)
463: 370 CONTINUE
464: END IF
465: 380 CONTINUE
466: END IF
467: END IF
468: END IF
469: *
470: RETURN
471: *
472: * End of ZTRSM
473: *
474: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ztrsm.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas