91
92
93
94
95
96
97 INTEGER LDA, M, N, SCALE
98 DOUBLE PRECISION NORMA
99
100
101 INTEGER ISEED( 4 )
102 COMPLEX*16 A( LDA, * )
103
104
105
106
107
108 DOUBLE PRECISION ONE
109 parameter( one = 1.0d0 )
110
111
112 INTEGER INFO, J
113 DOUBLE PRECISION BIGNUM, SMLNUM
114
115
116 DOUBLE PRECISION DLAMCH, DZASUM, ZLANGE
118
119
121
122
123 INTRINSIC dble, dcmplx, sign
124
125
126 DOUBLE PRECISION DUMMY( 1 )
127
128
129
130 IF( m.LE.0 .OR. n.LE.0 )
131 $ RETURN
132
133
134
135 DO 10 j = 1, n
136 CALL zlarnv( 2, iseed, m, a( 1, j ) )
137 IF( j.LE.m ) THEN
138 a( j, j ) = a( j, j ) + dcmplx( sign(
dzasum( m, a( 1, j ),
139 $ 1 ), dble( a( j, j ) ) ) )
140 END IF
141 10 CONTINUE
142
143
144
145 IF( scale.NE.1 ) THEN
146 norma =
zlange(
'Max', m, n, a, lda, dummy )
147 smlnum =
dlamch(
'Safe minimum' )
148 bignum = one / smlnum
149 CALL dlabad( smlnum, bignum )
150 smlnum = smlnum /
dlamch(
'Epsilon' )
151 bignum = one / smlnum
152
153 IF( scale.EQ.2 ) THEN
154
155
156
157 CALL zlascl(
'General', 0, 0, norma, bignum, m, n, a, lda,
158 $ info )
159 ELSE IF( scale.EQ.3 ) THEN
160
161
162
163 CALL zlascl(
'General', 0, 0, norma, smlnum, m, n, a, lda,
164 $ info )
165 END IF
166 END IF
167
168 norma =
zlange(
'One-norm', m, n, a, lda, dummy )
169 RETURN
170
171
172
double precision function dlamch(CMACH)
DLAMCH
subroutine dlabad(SMALL, LARGE)
DLABAD
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
double precision function dzasum(N, ZX, INCX)
DZASUM