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: *
118: *  Level 3 Blas routine.
119: *
120: *  -- Written on 8-February-1989.
121: *     Jack Dongarra, Argonne National Laboratory.
122: *     Iain Duff, AERE Harwell.
123: *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
124: *     Sven Hammarling, Numerical Algorithms Group Ltd.
125: *
126: *
127: *     .. External Functions ..
128:       LOGICAL LSAME
129:       EXTERNAL LSAME
130: *     ..
131: *     .. External Subroutines ..
132:       EXTERNAL XERBLA
133: *     ..
134: *     .. Intrinsic Functions ..
135:       INTRINSIC CONJG,MAX
136: *     ..
137: *     .. Local Scalars ..
138:       COMPLEX TEMP
139:       INTEGER I,INFO,J,K,NROWA
140:       LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
141: *     ..
142: *     .. Parameters ..
143:       COMPLEX ONE
144:       PARAMETER (ONE= (1.0E+0,0.0E+0))
145:       COMPLEX ZERO
146:       PARAMETER (ZERO= (0.0E+0,0.0E+0))
147: *     ..
148: *
149: *     Test the input parameters.
150: *
151:       LSIDE = LSAME(SIDE,'L')
152:       IF (LSIDE) THEN
153:           NROWA = M
154:       ELSE
155:           NROWA = N
156:       END IF
157:       NOCONJ = LSAME(TRANSA,'T')
158:       NOUNIT = LSAME(DIAG,'N')
159:       UPPER = LSAME(UPLO,'U')
160: *
161:       INFO = 0
162:       IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
163:           INFO = 1
164:       ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
165:           INFO = 2
166:       ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
167:      +         (.NOT.LSAME(TRANSA,'T')) .AND.
168:      +         (.NOT.LSAME(TRANSA,'C'))) THEN
169:           INFO = 3
170:       ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
171:           INFO = 4
172:       ELSE IF (M.LT.0) THEN
173:           INFO = 5
174:       ELSE IF (N.LT.0) THEN
175:           INFO = 6
176:       ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
177:           INFO = 9
178:       ELSE IF (LDB.LT.MAX(1,M)) THEN
179:           INFO = 11
180:       END IF
181:       IF (INFO.NE.0) THEN
182:           CALL XERBLA('CTRMM ',INFO)
183:           RETURN
184:       END IF
185: *
186: *     Quick return if possible.
187: *
188:       IF (M.EQ.0 .OR. N.EQ.0) RETURN
189: *
190: *     And when  alpha.eq.zero.
191: *
192:       IF (ALPHA.EQ.ZERO) THEN
193:           DO 20 J = 1,N
194:               DO 10 I = 1,M
195:                   B(I,J) = ZERO
196:    10         CONTINUE
197:    20     CONTINUE
198:           RETURN
199:       END IF
200: *
201: *     Start the operations.
202: *
203:       IF (LSIDE) THEN
204:           IF (LSAME(TRANSA,'N')) THEN
205: *
206: *           Form  B := alpha*A*B.
207: *
208:               IF (UPPER) THEN
209:                   DO 50 J = 1,N
210:                       DO 40 K = 1,M
211:                           IF (B(K,J).NE.ZERO) THEN
212:                               TEMP = ALPHA*B(K,J)
213:                               DO 30 I = 1,K - 1
214:                                   B(I,J) = B(I,J) + TEMP*A(I,K)
215:    30                         CONTINUE
216:                               IF (NOUNIT) TEMP = TEMP*A(K,K)
217:                               B(K,J) = TEMP
218:                           END IF
219:    40                 CONTINUE
220:    50             CONTINUE
221:               ELSE
222:                   DO 80 J = 1,N
223:                       DO 70 K = M,1,-1
224:                           IF (B(K,J).NE.ZERO) THEN
225:                               TEMP = ALPHA*B(K,J)
226:                               B(K,J) = TEMP
227:                               IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
228:                               DO 60 I = K + 1,M
229:                                   B(I,J) = B(I,J) + TEMP*A(I,K)
230:    60                         CONTINUE
231:                           END IF
232:    70                 CONTINUE
233:    80             CONTINUE
234:               END IF
235:           ELSE
236: *
237: *           Form  B := alpha*A'*B   or   B := alpha*conjg( A' )*B.
238: *
239:               IF (UPPER) THEN
240:                   DO 120 J = 1,N
241:                       DO 110 I = M,1,-1
242:                           TEMP = B(I,J)
243:                           IF (NOCONJ) THEN
244:                               IF (NOUNIT) TEMP = TEMP*A(I,I)
245:                               DO 90 K = 1,I - 1
246:                                   TEMP = TEMP + A(K,I)*B(K,J)
247:    90                         CONTINUE
248:                           ELSE
249:                               IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I))
250:                               DO 100 K = 1,I - 1
251:                                   TEMP = TEMP + CONJG(A(K,I))*B(K,J)
252:   100                         CONTINUE
253:                           END IF
254:                           B(I,J) = ALPHA*TEMP
255:   110                 CONTINUE
256:   120             CONTINUE
257:               ELSE
258:                   DO 160 J = 1,N
259:                       DO 150 I = 1,M
260:                           TEMP = B(I,J)
261:                           IF (NOCONJ) THEN
262:                               IF (NOUNIT) TEMP = TEMP*A(I,I)
263:                               DO 130 K = I + 1,M
264:                                   TEMP = TEMP + A(K,I)*B(K,J)
265:   130                         CONTINUE
266:                           ELSE
267:                               IF (NOUNIT) TEMP = TEMP*CONJG(A(I,I))
268:                               DO 140 K = I + 1,M
269:                                   TEMP = TEMP + CONJG(A(K,I))*B(K,J)
270:   140                         CONTINUE
271:                           END IF
272:                           B(I,J) = ALPHA*TEMP
273:   150                 CONTINUE
274:   160             CONTINUE
275:               END IF
276:           END IF
277:       ELSE
278:           IF (LSAME(TRANSA,'N')) THEN
279: *
280: *           Form  B := alpha*B*A.
281: *
282:               IF (UPPER) THEN
283:                   DO 200 J = N,1,-1
284:                       TEMP = ALPHA
285:                       IF (NOUNIT) TEMP = TEMP*A(J,J)
286:                       DO 170 I = 1,M
287:                           B(I,J) = TEMP*B(I,J)
288:   170                 CONTINUE
289:                       DO 190 K = 1,J - 1
290:                           IF (A(K,J).NE.ZERO) THEN
291:                               TEMP = ALPHA*A(K,J)
292:                               DO 180 I = 1,M
293:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
294:   180                         CONTINUE
295:                           END IF
296:   190                 CONTINUE
297:   200             CONTINUE
298:               ELSE
299:                   DO 240 J = 1,N
300:                       TEMP = ALPHA
301:                       IF (NOUNIT) TEMP = TEMP*A(J,J)
302:                       DO 210 I = 1,M
303:                           B(I,J) = TEMP*B(I,J)
304:   210                 CONTINUE
305:                       DO 230 K = J + 1,N
306:                           IF (A(K,J).NE.ZERO) THEN
307:                               TEMP = ALPHA*A(K,J)
308:                               DO 220 I = 1,M
309:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
310:   220                         CONTINUE
311:                           END IF
312:   230                 CONTINUE
313:   240             CONTINUE
314:               END IF
315:           ELSE
316: *
317: *           Form  B := alpha*B*A'   or   B := alpha*B*conjg( A' ).
318: *
319:               IF (UPPER) THEN
320:                   DO 280 K = 1,N
321:                       DO 260 J = 1,K - 1
322:                           IF (A(J,K).NE.ZERO) THEN
323:                               IF (NOCONJ) THEN
324:                                   TEMP = ALPHA*A(J,K)
325:                               ELSE
326:                                   TEMP = ALPHA*CONJG(A(J,K))
327:                               END IF
328:                               DO 250 I = 1,M
329:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
330:   250                         CONTINUE
331:                           END IF
332:   260                 CONTINUE
333:                       TEMP = ALPHA
334:                       IF (NOUNIT) THEN
335:                           IF (NOCONJ) THEN
336:                               TEMP = TEMP*A(K,K)
337:                           ELSE
338:                               TEMP = TEMP*CONJG(A(K,K))
339:                           END IF
340:                       END IF
341:                       IF (TEMP.NE.ONE) THEN
342:                           DO 270 I = 1,M
343:                               B(I,K) = TEMP*B(I,K)
344:   270                     CONTINUE
345:                       END IF
346:   280             CONTINUE
347:               ELSE
348:                   DO 320 K = N,1,-1
349:                       DO 300 J = K + 1,N
350:                           IF (A(J,K).NE.ZERO) THEN
351:                               IF (NOCONJ) THEN
352:                                   TEMP = ALPHA*A(J,K)
353:                               ELSE
354:                                   TEMP = ALPHA*CONJG(A(J,K))
355:                               END IF
356:                               DO 290 I = 1,M
357:                                   B(I,J) = B(I,J) + TEMP*B(I,K)
358:   290                         CONTINUE
359:                           END IF
360:   300                 CONTINUE
361:                       TEMP = ALPHA
362:                       IF (NOUNIT) THEN
363:                           IF (NOCONJ) THEN
364:                               TEMP = TEMP*A(K,K)
365:                           ELSE
366:                               TEMP = TEMP*CONJG(A(K,K))
367:                           END IF
368:                       END IF
369:                       IF (TEMP.NE.ONE) THEN
370:                           DO 310 I = 1,M
371:                               B(I,K) = TEMP*B(I,K)
372:   310                     CONTINUE
373:                       END IF
374:   320             CONTINUE
375:               END IF
376:           END IF
377:       END IF
378: *
379:       RETURN
380: *
381: *     End of CTRMM .
382: *
383:       END
384: