1 SUBROUTINE dtrsm(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
5 CHARACTER diag,side,transa,uplo
8 DOUBLE PRECISION a(lda,*),b(ldb,*)
144 DOUBLE PRECISION temp
145 INTEGER i,info,j,k,nrowa
146 LOGICAL lside,nounit,upper
149 DOUBLE PRECISION one,zero
150 parameter(one=1.0d+0,zero=0.0d+0)
155 lside = lsame(side,
'L')
161 nounit = lsame(diag,
'N')
162 upper = lsame(uplo,
'U')
165 IF ((.NOT.lside) .AND. (.NOT.lsame(side,
'R')))
THEN 167 ELSE IF ((.NOT.upper) .AND. (.NOT.lsame(uplo,
'L')))
THEN 169 ELSE IF ((.NOT.lsame(transa,
'N')) .AND.
170 + (.NOT.lsame(transa,
'T')) .AND.
171 + (.NOT.lsame(transa,
'C')))
THEN 173 ELSE IF ((.NOT.lsame(diag,
'U')) .AND. (.NOT.lsame(diag,
'N')))
THEN 175 ELSE IF (m.LT.0)
THEN 177 ELSE IF (n.LT.0)
THEN 179 ELSE IF (lda.LT.max(1,nrowa))
THEN 181 ELSE IF (ldb.LT.max(1,m))
THEN 185 CALL xerbla(
'DTRSM ',info)
191 IF (m.EQ.0 .OR. n.EQ.0)
RETURN 195 IF (alpha.EQ.zero)
THEN 207 IF (lsame(transa,
'N'))
THEN 213 IF (alpha.NE.one)
THEN 215 b(i,j) = alpha*b(i,j)
219 IF (b(k,j).NE.zero)
THEN 220 IF (nounit) b(k,j) = b(k,j)/a(k,k)
222 b(i,j) = b(i,j) - b(k,j)*a(i,k)
229 IF (alpha.NE.one)
THEN 231 b(i,j) = alpha*b(i,j)
235 IF (b(k,j).NE.zero)
THEN 236 IF (nounit) b(k,j) = b(k,j)/a(k,k)
238 b(i,j) = b(i,j) - b(k,j)*a(i,k)
253 temp = temp - a(k,i)*b(k,j)
255 IF (nounit) temp = temp/a(i,i)
264 temp = temp - a(k,i)*b(k,j)
266 IF (nounit) temp = temp/a(i,i)
273 IF (lsame(transa,
'N'))
THEN 279 IF (alpha.NE.one)
THEN 281 b(i,j) = alpha*b(i,j)
285 IF (a(k,j).NE.zero)
THEN 287 b(i,j) = b(i,j) - a(k,j)*b(i,k)
300 IF (alpha.NE.one)
THEN 302 b(i,j) = alpha*b(i,j)
306 IF (a(k,j).NE.zero)
THEN 308 b(i,j) = b(i,j) - a(k,j)*b(i,k)
333 IF (a(j,k).NE.zero)
THEN 336 b(i,j) = b(i,j) - temp*b(i,k)
340 IF (alpha.NE.one)
THEN 342 b(i,k) = alpha*b(i,k)
355 IF (a(j,k).NE.zero)
THEN 358 b(i,j) = b(i,j) - temp*b(i,k)
362 IF (alpha.NE.one)
THEN 364 b(i,k) = alpha*b(i,k)