5
6
7
8
9
10
11
12
13 LOGICAL WKNOWN
14 CHARACTER RANGE
15 INTEGER IL, IU, MAXSIZE, N, VALSIZE, VECSIZE
16 DOUBLE PRECISION VL, VU
17
18
19 INTEGER DESCA( * ), ISEED( 4 )
20 DOUBLE PRECISION WIN( * )
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
105 $ MB_, NB_, RSRC_, CSRC_, LLD_
106 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
107 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
108 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
109 DOUBLE PRECISION TWENTY
110 parameter( twenty = 20.0d0 )
111
112
113
114 INTEGER CLUSTERSIZE, I, ILMIN, IUMAX, MAXCLUSTERSIZE,
115 $ MQ0, MYCOL, MYIL, MYIU, MYROW, NB, NEIG, NN,
116 $ NP0, NPCOL, NPROW
117 DOUBLE PRECISION ANORM, EPS, ORFAC, SAFMIN, VLMIN, VUMAX
118
119
120
121
122 LOGICAL LSAME
123 INTEGER ICEIL, NUMROC
124 DOUBLE PRECISION DLARAN, PDLAMCH
126
127
128 EXTERNAL blacs_gridinfo
129
130
131 INTRINSIC abs, dble, int,
max
132
133
134
135 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
136 $ rsrc_.LT.0 )RETURN
137
138 orfac = 1.0d-3
139
140
141 CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
142 eps =
pdlamch( desca( ctxt_ ),
'Precision' )
143 safmin =
pdlamch( desca( ctxt_ ),
'Safe Minimum' )
144 nb = desca( mb_ )
146 np0 =
numroc( nn, nb, 0, 0, nprow )
147
148 valsize = 5*n +
max( 5*nn, nb*( np0+1 ) )
149
150 IF( wknown ) THEN
151 anorm = safmin / eps
152 IF( n.GE.1 )
153 $ anorm =
max( abs( win( 1 ) ), abs( win( n ) ), anorm )
154
155 IF(
lsame( range,
'I' ) )
THEN
156 IF( il.LT.0 )
157 $ il = int(
dlaran( iseed )*dble( n ) ) + 1
158 IF( iu.LT.0 )
159 $ iu = int(
dlaran( iseed )*dble( n-il ) ) + il
160 IF( n.EQ.0 )
161 $ iu = 0
162 ELSE IF(
lsame( range,
'V' ) )
THEN
163 IF( vl.GT.vu ) THEN
164 myil = int(
dlaran( iseed )*dble( n ) ) + 1
165 myiu = int(
dlaran( iseed )*dble( n-myil ) ) + myil
166 vl = win( myil ) + twenty*eps*abs( win( myil ) )
167 vu = win( myiu ) + twenty*eps*abs( win( myiu ) )
168 vu =
max( vu, vl+eps*twenty*abs( vl )+safmin )
169 END IF
170 END IF
171
172 END IF
173 IF(
lsame( range,
'V' ) )
THEN
174
175
176
177 IF( wknown ) THEN
178 vlmin = vl - twenty*eps*anorm
179 vumax = vu + twenty*eps*anorm
180 ilmin = 1
181 iumax = 0
182 DO 10 i = 1, n
183 IF( win( i ).LT.vlmin )
184 $ ilmin = ilmin + 1
185 IF( win( i ).LT.vumax )
186 $ iumax = iumax + 1
187 10 CONTINUE
188 ELSE
189 ilmin = 1
190 iumax = n
191 END IF
192 ELSE IF(
lsame( range,
'I' ) )
THEN
193 ilmin = il
194 iumax = iu
195 ELSE IF(
lsame( range,
'A' ) )
THEN
196 ilmin = 1
197 iumax = n
198 END IF
199
200 neig = iumax - ilmin + 1
201
202 mq0 =
numroc(
max( neig, nb, 2 ), nb, 0, 0, npcol )
203 vecsize = 5*n +
max( 5*nn, np0*mq0+2*nb*nb ) +
204 $
iceil( neig, nprow*npcol )*nn
205
206 IF( wknown ) THEN
207 clustersize = 1
208 maxclustersize = 1
209 DO 20 i = ilmin + 1, iumax
210 IF( ( win( i )-win( i-1 ) ).LT.orfac*2*anorm ) THEN
211 clustersize = clustersize + 1
212 IF( clustersize.GT.maxclustersize )
213 $ maxclustersize = clustersize
214 ELSE
215 clustersize = 1
216 END IF
217 20 CONTINUE
218 IF( clustersize.GT.maxclustersize )
219 $ maxclustersize = clustersize
220 ELSE
221 maxclustersize = n
222 END IF
223
224 maxsize = vecsize +
max( ( maxclustersize-1 ), 0 )*n
225
226
227 RETURN
228
229
230
integer function iceil(inum, idenom)
integer function numroc(n, nb, iproc, isrcproc, nprocs)
double precision function pdlamch(ictxt, cmach)