001:       SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A,
002:      +                  B, LDB )
003: *
004: *  -- LAPACK routine (version 3.2)                                    --
005: *
006: *  -- Contributed by Fred Gustavson of the IBM Watson Research Center --
007: *  -- November 2008                                                   --
008: *
009: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
010: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
011: *
012: *     ..
013: *     .. Scalar Arguments ..
014:       CHARACTER          TRANSR, DIAG, SIDE, TRANS, UPLO
015:       INTEGER            LDB, M, N
016:       COMPLEX            ALPHA
017: *     ..
018: *     .. Array Arguments ..
019:       COMPLEX            A( 0: * ), B( 0: LDB-1, 0: * )
020: *     ..
021: *
022: *  Purpose
023: *  =======
024: *
025: *  Level 3 BLAS like routine for A in RFP Format.
026: *
027: *  CTFSM solves the matrix equation
028: *
029: *     op( A )*X = alpha*B  or  X*op( A ) = alpha*B
030: *
031: *  where alpha is a scalar, X and B are m by n matrices, A is a unit, or
032: *  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
033: *
034: *     op( A ) = A   or   op( A ) = conjg( A' ).
035: *
036: *  A is in Rectangular Full Packed (RFP) Format.
037: *
038: *  The matrix X is overwritten on B.
039: *
040: *  Arguments
041: *  ==========
042: *
043: *  TRANSR - (input) CHARACTER
044: *          = 'N':  The Normal Form of RFP A is stored;
045: *          = 'C':  The Conjugate-transpose Form of RFP A is stored.
046: *
047: *  SIDE   - (input) CHARACTER
048: *           On entry, SIDE specifies whether op( A ) appears on the left
049: *           or right of X as follows:
050: *
051: *              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
052: *
053: *              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
054: *
055: *           Unchanged on exit.
056: *
057: *  UPLO   - (input) CHARACTER
058: *           On entry, UPLO specifies whether the RFP matrix A came from
059: *           an upper or lower triangular matrix as follows:
060: *           UPLO = 'U' or 'u' RFP A came from an upper triangular matrix
061: *           UPLO = 'L' or 'l' RFP A came from a  lower triangular matrix
062: *
063: *           Unchanged on exit.
064: *
065: *  TRANS  - (input) CHARACTER
066: *           On entry, TRANS  specifies the form of op( A ) to be used
067: *           in the matrix multiplication as follows:
068: *
069: *              TRANS  = 'N' or 'n'   op( A ) = A.
070: *
071: *              TRANS  = 'C' or 'c'   op( A ) = conjg( A' ).
072: *
073: *           Unchanged on exit.
074: *
075: *  DIAG   - (input) CHARACTER
076: *           On entry, DIAG specifies whether or not RFP A is unit
077: *           triangular as follows:
078: *
079: *              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
080: *
081: *              DIAG = 'N' or 'n'   A is not assumed to be unit
082: *                                  triangular.
083: *
084: *           Unchanged on exit.
085: *
086: *  M      - (input) INTEGER.
087: *           On entry, M specifies the number of rows of B. M must be at
088: *           least zero.
089: *           Unchanged on exit.
090: *
091: *  N      - (input) INTEGER.
092: *           On entry, N specifies the number of columns of B.  N must be
093: *           at least zero.
094: *           Unchanged on exit.
095: *
096: *  ALPHA  - (input) COMPLEX.
097: *           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
098: *           zero then  A is not referenced and  B need not be set before
099: *           entry.
100: *           Unchanged on exit.
101: *
102: *  A      - (input) COMPLEX array, dimension ( N*(N+1)/2 );
103: *           NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
104: *           RFP Format is described by TRANSR, UPLO and N as follows:
105: *           If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
106: *           K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
107: *           TRANSR = 'C' then RFP is the Conjugate-transpose of RFP A as
108: *           defined when TRANSR = 'N'. The contents of RFP A are defined
109: *           by UPLO as follows: If UPLO = 'U' the RFP A contains the NT
110: *           elements of upper packed A either in normal or
111: *           conjugate-transpose Format. If UPLO = 'L' the RFP A contains
112: *           the NT elements of lower packed A either in normal or
113: *           conjugate-transpose Format. The LDA of RFP A is (N+1)/2 when
114: *           TRANSR = 'C'. When TRANSR is 'N' the LDA is N+1 when N is
115: *           even and is N when is odd.
116: *           See the Note below for more details. Unchanged on exit.
117: *
118: *  B      - (input/ouptut) COMPLEX array,  DIMENSION ( LDB, N )
119: *           Before entry,  the leading  m by n part of the array  B must
120: *           contain  the  right-hand  side  matrix  B,  and  on exit  is
121: *           overwritten by the solution matrix  X.
122: *
123: *  LDB    - (input) INTEGER.
124: *           On entry, LDB specifies the first dimension of B as declared
125: *           in  the  calling  (sub)  program.   LDB  must  be  at  least
126: *           max( 1, m ).
127: *           Unchanged on exit.
128: *
129: *  Notes:
130: *  ======
131: *
132: *  We first consider Standard Packed Format when N is even.
133: *  We give an example where N = 6.
134: *
135: *      AP is Upper             AP is Lower
136: *
137: *   00 01 02 03 04 05       00
138: *      11 12 13 14 15       10 11
139: *         22 23 24 25       20 21 22
140: *            33 34 35       30 31 32 33
141: *               44 45       40 41 42 43 44
142: *                  55       50 51 52 53 54 55
143: *
144: *
145: *  Let TRANSR = 'N'. RFP holds AP as follows:
146: *  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
147: *  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
148: *  conjugate-transpose of the first three columns of AP upper.
149: *  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
150: *  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
151: *  conjugate-transpose of the last three columns of AP lower.
152: *  To denote conjugate we place -- above the element. This covers the
153: *  case N even and TRANSR = 'N'.
154: *
155: *         RFP A                   RFP A
156: *
157: *                                -- -- --
158: *        03 04 05                33 43 53
159: *                                   -- --
160: *        13 14 15                00 44 54
161: *                                      --
162: *        23 24 25                10 11 55
163: *
164: *        33 34 35                20 21 22
165: *        --
166: *        00 44 45                30 31 32
167: *        -- --
168: *        01 11 55                40 41 42
169: *        -- -- --
170: *        02 12 22                50 51 52
171: *
172: *  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
173: *  transpose of RFP A above. One therefore gets:
174: *
175: *
176: *           RFP A                   RFP A
177: *
178: *     -- -- -- --                -- -- -- -- -- --
179: *     03 13 23 33 00 01 02    33 00 10 20 30 40 50
180: *     -- -- -- -- --                -- -- -- -- --
181: *     04 14 24 34 44 11 12    43 44 11 21 31 41 51
182: *     -- -- -- -- -- --                -- -- -- --
183: *     05 15 25 35 45 55 22    53 54 55 22 32 42 52
184: *
185: *
186: *  We next  consider Standard Packed Format when N is odd.
187: *  We give an example where N = 5.
188: *
189: *     AP is Upper                 AP is Lower
190: *
191: *   00 01 02 03 04              00
192: *      11 12 13 14              10 11
193: *         22 23 24              20 21 22
194: *            33 34              30 31 32 33
195: *               44              40 41 42 43 44
196: *
197: *
198: *  Let TRANSR = 'N'. RFP holds AP as follows:
199: *  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
200: *  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
201: *  conjugate-transpose of the first two   columns of AP upper.
202: *  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
203: *  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
204: *  conjugate-transpose of the last two   columns of AP lower.
205: *  To denote conjugate we place -- above the element. This covers the
206: *  case N odd  and TRANSR = 'N'.
207: *
208: *         RFP A                   RFP A
209: *
210: *                                   -- --
211: *        02 03 04                00 33 43
212: *                                      --
213: *        12 13 14                10 11 44
214: *
215: *        22 23 24                20 21 22
216: *        --
217: *        00 33 34                30 31 32
218: *        -- --
219: *        01 11 44                40 41 42
220: *
221: *  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
222: *  transpose of RFP A above. One therefore gets:
223: *
224: *
225: *           RFP A                   RFP A
226: *
227: *     -- -- --                   -- -- -- -- -- --
228: *     02 12 22 00 01             00 10 20 30 40 50
229: *     -- -- -- --                   -- -- -- -- --
230: *     03 13 23 33 11             33 11 21 31 41 51
231: *     -- -- -- -- --                   -- -- -- --
232: *     04 14 24 34 44             43 44 22 32 42 52
233: *
234: *     ..
235: *     .. Parameters ..
236:       COMPLEX            CONE, CZERO
237:       PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ),
238:      +                   CZERO = ( 0.0E+0, 0.0E+0 ) )
239: *     ..
240: *     .. Local Scalars ..
241:       LOGICAL            LOWER, LSIDE, MISODD, NISODD, NORMALTRANSR,
242:      +                   NOTRANS
243:       INTEGER            M1, M2, N1, N2, K, INFO, I, J
244: *     ..
245: *     .. External Functions ..
246:       LOGICAL            LSAME
247:       EXTERNAL           LSAME
248: *     ..
249: *     .. External Subroutines ..
250:       EXTERNAL           XERBLA, CGEMM, CTRSM
251: *     ..
252: *     .. Intrinsic Functions ..
253:       INTRINSIC          MAX, MOD
254: *     ..
255: *     .. Executable Statements ..
256: *
257: *     Test the input parameters.
258: *
259:       INFO = 0
260:       NORMALTRANSR = LSAME( TRANSR, 'N' )
261:       LSIDE = LSAME( SIDE, 'L' )
262:       LOWER = LSAME( UPLO, 'L' )
263:       NOTRANS = LSAME( TRANS, 'N' )
264:       IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'C' ) ) THEN
265:          INFO = -1
266:       ELSE IF( .NOT.LSIDE .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
267:          INFO = -2
268:       ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
269:          INFO = -3
270:       ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
271:          INFO = -4
272:       ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) )
273:      +         THEN
274:          INFO = -5
275:       ELSE IF( M.LT.0 ) THEN
276:          INFO = -6
277:       ELSE IF( N.LT.0 ) THEN
278:          INFO = -7
279:       ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
280:          INFO = -11
281:       END IF
282:       IF( INFO.NE.0 ) THEN
283:          CALL XERBLA( 'CTFSM ', -INFO )
284:          RETURN
285:       END IF
286: *
287: *     Quick return when ( (N.EQ.0).OR.(M.EQ.0) )
288: *
289:       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
290:      +   RETURN
291: *
292: *     Quick return when ALPHA.EQ.(0E+0,0E+0)
293: *
294:       IF( ALPHA.EQ.CZERO ) THEN
295:          DO 20 J = 0, N - 1
296:             DO 10 I = 0, M - 1
297:                B( I, J ) = CZERO
298:    10       CONTINUE
299:    20    CONTINUE
300:          RETURN
301:       END IF
302: *
303:       IF( LSIDE ) THEN
304: *
305: *        SIDE = 'L'
306: *
307: *        A is M-by-M.
308: *        If M is odd, set NISODD = .TRUE., and M1 and M2.
309: *        If M is even, NISODD = .FALSE., and M.
310: *
311:          IF( MOD( M, 2 ).EQ.0 ) THEN
312:             MISODD = .FALSE.
313:             K = M / 2
314:          ELSE
315:             MISODD = .TRUE.
316:             IF( LOWER ) THEN
317:                M2 = M / 2
318:                M1 = M - M2
319:             ELSE
320:                M1 = M / 2
321:                M2 = M - M1
322:             END IF
323:          END IF
324: *
325:          IF( MISODD ) THEN
326: *
327: *           SIDE = 'L' and N is odd
328: *
329:             IF( NORMALTRANSR ) THEN
330: *
331: *              SIDE = 'L', N is odd, and TRANSR = 'N'
332: *
333:                IF( LOWER ) THEN
334: *
335: *                 SIDE  ='L', N is odd, TRANSR = 'N', and UPLO = 'L'
336: *
337:                   IF( NOTRANS ) THEN
338: *
339: *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
340: *                    TRANS = 'N'
341: *
342:                      CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
343:      +                           A( 0 ), M, B, LDB )
344:                      CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), M,
345:      +                           B, LDB, ALPHA, B( M1, 0 ), LDB )
346:                      CALL CTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE,
347:      +                           A( M ), M, B( M1, 0 ), LDB )
348: *
349:                   ELSE
350: *
351: *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'L', and
352: *                    TRANS = 'C'
353: *
354:                      CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
355:      +                           A( M ), M, B( M1, 0 ), LDB )
356:                      CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), M,
357:      +                           B( M1, 0 ), LDB, ALPHA, B, LDB )
358:                      CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE,
359:      +                           A( 0 ), M, B, LDB )
360: *
361:                   END IF
362: *
363:                ELSE
364: *
365: *                 SIDE  ='L', N is odd, TRANSR = 'N', and UPLO = 'U'
366: *
367:                   IF( .NOT.NOTRANS ) THEN
368: *
369: *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
370: *                    TRANS = 'N'
371: *
372:                      CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA,
373:      +                           A( M2 ), M, B, LDB )
374:                      CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), M,
375:      +                           B, LDB, ALPHA, B( M1, 0 ), LDB )
376:                      CALL CTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE,
377:      +                           A( M1 ), M, B( M1, 0 ), LDB )
378: *
379:                   ELSE
380: *
381: *                    SIDE  ='L', N is odd, TRANSR = 'N', UPLO = 'U', and
382: *                    TRANS = 'C'
383: *
384:                      CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA,
385:      +                           A( M1 ), M, B( M1, 0 ), LDB )
386:                      CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), M,
387:      +                           B( M1, 0 ), LDB, ALPHA, B, LDB )
388:                      CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE,
389:      +                           A( M2 ), M, B, LDB )
390: *
391:                   END IF
392: *
393:                END IF
394: *
395:             ELSE
396: *
397: *              SIDE = 'L', N is odd, and TRANSR = 'C'
398: *
399:                IF( LOWER ) THEN
400: *
401: *                 SIDE  ='L', N is odd, TRANSR = 'C', and UPLO = 'L'
402: *
403:                   IF( NOTRANS ) THEN
404: *
405: *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'L', and
406: *                    TRANS = 'N'
407: *
408:                      CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA,
409:      +                           A( 0 ), M1, B, LDB )
410:                      CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, A( M1*M1 ),
411:      +                           M1, B, LDB, ALPHA, B( M1, 0 ), LDB )
412:                      CALL CTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE,
413:      +                           A( 1 ), M1, B( M1, 0 ), LDB )
414: *
415:                   ELSE
416: *
417: *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'L', and
418: *                    TRANS = 'C'
419: *
420:                      CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA,
421:      +                           A( 1 ), M1, B( M1, 0 ), LDB )
422:                      CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, A( M1*M1 ),
423:      +                           M1, B( M1, 0 ), LDB, ALPHA, B, LDB )
424:                      CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE,
425:      +                           A( 0 ), M1, B, LDB )
426: *
427:                   END IF
428: *
429:                ELSE
430: *
431: *                 SIDE  ='L', N is odd, TRANSR = 'C', and UPLO = 'U'
432: *
433:                   IF( .NOT.NOTRANS ) THEN
434: *
435: *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'U', and
436: *                    TRANS = 'N'
437: *
438:                      CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA,
439:      +                           A( M2*M2 ), M2, B, LDB )
440:                      CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), M2,
441:      +                           B, LDB, ALPHA, B( M1, 0 ), LDB )
442:                      CALL CTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE,
443:      +                           A( M1*M2 ), M2, B( M1, 0 ), LDB )
444: *
445:                   ELSE
446: *
447: *                    SIDE  ='L', N is odd, TRANSR = 'C', UPLO = 'U', and
448: *                    TRANS = 'C'
449: *
450:                      CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA,
451:      +                           A( M1*M2 ), M2, B( M1, 0 ), LDB )
452:                      CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), M2,
453:      +                           B( M1, 0 ), LDB, ALPHA, B, LDB )
454:                      CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE,
455:      +                           A( M2*M2 ), M2, B, LDB )
456: *
457:                   END IF
458: *
459:                END IF
460: *
461:             END IF
462: *
463:          ELSE
464: *
465: *           SIDE = 'L' and N is even
466: *
467:             IF( NORMALTRANSR ) THEN
468: *
469: *              SIDE = 'L', N is even, and TRANSR = 'N'
470: *
471:                IF( LOWER ) THEN
472: *
473: *                 SIDE  ='L', N is even, TRANSR = 'N', and UPLO = 'L'
474: *
475:                   IF( NOTRANS ) THEN
476: *
477: *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'L',
478: *                    and TRANS = 'N'
479: *
480:                      CALL CTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
481:      +                           A( 1 ), M+1, B, LDB )
482:                      CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( K+1 ),
483:      +                           M+1, B, LDB, ALPHA, B( K, 0 ), LDB )
484:                      CALL CTRSM( 'L', 'U', 'C', DIAG, K, N, CONE,
485:      +                           A( 0 ), M+1, B( K, 0 ), LDB )
486: *
487:                   ELSE
488: *
489: *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'L',
490: *                    and TRANS = 'C'
491: *
492:                      CALL CTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
493:      +                           A( 0 ), M+1, B( K, 0 ), LDB )
494:                      CALL CGEMM( 'C', 'N', K, N, K, -CONE, A( K+1 ),
495:      +                           M+1, B( K, 0 ), LDB, ALPHA, B, LDB )
496:                      CALL CTRSM( 'L', 'L', 'C', DIAG, K, N, CONE,
497:      +                           A( 1 ), M+1, B, LDB )
498: *
499:                   END IF
500: *
501:                ELSE
502: *
503: *                 SIDE  ='L', N is even, TRANSR = 'N', and UPLO = 'U'
504: *
505:                   IF( .NOT.NOTRANS ) THEN
506: *
507: *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'U',
508: *                    and TRANS = 'N'
509: *
510:                      CALL CTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA,
511:      +                           A( K+1 ), M+1, B, LDB )
512:                      CALL CGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), M+1,
513:      +                           B, LDB, ALPHA, B( K, 0 ), LDB )
514:                      CALL CTRSM( 'L', 'U', 'C', DIAG, K, N, CONE,
515:      +                           A( K ), M+1, B( K, 0 ), LDB )
516: *
517:                   ELSE
518: *
519: *                    SIDE  ='L', N is even, TRANSR = 'N', UPLO = 'U',
520: *                    and TRANS = 'C'
521:                      CALL CTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA,
522:      +                           A( K ), M+1, B( K, 0 ), LDB )
523:                      CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), M+1,
524:      +                           B( K, 0 ), LDB, ALPHA, B, LDB )
525:                      CALL CTRSM( 'L', 'L', 'C', DIAG, K, N, CONE,
526:      +                           A( K+1 ), M+1, B, LDB )
527: *
528:                   END IF
529: *
530:                END IF
531: *
532:             ELSE
533: *
534: *              SIDE = 'L', N is even, and TRANSR = 'C'
535: *
536:                IF( LOWER ) THEN
537: *
538: *                 SIDE  ='L', N is even, TRANSR = 'C', and UPLO = 'L'
539: *
540:                   IF( NOTRANS ) THEN
541: *
542: *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'L',
543: *                    and TRANS = 'N'
544: *
545:                      CALL CTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA,
546:      +                           A( K ), K, B, LDB )
547:                      CALL CGEMM( 'C', 'N', K, N, K, -CONE,
548:      +                           A( K*( K+1 ) ), K, B, LDB, ALPHA,
549:      +                           B( K, 0 ), LDB )
550:                      CALL CTRSM( 'L', 'L', 'N', DIAG, K, N, CONE,
551:      +                           A( 0 ), K, B( K, 0 ), LDB )
552: *
553:                   ELSE
554: *
555: *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'L',
556: *                    and TRANS = 'C'
557: *
558:                      CALL CTRSM( 'L', 'L', 'C', DIAG, K, N, ALPHA,
559:      +                           A( 0 ), K, B( K, 0 ), LDB )
560:                      CALL CGEMM( 'N', 'N', K, N, K, -CONE,
561:      +                           A( K*( K+1 ) ), K, B( K, 0 ), LDB,
562:      +                           ALPHA, B, LDB )
563:                      CALL CTRSM( 'L', 'U', 'N', DIAG, K, N, CONE,
564:      +                           A( K ), K, B, LDB )
565: *
566:                   END IF
567: *
568:                ELSE
569: *
570: *                 SIDE  ='L', N is even, TRANSR = 'C', and UPLO = 'U'
571: *
572:                   IF( .NOT.NOTRANS ) THEN
573: *
574: *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'U',
575: *                    and TRANS = 'N'
576: *
577:                      CALL CTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA,
578:      +                           A( K*( K+1 ) ), K, B, LDB )
579:                      CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, B,
580:      +                           LDB, ALPHA, B( K, 0 ), LDB )
581:                      CALL CTRSM( 'L', 'L', 'N', DIAG, K, N, CONE,
582:      +                           A( K*K ), K, B( K, 0 ), LDB )
583: *
584:                   ELSE
585: *
586: *                    SIDE  ='L', N is even, TRANSR = 'C', UPLO = 'U',
587: *                    and TRANS = 'C'
588: *
589:                      CALL CTRSM( 'L', 'L', 'C', DIAG, K, N, ALPHA,
590:      +                           A( K*K ), K, B( K, 0 ), LDB )
591:                      CALL CGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), K,
592:      +                           B( K, 0 ), LDB, ALPHA, B, LDB )
593:                      CALL CTRSM( 'L', 'U', 'N', DIAG, K, N, CONE,
594:      +                           A( K*( K+1 ) ), K, B, LDB )
595: *
596:                   END IF
597: *
598:                END IF
599: *
600:             END IF
601: *
602:          END IF
603: *
604:       ELSE
605: *
606: *        SIDE = 'R'
607: *
608: *        A is N-by-N.
609: *        If N is odd, set NISODD = .TRUE., and N1 and N2.
610: *        If N is even, NISODD = .FALSE., and K.
611: *
612:          IF( MOD( N, 2 ).EQ.0 ) THEN
613:             NISODD = .FALSE.
614:             K = N / 2
615:          ELSE
616:             NISODD = .TRUE.
617:             IF( LOWER ) THEN
618:                N2 = N / 2
619:                N1 = N - N2
620:             ELSE
621:                N1 = N / 2
622:                N2 = N - N1
623:             END IF
624:          END IF
625: *
626:          IF( NISODD ) THEN
627: *
628: *           SIDE = 'R' and N is odd
629: *
630:             IF( NORMALTRANSR ) THEN
631: *
632: *              SIDE = 'R', N is odd, and TRANSR = 'N'
633: *
634:                IF( LOWER ) THEN
635: *
636: *                 SIDE  ='R', N is odd, TRANSR = 'N', and UPLO = 'L'
637: *
638:                   IF( NOTRANS ) THEN
639: *
640: *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
641: *                    TRANS = 'N'
642: *
643:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA,
644:      +                           A( N ), N, B( 0, N1 ), LDB )
645:                      CALL CGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ),
646:      +                           LDB, A( N1 ), N, ALPHA, B( 0, 0 ),
647:      +                           LDB )
648:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE,
649:      +                           A( 0 ), N, B( 0, 0 ), LDB )
650: *
651:                   ELSE
652: *
653: *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'L', and
654: *                    TRANS = 'C'
655: *
656:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA,
657:      +                           A( 0 ), N, B( 0, 0 ), LDB )
658:                      CALL CGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ),
659:      +                           LDB, A( N1 ), N, ALPHA, B( 0, N1 ),
660:      +                           LDB )
661:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE,
662:      +                           A( N ), N, B( 0, N1 ), LDB )
663: *
664:                   END IF
665: *
666:                ELSE
667: *
668: *                 SIDE  ='R', N is odd, TRANSR = 'N', and UPLO = 'U'
669: *
670:                   IF( NOTRANS ) THEN
671: *
672: *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
673: *                    TRANS = 'N'
674: *
675:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA,
676:      +                           A( N2 ), N, B( 0, 0 ), LDB )
677:                      CALL CGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ),
678:      +                           LDB, A( 0 ), N, ALPHA, B( 0, N1 ),
679:      +                           LDB )
680:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE,
681:      +                           A( N1 ), N, B( 0, N1 ), LDB )
682: *
683:                   ELSE
684: *
685: *                    SIDE  ='R', N is odd, TRANSR = 'N', UPLO = 'U', and
686: *                    TRANS = 'C'
687: *
688:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA,
689:      +                           A( N1 ), N, B( 0, N1 ), LDB )
690:                      CALL CGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ),
691:      +                           LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB )
692:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE,
693:      +                           A( N2 ), N, B( 0, 0 ), LDB )
694: *
695:                   END IF
696: *
697:                END IF
698: *
699:             ELSE
700: *
701: *              SIDE = 'R', N is odd, and TRANSR = 'C'
702: *
703:                IF( LOWER ) THEN
704: *
705: *                 SIDE  ='R', N is odd, TRANSR = 'C', and UPLO = 'L'
706: *
707:                   IF( NOTRANS ) THEN
708: *
709: *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'L', and
710: *                    TRANS = 'N'
711: *
712:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
713:      +                           A( 1 ), N1, B( 0, N1 ), LDB )
714:                      CALL CGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ),
715:      +                           LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ),
716:      +                           LDB )
717:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE,
718:      +                           A( 0 ), N1, B( 0, 0 ), LDB )
719: *
720:                   ELSE
721: *
722: *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'L', and
723: *                    TRANS = 'C'
724: *
725:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
726:      +                           A( 0 ), N1, B( 0, 0 ), LDB )
727:                      CALL CGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ),
728:      +                           LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ),
729:      +                           LDB )
730:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE,
731:      +                           A( 1 ), N1, B( 0, N1 ), LDB )
732: *
733:                   END IF
734: *
735:                ELSE
736: *
737: *                 SIDE  ='R', N is odd, TRANSR = 'C', and UPLO = 'U'
738: *
739:                   IF( NOTRANS ) THEN
740: *
741: *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'U', and
742: *                    TRANS = 'N'
743: *
744:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA,
745:      +                           A( N2*N2 ), N2, B( 0, 0 ), LDB )
746:                      CALL CGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ),
747:      +                           LDB, A( 0 ), N2, ALPHA, B( 0, N1 ),
748:      +                           LDB )
749:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE,
750:      +                           A( N1*N2 ), N2, B( 0, N1 ), LDB )
751: *
752:                   ELSE
753: *
754: *                    SIDE  ='R', N is odd, TRANSR = 'C', UPLO = 'U', and
755: *                    TRANS = 'C'
756: *
757:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA,
758:      +                           A( N1*N2 ), N2, B( 0, N1 ), LDB )
759:                      CALL CGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ),
760:      +                           LDB, A( 0 ), N2, ALPHA, B( 0, 0 ),
761:      +                           LDB )
762:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE,
763:      +                           A( N2*N2 ), N2, B( 0, 0 ), LDB )
764: *
765:                   END IF
766: *
767:                END IF
768: *
769:             END IF
770: *
771:          ELSE
772: *
773: *           SIDE = 'R' and N is even
774: *
775:             IF( NORMALTRANSR ) THEN
776: *
777: *              SIDE = 'R', N is even, and TRANSR = 'N'
778: *
779:                IF( LOWER ) THEN
780: *
781: *                 SIDE  ='R', N is even, TRANSR = 'N', and UPLO = 'L'
782: *
783:                   IF( NOTRANS ) THEN
784: *
785: *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'L',
786: *                    and TRANS = 'N'
787: *
788:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, K, ALPHA,
789:      +                           A( 0 ), N+1, B( 0, K ), LDB )
790:                      CALL CGEMM( 'N', 'N', M, K, K, -CONE, B( 0, K ),
791:      +                           LDB, A( K+1 ), N+1, ALPHA, B( 0, 0 ),
792:      +                           LDB )
793:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, K, CONE,
794:      +                           A( 1 ), N+1, B( 0, 0 ), LDB )
795: *
796:                   ELSE
797: *
798: *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'L',
799: *                    and TRANS = 'C'
800: *
801:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, K, ALPHA,
802:      +                           A( 1 ), N+1, B( 0, 0 ), LDB )
803:                      CALL CGEMM( 'N', 'C', M, K, K, -CONE, B( 0, 0 ),
804:      +                           LDB, A( K+1 ), N+1, ALPHA, B( 0, K ),
805:      +                           LDB )
806:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, K, CONE,
807:      +                           A( 0 ), N+1, B( 0, K ), LDB )
808: *
809:                   END IF
810: *
811:                ELSE
812: *
813: *                 SIDE  ='R', N is even, TRANSR = 'N', and UPLO = 'U'
814: *
815:                   IF( NOTRANS ) THEN
816: *
817: *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'U',
818: *                    and TRANS = 'N'
819: *
820:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, K, ALPHA,
821:      +                           A( K+1 ), N+1, B( 0, 0 ), LDB )
822:                      CALL CGEMM( 'N', 'N', M, K, K, -CONE, B( 0, 0 ),
823:      +                           LDB, A( 0 ), N+1, ALPHA, B( 0, K ),
824:      +                           LDB )
825:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, K, CONE,
826:      +                           A( K ), N+1, B( 0, K ), LDB )
827: *
828:                   ELSE
829: *
830: *                    SIDE  ='R', N is even, TRANSR = 'N', UPLO = 'U',
831: *                    and TRANS = 'C'
832: *
833:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, K, ALPHA,
834:      +                           A( K ), N+1, B( 0, K ), LDB )
835:                      CALL CGEMM( 'N', 'C', M, K, K, -CONE, B( 0, K ),
836:      +                           LDB, A( 0 ), N+1, ALPHA, B( 0, 0 ),
837:      +                           LDB )
838:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, K, CONE,
839:      +                           A( K+1 ), N+1, B( 0, 0 ), LDB )
840: *
841:                   END IF
842: *
843:                END IF
844: *
845:             ELSE
846: *
847: *              SIDE = 'R', N is even, and TRANSR = 'C'
848: *
849:                IF( LOWER ) THEN
850: *
851: *                 SIDE  ='R', N is even, TRANSR = 'C', and UPLO = 'L'
852: *
853:                   IF( NOTRANS ) THEN
854: *
855: *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'L',
856: *                    and TRANS = 'N'
857: *
858:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
859:      +                           A( 0 ), K, B( 0, K ), LDB )
860:                      CALL CGEMM( 'N', 'C', M, K, K, -CONE, B( 0, K ),
861:      +                           LDB, A( ( K+1 )*K ), K, ALPHA,
862:      +                           B( 0, 0 ), LDB )
863:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, K, CONE,
864:      +                           A( K ), K, B( 0, 0 ), LDB )
865: *
866:                   ELSE
867: *
868: *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'L',
869: *                    and TRANS = 'C'
870: *
871:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
872:      +                           A( K ), K, B( 0, 0 ), LDB )
873:                      CALL CGEMM( 'N', 'N', M, K, K, -CONE, B( 0, 0 ),
874:      +                           LDB, A( ( K+1 )*K ), K, ALPHA,
875:      +                           B( 0, K ), LDB )
876:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, K, CONE,
877:      +                           A( 0 ), K, B( 0, K ), LDB )
878: *
879:                   END IF
880: *
881:                ELSE
882: *
883: *                 SIDE  ='R', N is even, TRANSR = 'C', and UPLO = 'U'
884: *
885:                   IF( NOTRANS ) THEN
886: *
887: *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'U',
888: *                    and TRANS = 'N'
889: *
890:                      CALL CTRSM( 'R', 'U', 'N', DIAG, M, K, ALPHA,
891:      +                           A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
892:                      CALL CGEMM( 'N', 'C', M, K, K, -CONE, B( 0, 0 ),
893:      +                           LDB, A( 0 ), K, ALPHA, B( 0, K ), LDB )
894:                      CALL CTRSM( 'R', 'L', 'C', DIAG, M, K, CONE,
895:      +                           A( K*K ), K, B( 0, K ), LDB )
896: *
897:                   ELSE
898: *
899: *                    SIDE  ='R', N is even, TRANSR = 'C', UPLO = 'U',
900: *                    and TRANS = 'C'
901: *
902:                      CALL CTRSM( 'R', 'L', 'N', DIAG, M, K, ALPHA,
903:      +                           A( K*K ), K, B( 0, K ), LDB )
904:                      CALL CGEMM( 'N', 'N', M, K, K, -CONE, B( 0, K ),
905:      +                           LDB, A( 0 ), K, ALPHA, B( 0, 0 ), LDB )
906:                      CALL CTRSM( 'R', 'U', 'C', DIAG, M, K, CONE,
907:      +                           A( ( K+1 )*K ), K, B( 0, 0 ), LDB )
908: *
909:                   END IF
910: *
911:                END IF
912: *
913:             END IF
914: *
915:          END IF
916:       END IF
917: *
918:       RETURN
919: *
920: *     End of CTFSM
921: *
922:       END
923: