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