ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pclasizesepr.f
Go to the documentation of this file.
1  SUBROUTINE pclasizesepr( DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT,
2  $ SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ,
3  $ SIZECHK, SIZEHEEVR, RSIZEHEEVR,
4  $ ISIZEHEEVR, SIZESUBTST, RSIZESUBTST,
5  $ ISIZESUBTST, SIZETST, RSIZETST,
6  $ ISIZETST )
7 *
8 * -- ScaLAPACK routine (@(MODE)version *TBA*) --
9 * University of California, Berkeley and
10 * University of Tennessee, Knoxville.
11 * October 21, 2006
12 *
13  IMPLICIT NONE
14 *
15 * .. Scalar Arguments ..
16  INTEGER IPOSTPAD, IPREPAD, ISIZEHEEVR, ISIZESUBTST,
17  $ ISIZETST, RSIZEHEEVR, RSIZESUBTST, RSIZETST,
18  $ sizechk, sizeheevr, sizemqrleft, sizemqrright,
19  $ sizeqrf, sizeqtq, sizesubtst, sizetms, sizetst
20 * ..
21 * .. Array Arguments ..
22  INTEGER DESCA( * )
23 *
24 * Purpose
25 * =======
26 *
27 * PCLASIZESEPR computes the amount of memory needed by
28 * various SEPR test routines, as well as PCHEEVR itself.
29 *
30 * Arguments
31 * =========
32 *
33 * DESCA (global input) INTEGER array dimension ( DLEN_ )
34 * Array descriptor for dense matrix.
35 *
36 * SIZEMQRLEFT LWORK for the 1st PCUNMQR call in PCLAGHE
37 *
38 * SIZEMQRRIGHT LWORK for the 2nd PCUNMQR call in PCLAGHE
39 *
40 * SIZEQRF LWORK for PCGEQRF in PCLAGHE
41 *
42 * SIZETMS LWORK for PCLATMS
43 *
44 * SIZEQTQ LWORK for PCSEPQTQ
45 *
46 * SIZECHK LWORK for PCSEPCHK
47 *
48 * SIZEHEEVR LWORK for PCHEEVR
49 *
50 * RSIZEHEEVR LRWORK for PCHEEVR
51 *
52 * ISIZEHEEVR LIWORK for PCHEEVR
53 *
54 * SIZESUBTST LWORK for PCSEPRSUBTST
55 *
56 * RSIZESUBTST LRWORK for PCSEPRSUBTST
57 *
58 * ISIZESUBTST LIWORK for PCSEPRSUBTST
59 *
60 * SIZETST LWORK for PCSEPRTST
61 *
62 * RSIZETST LRWORK for PCSEPRTST
63 *
64 * ISIZETST LIWORK for PCSEPRTST
65 *
66 *
67 * .. Parameters ..
68  INTEGER CTXT_, M_,
69  $ MB_, NB_, RSRC_, CSRC_, LLD_
70  PARAMETER (
71  $ CTXT_ = 2, m_ = 3, mb_ = 5, nb_ = 6,
72  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER CSRC_A, IACOL, IAROW, ICOFFA, IROFFA, LCM,
76  $ LCMQ, LDA, MQ0, MYCOL, MYROW, N, NB, NEIG, NN,
77  $ NNP, NP, NP0, NPCOL, NPROW, NQ, RSRC_A
78  INTEGER ANB, ICTXT, NHETRD_LWOPT, NPS, SQNPC
79 * ..
80 * .. External Functions ..
81  INTEGER ICEIL, ILCM, INDXG2P, NUMROC
82  EXTERNAL ICEIL, ILCM, INDXG2P, NUMROC
83  INTEGER PJLAENV
84  EXTERNAL PJLAENV
85 *
86 * .. External Subroutines ..
87  EXTERNAL blacs_gridinfo
88 * ..
89 * .. Intrinsic Functions ..
90  INTRINSIC dble, int, max, sqrt
91 * ..
92 * .. Executable Statements ..
93 *
94  n = desca( m_ )
95  nb = desca( mb_ )
96  rsrc_a = desca( rsrc_ )
97  csrc_a = desca( csrc_ )
98 *
99  lda = desca( lld_ )
100  CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
101 *
102  lcm = ilcm( nprow, npcol )
103  lcmq = lcm / npcol
104  iroffa = 0
105  icoffa = 0
106  iarow = indxg2p( 1, nb, myrow, rsrc_a, nprow )
107  iacol = indxg2p( 1, nb, mycol, csrc_a, npcol )
108  np = numroc( n+iroffa, nb, myrow, iarow, nprow )
109  nq = numroc( n+icoffa, nb, mycol, iacol, npcol )
110  sizemqrleft = max( ( nb*( nb-1 ) ) / 2, ( np+nq )*nb ) + nb*nb
111  sizemqrright = max( ( nb*( nb-1 ) ) / 2,
112  $ ( nq+max( np+numroc( numroc( n+icoffa, nb, 0, 0,
113  $ npcol ), nb, 0, 0, lcmq ), np ) )*nb ) + nb*nb
114  sizeqrf = nb*np + nb*nq + nb*nb
115  sizetms = ( lda+1 )*max( 1, nq ) +
116  $ max( sizemqrleft, sizemqrright, sizeqrf )
117 *
118  np0 = numroc( n, desca( mb_ ), 0, 0, nprow )
119  mq0 = numroc( n, desca( nb_ ), 0, 0, npcol )
120  sizeqtq = 2 + max( desca( mb_ ), 2 )*( 2*np0+mq0 )
121  sizechk = numroc( n, desca( nb_ ), mycol, 0, npcol )
122 *
123  neig = n
124  nn = max( n, nb, 2 ) + 1
125  np0 = numroc( nn, nb, 0, 0, nprow )
126  mq0 = numroc( max( neig, nb, 2 ), nb, 0, 0, npcol )
127  nnp = max( n, nprow*npcol+1, 4 )
128 *
129 *
130  sizeheevr = 1+n + ( np0+mq0+nb )*nb
131  sizeheevr = max(3, sizeheevr)
132  rsizeheevr = 1 + 5*n + max( 18*nn, np0*mq0+2*nb*nb ) +
133  $ (2 + iceil( neig, nprow*npcol ))*nn
134  rsizeheevr = max(3, rsizeheevr)
135 *
136  isizeheevr = 12*nnp + 2*n
137 *
138  ictxt = desca( ctxt_ )
139  anb = pjlaenv( ictxt, 3, 'PCHETTRD', 'L', 0, 0, 0, 0 )
140  sqnpc = int( sqrt( dble( nprow*npcol ) ) )
141  nps = max( numroc( n, 1, 0, 0, sqnpc ), 2*anb )
142  nhetrd_lwopt = 2*( anb+1 )*( 4*nps+2 ) + ( nps+2 )*nps
143  sizeheevr = max( sizeheevr, n + nhetrd_lwopt )
144 *
145  sizesubtst = max( sizetms, sizeheevr ) +
146  $ iprepad + ipostpad
147  rsizesubtst = max( sizeqtq, sizechk, rsizeheevr ) +
148  $ iprepad + ipostpad
149  isizesubtst = isizeheevr + iprepad + ipostpad
150 *
151 * Allow room for A, COPYA, Z, WORK
152 *
153  sizetst = 3*( lda*np+iprepad+ipostpad ) + sizesubtst
154 *
155 * Allow room for DIAG, WIN, WNEW, GAP, RWORK
156 *
157  rsizetst = 4*( n+iprepad+ipostpad ) + rsizesubtst
158 *
159 * Allow room for IFAIL, ICLUSTR, and IWORK
160 * (only needed for PCHEEVX)
161 *
162  isizetst = n + 2*nprow*npcol + 2*( iprepad+ipostpad ) +
163  $ isizesubtst
164 *
165 *
166  RETURN
167  END
max
#define max(A, B)
Definition: pcgemr.c:180
pclasizesepr
subroutine pclasizesepr(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZEHEEVR, RSIZEHEEVR, ISIZEHEEVR, SIZESUBTST, RSIZESUBTST, ISIZESUBTST, SIZETST, RSIZETST, ISIZETST)
Definition: pclasizesepr.f:7