180 SUBROUTINE dtrsm(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
187 DOUBLE PRECISION ALPHA
189 CHARACTER DIAG,SIDE,TRANSA,UPLO
192 DOUBLE PRECISION A(LDA,*),B(LDB,*)
208 DOUBLE PRECISION TEMP
209 INTEGER I,INFO,J,K,NROWA
210 LOGICAL LSIDE,NOUNIT,UPPER
213 DOUBLE PRECISION ONE,ZERO
214 parameter(one=1.0d+0,zero=0.0d+0)
219 lside = lsame(side,
'L')
225 nounit = lsame(diag,
'N')
226 upper = lsame(uplo,
'U')
229 IF ((.NOT.lside) .AND. (.NOT.lsame(side,
'R')))
THEN
231 ELSE IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,
'L')))
THEN
233 ELSE IF ((.NOT.lsame(transa,
'N')) .AND.
234 + (.NOT.lsame(transa,
'T')) .AND.
235 + (.NOT.lsame(transa,
'C')))
THEN
237 ELSE IF ((.NOT.lsame(diag,
'U')) .AND. (.NOT.lsame(diag,
'N')))
THEN
239 ELSE IF (m.LT.0)
THEN
241 ELSE IF (n.LT.0)
THEN
243 ELSE IF (lda.LT.max(1,nrowa))
THEN
245 ELSE IF (ldb.LT.max(1,m))
THEN
249 CALL xerbla(
'DTRSM ',info)
255 IF (m.EQ.0 .OR. n.EQ.0)
RETURN
259 IF (alpha.EQ.zero)
THEN
271 IF (lsame(transa,
'N'))
THEN
277 IF (alpha.NE.one)
THEN
279 b(i,j) = alpha*b(i,j)
283 IF (b(k,j).NE.zero)
THEN
284 IF (nounit) b(k,j) = b(k,j)/a(k,k)
286 b(i,j) = b(i,j) - b(k,j)*a(i,k)
293 IF (alpha.NE.one)
THEN
295 b(i,j) = alpha*b(i,j)
299 IF (b(k,j).NE.zero)
THEN
300 IF (nounit) b(k,j) = b(k,j)/a(k,k)
302 b(i,j) = b(i,j) - b(k,j)*a(i,k)
317 temp = temp - a(k,i)*b(k,j)
319 IF (nounit) temp = temp/a(i,i)
328 temp = temp - a(k,i)*b(k,j)
330 IF (nounit) temp = temp/a(i,i)
337 IF (lsame(transa,
'N'))
THEN
343 IF (alpha.NE.one)
THEN
345 b(i,j) = alpha*b(i,j)
349 IF (a(k,j).NE.zero)
THEN
351 b(i,j) = b(i,j) - a(k,j)*b(i,k)
364 IF (alpha.NE.one)
THEN
366 b(i,j) = alpha*b(i,j)
370 IF (a(k,j).NE.zero)
THEN
372 b(i,j) = b(i,j) - a(k,j)*b(i,k)
397 IF (a(j,k).NE.zero)
THEN
400 b(i,j) = b(i,j) - temp*b(i,k)
404 IF (alpha.NE.one)
THEN
406 b(i,k) = alpha*b(i,k)
419 IF (a(j,k).NE.zero)
THEN
422 b(i,j) = b(i,j) - temp*b(i,k)
426 IF (alpha.NE.one)
THEN
428 b(i,k) = alpha*b(i,k)
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM