OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pzlatms.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine pzlatms (m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)

Function/Subroutine Documentation

◆ pzlatms()

subroutine pzlatms ( integer m,
integer n,
character dist,
integer, dimension( 4 ) iseed,
character sym,
double precision, dimension( * ) d,
integer mode,
double precision cond,
double precision dmax,
integer kl,
integer ku,
character pack,
complex*16, dimension( * ) a,
integer ia,
integer ja,
integer, dimension( * ) desca,
integer order,
complex*16, dimension( * ) work,
integer lwork,
integer info )

Definition at line 3 of file pzlatms.f.

6*
7* -- ScaLAPACK routine (version 1.7) --
8* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
9* and University of California, Berkeley.
10* May 1, 1997
11*
12* .. Scalar Arguments ..
13 CHARACTER DIST, PACK, SYM
14 INTEGER IA, INFO, JA, KL, KU, LWORK, M, MODE, N, ORDER
15 DOUBLE PRECISION COND, DMAX
16* ..
17* .. Array Arguments ..
18 INTEGER DESCA( * ), ISEED( 4 )
19 DOUBLE PRECISION D( * )
20 COMPLEX*16 A( * ), WORK( * )
21* ..
22*
23* Purpose
24* =======
25*
26* PZLATMS generates random Hermitian matrices with specified
27* eigenvalues for testing SCALAPACK programs.
28*
29* PZLATMS operates by applying the following sequence of
30* operations:
31*
32* Set the diagonal to D, where D may be input or
33* computed according to MODE, COND, DMAX, and SYM
34* as described below.
35*
36* Generate a dense M x N matrix by multiplying D on the left
37* and the right by random unitary matrices, then:
38*
39* Reduce the bandwidth according to KL and KU, using
40* Householder transformations.
41* ### bandwidth reduction NOT SUPPORTED ###
42*
43* Arguments
44* =========
45*
46* M - (global input) INTEGER
47* The number of rows of A. Not modified.
48*
49* N - (global input) INTEGER
50* The number of columns of A. Not modified.
51* ### M .ne. N unsupported
52*
53* DIST - (global input) CHARACTER*1
54* On entry, DIST specifies the type of distribution to be used
55* to generate the random eigen-/singular values.
56* 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
57* 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
58* 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
59* Not modified.
60*
61* ISEED - (global input) INTEGER array, dimension ( 4 )
62* On entry ISEED specifies the seed of the random number
63* generator. They should lie between 0 and 4095 inclusive,
64* and ISEED(4) should be odd. The random number generator
65* uses a linear congruential sequence limited to small
66* integers, and so should produce machine independent
67* random numbers. The values of ISEED are changed on
68* exit, and can be used in the next call to ZLATMS
69* to continue the same random number sequence.
70* Changed on exit.
71*
72* SYM - (global input) CHARACTER*1
73* If SYM='S' or 'H', the generated matrix is Hermitian, with
74* eigenvalues specified by D, COND, MODE, and DMAX; they
75* may be positive, negative, or zero.
76* If SYM='P', the generated matrix is Hermitian, with
77* eigenvalues (= singular values) specified by D, COND,
78* MODE, and DMAX; they will not be negative.
79* If SYM='N', the generated matrix is nonsymmetric, with
80* singular values specified by D, COND, MODE, and DMAX;
81* they will not be negative.
82* ### SYM = 'N' NOT SUPPORTED ###
83* Not modified.
84*
85* D - (local input/output) DOUBLE PRECISION array,
86* dimension ( MIN( M , N ) )
87* This array is used to specify the singular values or
88* eigenvalues of A (see SYM, above.) If MODE=0, then D is
89* assumed to contain the singular/eigenvalues, otherwise
90* they will be computed according to MODE, COND, and DMAX,
91* and placed in D.
92* Modified if MODE is nonzero.
93*
94* MODE - (global input) INTEGER
95* On entry this describes how the singular/eigenvalues are to
96* be specified:
97* MODE = 0 means use D as input
98* MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
99* MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
100* MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
101* MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
102* MODE = 5 sets D to random numbers in the range
103* ( 1/COND , 1 ) such that their logarithms
104* are uniformly distributed.
105* MODE = 6 set D to random numbers from same distribution
106* as the rest of the matrix.
107* MODE < 0 has the same meaning as ABS(MODE), except that
108* the order of the elements of D is reversed.
109* Thus if MODE is positive, D has entries ranging from
110* 1 to 1/COND, if negative, from 1/COND to 1,
111* If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then
112* the elements of D will also be multiplied by a random
113* sign (i.e., +1 or -1.)
114* Not modified.
115*
116* COND - (global input) DOUBLE PRECISION
117* On entry, this is used as described under MODE above.
118* If used, it must be >= 1. Not modified.
119*
120* DMAX - (global input) DOUBLE PRECISION
121* If MODE is neither -6, 0 nor 6, the contents of D, as
122* computed according to MODE and COND, will be scaled by
123* DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or
124* singular value (which is to say the norm) will be abs(DMAX).
125* Note that DMAX need not be positive: if DMAX is negative
126* (or zero), D will be scaled by a negative number (or zero).
127* Not modified.
128*
129* KL - (global input) INTEGER
130* This specifies the lower bandwidth of the matrix. For
131* example, KL=0 implies upper triangular, KL=1 implies upper
132* Hessenberg, and KL being at least M-1 means that the matrix
133* has full lower bandwidth. KL must equal KU if the matrix
134* is Hermitian.
135* Not modified.
136* ### 1 <= KL < N-1 is NOT SUPPORTED ###
137*
138* KU - (global input) INTEGER
139* This specifies the upper bandwidth of the matrix. For
140* example, KU=0 implies lower triangular, KU=1 implies lower
141* Hessenberg, and KU being at least N-1 means that the matrix
142* has full upper bandwidth. KL must equal KU if the matrix
143* is Hermitian.
144* Not modified.
145* ### 1 <= KU < N-1 is NOT SUPPORTED ###
146*
147* PACK - (global input) CHARACTER*1
148* This specifies packing of matrix as follows:
149* 'N' => no packing
150* ### PACK must be 'N' all other options NOT SUPPORTED ###
151*
152* A - (local output) COMPLEX*16 array
153* Global dimension (M, N), local dimension (MP, NQ)
154* On exit A is the desired test matrix.
155*
156* IA (global input) INTEGER
157* A's global row index, which points to the beginning of the
158* submatrix which is to be operated on.
159*
160* JA (global input) INTEGER
161* A's global column index, which points to the beginning of
162* the submatrix which is to be operated on.
163*
164* DESCA (global and local input) INTEGER array of dimension DLEN_.
165* The array descriptor for the distributed matrix A.
166*
167* ORDER - (input) INTEGER
168* The number of reflectors used to define the orthogonal
169* matrix Q. A = Q * D * Q'
170* Higher ORDER requires more computation and communication.
171*
172* WORK - (local input/output) COMPLEX*16 array,
173* dimension (LWORK)
174*
175* LWORK - (local input) INTEGER dimension of WORK
176* LWORK >= SIZETMS as returned by PZLASIZESEP
177*
178* INFO - (global output) INTEGER
179* Error code. On exit, INFO will be set to one of the
180* following values:
181* 0 => normal return
182* -1 => M negative or unequal to N and SYM='S', 'H', or 'P'
183* -2 => N negative
184* -3 => DIST illegal string
185* -5 => SYM illegal string
186* -7 => MODE not in range -6 to 6
187* -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
188* -10 => KL negative
189* -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL
190* -16 => DESCA is inconsistent
191* -17 => ORDER not in the range 0 to N inclusive
192* 1 => Error return from DLATM1
193* 2 => Cannot scale to DMAX (max. sing. value is 0)
194* 3 => Error return from PZLAGHE
195*
196*-----------------------------------------------------------------------
197*
198*
199* .. Parameters ..
200 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
201 $ MB_, NB_, RSRC_, CSRC_, LLD_
202 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
203 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
204 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
205 DOUBLE PRECISION ZERO, ONE
206 parameter( zero = 0.0d+0, one = 1.0d+0 )
207 COMPLEX*16 ZZERO
208 parameter( zzero = ( 0.0d+0, 0.0d+0 ) )
209* ..
210* .. Local Scalars ..
211 INTEGER I, IDIST, IINFO, IPACK, IRSIGN, ISYM, LLB,
212 $ MNMIN, MYCOL, MYROW, NP, NPCOL, NPROW, NQ
213 DOUBLE PRECISION ALPHA, TEMP
214* ..
215* .. Local Arrays ..
216 INTEGER IDUM1( 1 ), IDUM2( 1 )
217* ..
218* .. External Functions ..
219 LOGICAL LSAME
220 INTEGER NUMROC
221 EXTERNAL lsame, numroc
222* ..
223* .. External Subroutines ..
224 EXTERNAL blacs_gridinfo, chk1mat, dlatm1, dscal,
225 $ pchk1mat, pxerbla, pzlaghe, zlaset
226* ..
227* .. Intrinsic Functions ..
228 INTRINSIC abs, max, min, mod
229* ..
230* .. Executable Statements ..
231* This is just to keep ftnchek happy
232 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
233 $ rsrc_.LT.0 )RETURN
234*
235* 1) Decode and Test the input parameters.
236* Initialize flags & seed.
237*
238*
239 info = 0
240*
241 CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
242 IF( ( myrow.GE.nprow .OR. myrow.LT.0 ) .OR.
243 $ ( mycol.GE.npcol .OR. mycol.LT.0 ) )RETURN
244*
245 np = numroc( n, desca( mb_ ), myrow, 0, nprow )
246 nq = numroc( n, desca( nb_ ), mycol, 0, npcol )
247*
248* Quick return if possible
249*
250 IF( m.EQ.0 .OR. n.EQ.0 )
251 $ RETURN
252*
253* Decode DIST
254*
255 IF( lsame( dist, 'U' ) ) THEN
256 idist = 1
257 ELSE IF( lsame( dist, 's' ) ) THEN
258 IDIST = 2
259 ELSE IF( LSAME( DIST, 'n' ) ) THEN
260 IDIST = 3
261 ELSE
262 IDIST = -1
263 END IF
264*
265* Decode SYM
266*
267 IF( LSAME( SYM, 'n' ) ) THEN
268 ISYM = 1
269 IRSIGN = 0
270 ELSE IF( LSAME( SYM, 'p' ) ) THEN
271 ISYM = 2
272 IRSIGN = 0
273 ELSE IF( LSAME( SYM, 's' ) ) THEN
274 ISYM = 2
275 IRSIGN = 1
276 ELSE IF( LSAME( SYM, 'h' ) ) THEN
277 ISYM = 2
278 IRSIGN = 1
279 ELSE
280 ISYM = -1
281 END IF
282*
283* Decode PACK
284*
285 IF( LSAME( PACK, 'n' ) ) THEN
286 IPACK = 0
287 ELSE
288 IPACK = 1
289 END IF
290*
291* Set certain internal parameters
292*
293 MNMIN = MIN( M, N )
294 LLB = MIN( KL, M-1 )
295*
296.EQ. IF( ORDER0 )
297 $ ORDER = N
298*
299* Set INFO if an error
300*
301.EQ. IF( NPROW-1 ) THEN
302 INFO = -( 1600+CTXT_ )
303 ELSE
304 CALL CHK1MAT( M, 1, N, 2, IA, JA, DESCA, 16, INFO )
305.EQ. IF( INFO0 ) THEN
306.NE..AND..NE. IF( MN ISYM1 ) THEN
307 INFO = -2
308.EQ. ELSE IF( IDIST-1 ) THEN
309 INFO = -3
310.EQ. ELSE IF( ISYM-1 ) THEN
311 INFO = -5
312.GT. ELSE IF( ABS( MODE )6 ) THEN
313 INFO = -7
314.NE..AND..NE..AND..LT. ELSE IF( ( MODE0 ABS( MODE )6 ) COND
315 $ ONE ) THEN
316 INFO = -8
317.LT. ELSE IF( KL0 ) THEN
318 INFO = -10
319.LT..OR..NE..AND..NE. ELSE IF( KU0 ( ISYM1 KLKU ) ) THEN
320 INFO = -11
321.LT..OR..GT. ELSE IF( ( ORDER0 ) ( ORDERN ) ) THEN
322 INFO = -17
323 END IF
324 END IF
325 CALL PCHK1MAT( M, 1, N, 2, IA, JA, DESCA, 16, 0, IDUM1, IDUM2,
326 $ INFO )
327 END IF
328*
329* Check for unsupported features
330*
331.NE. IF( ISYM2 ) THEN
332 INFO = -5
333.NE. ELSE IF( IPACK0 ) THEN
334 INFO = -12
335.GT..AND..LT. ELSE IF( KL0 KLM-1 ) THEN
336 INFO = -10
337.GT..AND..LT. ELSE IF( KU0 KUN-1 ) THEN
338 INFO = -11
339.NE..AND..NE. ELSE IF( LLB0 LLBM-1 ) THEN
340 INFO = -10
341 END IF
342.NE. IF( INFO0 ) THEN
343 CALL PXERBLA( DESCA( CTXT_ ), 'pzlatms', -INFO )
344 RETURN
345 END IF
346*
347* Initialize random number generator
348*
349 DO 10 I = 1, 4
350 ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
351 10 CONTINUE
352*
353.NE. IF( MOD( ISEED( 4 ), 2 )1 )
354 $ ISEED( 4 ) = ISEED( 4 ) + 1
355*
356* 2) Set up D if indicated.
357*
358* Compute D according to COND and MODE
359*
360 CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO )
361*
362.NE. IF( IINFO0 ) THEN
363 INFO = 1
364 RETURN
365 END IF
366*
367*
368.NE..AND..NE. IF( MODE0 ABS( MODE )6 ) THEN
369*
370* Scale by DMAX
371*
372 TEMP = ABS( D( 1 ) )
373 DO 20 I = 2, MNMIN
374 TEMP = MAX( TEMP, ABS( D( I ) ) )
375 20 CONTINUE
376*
377.GT. IF( TEMPZERO ) THEN
378 ALPHA = DMAX / TEMP
379 ELSE
380 INFO = 2
381 RETURN
382 END IF
383*
384 CALL DSCAL( MNMIN, ALPHA, D, 1 )
385*
386 END IF
387*
388 CALL ZLASET( 'a', NP, NQ, ZZERO, ZZERO, A, DESCA( LLD_ ) )
389*
390* Hermitian -- A = U D U'
391*
392 CALL PZLAGHE( M, LLB, D, A, IA, JA, DESCA, ISEED, ORDER, WORK,
393 $ LWORK, IINFO )
394*
395 RETURN
396*
397* End of PZLATMS
398*
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
zlaset
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition zlaset.f:106
dscal
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
dlatm1
subroutine dlatm1(mode, cond, irsign, idist, iseed, d, n, info)
DLATM1
Definition dlatm1.f:135
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
chk1mat
subroutine chk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, info)
Definition mpi.f:1577
pxerbla
subroutine pxerbla(contxt, srname, info)
Definition mpi.f:1600
blacs_gridinfo
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition mpi.f:786
pchk1mat
subroutine pchk1mat(ma, mapos0, na, napos0, ia, ja, desca, descapos0, nextra, ex, expos, info)
Definition pchkxmat.f:3
pzlaghe
subroutine pzlaghe(n, k, d, a, ia, ja, desca, iseed, order, work, lwork, info)
Definition pzlagsy.f:5
pzlatms
subroutine pzlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)
Definition pzlatms.f:6