001:       SUBROUTINE CTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
002: *     .. Scalar Arguments ..
003:       COMPLEX ALPHA
004:       INTEGER LDA,LDB,M,N
005:       CHARACTER DIAG,SIDE,TRANSA,UPLO
006: *     ..
007: *     .. Array Arguments ..
008:       COMPLEX A(LDA,*),B(LDB,*)
009: *     ..
010: *
011: *  Purpose
012: *  =======
013: *
014: *  CTRMM  performs one of the matrix-matrix operations
015: *
016: *     B := alpha*op( A )*B,   or   B := alpha*B*op( A )
017: *
018: *  where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
019: *  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
020: *
021: *     op( A ) = A   or   op( A ) = A'   or   op( A ) = conjg( A' ).
022: *
023: *  Arguments
024: *  ==========
025: *
026: *  SIDE   - CHARACTER*1.
027: *           On entry,  SIDE specifies whether  op( A ) multiplies B from
028: *           the left or right as follows:
029: *
030: *              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
031: *
032: *              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
033: *
034: *           Unchanged on exit.
035: *
036: *  UPLO   - CHARACTER*1.
037: *           On entry, UPLO specifies whether the matrix A is an upper or
038: *           lower triangular matrix as follows:
039: *
040: *              UPLO = 'U' or 'u'   A is an upper triangular matrix.
041: *
042: *              UPLO = 'L' or 'l'   A is a lower triangular matrix.
043: *
044: *           Unchanged on exit.
045: *
046: *  TRANSA - CHARACTER*1.
047: *           On entry, TRANSA specifies the form of op( A ) to be used in
048: *           the matrix multiplication as follows:
049: *
050: *              TRANSA = 'N' or 'n'   op( A ) = A.
051: *
052: *              TRANSA = 'T' or 't'   op( A ) = A'.
053: *
054: *              TRANSA = 'C' or 'c'   op( A ) = conjg( A' ).
055: *
056: *           Unchanged on exit.
057: *
058: *  DIAG   - CHARACTER*1.
059: *           On entry, DIAG specifies whether or not A is unit triangular
060: *           as follows:
061: *
062: *              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
063: *
064: *              DIAG = 'N' or 'n'   A is not assumed to be unit
065: *                                  triangular.
066: *
067: *           Unchanged on exit.
068: *
069: *  M      - INTEGER.
070: *           On entry, M specifies the number of rows of B. M must be at
071: *           least zero.
072: *           Unchanged on exit.
073: *
074: *  N      - INTEGER.
075: *           On entry, N specifies the number of columns of B.  N must be
076: *           at least zero.
077: *           Unchanged on exit.
078: *
079: *  ALPHA  - COMPLEX         .
080: *           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
081: *           zero then  A is not referenced and  B need not be set before
082: *           entry.
083: *           Unchanged on exit.
084: *
085: *  A      - COMPLEX          array of DIMENSION ( LDA, k ), where k is m
086: *           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
087: *           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
088: *           upper triangular part of the array  A must contain the upper
089: *           triangular matrix  and the strictly lower triangular part of
090: *           A is not referenced.
091: *           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
092: *           lower triangular part of the array  A must contain the lower
093: *           triangular matrix  and the strictly upper triangular part of
094: *           A is not referenced.
095: *           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
096: *           A  are not referenced either,  but are assumed to be  unity.
097: *           Unchanged on exit.
098: *
099: *  LDA    - INTEGER.
100: *           On entry, LDA specifies the first dimension of A as declared
101: *           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
102: *           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
103: *           then LDA must be at least max( 1, n ).
104: *           Unchanged on exit.
105: *
106: *  B      - COMPLEX          array of DIMENSION ( LDB, n ).
107: *           Before entry,  the leading  m by n part of the array  B must
108: *           contain the matrix  B,  and  on exit  is overwritten  by the
109: *           transformed matrix.
110: *
111: *  LDB    - INTEGER.
112: *           On entry, LDB specifies the first dimension of B as declared
113: *           in  the  calling  (sub)  program.   LDB  must  be  at  least
114: *           max( 1, m ).
115: *           Unchanged on exit.
116: *
117: *  Further Details
118: *  ===============
119: *
120: *  Level 3 Blas routine.
121: *
122: *  -- Written on 8-February-1989.
123: *     Jack Dongarra, Argonne National Laboratory.
124: *     Iain Duff, AERE Harwell.
125: *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
126: *     Sven Hammarling, Numerical Algorithms Group Ltd.
127: *
128: *  =====================================================================
129: *
130: *     .. External Functions ..
131:       LOGICAL LSAME
132:       EXTERNAL LSAME
133: *     ..
134: *     .. External Subroutines ..
135:       EXTERNAL XERBLA
136: *     ..
137: *     .. Intrinsic Functions ..
138:       INTRINSIC CONJG,MAX
139: *     ..
140: *     .. Local Scalars ..
141:       COMPLEX TEMP
142:       INTEGER I,INFO,J,K,NROWA
143:       LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
144: *     ..
145: *     .. Parameters ..
146:       COMPLEX ONE
147:       PARAMETER (ONE= (1.0E+0,0.0E+0))
148:       COMPLEX ZERO
149:       PARAMETER (ZERO= (0.0E+0,0.0E+0))
150: *     ..
151: *
152: *     Test the input parameters.
153: *
154:       LSIDE = LSAME(SIDE,'L')
155:       IF (LSIDE) THEN
156:           NROWA = M
157:       ELSE
158:           NROWA = N
159:       END IF
160:       NOCONJ = LSAME(TRANSA,'T')
161:       NOUNIT = LSAME(DIAG,'N')
162:       UPPER = LSAME(UPLO,'U')
163: *
164:       INFO = 0
165:       IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
166:           INFO = 1
167:       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
168:           INFO = 2
169:       ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
170:      +         (.NOT.LSAME(TRANSA,'T')) .AND.
171:      +         (.NOT.LSAME(TRANSA,'C'))) THEN
172:           INFO = 3
173:       ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
174:           INFO = 4
175:       ELSE IF (M.LT.0) THEN
176:           INFO = 5
177:       ELSE IF (N.LT.0) THEN
178:           INFO = 6
179:       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
180:           INFO = 9
181:       ELSE IF (LDB.LT.MAX(1,M)) THEN
182:           INFO = 11
183:       END IF
184:       IF (INFO.NE.0) THEN
185:           CALL XERBLA('CTRMM ',INFO)
186:           RETURN
187:       END IF
188: *
189: *     Quick return if possible.
190: *
191:       IF (M.EQ.0 .OR. N.EQ.0) RETURN
192: *
193: *     And when  alpha.eq.zero.
194: *
195:       IF (ALPHA.EQ.ZERO) THEN
196:           DO 20 J = 1,N
197:               DO 10 I = 1,M
198:                   B(I,J) = ZERO
199:    10         CONTINUE
200:    20     CONTINUE
201:           RETURN
202:       END IF
203: *
204: *     Start the operations.
205: *
206:       IF (LSIDE) THEN
207:           IF (LSAME(TRANSA,'N')) THEN
208: *
209: *           Form  B := alpha*A*B.
210: *
211:               IF (UPPER) THEN
212:                   DO 50 J = 1,N
213:                       DO 40 K = 1,M
214:                           IF (B(K,J).NE.ZERO) THEN
215:                               TEMP = ALPHA*B(K,J)
216:                               DO 30 I = 1,K - 1
217:                                   B(I,J) = B(I,J) + TEMP*A(I,K)
218:    30                         CONTINUE
219:                               IF (NOUNIT) TEMP = TEMP*A(K,K)
220:                               B(K,J) = TEMP
221:                           END IF
222:    40                 CONTINUE
223:    50             CONTINUE
224:               ELSE
225:                   DO 80 J = 1,N
226:                       DO 70 K = M,1,-1
227:                           IF (B(K,J).NE.ZERO) THEN
228:                               TEMP = ALPHA*B(K,J)
229:                               B(K,J) = TEMP
230:                               IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
231:                               DO 60 I = K + 1,M
232:                                   B(I,J) = B(I,J) + TEMP*A(I,K)
233:    60                         CONTINUE
234:                           END IF
235:    70                 CONTINUE
236:    80             CONTINUE
237:               END IF
238:           ELSE
239: *
240: *           Form  B := alpha*A'*B   or   B := alpha*conjg( A' )*B.
241: *
242:               IF (UPPER) THEN
243:                   DO 120 J = 1,N
244:                       DO 110 I = M,1,-1
245:                           TEMP = B(I,J)
246:                           IF (NOCONJ) THEN
247:                               IF (NOUNIT) TEMP = TEMP*A(I,I)
248:                               DO 90 K = 1,I - 1
249:                                   TEMP = TEMP + A(K,I)*B(K,J)
250:    90                         CONTINUE
251:                           ELSE
252:                               IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I))
253:                               DO 100 K = 1,I - 1
254:                                   TEMP = TEMP + CONJG(A(K,I))*B(K,J)
255:   100                         CONTINUE
256:                           END IF
257:                           B(I,J) = ALPHA*TEMP
258:   110                 CONTINUE
259:   120             CONTINUE
260:               ELSE
261:                   DO 160 J = 1,N
262:                       DO 150 I = 1,M
263:                           TEMP = B(I,J)
264:                           IF (NOCONJ) THEN
265:                               IF (NOUNIT) TEMP = TEMP*A(I,I)
266:                               DO 130 K = I + 1,M
267:                                   TEMP = TEMP + A(K,I)*B(K,J)
268:   130                         CONTINUE
269:                           ELSE
270:                               IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I))
271:                               DO 140 K = I + 1,M
272:                                   TEMP = TEMP + CONJG(A(K,I))*B(K,J)
273:   140                         CONTINUE
274:                           END IF
275:                           B(I,J) = ALPHA*TEMP
276:   150                 CONTINUE
277:   160             CONTINUE
278:               END IF
279:           END IF
280:       ELSE
281:           IF (LSAME(TRANSA,'N')) THEN
282: *
283: *           Form  B := alpha*B*A.
284: *
285:               IF (UPPER) THEN
286:                   DO 200 J = N,1,-1
287:                       TEMP = ALPHA
288:                       IF (NOUNIT) TEMP = TEMP*A(J,J)
289:                       DO 170 I = 1,M
290:                           B(I,J) = TEMP*B(I,J)
291:   170                 CONTINUE
292:                       DO 190 K = 1,J - 1
293:                           IF (A(K,J).NE.ZERO) THEN
294:                               TEMP = ALPHA*A(K,J)
295:                               DO 180 I = 1,M
296:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
297:   180                         CONTINUE
298:                           END IF
299:   190                 CONTINUE
300:   200             CONTINUE
301:               ELSE
302:                   DO 240 J = 1,N
303:                       TEMP = ALPHA
304:                       IF (NOUNIT) TEMP = TEMP*A(J,J)
305:                       DO 210 I = 1,M
306:                           B(I,J) = TEMP*B(I,J)
307:   210                 CONTINUE
308:                       DO 230 K = J + 1,N
309:                           IF (A(K,J).NE.ZERO) THEN
310:                               TEMP = ALPHA*A(K,J)
311:                               DO 220 I = 1,M
312:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
313:   220                         CONTINUE
314:                           END IF
315:   230                 CONTINUE
316:   240             CONTINUE
317:               END IF
318:           ELSE
319: *
320: *           Form  B := alpha*B*A'   or   B := alpha*B*conjg( A' ).
321: *
322:               IF (UPPER) THEN
323:                   DO 280 K = 1,N
324:                       DO 260 J = 1,K - 1
325:                           IF (A(J,K).NE.ZERO) THEN
326:                               IF (NOCONJ) THEN
327:                                   TEMP = ALPHA*A(J,K)
328:                               ELSE
329:                                   TEMP = ALPHA*CONJG(A(J,K))
330:                               END IF
331:                               DO 250 I = 1,M
332:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
333:   250                         CONTINUE
334:                           END IF
335:   260                 CONTINUE
336:                       TEMP = ALPHA
337:                       IF (NOUNIT) THEN
338:                           IF (NOCONJ) THEN
339:                               TEMP = TEMP*A(K,K)
340:                           ELSE
341:                               TEMP = TEMP*CONJG(A(K,K))
342:                           END IF
343:                       END IF
344:                       IF (TEMP.NE.ONE) THEN
345:                           DO 270 I = 1,M
346:                               B(I,K) = TEMP*B(I,K)
347:   270                     CONTINUE
348:                       END IF
349:   280             CONTINUE
350:               ELSE
351:                   DO 320 K = N,1,-1
352:                       DO 300 J = K + 1,N
353:                           IF (A(J,K).NE.ZERO) THEN
354:                               IF (NOCONJ) THEN
355:                                   TEMP = ALPHA*A(J,K)
356:                               ELSE
357:                                   TEMP = ALPHA*CONJG(A(J,K))
358:                               END IF
359:                               DO 290 I = 1,M
360:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
361:   290                         CONTINUE
362:                           END IF
363:   300                 CONTINUE
364:                       TEMP = ALPHA
365:                       IF (NOUNIT) THEN
366:                           IF (NOCONJ) THEN
367:                               TEMP = TEMP*A(K,K)
368:                           ELSE
369:                               TEMP = TEMP*CONJG(A(K,K))
370:                           END IF
371:                       END IF
372:                       IF (TEMP.NE.ONE) THEN
373:                           DO 310 I = 1,M
374:                               B(I,K) = TEMP*B(I,K)
375:   310                     CONTINUE
376:                       END IF
377:   320             CONTINUE
378:               END IF
379:           END IF
380:       END IF
381: *
382:       RETURN
383: *
384: *     End of CTRMM .
385: *
386:       END
387: