3 SUBROUTINE pcsepreq( NIN, MEM, MEMSIZE, NOUT, ISEED, NTESTS,
4 $ NSKIPPED, NNOCHECK, NPASSED, INFO )
12 INTEGER INFO, MEMSIZE, NIN, NNOCHECK, NOUT, NPASSED,
17 COMPLEX MEM( MEMSIZE )
75 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
76 $ mb_, nb_, rsrc_, csrc_, lld_
77 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
78 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
79 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
80 INTEGER CPLXSZ, INTGSZ
81 parameter( cplxsz = 8, intgsz = 4 )
83 parameter( realsz = 4 )
85 parameter( maxsetsize = 50 )
89 INTEGER CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
90 $ iprepad, isizeheevx, isizesubtst, isizetst,
91 $ lda, llrwork, matsize, mattype, mycol, myrow,
92 $ n, nb, nmatsizes, nmattypes, nnodes, np, npcol,
93 $ npconfigs, nprow, nq, nuplos, order, pconfig,
94 $ ptra, ptrcopya, ptrgap, ptriclus, ptrifail,
95 $ ptriwrk, ptrrwork, ptrw, ptrw2, ptrwork, ptrz,
96 $ res, rsizechk, rsizeheevx, rsizeqtq,
97 $ rsizesubtst, rsizetst, sizeheevx, sizemqrleft,
98 $ sizemqrright, sizeqrf, sizesubtst, sizetms,
99 $ sizetst, uplo,sizeheevd, rsizeheevd, isizeheevd
104 INTEGER DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
105 $ mattypes( maxsetsize ), nbs( maxsetsize ),
106 $ npcols( maxsetsize ), nprows( maxsetsize )
109 INTEGER ICEIL, NUMROC
110 EXTERNAL iceil, numroc
113 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
114 $ blacs_gridinfo, blacs_gridinit, blacs_pinfo,
122 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
125 CALL blacs_pinfo( iam, nnodes )
126 CALL blacs_get( -1, 0, initcon )
127 CALL blacs_gridinit( initcon,
'R', 1, nnodes )
129 CALL pssepinfo( initcon, iam, nin, nout, maxsetsize, nmatsizes,
130 $ matsizes, nuplos, uplos, npconfigs, nprows,
131 $ npcols, nbs, nmattypes, mattypes, 22, subtests,
132 $ thresh, order, abstol, info )
134 CALL blacs_gridexit( initcon )
139 DO 40 matsize = 1, nmatsizes
141 DO 30 pconfig = 1, npconfigs
143 DO 20 mattype = 1, nmattypes
145 DO 10 uplo = 1, nuplos
147 n = matsizes( matsize )
150 nprow = nprows( pconfig )
151 npcol = npcols( pconfig )
154 np = numroc( n, nb, 0, 0, nprow )
155 nq = numroc( n, nb, 0, 0, npcol )
156 iprepad =
max( nb, np )
158 ipostpad =
max( nb, nq )
160 lda =
max( np, 1 ) + imidpad
162 CALL blacs_get( -1, 0, context )
163 CALL blacs_gridinit( context,
'R', nprow, npcol )
164 CALL blacs_gridinfo( context, nprow, npcol, myrow,
166 IF( myrow.GE.0 )
THEN
167 CALL descinit( desca, n, n, nb, nb, 0, 0,
168 $ context, lda, info )
170 $ sizemqrleft, sizemqrright,
171 $ sizeqrf, sizetms, rsizeqtq,
172 $ rsizechk, sizeheevx,
173 $ rsizeheevx, isizeheevx,
174 $ sizeheevd, rsizeheevd, isizeheevd,
175 $ sizesubtst, rsizesubtst,
176 $ isizesubtst, sizetst,
177 $ rsizetst, isizetst )
180 ptrz = ptra + lda*nq + iprepad + ipostpad
181 ptrcopya = ptrz + lda*nq + iprepad + ipostpad
182 ptrw = ptrcopya + lda*nq + iprepad + ipostpad
183 ptrw2 = ptrw + iceil(
max( n, 1 )+iprepad+
184 $ ipostpad, cplxsz / realsz )
185 ptrwork = ptrw2 + iceil(
max( n, 1 )+iprepad+
186 $ ipostpad, cplxsz / realsz )
187 ptrgap = ptrwork + sizetst + iprepad + ipostpad
188 ptrifail = ptrgap + iceil( nprow*npcol+iprepad+
189 $ ipostpad, cplxsz / realsz )
190 ptriclus = ptrifail + iceil( n+iprepad+ipostpad,
192 ptriwrk = ptriclus + iceil( 2*nprow*npcol+
193 $ iprepad+ipostpad, cplxsz / intgsz )
194 ptrrwork = ptriwrk + iceil( isizetst+iprepad+
195 $ ipostpad, cplxsz / intgsz )
196 llrwork = ( memsize-ptrrwork+1 )*cplxsz / realsz
200 IF( llrwork.LT.rsizetst )
THEN
201 nskipped = nskipped + 1
203 CALL pcseptst( desca, uplos( uplo ), n,
204 $ mattypes( mattype ), subtests,
205 $ thresh, n, abstol, iseed,
206 $ mem( ptra ), mem( ptrcopya ),
207 $ mem( ptrz ), lda, mem( ptrw ),
208 $ mem( ptrw2 ), mem( ptrifail ),
210 $ mem( ptrgap ), iprepad,
211 $ ipostpad, mem( ptrwork ),
212 $ sizetst, mem( ptrrwork ),
213 $ llrwork, mem( ptriwrk ),
214 $ isizetst, nout, res )
217 npassed = npassed + 1
218 ELSE IF( res.EQ.2 )
THEN
219 nnocheck = nnocheck + 1
220 ELSE IF( res.EQ.3 )
THEN
221 nskipped = nskipped + 1
222 WRITE( nout, fmt=*)
'pCSEPREQ failed'
223 CALL blacs_abort( context, -1 )
226 CALL blacs_gridexit( context )