ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pslasizesqp.f
Go to the documentation of this file.
1  SUBROUTINE pslasizesqp( DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT,
2  $ SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ,
3  $ SIZECHK, SIZESYEVX, ISIZESYEVX,
4  $ SIZESYEV, SIZESYEVD, ISIZESYEVD,
5  $ SIZESUBTST, ISIZESUBTST,
6  $ SIZETST, ISIZETST )
7 *
8 * -- ScaLAPACK routine (version 1.7) --
9 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
10 * and University of California, Berkeley.
11 * February 23, 2000
12 *
13 * .. Scalar Arguments ..
14  INTEGER IPOSTPAD, IPREPAD, ISIZESUBTST, ISIZESYEVX,
15  $ ISIZETST, SIZECHK, SIZEMQRLEFT, SIZEMQRRIGHT,
16  $ SIZEQRF, SIZEQTQ, SIZESUBTST, SIZESYEV,
17  $ SIZESYEVX, SIZETMS, SIZETST,
18  $ SIZESYEVD, ISIZESYEVD
19 * ..
20 * .. Array Arguments ..
21  INTEGER DESCA( * )
22 * ..
23 *
24 * Purpose
25 * =======
26 *
27 * PSLASIZESQP computes the amount of memory needed by
28 * various SEP test routines, as well as PSYEVX and PSSYEV
29 *
30 * Arguments
31 * =========
32 *
33 * DESCA (global input) INTEGER array dimension ( DLEN_ )
34 * Array descriptor as passed to PSSYEVX or PSSYEV
35 *
36 * SIZEMQRLEFT LWORK for the 1st PSORMQR call in PSLAGSY
37 *
38 * SIZEMQRRIGHT LWORK for the 2nd PSORMQR call in PSLAGSY
39 *
40 * SIZEQRF LWORK for PSGEQRF in PSLAGSY
41 *
42 * SIZETMS LWORK for PSLATMS
43 *
44 * SIZEQTQ LWORK for PSSEPQTQ (nexer complex)
45 *
46 * SIZECHK LWORK for PSSEPCHK
47 *
48 * SIZESYEVX LWORK for PSSYEVX
49 *
50 * ISIZESYEVX LIWORK for PSSYEVX
51 *
52 * SIZESYEV LWORK for PSSYEV
53 *
54 * SIZESYEVD LWORK for PSSYEVD
55 *
56 * ISIZESYEVD LIWORK for PSSYEVD
57 *
58 * SIZESUBTST LWORK for PSSUBTST
59 *
60 * ISIZESUBTST LIWORK for PSSUBTST
61 *
62 * SIZETST LWORK for PSTST
63 *
64 * ISIZETST LIWORK for PSTST
65 *
66 * .. Parameters ..
67  INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
68  $ MB_, NB_, RSRC_, CSRC_, LLD_
69  PARAMETER ( BLOCK_CYCLIC_2D = 1, dlen_ = 9, dtype_ = 1,
70  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
71  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER CONTEXTC, CSRC_A, IACOL, IAROW, ICOFFA, IROFFA,
75  $ LCM, LCMQ, LDA, LDC, MQ0, MYCOL, MYPCOLC,
76  $ MYPROWC, MYROW, N, NB, NEIG, NN, NNP, NP,
77  $ NPCOLC, NPROWC, NP0, NPCOL, NPROW, NQ, RSRC_A
78 * ..
79 * .. External Functions ..
80  INTEGER ICEIL, ILCM, INDXG2P, NUMROC, SL_GRIDRESHAPE
81  EXTERNAL ICEIL, ILCM, INDXG2P, NUMROC, SL_GRIDRESHAPE
82 * ..
83 * .. Executable Statements ..
84 *
85 * .. External Subroutines ..
86  EXTERNAL blacs_gridinfo, blacs_gridexit
87 * ..
88 * .. Intrinsic Functions ..
89  INTRINSIC max
90 * ..
91 * .. Executable Statements ..
92  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
93  $ rsrc_.LT.0 )RETURN
94 *
95  n = desca( m_ )
96  nb = desca( mb_ )
97  rsrc_a = desca( rsrc_ )
98  csrc_a = desca( csrc_ )
99 *
100  lda = desca( lld_ )
101  CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
102 *
103  lcm = ilcm( nprow, npcol )
104  lcmq = lcm / npcol
105  iroffa = 0
106  icoffa = 0
107  iarow = indxg2p( 1, nb, myrow, rsrc_a, nprow )
108  iacol = indxg2p( 1, nb, mycol, csrc_a, npcol )
109  np = numroc( n+iroffa, nb, myrow, iarow, nprow )
110  nq = numroc( n+icoffa, nb, mycol, iacol, npcol )
111  sizemqrleft = max( ( nb*( nb-1 ) ) / 2, ( np+nq )*nb ) + nb*nb
112  sizemqrright = max( ( nb*( nb-1 ) ) / 2,
113  $ ( nq+max( np+numroc( numroc( n+icoffa, nb, 0, 0,
114  $ npcol ), nb, 0, 0, lcmq ), np ) )*nb ) + nb*nb
115  sizeqrf = nb*np + nb*nq + nb*nb
116  sizetms = ( lda+1 )*max( 1, nq ) +
117  $ max( sizemqrleft, sizemqrright, sizeqrf )
118 *
119  np0 = numroc( n, desca( mb_ ), 0, 0, nprow )
120  mq0 = numroc( n, desca( nb_ ), 0, 0, npcol )
121  sizeqtq = 2 + max( desca( mb_ ), 2 )*( 2*np0+mq0 )
122  sizechk = numroc( n, desca( nb_ ), mycol, 0, npcol )
123 *
124  neig = n
125  nn = max( n, nb, 2 )
126  np0 = numroc( nn, nb, 0, 0, nprow )
127  mq0 = numroc( max( neig, nb, 2 ), nb, 0, 0, npcol )
128  sizesyevx = 5*n + max( 5*nn, np0*mq0+2*nb*nb ) +
129  $ iceil( neig, nprow*npcol )*nn
130  nnp = max( n, nprow*npcol+1, 4 )
131  isizesyevx = 6*nnp
132 *
133 * Allow room for the new context created in PSSYEV
134 *
135  contextc = sl_gridreshape( desca( ctxt_ ), 0, 1, 1,
136  $ nprow*npcol, 1 )
137  CALL blacs_gridinfo( contextc, nprowc, npcolc, myprowc,
138  $ mypcolc )
139  ldc = max( 1, numroc( n, nb, myprowc, 0, nprow*npcol ) )
140  sizesyev = 5*n + max( 2*np0 + mq0 + nb*nn , 2*nn-2 ) + n*ldc
141  CALL blacs_gridexit( contextc )
142 *
143  np = numroc( n, nb, myrow, iarow, nprow )
144  nq = numroc( n, nb, mycol, iacol, npcol )
145  nn = max( n, nb, 2 )
146  nnp = 3*n + max( nb*( np+1 ), 3*nb )
147  sizesyevd = max( nnp, 1+6*n+2*np*nq ) + 2*n
148  isizesyevd = 2+7*n+8*npcol
149 *
150  sizesubtst = max( sizetms, sizeqtq, sizechk, sizesyevx,
151  $ sizemqrleft, sizemqrright, sizesyev ) +
152  $ iprepad + ipostpad
153  isizesubtst = isizesyevx + iprepad + ipostpad
154 *
155 *
156 * Allow room for A, COPYA and Z and DIAG, WIN, WNEW, GAP, WORK
157 *
158  sizetst = 3*( lda*np+iprepad+ipostpad ) +
159  $ 4*( n+iprepad+ipostpad ) + sizesubtst
160 *
161 * Allow room for IFAIL, ICLUSTR, and IWORK (all in PSSYEVX)
162 *
163  isizetst = n + 2*nprow*npcol + 2*( iprepad+ipostpad ) +
164  $ isizesubtst
165 *
166  RETURN
167  END
max
#define max(A, B)
Definition: pcgemr.c:180
pslasizesqp
subroutine pslasizesqp(DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF, SIZETMS, SIZEQTQ, SIZECHK, SIZESYEVX, ISIZESYEVX, SIZESYEV, SIZESYEVD, ISIZESYEVD, SIZESUBTST, ISIZESUBTST, SIZETST, ISIZETST)
Definition: pslasizesqp.f:7