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