/src/igraph/vendor/lapack/dtrmm.c

Source (jump to first uncovered line)
/*  -- translated by f2c (version 20191129).
   You must link the resulting object file with libf2c:
  on Microsoft Windows system, link with libf2c.lib;
  on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  or, if you install libf2c.a in a standard place, with -lf2c -lm
  -- in that order, at the end of the command line, as in
    cc *.o -lf2c -lm
  Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

    http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* > \brief \b DTRMM   

    =========== DOCUMENTATION ===========   

   Online html documentation available at   
              http://www.netlib.org/lapack/explore-html/   

    Definition:   
    ===========   

         SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)   

         DOUBLE PRECISION ALPHA   
         INTEGER LDA,LDB,M,N   
         CHARACTER DIAG,SIDE,TRANSA,UPLO   
         DOUBLE PRECISION A(LDA,*),B(LDB,*)   


   > \par Purpose:   
    =============   
   >   
   > \verbatim   
   >   
   > DTRMM  performs one of the matrix-matrix operations   
   >   
   >    B := alpha*op( A )*B,   or   B := alpha*B*op( A ),   
   >   
   > where  alpha  is a scalar,  B  is an m by n matrix,  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**T.   
   > \endverbatim   

    Arguments:   
    ==========   

   > \param[in] SIDE   
   > \verbatim   
   >          SIDE is CHARACTER*1   
   >           On entry,  SIDE specifies whether  op( A ) multiplies B from   
   >           the left or right as follows:   
   >   
   >              SIDE = 'L' or 'l'   B := alpha*op( A )*B.   
   >   
   >              SIDE = 'R' or 'r'   B := alpha*B*op( A ).   
   > \endverbatim   
   >   
   > \param[in] UPLO   
   > \verbatim   
   >          UPLO is 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.   
   > \endverbatim   
   >   
   > \param[in] TRANSA   
   > \verbatim   
   >          TRANSA is 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**T.   
   >   
   >              TRANSA = 'C' or 'c'   op( A ) = A**T.   
   > \endverbatim   
   >   
   > \param[in] DIAG   
   > \verbatim   
   >          DIAG is 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.   
   > \endverbatim   
   >   
   > \param[in] M   
   > \verbatim   
   >          M is INTEGER   
   >           On entry, M specifies the number of rows of B. M must be at   
   >           least zero.   
   > \endverbatim   
   >   
   > \param[in] N   
   > \verbatim   
   >          N is INTEGER   
   >           On entry, N specifies the number of columns of B.  N must be   
   >           at least zero.   
   > \endverbatim   
   >   
   > \param[in] ALPHA   
   > \verbatim   
   >          ALPHA is 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.   
   > \endverbatim   
   >   
   > \param[in] A   
   > \verbatim   
   >           A is DOUBLE PRECISION array, 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.   
   > \endverbatim   
   >   
   > \param[in] LDA   
   > \verbatim   
   >          LDA is 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 ).   
   > \endverbatim   
   >   
   > \param[in,out] B   
   > \verbatim   
   >          B is DOUBLE PRECISION array, dimension ( LDB, N )   
   >           Before entry,  the leading  m by n part of the array  B must   
   >           contain the matrix  B,  and  on exit  is overwritten  by the   
   >           transformed matrix.   
   > \endverbatim   
   >   
   > \param[in] LDB   
   > \verbatim   
   >          LDB is 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 ).   
   > \endverbatim   

    Authors:   
    ========   

   > \author Univ. of Tennessee   
   > \author Univ. of California Berkeley   
   > \author Univ. of Colorado Denver   
   > \author NAG Ltd.   

   > \date December 2016   

   > \ingroup double_blas_level3   

   > \par Further Details:   
    =====================   
   >   
   > \verbatim   
   >   
   >  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.   
   > \endverbatim   
   >   
    =====================================================================   
   Subroutine */ int igraphdtrmm_(char *side, char *uplo, char *transa, char *diag, 
  integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
  lda, doublereal *b, integer *ldb)
{
    /* System generated locals */
    integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;

    /* Local variables */
    integer i__, j, k, info;
    doublereal temp;
    logical lside;
    extern logical igraphlsame_(char *, char *);
    integer nrowa;
    logical upper;
    extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen);
    logical nounit;


