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*> \date December 2016
163*
164*> \ingroup complex16_blas_level3
165*
166*> \par Further Details:
167*  =====================
168*>
169*> \verbatim
170*>
171*>  Level 3 Blas routine.
172*>
173*>  -- Written on 8-February-1989.
174*>     Jack Dongarra, Argonne National Laboratory.
175*>     Iain Duff, AERE Harwell.
176*>     Jeremy Du Croz, Numerical Algorithms Group Ltd.
177*>     Sven Hammarling, Numerical Algorithms Group Ltd.
178*> \endverbatim
179*>
180*  =====================================================================
181      SUBROUTINE ZTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
182*
183*  -- Reference BLAS level3 routine (version 3.7.0) --
184*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
185*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
186*     December 2016
187*
188*     .. Scalar Arguments ..
189      COMPLEX*16 ALPHA
190      INTEGER LDA,LDB,M,N
191      CHARACTER DIAG,SIDE,TRANSA,UPLO
192*     ..
193*     .. Array Arguments ..
194      COMPLEX*16 A(LDA,*),B(LDB,*)
195*     ..
196*
197*  =====================================================================
198*
199*     .. External Functions ..
200      LOGICAL LSAME
201      EXTERNAL LSAME
202*     ..
203*     .. External Subroutines ..
204      EXTERNAL XERBLA
205*     ..
206*     .. Intrinsic Functions ..
207      INTRINSIC DCONJG,MAX
208*     ..
209*     .. Local Scalars ..
210      COMPLEX*16 TEMP
211      INTEGER I,INFO,J,K,NROWA
212      LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
213*     ..
214*     .. Parameters ..
215      COMPLEX*16 ONE
216      PARAMETER (ONE= (1.0D+0,0.0D+0))
217      COMPLEX*16 ZERO
218      PARAMETER (ZERO= (0.0D+0,0.0D+0))
219*     ..
220*
221*     Test the input parameters.
222*
223      LSIDE = LSAME(SIDE,'L')
224      IF (LSIDE) THEN
225          NROWA = M
226      ELSE
227          NROWA = N
228      END IF
229      NOCONJ = LSAME(TRANSA,'T')
230      NOUNIT = LSAME(DIAG,'N')
231      UPPER = LSAME(UPLO,'U')
232*
233      INFO = 0
234      IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
235          INFO = 1
236      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
237          INFO = 2
238      ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
239     +         (.NOT.LSAME(TRANSA,'T')) .AND.
240     +         (.NOT.LSAME(TRANSA,'C'))) THEN
241          INFO = 3
242      ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
243          INFO = 4
244      ELSE IF (M.LT.0) THEN
245          INFO = 5
246      ELSE IF (N.LT.0) THEN
247          INFO = 6
248      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
249          INFO = 9
250      ELSE IF (LDB.LT.MAX(1,M)) THEN
251          INFO = 11
252      END IF
253      IF (INFO.NE.0) THEN
254          CALL XERBLA('ZTRSM ',INFO)
255          RETURN
256      END IF
257*
258*     Quick return if possible.
259*
260      IF (M.EQ.0 .OR. N.EQ.0) RETURN
261*
262*     And when  alpha.eq.zero.
263*
264      IF (ALPHA.EQ.ZERO) THEN
265          DO 20 J = 1,N
266              DO 10 I = 1,M
267                  B(I,J) = ZERO
268   10         CONTINUE
269   20     CONTINUE
270          RETURN
271      END IF
272*
273*     Start the operations.
274*
275      IF (LSIDE) THEN
276          IF (LSAME(TRANSA,'N')) THEN
277*
278*           Form  B := alpha*inv( A )*B.
279*
280              IF (UPPER) THEN
281                  DO 60 J = 1,N
282                      IF (ALPHA.NE.ONE) THEN
283                          DO 30 I = 1,M
284                              B(I,J) = ALPHA*B(I,J)
285   30                     CONTINUE
286                      END IF
287                      DO 50 K = M,1,-1
288                          IF (B(K,J).NE.ZERO) THEN
289                              IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
290                              DO 40 I = 1,K - 1
291                                  B(I,J) = B(I,J) - B(K,J)*A(I,K)
292   40                         CONTINUE
293                          END IF
294   50                 CONTINUE
295   60             CONTINUE
296              ELSE
297                  DO 100 J = 1,N
298                      IF (ALPHA.NE.ONE) THEN
299                          DO 70 I = 1,M
300                              B(I,J) = ALPHA*B(I,J)
301   70                     CONTINUE
302                      END IF
303                      DO 90 K = 1,M
304                          IF (B(K,J).NE.ZERO) THEN
305                              IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
306                              DO 80 I = K + 1,M
307                                  B(I,J) = B(I,J) - B(K,J)*A(I,K)
308   80                         CONTINUE
309                          END IF
310   90                 CONTINUE
311  100             CONTINUE
312              END IF
313          ELSE
314*
315*           Form  B := alpha*inv( A**T )*B
316*           or    B := alpha*inv( A**H )*B.
317*
318              IF (UPPER) THEN
319                  DO 140 J = 1,N
320                      DO 130 I = 1,M
321                          TEMP = ALPHA*B(I,J)
322                          IF (NOCONJ) THEN
323                              DO 110 K = 1,I - 1
324                                  TEMP = TEMP - A(K,I)*B(K,J)
325  110                         CONTINUE
326                              IF (NOUNIT) TEMP = TEMP/A(I,I)
327                          ELSE
328                              DO 120 K = 1,I - 1
329                                  TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
330  120                         CONTINUE
331                              IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
332                          END IF
333                          B(I,J) = TEMP
334  130                 CONTINUE
335  140             CONTINUE
336              ELSE
337                  DO 180 J = 1,N
338                      DO 170 I = M,1,-1
339                          TEMP = ALPHA*B(I,J)
340                          IF (NOCONJ) THEN
341                              DO 150 K = I + 1,M
342                                  TEMP = TEMP - A(K,I)*B(K,J)
343  150                         CONTINUE
344                              IF (NOUNIT) TEMP = TEMP/A(I,I)
345                          ELSE
346                              DO 160 K = I + 1,M
347                                  TEMP = TEMP - DCONJG(A(K,I))*B(K,J)
348  160                         CONTINUE
349                              IF (NOUNIT) TEMP = TEMP/DCONJG(A(I,I))
350                          END IF
351                          B(I,J) = TEMP
352  170                 CONTINUE
353  180             CONTINUE
354              END IF
355          END IF
356      ELSE
357          IF (LSAME(TRANSA,'N')) THEN
358*
359*           Form  B := alpha*B*inv( A ).
360*
361              IF (UPPER) THEN
362                  DO 230 J = 1,N
363                      IF (ALPHA.NE.ONE) THEN
364                          DO 190 I = 1,M
365                              B(I,J) = ALPHA*B(I,J)
366  190                     CONTINUE
367                      END IF
368                      DO 210 K = 1,J - 1
369                          IF (A(K,J).NE.ZERO) THEN
370                              DO 200 I = 1,M
371                                  B(I,J) = B(I,J) - A(K,J)*B(I,K)
372  200                         CONTINUE
373                          END IF
374  210                 CONTINUE
375                      IF (NOUNIT) THEN
376                          TEMP = ONE/A(J,J)
377                          DO 220 I = 1,M
378                              B(I,J) = TEMP*B(I,J)
379  220                     CONTINUE
380                      END IF
381  230             CONTINUE
382              ELSE
383                  DO 280 J = N,1,-1
384                      IF (ALPHA.NE.ONE) THEN
385                          DO 240 I = 1,M
386                              B(I,J) = ALPHA*B(I,J)
387  240                     CONTINUE
388                      END IF
389                      DO 260 K = J + 1,N
390                          IF (A(K,J).NE.ZERO) THEN
391                              DO 250 I = 1,M
392                                  B(I,J) = B(I,J) - A(K,J)*B(I,K)
393  250                         CONTINUE
394                          END IF
395  260                 CONTINUE
396                      IF (NOUNIT) THEN
397                          TEMP = ONE/A(J,J)
398                          DO 270 I = 1,M
399                              B(I,J) = TEMP*B(I,J)
400  270                     CONTINUE
401                      END IF
402  280             CONTINUE
403              END IF
404          ELSE
405*
406*           Form  B := alpha*B*inv( A**T )
407*           or    B := alpha*B*inv( A**H ).
408*
409              IF (UPPER) THEN
410                  DO 330 K = N,1,-1
411                      IF (NOUNIT) THEN
412                          IF (NOCONJ) THEN
413                              TEMP = ONE/A(K,K)
414                          ELSE
415                              TEMP = ONE/DCONJG(A(K,K))
416                          END IF
417                          DO 290 I = 1,M
418                              B(I,K) = TEMP*B(I,K)
419  290                     CONTINUE
420                      END IF
421                      DO 310 J = 1,K - 1
422                          IF (A(J,K).NE.ZERO) THEN
423                              IF (NOCONJ) THEN
424                                  TEMP = A(J,K)
425                              ELSE
426                                  TEMP = DCONJG(A(J,K))
427                              END IF
428                              DO 300 I = 1,M
429                                  B(I,J) = B(I,J) - TEMP*B(I,K)
430  300                         CONTINUE
431                          END IF
432  310                 CONTINUE
433                      IF (ALPHA.NE.ONE) THEN
434                          DO 320 I = 1,M
435                              B(I,K) = ALPHA*B(I,K)
436  320                     CONTINUE
437                      END IF
438  330             CONTINUE
439              ELSE
440                  DO 380 K = 1,N
441                      IF (NOUNIT) THEN
442                          IF (NOCONJ) THEN
443                              TEMP = ONE/A(K,K)
444                          ELSE
445                              TEMP = ONE/DCONJG(A(K,K))
446                          END IF
447                          DO 340 I = 1,M
448                              B(I,K) = TEMP*B(I,K)
449  340                     CONTINUE
450                      END IF
451                      DO 360 J = K + 1,N
452                          IF (A(J,K).NE.ZERO) THEN
453                              IF (NOCONJ) THEN
454                                  TEMP = A(J,K)
455                              ELSE
456                                  TEMP = DCONJG(A(J,K))
457                              END IF
458                              DO 350 I = 1,M
459                                  B(I,J) = B(I,J) - TEMP*B(I,K)
460  350                         CONTINUE
461                          END IF
462  360                 CONTINUE
463                      IF (ALPHA.NE.ONE) THEN
464                          DO 370 I = 1,M
465                              B(I,K) = ALPHA*B(I,K)
466  370                     CONTINUE
467                      END IF
468  380             CONTINUE
469              END IF
470          END IF
471      END IF
472*
473      RETURN
474*
475*     End of ZTRSM .
476*
477      END
478