```      SUBROUTINE CTRSM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
*     .. Scalar Arguments ..
COMPLEX ALPHA
INTEGER LDA,LDB,M,N
CHARACTER DIAG,SIDE,TRANSA,UPLO
*     ..
*     .. Array Arguments ..
COMPLEX A(LDA,*),B(LDB,*)
*     ..
*
*  Purpose
*  =======
*
*  CTRSM  solves one of the matrix equations
*
*     op( A )*X = alpha*B,   or   X*op( A ) = alpha*B,
*
*  where alpha is a scalar, X and B are m by n matrices, A is a unit, or
*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
*
*     op( A ) = A   or   op( A ) = A'   or   op( A ) = conjg( A' ).
*
*  The matrix X is overwritten on B.
*
*  Arguments
*  ==========
*
*  SIDE   - CHARACTER*1.
*           On entry, SIDE specifies whether op( A ) appears on the left
*           or right of X as follows:
*
*              SIDE = 'L' or 'l'   op( A )*X = alpha*B.
*
*              SIDE = 'R' or 'r'   X*op( A ) = alpha*B.
*
*           Unchanged on exit.
*
*  UPLO   - CHARACTER*1.
*           On entry, UPLO specifies whether the matrix A is an upper or
*           lower triangular matrix as follows:
*
*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
*
*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
*
*           Unchanged on exit.
*
*  TRANSA - CHARACTER*1.
*           On entry, TRANSA specifies the form of op( A ) to be used in
*           the matrix multiplication as follows:
*
*              TRANSA = 'N' or 'n'   op( A ) = A.
*
*              TRANSA = 'T' or 't'   op( A ) = A'.
*
*              TRANSA = 'C' or 'c'   op( A ) = conjg( A' ).
*
*           Unchanged on exit.
*
*  DIAG   - CHARACTER*1.
*           On entry, DIAG specifies whether or not A is unit triangular
*           as follows:
*
*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
*
*              DIAG = 'N' or 'n'   A is not assumed to be unit
*                                  triangular.
*
*           Unchanged on exit.
*
*  M      - INTEGER.
*           On entry, M specifies the number of rows of B. M must be at
*           least zero.
*           Unchanged on exit.
*
*  N      - INTEGER.
*           On entry, N specifies the number of columns of B.  N must be
*           at least zero.
*           Unchanged on exit.
*
*  ALPHA  - COMPLEX         .
*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
*           zero then  A is not referenced and  B need not be set before
*           entry.
*           Unchanged on exit.
*
*  A      - COMPLEX          array of DIMENSION ( LDA, k ), where k is m
*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
*           upper triangular part of the array  A must contain the upper
*           triangular matrix  and the strictly lower triangular part of
*           A is not referenced.
*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
*           lower triangular part of the array  A must contain the lower
*           triangular matrix  and the strictly upper triangular part of
*           A is not referenced.
*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
*           A  are not referenced either,  but are assumed to be  unity.
*           Unchanged on exit.
*
*  LDA    - INTEGER.
*           On entry, LDA specifies the first dimension of A as declared
*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
*           then LDA must be at least max( 1, n ).
*           Unchanged on exit.
*
*  B      - COMPLEX          array of DIMENSION ( LDB, n ).
*           Before entry,  the leading  m by n part of the array  B must
*           contain  the  right-hand  side  matrix  B,  and  on exit  is
*           overwritten by the solution matrix  X.
*
*  LDB    - INTEGER.
*           On entry, LDB specifies the first dimension of B as declared
*           in  the  calling  (sub)  program.   LDB  must  be  at  least
*           max( 1, m ).
*           Unchanged on exit.
*
*
*  Level 3 Blas routine.
*
*  -- Written on 8-February-1989.
*     Jack Dongarra, Argonne National Laboratory.
*     Iain Duff, AERE Harwell.
*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
*     Sven Hammarling, Numerical Algorithms Group Ltd.
*
*
*     .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
*     ..
*     .. External Subroutines ..
EXTERNAL XERBLA
*     ..
*     .. Intrinsic Functions ..
INTRINSIC CONJG,MAX
*     ..
*     .. Local Scalars ..
COMPLEX TEMP
INTEGER I,INFO,J,K,NROWA
LOGICAL LSIDE,NOCONJ,NOUNIT,UPPER
*     ..
*     .. Parameters ..
COMPLEX ONE
PARAMETER (ONE= (1.0E+0,0.0E+0))
COMPLEX ZERO
PARAMETER (ZERO= (0.0E+0,0.0E+0))
*     ..
*
*     Test the input parameters.
*
LSIDE = LSAME(SIDE,'L')
IF (LSIDE) THEN
NROWA = M
ELSE
NROWA = N
END IF
NOCONJ = LSAME(TRANSA,'T')
NOUNIT = LSAME(DIAG,'N')
UPPER = LSAME(UPLO,'U')
*
INFO = 0
IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
INFO = 1
ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
INFO = 2
ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+         (.NOT.LSAME(TRANSA,'T')) .AND.
+         (.NOT.LSAME(TRANSA,'C'))) THEN
INFO = 3
ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
INFO = 4
ELSE IF (M.LT.0) THEN
INFO = 5
ELSE IF (N.LT.0) THEN
INFO = 6
ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
INFO = 9
ELSE IF (LDB.LT.MAX(1,M)) THEN
INFO = 11
END IF
IF (INFO.NE.0) THEN
CALL XERBLA('CTRSM ',INFO)
RETURN
END IF
*
*     Quick return if possible.
*
IF (N.EQ.0) RETURN
*
*     And when  alpha.eq.zero.
*
IF (ALPHA.EQ.ZERO) THEN
DO 20 J = 1,N
DO 10 I = 1,M
B(I,J) = ZERO
10         CONTINUE
20     CONTINUE
RETURN
END IF
*
*     Start the operations.
*
IF (LSIDE) THEN
IF (LSAME(TRANSA,'N')) THEN
*
*           Form  B := alpha*inv( A )*B.
*
IF (UPPER) THEN
DO 60 J = 1,N
IF (ALPHA.NE.ONE) THEN
DO 30 I = 1,M
B(I,J) = ALPHA*B(I,J)
30                     CONTINUE
END IF
DO 50 K = M,1,-1
IF (B(K,J).NE.ZERO) THEN
IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
DO 40 I = 1,K - 1
B(I,J) = B(I,J) - B(K,J)*A(I,K)
40                         CONTINUE
END IF
50                 CONTINUE
60             CONTINUE
ELSE
DO 100 J = 1,N
IF (ALPHA.NE.ONE) THEN
DO 70 I = 1,M
B(I,J) = ALPHA*B(I,J)
70                     CONTINUE
END IF
DO 90 K = 1,M
IF (B(K,J).NE.ZERO) THEN
IF (NOUNIT) B(K,J) = B(K,J)/A(K,K)
DO 80 I = K + 1,M
B(I,J) = B(I,J) - B(K,J)*A(I,K)
80                         CONTINUE
END IF
90                 CONTINUE
100             CONTINUE
END IF
ELSE
*
*           Form  B := alpha*inv( A' )*B
*           or    B := alpha*inv( conjg( A' ) )*B.
*
IF (UPPER) THEN
DO 140 J = 1,N
DO 130 I = 1,M
TEMP = ALPHA*B(I,J)
IF (NOCONJ) THEN
DO 110 K = 1,I - 1
TEMP = TEMP - A(K,I)*B(K,J)
110                         CONTINUE
IF (NOUNIT) TEMP = TEMP/A(I,I)
ELSE
DO 120 K = 1,I - 1
TEMP = TEMP - CONJG(A(K,I))*B(K,J)
120                         CONTINUE
IF (NOUNIT) TEMP = TEMP/CONJG(A(I,I))
END IF
B(I,J) = TEMP
130                 CONTINUE
140             CONTINUE
ELSE
DO 180 J = 1,N
DO 170 I = M,1,-1
TEMP = ALPHA*B(I,J)
IF (NOCONJ) THEN
DO 150 K = I + 1,M
TEMP = TEMP - A(K,I)*B(K,J)
150                         CONTINUE
IF (NOUNIT) TEMP = TEMP/A(I,I)
ELSE
DO 160 K = I + 1,M
TEMP = TEMP - CONJG(A(K,I))*B(K,J)
160                         CONTINUE
IF (NOUNIT) TEMP = TEMP/CONJG(A(I,I))
END IF
B(I,J) = TEMP
170                 CONTINUE
180             CONTINUE
END IF
END IF
ELSE
IF (LSAME(TRANSA,'N')) THEN
*
*           Form  B := alpha*B*inv( A ).
*
IF (UPPER) THEN
DO 230 J = 1,N
IF (ALPHA.NE.ONE) THEN
DO 190 I = 1,M
B(I,J) = ALPHA*B(I,J)
190                     CONTINUE
END IF
DO 210 K = 1,J - 1
IF (A(K,J).NE.ZERO) THEN
DO 200 I = 1,M
B(I,J) = B(I,J) - A(K,J)*B(I,K)
200                         CONTINUE
END IF
210                 CONTINUE
IF (NOUNIT) THEN
TEMP = ONE/A(J,J)
DO 220 I = 1,M
B(I,J) = TEMP*B(I,J)
220                     CONTINUE
END IF
230             CONTINUE
ELSE
DO 280 J = N,1,-1
IF (ALPHA.NE.ONE) THEN
DO 240 I = 1,M
B(I,J) = ALPHA*B(I,J)
240                     CONTINUE
END IF
DO 260 K = J + 1,N
IF (A(K,J).NE.ZERO) THEN
DO 250 I = 1,M
B(I,J) = B(I,J) - A(K,J)*B(I,K)
250                         CONTINUE
END IF
260                 CONTINUE
IF (NOUNIT) THEN
TEMP = ONE/A(J,J)
DO 270 I = 1,M
B(I,J) = TEMP*B(I,J)
270                     CONTINUE
END IF
280             CONTINUE
END IF
ELSE
*
*           Form  B := alpha*B*inv( A' )
*           or    B := alpha*B*inv( conjg( A' ) ).
*
IF (UPPER) THEN
DO 330 K = N,1,-1
IF (NOUNIT) THEN
IF (NOCONJ) THEN
TEMP = ONE/A(K,K)
ELSE
TEMP = ONE/CONJG(A(K,K))
END IF
DO 290 I = 1,M
B(I,K) = TEMP*B(I,K)
290                     CONTINUE
END IF
DO 310 J = 1,K - 1
IF (A(J,K).NE.ZERO) THEN
IF (NOCONJ) THEN
TEMP = A(J,K)
ELSE
TEMP = CONJG(A(J,K))
END IF
DO 300 I = 1,M
B(I,J) = B(I,J) - TEMP*B(I,K)
300                         CONTINUE
END IF
310                 CONTINUE
IF (ALPHA.NE.ONE) THEN
DO 320 I = 1,M
B(I,K) = ALPHA*B(I,K)
320                     CONTINUE
END IF
330             CONTINUE
ELSE
DO 380 K = 1,N
IF (NOUNIT) THEN
IF (NOCONJ) THEN
TEMP = ONE/A(K,K)
ELSE
TEMP = ONE/CONJG(A(K,K))
END IF
DO 340 I = 1,M
B(I,K) = TEMP*B(I,K)
340                     CONTINUE
END IF
DO 360 J = K + 1,N
IF (A(J,K).NE.ZERO) THEN
IF (NOCONJ) THEN
TEMP = A(J,K)
ELSE
TEMP = CONJG(A(J,K))
END IF
DO 350 I = 1,M
B(I,J) = B(I,J) - TEMP*B(I,K)
350                         CONTINUE
END IF
360                 CONTINUE
IF (ALPHA.NE.ONE) THEN
DO 370 I = 1,M
B(I,K) = ALPHA*B(I,K)
370                     CONTINUE
END IF
380             CONTINUE
END IF
END IF
END IF
*
RETURN
*
*     End of CTRSM .
*
END

```