/*  -- Reference BLAS level3 routine (version 3.7.0) --   
    -- Reference BLAS is a software package provided by Univ. of Tennessee,    --   
    -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--   
       December 2016   


    =====================================================================   


       Test the input parameters.   

       Parameter adjustments */
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    b_dim1 = *ldb;
    b_offset = 1 + b_dim1;
    b -= b_offset;

    /* Function Body */
    lside = igraphlsame_(side, "L");
    if (lside) {
  nrowa = *m;
    } else {
  nrowa = *n;
    }
    nounit = igraphlsame_(diag, "N");
    upper = igraphlsame_(uplo, "U");

    info = 0;
    if (! lside && ! igraphlsame_(side, "R")) {
  info = 1;
    } else if (! upper && ! igraphlsame_(uplo, "L")) {
  info = 2;
    } else if (! igraphlsame_(transa, "N") && ! igraphlsame_(transa,
       "T") && ! igraphlsame_(transa, "C")) {
  info = 3;
    } else if (! igraphlsame_(diag, "U") && ! igraphlsame_(diag, 
      "N")) {
  info = 4;
    } else if (*m < 0) {
  info = 5;
    } else if (*n < 0) {
  info = 6;
    } else if (*lda < max(1,nrowa)) {
  info = 9;
    } else if (*ldb < max(1,*m)) {
  info = 11;
    }
    if (info != 0) {
  igraphxerbla_("DTRMM ", &info, (ftnlen)6);
  return 0;
    }

/*     Quick return if possible. */

    if (*m == 0 || *n == 0) {
  return 0;
    }

/*     And when  alpha.eq.zero. */

    if (*alpha == 0.) {
  i__1 = *n;
  for (j = 1; j <= i__1; ++j) {
      i__2 = *m;
      for (i__ = 1; i__ <= i__2; ++i__) {
    b[i__ + j * b_dim1] = 0.;
/* L10: */
      }
/* L20: */
  }
  return 0;
    }

