1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
! { dg-do compile }
! { dg-options "-O -floop-nest-optimize" }
SUBROUTINE ZTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, &
B, LDB )
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
INTEGER M, N, LDA, LDB
complex(kind((1.0d0,1.0d0))) ALPHA
complex(kind((1.0d0,1.0d0))) A( LDA, * ), B( LDB, * )
EXTERNAL XERBLA
INTRINSIC CONJG, MAX
LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
INTEGER I, INFO, J, K, NROWA
complex(kind((1.0d0,1.0d0))) TEMP
complex(kind((1.0d0,1.0d0))) ONE
PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
complex(kind((1.0d0,1.0d0))) ZERO
PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
LSIDE = scan( SIDE , 'Ll' )>0
IF( LSIDE )THEN
NROWA = M
ELSE
NROWA = N
END IF
NOCONJ = scan( TRANSA, 'Tt' )>0
NOUNIT = scan( DIAG , 'Nn' )>0
UPPER = scan( UPLO , 'Uu' )>0
INFO = 0
IF( N.EQ.0 ) &
RETURN
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
DO 160, J = 1, N
DO 150, I = 1, M
TEMP = B( I, J )
IF( NOCONJ )THEN
IF( NOUNIT ) &
TEMP = TEMP*A( I, I )
DO 130, K = I + 1, M
TEMP = TEMP + A( K, I )*B( K, J )
130 CONTINUE
ELSE
IF( NOUNIT ) &
TEMP = TEMP*CONJG( A( I, I ) )
DO 140, K = I + 1, M
TEMP = TEMP + CONJG( A( K, I ) )*B( K, J )
140 CONTINUE
END IF
B( I, J ) = ALPHA*TEMP
150 CONTINUE
160 CONTINUE
RETURN
END
|
