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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ pslatms()

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

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