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
475