/*     Start the operations. */

    if (lside) {
  if (igraphlsame_(transa, "N")) {

/*           Form  B := alpha*A*B. */

      if (upper) {
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
        i__2 = *m;
        for (k = 1; k <= i__2; ++k) {
      if (b[k + j * b_dim1] != 0.) {
          temp = *alpha * b[k + j * b_dim1];
          i__3 = k - 1;
          for (i__ = 1; i__ <= i__3; ++i__) {
        b[i__ + j * b_dim1] += temp * a[i__ + k * 
          a_dim1];
/* L30: */
          }
          if (nounit) {
        temp *= a[k + k * a_dim1];
          }
          b[k + j * b_dim1] = temp;
      }
/* L40: */
        }
/* L50: */
    }
      } else {
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
        for (k = *m; k >= 1; --k) {
      if (b[k + j * b_dim1] != 0.) {
          temp = *alpha * b[k + j * b_dim1];
          b[k + j * b_dim1] = temp;
          if (nounit) {
        b[k + j * b_dim1] *= a[k + k * a_dim1];
          }
          i__2 = *m;
          for (i__ = k + 1; i__ <= i__2; ++i__) {
        b[i__ + j * b_dim1] += temp * a[i__ + k * 
          a_dim1];
/* L60: */
          }
      }
/* L70: */
        }
/* L80: */
    }
      }
  } else {

/*           Form  B := alpha*A**T*B. */

      if (upper) {
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
        for (i__ = *m; i__ >= 1; --i__) {
      temp = b[i__ + j * b_dim1];
      if (nounit) {
          temp *= a[i__ + i__ * a_dim1];
      }
      i__2 = i__ - 1;
      for (k = 1; k <= i__2; ++k) {
          temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
/* L90: */
      }
      b[i__ + j * b_dim1] = *alpha * temp;
/* L100: */
        }
/* L110: */
    }
      } else {
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
        i__2 = *m;
        for (i__ = 1; i__ <= i__2; ++i__) {
      temp = b[i__ + j * b_dim1];
      if (nounit) {
          temp *= a[i__ + i__ * a_dim1];
      }
      i__3 = *m;
      for (k = i__ + 1; k <= i__3; ++k) {
          temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
/* L120: */
      }
      b[i__ + j * b_dim1] = *alpha * temp;
/* L130: */
        }
/* L140: */
    }
      }
  }
    } else {
  if (igraphlsame_(transa, "N")) {

/*           Form  B := alpha*B*A. */

      if (upper) {
    for (j = *n; j >= 1; --j) {
        temp = *alpha;
        if (nounit) {
      temp *= a[j + j * a_dim1];
        }
        i__1 = *m;
        for (i__ = 1; i__ <= i__1; ++i__) {
      b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
/* L150: */
        }
        i__1 = j - 1;
        for (k = 1; k <= i__1; ++k) {
      if (a[k + j * a_dim1] != 0.) {
          temp = *alpha * a[k + j * a_dim1];
          i__2 = *m;
          for (i__ = 1; i__ <= i__2; ++i__) {
        b[i__ + j * b_dim1] += temp * b[i__ + k * 
          b_dim1];
/* L160: */
          }
      }
/* L170: */
        }
/* L180: */
    }
      } else {
    i__1 = *n;
    for (j = 1; j <= i__1; ++j) {
        temp = *alpha;
        if (nounit) {
      temp *= a[j + j * a_dim1];
        }
        i__2 = *m;
        for (i__ = 1; i__ <= i__2; ++i__) {
      b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
/* L190: */
        }
        i__2 = *n;
        for (k = j + 1; k <= i__2; ++k) {
      if (a[k + j * a_dim1] != 0.) {
          temp = *alpha * a[k + j * a_dim1];
          i__3 = *m;
          for (i__ = 1; i__ <= i__3; ++i__) {
        b[i__ + j * b_dim1] += temp * b[i__ + k * 
          b_dim1];
/* L200: */
          }
      }
/* L210: */
        }
/* L220: */
    }
      }
  } else {

/*           Form  B := alpha*B*A**T. */

      if (upper) {
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
        i__2 = k - 1;
        for (j = 1; j <= i__2; ++j) {
      if (a[j + k * a_dim1] != 0.) {
          temp = *alpha * a[j + k * a_dim1];
          i__3 = *m;
          for (i__ = 1; i__ <= i__3; ++i__) {
        b[i__ + j * b_dim1] += temp * b[i__ + k * 
          b_dim1];
/* L230: */
          }
      }
/* L240: */
        }
        temp = *alpha;
        if (nounit) {
      temp *= a[k + k * a_dim1];
        }
        if (temp != 1.) {
      i__2 = *m;
      for (i__ = 1; i__ <= i__2; ++i__) {
          b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
/* L250: */
      }
        }
/* L260: */
    }
      } else {
    for (k = *n; k >= 1; --k) {
        i__1 = *n;
        for (j = k + 1; j <= i__1; ++j) {
      if (a[j + k * a_dim1] != 0.) {
          temp = *alpha * a[j + k * a_dim1];
          i__2 = *m;
          for (i__ = 1; i__ <= i__2; ++i__) {
        b[i__ + j * b_dim1] += temp * b[i__ + k * 
          b_dim1];
/* L270: */
          }
      }
/* L280: */
        }
        temp = *alpha;
        if (nounit) {
      temp *= a[k + k * a_dim1];
        }
        if (temp != 1.) {
      i__1 = *m;
      for (i__ = 1; i__ <= i__1; ++i__) {
          b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
/* L290: */
      }
        }
/* L300: */
    }
      }
  }
    }

    return 0;

/*     End of DTRMM . */

} /* igraphdtrmm_ */


Coverage Report

Created: 2023-09-25 06:05

