ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pclasizeheevr.f
Go to the documentation of this file.
1  SUBROUTINE pclasizeheevr( WKNOWN, RANGE, N, DESCA, VL, VU, IL, IU,
2  $ ISEED, WIN, MAXSIZE, VECSIZE, VALSIZE )
3 *
4 * -- ScaLAPACK routine (@(MODE)version *TBA*) --
5 * University of California, Berkeley and
6 * University of Tennessee, Knoxville.
7 * October 21, 2006
8 *
9  IMPLICIT NONE
10 *
11 * .. Scalar Arguments ..
12  LOGICAL WKNOWN
13  CHARACTER RANGE
14  INTEGER IL, IU, MAXSIZE, N, VALSIZE, VECSIZE
15  REAL VL, VU
16 
17 * ..
18 * .. Array Arguments ..
19  INTEGER DESCA( * ), ISEED( 4 )
20  REAL WIN( * )
21 * ..
22 *
23 * Purpose
24 * =======
25 *
26 * PCLASIZEHEEVR computes the amount of memory needed by PCHEEVR
27 * to ensure:
28 * 1) Orthogonal Eigenvectors
29 * 2) Eigenpairs with small residual norms
30 *
31 * Arguments
32 * =========
33 *
34 * WKNOWN (global input) INTEGER
35 * .FALSE.: WIN does not contain the eigenvalues
36 * .TRUE.: WIN does contain the eigenvalues
37 *
38 * RANGE (global input) CHARACTER*1
39 * = 'A': all eigenvalues will be found.
40 * = 'V': all eigenvalues in the interval [VL,VU]
41 * will be found.
42 * = 'I': the IL-th through IU-th eigenvalues will be found.
43 *
44 * N (global input) INTEGER
45 * Size of the matrix to be tested. (global size)
46 *
47 * DESCA (global input) INTEGER array dimension ( DLEN_ )
48 *
49 * VL (global input/output ) REAL
50 * If RANGE='V', the lower bound of the interval to be searched
51 * for eigenvalues. Not referenced if RANGE = 'A' or 'I'.
52 * If VL > VU, RANGE='V' and WKNOWN = .TRUE., VL is set
53 * to a random value near an entry in WIN
54 *
55 * VU (global input/output ) REAL
56 * If RANGE='V', the upper bound of the interval to be searched
57 * for eigenvalues. Not referenced if RANGE = 'A' or 'I'.
58 * If VL > VU, RANGE='V' and WKNOWN = .TRUE., VU is set
59 * to a random value near an entry in WIN
60 *
61 * IL (global input/output ) INTEGER
62 * If RANGE='I', the index (from smallest to largest) of the
63 * smallest eigenvalue to be returned. IL >= 1.
64 * Not referenced if RANGE = 'A' or 'V'.
65 * If IL < 0, RANGE='I' and WKNOWN = .TRUE., IL is set
66 * to a random value from 1 to N
67 *
68 * IU (global input/output ) INTEGER
69 * If RANGE='I', the index (from smallest to largest) of the
70 * largest eigenvalue to be returned. min(IL,N) <= IU <= N.
71 * Not referenced if RANGE = 'A' or 'V'.
72 * If IU < 0, RANGE='I' and WKNOWN = .TRUE., IU is set
73 * to a random value from IL to N
74 *
75 * ISEED (global input/output) INTEGER array, dimension (4)
76 * On entry, the seed of the random number generator; the array
77 * elements must be between 0 and 4095, and ISEED(4) must be
78 * odd.
79 * On exit, the seed is updated.
80 * ISEED is not touched unless IL, IU, VL or VU are modified.
81 *
82 * WIN (global input) REAL array, dimension (N)
83 * If WKNOWN=1, WIN contains the eigenvalues of the matrix.
84 *
85 * MAXSIZE (global output) INTEGER
86 * Workspace required to guarantee that PCHEEVR will return
87 * orthogonal eigenvectors. IF WKNOWN=0, MAXSIZE is set to a
88 * a value which guarantees orthogonality no matter what the
89 * spectrum is. If WKNOWN=1, MAXSIZE is set to a value which
90 * guarantees orthogonality on a matrix with eigenvalues given
91 * by WIN.
92 *
93 * VECSIZE (global output) INTEGER
94 * Workspace required to guarantee that PCHEEVR
95 * will compute eigenvectors.
96 *
97 * VALSIZE (global output) INTEGER
98 * Workspace required to guarantee that PCHEEVR
99 * will compute eigenvalues.
100 *
101 *
102 * .. Parameters ..
103  INTEGER CTXT_, MB_
104  parameter( ctxt_ = 2, mb_ = 5 )
105  REAL TWENTY
106  parameter( twenty = 20.0e0 )
107 * ..
108 * .. Local Scalars ..
109 *
110  INTEGER ILMIN, IUMAX,
111  $ mq0, mycol, myil, myiu, myrow, nb, neig, nn,
112  $ np0, npcol, nprow
113  REAL ANORM, EPS, SAFMIN
114 * ..
115 * .. External Functions ..
116  LOGICAL LSAME
117  INTEGER ICEIL, NUMROC
118  REAL SLARAN, PSLAMCH
119  EXTERNAL lsame, iceil, numroc, slaran, pslamch
120 * ..
121 * .. External Subroutines ..
122  EXTERNAL blacs_gridinfo
123 * ..
124 * .. Intrinsic Functions ..
125  INTRINSIC abs, real, int, max
126 
127 * ..
128 * .. Executable Statements ..
129 *
130  CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
131  eps = pslamch( desca( ctxt_ ), 'Precision' )
132  safmin = pslamch( desca( ctxt_ ), 'Safe Minimum' )
133  nb = desca( mb_ )
134  nn = max( n, nb, 2 )
135  np0 = numroc( nn, nb, 0, 0, nprow )
136 
137  valsize = 3 + 5*n + max( 12*nn, nb*( np0+1 ) )
138 
139  IF( wknown ) THEN
140  anorm = safmin / eps
141  IF( n.GE.1 )
142  $ anorm = max( abs( win( 1 ) ), abs( win( n ) ), anorm )
143  IF( lsame( range, 'I' ) ) THEN
144  IF( il.LT.0 )
145  $ il = int( slaran( iseed )*real( n ) ) + 1
146  IF( iu.LT.0 )
147  $ iu = int( slaran( iseed )*real( n-il ) ) + il
148  IF( n.EQ.0 )
149  $ iu = 0
150  ELSE IF( lsame( range, 'V' ) ) THEN
151  IF( vl.GT.vu ) THEN
152  myil = int( slaran( iseed )*real( n ) ) + 1
153  myiu = int( slaran( iseed )*real( n-myil ) ) + myil
154  vl = win( myil ) - twenty*eps*abs( win( myil ) )
155  vu = win( myiu ) + twenty*eps*abs( win( myiu ) )
156  vu = max( vu, vl+eps*twenty*abs( vl )+safmin )
157  END IF
158  END IF
159 *
160  END IF
161  IF( lsame( range, 'V' ) ) THEN
162 * We do not know how many eigenvalues will be computed
163  ilmin = 1
164  iumax = n
165  ELSE IF( lsame( range, 'I' ) ) THEN
166  ilmin = il
167  iumax = iu
168  ELSE IF( lsame( range, 'A' ) ) THEN
169  ilmin = 1
170  iumax = n
171  END IF
172 *
173  neig = iumax - ilmin + 1
174 *
175  mq0 = numroc( max( neig, nb, 2 ), nb, 0, 0, npcol )
176 *
177  vecsize = 3 + 5*n + max( 18*nn, np0*mq0+2*nb*nb ) +
178  $ (2 + iceil( neig, nprow*npcol ))*nn
179 
180  valsize = max(3, valsize)
181  vecsize = max(3, vecsize)
182  maxsize = vecsize
183 *
184  RETURN
185 *
186 * End of PCLASIZEHEEVR
187 *
188  END
max
#define max(A, B)
Definition: pcgemr.c:180
pclasizeheevr
subroutine pclasizeheevr(WKNOWN, RANGE, N, DESCA, VL, VU, IL, IU, ISEED, WIN, MAXSIZE, VECSIZE, VALSIZE)
Definition: pclasizeheevr.f:3