      SUBROUTINE DTRSM(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,A,LDA,
     +                   B, LDB )
****************************************************************************
*                                                                          *
*   DATA PARALLEL BLAS based on MPL                                        *
*                                                                          *
*   Version 1.0   1/9-92 ,                                                 *
*   For MasPar MP-1 computers                                              *
*                                                                          *
*   para//ab, University of Bergen, NORWAY                                 *
*                                                                          *
*   These programs must be called using F90 style array syntax.            *
*   Note that the F77 style calling sequence has been retained             *
*   in this version for compatibility reasons, be aware that               *
*   parameters related to the array dimensions and shape therefore may     *
*   be redundant and without any influence.                                *
*   The calling sequence may be changed in a future version.               *
*   Please report any BUGs, ideas for improvement or other                 *
*   comments to                                                            *
*                    adm@parallab.uib.no                                   *
*                                                                          *
*   Future versions may then reflect your suggestions.                     *
*   The most current version of this software is available                 *
*   from netlib@nac.no , send the message `send index from maspar'         *
*                                                                          *
*   REVISIONS:                                                             *
*                                                                          *
****************************************************************************
      implicit none
*     .. Scalar Arguments ..
      CHARACTER(1)       SIDE, UPLO, TRANSA, DIAG
      INTEGER            M, N, LDA, LDB
      DOUBLE PRECISION               ALPHA
*     .. Array Arguments ..
      DOUBLE PRECISION,ARRAY(:,:) ::   A,B

*     ..
*
*  Purpose
*  =======
*
*  DTRSM  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'.
*
*  The matrix X is overwritten on B.
*
*  Parameters
*  ==========
*
*  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 ) = 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  - DOUBLE PRECISION.
*           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      - DOUBLE PRECISION 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      - DOUBLE PRECISION 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.
*
*  -- Restructured, blocked and tuned for IBM 3090 VF in August-1989.
*     Per Ling,
*     Institute of Information Processing, University of Umea, Sweden.
*     V1.R0.
*
*  -- Modified for to run on Maspar MP-1  December 90
*     by Hans Hatlestad, Institute of Informatics,
*     University of Bergen, Norway.
*
*
* cts CMPF MPL MPL_DTRSM_LOT, MPL_DTRSM_UPT

cmpf ondpu a, b
CMPF MPL MPL_DTRSM_LON, MPL_DTRSM_UPN

*     .. Local Scalars ..
      INTEGER            I, J, INFO, NROWA
      integer                   int_diag
      double precision,array(1:n,1:m) ::    tmpB
      double precision,array(1:n,1:n) ::    tmpA
      LOGICAL            LSIDE, UPPER, NOTR, NOUNIT
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     .. External Subroutines ..
      EXTERNAL           XERBLA
*     .. Parameters ..
      DOUBLE PRECISION               ZERO
      PARAMETER        ( ZERO = 0.0D+0 )
cmpf  ondpu tmpA, tmpB
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*

      LSIDE  = LSAME( SIDE, 'L' )
      UPPER  = LSAME( UPLO, 'U' )
      NOTR   = LSAME( TRANSA, 'N' )
      NOUNIT = LSAME( DIAG, 'N' )
      IF( LSIDE )THEN
         NROWA = M
      ELSE
         NROWA = N
      END IF
      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.NOTR                ).AND.
     +         ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
     +         ( .NOT.LSAME( TRANSA, 'C' ) )      )THEN
         INFO = 3
      ELSE IF( ( .NOT.NOUNIT              ).AND.
     +         ( .NOT.LSAME( DIAG , 'U' ) )      )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( 'DTRSM ', INFO )
         RETURN
      END IF
*
*     Quick return if possible.
*
      IF( ( M.EQ.0 ).OR.( N.EQ.0 ) )
     +   RETURN
*
*     And when  alpha.eq.zero.
*
      IF( ALPHA.EQ.ZERO )THEN
	 B=ZERO
         RETURN
      END IF
****************************************************************************
*
*     Start the operations.
*

      if (NOUNIT) then
	 int_diag = 0
      else
	 int_diag = 1
      endif
      IF( LSIDE )THEN
*
*        Solve  op( A )*X = alpha*B.
*
         IF( UPPER )THEN
            IF( NOTR )THEN
*              Left, Upper, No transpose, MPL routine
	       B = ALPHA * B
               CALL MPL_DTRSM_UPN(int_diag, M, N, A,
     +                             LDA, B)
            ELSE
*              Left, Upper, Transpose, MPL routine

               A = TRANSPOSE(A)
	       B = ALPHA * B
	       CALL MPL_DTRSM_LON(int_diag, M, N, A,
     +                             LDA, B)
	       A = TRANSPOSE(A)
            END IF
         ELSE
            IF( NOTR )THEN
*              Left, Lower, No transpose, MPL routine

	       B = ALPHA * B
               CALL MPL_DTRSM_LON(int_diag, M, N, A,
     +                             LDA, B)
            ELSE
*              Left, Lower, Transpose, MPL routine

	       A =  TRANSPOSE(A)
	       B = ALPHA * B
	       CALL MPL_DTRSM_UPN(int_diag, M, N, A,
     +                             LDA, B)
	       A =  TRANSPOSE(A)
            END IF
         END IF
*
      ELSE   ! Side = right
*
*        Solve  X*op( A ) = alpha*B.
*
         IF( UPPER )THEN
            IF( NOTR )THEN
*              Right, Upper, No transpose, MPL routine

	       tmpB =  TRANSPOSE(B)
	       tmpB = ALPHA * tmpB
	       tmpA =  TRANSPOSE(A)
               call MPL_DTRSM_LON(int_diag,N,M,tmpA,
     +                             LDA,tmpB)
	       B =  TRANSPOSE(tmpB)
            ELSE
*              Right, Upper, Transpose, MPL routine

	       tmpB = TRANSPOSE(B)
               tmpB = ALPHA * tmpB
 	       tmpA = A
*	       write(*,*) 'kaller med R U T U/N '
*	       write(*,*) 'A =',N,'*',N,' lda =',LDA,'B =',N,'*',M
               call MPL_DTRSM_UPN(int_diag,N,M,tmpA,LDA,tmpB)
               B = TRANSPOSE(tmpB)
            END IF
         ELSE
            IF( NOTR )THEN
*              Right, Lower, No transpose, MPL routine

	       tmpB =  TRANSPOSE(B)
	       tmpB = ALPHA * tmpB
	       tmpA =  TRANSPOSE(A)
	       call MPL_DTRSM_UPN(int_diag,N,M,tmpA,LDA,tmpB)
	       B =  TRANSPOSE(tmpB)
            ELSE
*              Right, Lower, Transpose, MPL routine

 	       tmpA = A
	       tmpB = TRANSPOSE(B)
               tmpB = ALPHA * tmpB
	       call MPL_DTRSM_LON(int_diag,N,M,tmpA,LDA,tmpB)
               B = TRANSPOSE(tmpB)
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of DTRSM .
*
      END