Line	Count	Source (jump to first uncovered line)
1		/* -- translated by f2c (version 20191129).
2		You must link the resulting object file with libf2c:
3		on Microsoft Windows system, link with libf2c.lib;
4		on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5		or, if you install libf2c.a in a standard place, with -lf2c -lm
6		-- in that order, at the end of the command line, as in
7		cc *.o -lf2c -lm
8		Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10		http://www.netlib.org/f2c/libf2c.zip
11		*/
12
13		#include "f2c.h"
14
15		/* > \brief \b DTRMM
16
17		=========== DOCUMENTATION ===========
18
19		Online html documentation available at
20		http://www.netlib.org/lapack/explore-html/
21
22		Definition:
23		===========
24
25		SUBROUTINE DTRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
26
27		DOUBLE PRECISION ALPHA
28		INTEGER LDA,LDB,M,N
29		CHARACTER DIAG,SIDE,TRANSA,UPLO
30		DOUBLE PRECISION A(LDA,),B(LDB,)
31
32
33		> \par Purpose:
34		=============
35		>
36		> \verbatim
37		>
38		> DTRMM performs one of the matrix-matrix operations
39		>
40		> B := alphaop( A )B, or B := alphaBop( A ),
41		>
42		> where alpha is a scalar, B is an m by n matrix, A is a unit, or
43		> non-unit, upper or lower triangular matrix and op( A ) is one of
44		>
45		> op( A ) = A or op( A ) = A**T.
46		> \endverbatim
47
48		Arguments:
49		==========
50
51		> \param[in] SIDE
52		> \verbatim
53		> SIDE is CHARACTER*1
54		> On entry, SIDE specifies whether op( A ) multiplies B from
55		> the left or right as follows:
56		>
57		> SIDE = 'L' or 'l' B := alphaop( A )B.
58		>
59		> SIDE = 'R' or 'r' B := alphaBop( A ).
60		> \endverbatim
61		>
62		> \param[in] UPLO
63		> \verbatim
64		> UPLO is CHARACTER*1
65		> On entry, UPLO specifies whether the matrix A is an upper or
66		> lower triangular matrix as follows:
67		>
68		> UPLO = 'U' or 'u' A is an upper triangular matrix.
69		>
70		> UPLO = 'L' or 'l' A is a lower triangular matrix.
71		> \endverbatim
72		>
73		> \param[in] TRANSA
74		> \verbatim
75		> TRANSA is CHARACTER*1
76		> On entry, TRANSA specifies the form of op( A ) to be used in
77		> the matrix multiplication as follows:
78		>
79		> TRANSA = 'N' or 'n' op( A ) = A.
80		>
81		> TRANSA = 'T' or 't' op( A ) = A**T.
82		>
83		> TRANSA = 'C' or 'c' op( A ) = A**T.
84		> \endverbatim
85		>
86		> \param[in] DIAG
87		> \verbatim
88		> DIAG is CHARACTER*1
89		> On entry, DIAG specifies whether or not A is unit triangular
90		> as follows:
91		>
92		> DIAG = 'U' or 'u' A is assumed to be unit triangular.
93		>
94		> DIAG = 'N' or 'n' A is not assumed to be unit
95		> triangular.
96		> \endverbatim
97		>
98		> \param[in] M
99		> \verbatim
100		> M is INTEGER
101		> On entry, M specifies the number of rows of B. M must be at
102		> least zero.
103		> \endverbatim
104		>
105		> \param[in] N
106		> \verbatim
107		> N is INTEGER
108		> On entry, N specifies the number of columns of B. N must be
109		> at least zero.
110		> \endverbatim
111		>
112		> \param[in] ALPHA
113		> \verbatim
114		> ALPHA is DOUBLE PRECISION.
115		> On entry, ALPHA specifies the scalar alpha. When alpha is
116		> zero then A is not referenced and B need not be set before
117		> entry.
118		> \endverbatim
119		>
120		> \param[in] A
121		> \verbatim
122		> A is DOUBLE PRECISION array, dimension ( LDA, k ), where k is m
123		> when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
124		> Before entry with UPLO = 'U' or 'u', the leading k by k
125		> upper triangular part of the array A must contain the upper
126		> triangular matrix and the strictly lower triangular part of
127		> A is not referenced.
128		> Before entry with UPLO = 'L' or 'l', the leading k by k
129		> lower triangular part of the array A must contain the lower
130		> triangular matrix and the strictly upper triangular part of
131		> A is not referenced.
132		> Note that when DIAG = 'U' or 'u', the diagonal elements of
133		> A are not referenced either, but are assumed to be unity.
134		> \endverbatim
135		>
136		> \param[in] LDA
137		> \verbatim
138		> LDA is INTEGER
139		> On entry, LDA specifies the first dimension of A as declared
140		> in the calling (sub) program. When SIDE = 'L' or 'l' then
141		> LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
142		> then LDA must be at least max( 1, n ).
143		> \endverbatim
144		>
145		> \param[in,out] B
146		> \verbatim
147		> B is DOUBLE PRECISION array, dimension ( LDB, N )
148		> Before entry, the leading m by n part of the array B must
149		> contain the matrix B, and on exit is overwritten by the
150		> transformed matrix.
151		> \endverbatim
152		>
153		> \param[in] LDB
154		> \verbatim
155		> LDB is INTEGER
156		> On entry, LDB specifies the first dimension of B as declared
157		> in the calling (sub) program. LDB must be at least
158		> max( 1, m ).
159		> \endverbatim
160
161		Authors:
162		========
163
164		> \author Univ. of Tennessee
165		> \author Univ. of California Berkeley
166		> \author Univ. of Colorado Denver
167		> \author NAG Ltd.
168
169		> \date December 2016
170
171		> \ingroup double_blas_level3
172
173		> \par Further Details:
174		=====================
175		>
176		> \verbatim
177		>
178		> Level 3 Blas routine.
179		>
180		> -- Written on 8-February-1989.
181		> Jack Dongarra, Argonne National Laboratory.
182		> Iain Duff, AERE Harwell.
183		> Jeremy Du Croz, Numerical Algorithms Group Ltd.
184		> Sven Hammarling, Numerical Algorithms Group Ltd.
185		> \endverbatim
186		>
187		=====================================================================
188		Subroutine / int igraphdtrmm_(char side, char uplo, char transa, char *diag,
189		integer m, integer n, doublereal alpha, doublereal a, integer *
190		lda, doublereal b, integer ldb)
191	0	{
192		/* System generated locals */
193	0	integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
194
195		/* Local variables */
196	0	integer i__, j, k, info;
197	0	doublereal temp;
198	0	logical lside;
199	0	extern logical igraphlsame_(char , char );
200	0	integer nrowa;
201	0	logical upper;
202	0	extern /* Subroutine / int igraphxerbla_(char , integer *, ftnlen);
203	0	logical nounit;
204
205
206		/* -- Reference BLAS level3 routine (version 3.7.0) --
207		-- Reference BLAS is a software package provided by Univ. of Tennessee, --
208		-- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
209		December 2016
210
211
212		=====================================================================
213
214
215		Test the input parameters.
216
217		Parameter adjustments */
218	0	a_dim1 = *lda;
219	0	a_offset = 1 + a_dim1;
220	0	a -= a_offset;
221	0	b_dim1 = *ldb;
222	0	b_offset = 1 + b_dim1;
223	0	b -= b_offset;
224
225		/* Function Body */
226	0	lside = igraphlsame_(side, "L");
227	0	if (lside) {
228	0	nrowa = *m;
229	0	} else {
230	0	nrowa = *n;
231	0	}
232	0	nounit = igraphlsame_(diag, "N");
233	0	upper = igraphlsame_(uplo, "U");
234
235	0	info = 0;
236	0	if (! lside && ! igraphlsame_(side, "R")) {
237	0	info = 1;
238	0	} else if (! upper && ! igraphlsame_(uplo, "L")) {
239	0	info = 2;
240	0	} else if (! igraphlsame_(transa, "N") && ! igraphlsame_(transa,
241	0	"T") && ! igraphlsame_(transa, "C")) {
242	0	info = 3;
243	0	} else if (! igraphlsame_(diag, "U") && ! igraphlsame_(diag,
244	0	"N")) {
245	0	info = 4;
246	0	} else if (*m < 0) {
247	0	info = 5;
248	0	} else if (*n < 0) {
249	0	info = 6;
250	0	} else if (*lda < max(1,nrowa)) {
251	0	info = 9;
252	0	} else if (ldb < max(1,m)) {
253	0	info = 11;
254	0	}
255	0	if (info != 0) {
256	0	igraphxerbla_("DTRMM ", &info, (ftnlen)6);
257	0	return 0;
258	0	}
259
260		/* Quick return if possible. */
261
262	0	if (m == 0 \|\| n == 0) {
263	0	return 0;
264	0	}
265
266		/* And when alpha.eq.zero. */
267
268	0	if (*alpha == 0.) {
269	0	i__1 = *n;
270	0	for (j = 1; j <= i__1; ++j) {
271	0	i__2 = *m;
272	0	for (i__ = 1; i__ <= i__2; ++i__) {
273	0	b[i__ + j * b_dim1] = 0.;
274		/* L10: */
275	0	}
276		/* L20: */
277	0	}
278	0	return 0;
279	0	}
280
281		/* Start the operations. */
282
283	0	if (lside) {
284	0	if (igraphlsame_(transa, "N")) {
285
286		/* Form B := alphaAB. */
287
288	0	if (upper) {
289	0	i__1 = *n;
290	0	for (j = 1; j <= i__1; ++j) {
291	0	i__2 = *m;
292	0	for (k = 1; k <= i__2; ++k) {
293	0	if (b[k + j * b_dim1] != 0.) {
294	0	temp = alpha b[k + j * b_dim1];
295	0	i__3 = k - 1;
296	0	for (i__ = 1; i__ <= i__3; ++i__) {
297	0	b[i__ + j * b_dim1] += temp * a[i__ + k *
298	0	a_dim1];
299		/* L30: */
300	0	}
301	0	if (nounit) {
302	0	temp = a[k + k a_dim1];
303	0	}
304	0	b[k + j * b_dim1] = temp;
305	0	}
306		/* L40: */
307	0	}
308		/* L50: */
309	0	}
310	0	} else {
311	0	i__1 = *n;
312	0	for (j = 1; j <= i__1; ++j) {
313	0	for (k = *m; k >= 1; --k) {
314	0	if (b[k + j * b_dim1] != 0.) {
315	0	temp = alpha b[k + j * b_dim1];
316	0	b[k + j * b_dim1] = temp;
317	0	if (nounit) {
318	0	b[k + j * b_dim1] = a[k + k a_dim1];
319	0	}
320	0	i__2 = *m;
321	0	for (i__ = k + 1; i__ <= i__2; ++i__) {
322	0	b[i__ + j * b_dim1] += temp * a[i__ + k *
323	0	a_dim1];
324		/* L60: */
325	0	}
326	0	}
327		/* L70: */
328	0	}
329		/* L80: */
330	0	}
331	0	}
332	0	} else {
333
334		/* Form B := alphaATB. */
335
336	0	if (upper) {
337	0	i__1 = *n;
338	0	for (j = 1; j <= i__1; ++j) {
339	0	for (i__ = *m; i__ >= 1; --i__) {
340	0	temp = b[i__ + j * b_dim1];
341	0	if (nounit) {
342	0	temp = a[i__ + i__ a_dim1];
343	0	}
344	0	i__2 = i__ - 1;
345	0	for (k = 1; k <= i__2; ++k) {
346	0	temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
347		/* L90: */
348	0	}
349	0	b[i__ + j * b_dim1] = alpha temp;
350		/* L100: */
351	0	}
352		/* L110: */
353	0	}
354	0	} else {
355	0	i__1 = *n;
356	0	for (j = 1; j <= i__1; ++j) {
357	0	i__2 = *m;
358	0	for (i__ = 1; i__ <= i__2; ++i__) {
359	0	temp = b[i__ + j * b_dim1];
360	0	if (nounit) {
361	0	temp = a[i__ + i__ a_dim1];
362	0	}
363	0	i__3 = *m;
364	0	for (k = i__ + 1; k <= i__3; ++k) {
365	0	temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
366		/* L120: */
367	0	}
368	0	b[i__ + j * b_dim1] = alpha temp;
369		/* L130: */
370	0	}
371		/* L140: */
372	0	}
373	0	}
374	0	}
375	0	} else {
376	0	if (igraphlsame_(transa, "N")) {
377
378		/* Form B := alphaBA. */
379
380	0	if (upper) {
381	0	for (j = *n; j >= 1; --j) {
382	0	temp = *alpha;
383	0	if (nounit) {
384	0	temp = a[j + j a_dim1];
385	0	}
386	0	i__1 = *m;
387	0	for (i__ = 1; i__ <= i__1; ++i__) {
388	0	b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
389		/* L150: */
390	0	}
391	0	i__1 = j - 1;
392	0	for (k = 1; k <= i__1; ++k) {
393	0	if (a[k + j * a_dim1] != 0.) {
394	0	temp = alpha a[k + j * a_dim1];
395	0	i__2 = *m;
396	0	for (i__ = 1; i__ <= i__2; ++i__) {
397	0	b[i__ + j * b_dim1] += temp * b[i__ + k *
398	0	b_dim1];
399		/* L160: */
400	0	}
401	0	}
402		/* L170: */
403	0	}
404		/* L180: */
405	0	}
406	0	} else {
407	0	i__1 = *n;
408	0	for (j = 1; j <= i__1; ++j) {
409	0	temp = *alpha;
410	0	if (nounit) {
411	0	temp = a[j + j a_dim1];
412	0	}
413	0	i__2 = *m;
414	0	for (i__ = 1; i__ <= i__2; ++i__) {
415	0	b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
416		/* L190: */
417	0	}
418	0	i__2 = *n;
419	0	for (k = j + 1; k <= i__2; ++k) {
420	0	if (a[k + j * a_dim1] != 0.) {
421	0	temp = alpha a[k + j * a_dim1];
422	0	i__3 = *m;
423	0	for (i__ = 1; i__ <= i__3; ++i__) {
424	0	b[i__ + j * b_dim1] += temp * b[i__ + k *
425	0	b_dim1];
426		/* L200: */
427	0	}
428	0	}
429		/* L210: */
430	0	}
431		/* L220: */
432	0	}
433	0	}
434	0	} else {
435
436		/* Form B := alphaBA*T. /
437
438	0	if (upper) {
439	0	i__1 = *n;
440	0	for (k = 1; k <= i__1; ++k) {
441	0	i__2 = k - 1;
442	0	for (j = 1; j <= i__2; ++j) {
443	0	if (a[j + k * a_dim1] != 0.) {
444	0	temp = alpha a[j + k * a_dim1];
445	0	i__3 = *m;
446	0	for (i__ = 1; i__ <= i__3; ++i__) {
447	0	b[i__ + j * b_dim1] += temp * b[i__ + k *
448	0	b_dim1];
449		/* L230: */
450	0	}
451	0	}
452		/* L240: */
453	0	}
454	0	temp = *alpha;
455	0	if (nounit) {
456	0	temp = a[k + k a_dim1];
457	0	}
458	0	if (temp != 1.) {
459	0	i__2 = *m;
460	0	for (i__ = 1; i__ <= i__2; ++i__) {
461	0	b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
462		/* L250: */
463	0	}
464	0	}
465		/* L260: */
466	0	}
467	0	} else {
468	0	for (k = *n; k >= 1; --k) {
469	0	i__1 = *n;
470	0	for (j = k + 1; j <= i__1; ++j) {
471	0	if (a[j + k * a_dim1] != 0.) {
472	0	temp = alpha a[j + k * a_dim1];
473	0	i__2 = *m;
474	0	for (i__ = 1; i__ <= i__2; ++i__) {
475	0	b[i__ + j * b_dim1] += temp * b[i__ + k *
476	0	b_dim1];
477		/* L270: */
478	0	}
479	0	}
480		/* L280: */
481	0	}
482	0	temp = *alpha;
483	0	if (nounit) {
484	0	temp = a[k + k a_dim1];
485	0	}
486	0	if (temp != 1.) {
487	0	i__1 = *m;
488	0	for (i__ = 1; i__ <= i__1; ++i__) {
489	0	b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
490		/* L290: */
491	0	}
492	0	}
493		/* L300: */
494	0	}
495	0	}
496	0	}
497	0	}
498
499	0	return 0;
500
501		/* End of DTRMM . */
502
503	0	} /* igraphdtrmm_ */
504