OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pzqrdriver.f
Go to the documentation of this file.
1 PROGRAM pzqrdriver
2*
3* -- ScaLAPACK testing driver (version 1.7) --
4* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5* and University of California, Berkeley.
6* May 28, 2001
7*
8* Purpose
9* =======
10*
11* PZQRDRIVER is the main test program for the COMPLEX*16
12* SCALAPACK QR factorization routines. This test driver performs a QR
13* QL, LQ, RQ, QP (QR factorization with column pivoting) or TZ
14* (complete unitary factorization) factorization and checks the
15* results.
16*
17* The program must be driven by a short data file. An annotated
18* example of a data file can be obtained by deleting the first 3
19* characters from the following 16 lines:
20* 'ScaLAPACK QR factorizations input file'
21* 'PVM machine'
22* 'QR.out' output file name (if any)
23* 6 device out
24* 6 number of factorizations
25* 'QR' 'QL' 'LQ' 'RQ' 'QP' 'TZ' factorization: QR, QL, LQ, RQ, QP, TZ
26* 4 number of problems sizes
27* 55 17 31 201 values of M
28* 5 71 31 201 values of N
29* 3 number of MB's and NB's
30* 4 3 5 values of MB
31* 4 7 3 values of NB
32* 7 number of process grids (ordered P & Q)
33* 1 2 1 4 2 3 8 values of P
34* 7 2 4 1 3 2 1 values of Q
35* 1.0 threshold
36*
37* Internal Parameters
38* ===================
39*
40* TOTMEM INTEGER, default = 2000000
41* TOTMEM is a machine-specific parameter indicating the
42* maximum amount of available memory in bytes.
43* The user should customize TOTMEM to his platform. Remember
44* to leave room in memory for the operating system, the BLACS
45* buffer, etc. For example, on a system with 8 MB of memory
46* per process (e.g., one processor on an Intel iPSC/860), the
47* parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
48* code, BLACS buffer, etc). However, for PVM, we usually set
49* TOTMEM = 2000000. Some experimenting with the maximum value
50* of TOTMEM may be required.
51*
52* INTGSZ INTEGER, default = 4 bytes.
53* DBLESZ INTEGER, default = 8 bytes.
54* ZPLXSZ INTEGER, default = 16 bytes.
55* INTGSZ, DBLESZ and ZPLXSZ indicate the length in bytes on
56* the given platform for an integer, a double precision real
57* and a double precision complex.
58* MEM COMPLEX*16 array, dimension ( TOTMEM / ZPLXSZ )
59*
60* All arrays used by SCALAPACK routines are allocated from
61* this array and referenced by pointers. The integer IPA,
62* for example, is a pointer to the starting element of MEM for
63* the matrix A.
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER block_cyclic_2d, csrc_, ctxt_, dlen_, dtype_,
69 $ lld_, mb_, m_, nb_, n_, rsrc_
70 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
71 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
72 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
73 INTEGER DBLESZ, intgsz, memsiz, ntests, totmem, zplxsz
74 COMPLEX*16 padval
75 parameter( dblesz = 8, intgsz = 4, totmem = 2000000,
76 $ zplxsz = 16, memsiz = totmem / zplxsz,
77 $ ntests = 20,
78 $ padval = ( -9923.0d+0, -9923.0d+0 ) )
79* ..
80* .. Local Scalars ..
81 CHARACTER*2 fact
82 CHARACTER*6 passed
83 CHARACTER*7 rout
84 CHARACTER*8 routchk
85 CHARACTER*80 outfile
86 LOGICAL check
87 INTEGER i, iam, iaseed, ictxt, imidpad, info, ipa,
88 $ ipostpad, ippiv, iprepad, iptau, iprw, ipw, j,
89 $ k, kfail, kpass, kskip, ktests, l, lipiv,
90 $ lrwork, ltau, lwork, m, maxmn, mb, minmn, mnp,
91 $ mnq, mp, mycol, myrow, n, nb, nfact, ngrids,
92 $ nmat, nnb, nout, npcol, nprocs, nprow, nq,
93 $ workfct, workrfct, worksiz
94 REAL thresh
95 DOUBLE PRECISION anorm, fresid, nops, tmflops
96* ..
97* .. Arrays ..
98 CHARACTER*2 factor( ntests )
99 INTEGER desca( dlen_ ), ierr( 1 ), mbval( ntests ),
100 $ mval( ntests ), nbval( ntests ),
101 $ nval( ntests ), pval( ntests ), qval( ntests )
102 DOUBLE PRECISION ctime( 1 ), wtime( 1 )
103 COMPLEX*16 mem( memsiz )
104* ..
105* .. External Subroutines ..
106 EXTERNAL blacs_barrier, blacs_exit, blacs_get,
107 $ blacs_gridexit, blacs_gridinfo, blacs_gridinit,
108 $ blacs_pinfo, descinit, igsum2d, pzchekpad,
109 $ pzfillpad, pzgelqf, pzgelqrv,
110 $ pzgeqlf, pzgeqlrv, pzgeqpf,
111 $ pzqppiv, pzgeqrf, pzgeqrrv,
112 $ pzgerqf, pzgerqrv, pztzrzrv,
113 $ pzmatgen, pzlafchk, pzqrinfo,
114 $ pztzrzf, slboot, slcombine, sltimer
115* ..
116* .. External Functions ..
117 LOGICAL lsamen
118 INTEGER iceil, numroc
119 DOUBLE PRECISION pzlange
120 EXTERNAL iceil, lsamen, numroc, pzlange
121* ..
122* .. Intrinsic Functions ..
123 INTRINSIC dble, max, min
124* ..
125* .. Data Statements ..
126 DATA ktests, kpass, kfail, kskip /4*0/
127* ..
128* .. Executable Statements ..
129*
130* Get starting information
131*
132 CALL blacs_pinfo( iam, nprocs )
133 iaseed = 100
134 CALL pzqrinfo( outfile, nout, nfact, factor, ntests, nmat, mval,
135 $ ntests, nval, ntests, nnb, mbval, ntests, nbval,
136 $ ntests, ngrids, pval, ntests, qval, ntests,
137 $ thresh, mem, iam, nprocs )
138 check = ( thresh.GE.0.0e+0 )
139*
140* Loop over the different factorization types
141*
142 DO 40 i = 1, nfact
143*
144 fact = factor( i )
145*
146* Print headings
147*
148 IF( iam.EQ.0 ) THEN
149 WRITE( nout, fmt = * )
150 IF( lsamen( 2, fact, 'QR' ) ) THEN
151 rout = 'PZGEQRF'
152 routchk = 'PZGEQRRV'
153 WRITE( nout, fmt = 9986 )
154 $ 'QR factorization tests.'
155 ELSE IF( lsamen( 2, fact, 'QL' ) ) THEN
156 rout = 'PZGEQLF'
157 routchk = 'PZGEQLRV'
158 WRITE( nout, fmt = 9986 )
159 $ 'QL factorization tests.'
160 ELSE IF( lsamen( 2, fact, 'LQ' ) ) THEN
161 rout = 'PZGELQF'
162 routchk = 'PZGELQRV'
163 WRITE( nout, fmt = 9986 )
164 $ 'LQ factorization tests.'
165 ELSE IF( lsamen( 2, fact, 'RQ' ) ) THEN
166 rout = 'PZGERQF'
167 routchk = 'PZGERQRV'
168 WRITE( nout, fmt = 9986 )
169 $ 'rq factorization tests.'
170 ELSE IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
171 ROUT = 'pzgeqpf'
172 ROUTCHK = 'pzgeqrrv'
173 WRITE( NOUT, FMT = 9986 )
174 $ 'qr factorization with column pivoting tests.'
175 ELSE IF( LSAMEN( 2, FACT, 'tz' ) ) THEN
176 ROUT = 'pztzrzf'
177 ROUTCHK = 'pztzrzrv'
178 WRITE( NOUT, FMT = 9986 )
179 $ 'complete unitary factorization tests.'
180 END IF
181 WRITE( NOUT, FMT = * )
182 WRITE( NOUT, FMT = 9995 )
183 WRITE( NOUT, FMT = 9994 )
184 WRITE( NOUT, FMT = * )
185 END IF
186*
187* Loop over different process grids
188*
189 DO 30 J = 1, NGRIDS
190*
191 NPROW = PVAL( J )
192 NPCOL = QVAL( J )
193*
194* Make sure grid information is correct
195*
196 IERR( 1 ) = 0
197.LT. IF( NPROW1 ) THEN
198.EQ. IF( IAM0 )
199 $ WRITE( NOUT, FMT = 9999 ) 'grid', 'nprow', NPROW
200 IERR( 1 ) = 1
201.LT. ELSE IF( NPCOL1 ) THEN
202.EQ. IF( IAM0 )
203 $ WRITE( NOUT, FMT = 9999 ) 'grid', 'npcol', NPCOL
204 IERR( 1 ) = 1
205.GT. ELSE IF( NPROW*NPCOLNPROCS ) THEN
206.EQ. IF( IAM0 )
207 $ WRITE( NOUT, FMT = 9998 ) NPROW*NPCOL, NPROCS
208 IERR( 1 ) = 1
209 END IF
210*
211.GT. IF( IERR( 1 )0 ) THEN
212.EQ. IF( IAM0 )
213 $ WRITE( NOUT, FMT = 9997 ) 'grid'
214 KSKIP = KSKIP + 1
215 GO TO 30
216 END IF
217*
218* Define process grid
219*
220 CALL BLACS_GET( -1, 0, ICTXT )
221 CALL BLACS_GRIDINIT( ICTXT, 'row-major', NPROW, NPCOL )
222 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
223*
224* Go to bottom of loop if this case doesn't use my process
225*
226.GE..OR..GE. IF( MYROWNPROW MYCOLNPCOL )
227 $ GO TO 30
228*
229 DO 20 K = 1, NMAT
230*
231 M = MVAL( K )
232 N = NVAL( K )
233*
234* Make sure matrix information is correct
235*
236 IERR(1) = 0
237.LT. IF( M1 ) THEN
238.EQ. IF( IAM0 )
239 $ WRITE( NOUT, FMT = 9999 ) 'matrix', 'm', M
240 IERR( 1 ) = 1
241.LT. ELSE IF( N1 ) THEN
242.EQ. IF( IAM0 )
243 $ WRITE( NOUT, FMT = 9999 ) 'matrix', 'n', N
244 IERR( 1 ) = 1
245 END IF
246*
247* Make sure no one had error
248*
249 CALL IGSUM2D( ICTXT, 'all', ' ', 1, 1, IERR, 1, -1, 0 )
250*
251.GT. IF( IERR( 1 )0 ) THEN
252.EQ. IF( IAM0 )
253 $ WRITE( NOUT, FMT = 9997 ) 'matrix'
254 KSKIP = KSKIP + 1
255 GO TO 20
256 END IF
257*
258* Loop over different blocking sizes
259*
260 DO 10 L = 1, NNB
261*
262 MB = MBVAL( L )
263 NB = NBVAL( L )
264*
265* Make sure mb is legal
266*
267 IERR( 1 ) = 0
268.LT. IF( MB1 ) THEN
269 IERR( 1 ) = 1
270.EQ. IF( IAM0 )
271 $ WRITE( NOUT, FMT = 9999 ) 'mb', 'mb', MB
272 END IF
273*
274* Check all processes for an error
275*
276 CALL IGSUM2D( ICTXT, 'all', ' ', 1, 1, IERR, 1, -1,
277 $ 0 )
278*
279.GT. IF( IERR( 1 )0 ) THEN
280.EQ. IF( IAM0 )
281 $ WRITE( NOUT, FMT = 9997 ) 'mb'
282 KSKIP = KSKIP + 1
283 GO TO 10
284 END IF
285*
286* Make sure nb is legal
287*
288 IERR( 1 ) = 0
289.LT. IF( NB1 ) THEN
290 IERR( 1 ) = 1
291.EQ. IF( IAM0 )
292 $ WRITE( NOUT, FMT = 9999 ) 'nb', 'nb', NB
293 END IF
294*
295* Check all processes for an error
296*
297 CALL IGSUM2D( ICTXT, 'all', ' ', 1, 1, IERR, 1, -1,
298 $ 0 )
299*
300.GT. IF( IERR( 1 )0 ) THEN
301.EQ. IF( IAM0 )
302 $ WRITE( NOUT, FMT = 9997 ) 'nb'
303 KSKIP = KSKIP + 1
304 GO TO 10
305 END IF
306*
307* Padding constants
308*
309 MP = NUMROC( M, MB, MYROW, 0, NPROW )
310 NQ = NUMROC( N, NB, MYCOL, 0, NPCOL )
311 MNP = NUMROC( MIN( M, N ), MB, MYROW, 0, NPROW )
312 MNQ = NUMROC( MIN( M, N ), NB, MYCOL, 0, NPCOL )
313 IF( CHECK ) THEN
314 IPREPAD = MAX( MB, MP )
315 IMIDPAD = NB
316 IPOSTPAD = MAX( NB, NQ )
317 ELSE
318 IPREPAD = 0
319 IMIDPAD = 0
320 IPOSTPAD = 0
321 END IF
322*
323* Initialize the array descriptor for the matrix A
324*
325 CALL DESCINIT( DESCA, M, N, MB, NB, 0, 0, ICTXT,
326 $ MAX( 1, MP ) + IMIDPAD, IERR( 1 ) )
327*
328* Check all processes for an error
329*
330 CALL IGSUM2D( ICTXT, 'all', ' ', 1, 1, IERR, 1, -1,
331 $ 0 )
332*
333.LT. IF( IERR( 1 )0 ) THEN
334.EQ. IF( IAM0 )
335 $ WRITE( NOUT, FMT = 9997 ) 'descriptor'
336 KSKIP = KSKIP + 1
337 GO TO 10
338 END IF
339*
340* Assign pointers into MEM for ScaLAPACK arrays, A is
341* allocated starting at position MEM( IPREPAD+1 )
342*
343 IPA = IPREPAD+1
344 IPTAU = IPA + DESCA( LLD_ ) * NQ + IPOSTPAD + IPREPAD
345*
346 IF( LSAMEN( 2, FACT, 'qr' ) ) THEN
347*
348 LTAU = MNQ
349 IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
350*
351* Figure the amount of workspace required by the QR
352* factorization
353*
354 LWORK = DESCA( NB_ ) * ( MP + NQ + DESCA( NB_ ) )
355 WORKFCT = LWORK + IPOSTPAD
356 WORKSIZ = WORKFCT
357*
358 IF( CHECK ) THEN
359*
360* Figure the amount of workspace required by the
361* checking routines PZLAFCHK, PZGEQRRV and
362* PZLANGE
363*
364 WORKSIZ = LWORK + MP*DESCA( NB_ ) + IPOSTPAD
365*
366 END IF
367*
368 ELSE IF( LSAMEN( 2, FACT, 'ql' ) ) THEN
369*
370 LTAU = NQ
371 IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
372*
373* Figure the amount of workspace required by the QL
374* factorization
375*
376 LWORK = DESCA( NB_ ) * ( MP + NQ + DESCA( NB_ ) )
377 WORKFCT = LWORK + IPOSTPAD
378 WORKSIZ = WORKFCT
379*
380 IF( CHECK ) THEN
381*
382* Figure the amount of workspace required by the
383* checking routines PZLAFCHK, PZGEQLRV and
384* PZLANGE
385*
386 WORKSIZ = LWORK + MP*DESCA( NB_ ) + IPOSTPAD
387*
388 END IF
389*
390 ELSE IF( LSAMEN( 2, FACT, 'lq' ) ) THEN
391*
392 LTAU = MNP
393 IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
394*
395* Figure the amount of workspace required by the LQ
396* factorization
397*
398 LWORK = DESCA( MB_ ) * ( MP + NQ + DESCA( MB_ ) )
399 WORKFCT = LWORK + IPOSTPAD
400 WORKSIZ = WORKFCT
401*
402 IF( CHECK ) THEN
403*
404* Figure the amount of workspace required by the
405* checking routines PZLAFCHK, PZGELQRV and
406* PZLANGE
407*
408 WORKSIZ = LWORK +
409 $ MAX( MP*DESCA( NB_ ), NQ*DESCA( MB_ )
410 $ ) + IPOSTPAD
411*
412 END IF
413*
414 ELSE IF( LSAMEN( 2, FACT, 'rq' ) ) THEN
415*
416 LTAU = MP
417 IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
418*
419* Figure the amount of workspace required by the QR
420* factorization
421*
422 LWORK = DESCA( MB_ ) * ( MP + NQ + DESCA( MB_ ) )
423 WORKFCT = LWORK + IPOSTPAD
424 WORKSIZ = WORKFCT
425*
426 IF( CHECK ) THEN
427*
428* Figure the amount of workspace required by the
429* checking routines PZLAFCHK, PZGERQRV and
430* PZLANGE
431*
432 WORKSIZ = LWORK +
433 $ MAX( MP*DESCA( NB_ ), NQ*DESCA( MB_ )
434 $ ) + IPOSTPAD
435*
436 END IF
437*
438 ELSE IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
439*
440 LTAU = MNQ
441 IPPIV = IPTAU + LTAU + IPOSTPAD + IPREPAD
442 LIPIV = ICEIL( INTGSZ*NQ, ZPLXSZ )
443 IPW = IPPIV + LIPIV + IPOSTPAD + IPREPAD
444*
445* Figure the amount of workspace required by the
446* factorization i.e from IPW on.
447*
448 LWORK = MAX( 3, MP + MAX( 1, NQ ) )
449 WORKFCT = LWORK + IPOSTPAD
450 LRWORK = MAX( 1, 2 * NQ )
451 WORKRFCT = ICEIL( LRWORK*DBLESZ, ZPLXSZ ) +
452 $ IPOSTPAD
453 IPRW = IPW + WORKFCT + IPREPAD
454 WORKSIZ = WORKFCT + IPREPAD + WORKRFCT
455*
456 IF( CHECK ) THEN
457*
458* Figure the amount of workspace required by the
459* checking routines PZLAFCHK, PZGEQRRV,
460* PZLANGE.
461*
462 WORKSIZ = MAX( WORKSIZ - IPOSTPAD,
463 $ DESCA( NB_ )*( 2*MP + NQ + DESCA( NB_ ) ) ) +
464 $ IPOSTPAD
465 END IF
466*
467 ELSE IF( LSAMEN( 2, FACT, 'tz' ) ) THEN
468*
469 LTAU = MP
470 IPW = IPTAU + LTAU + IPOSTPAD + IPREPAD
471*
472* Figure the amount of workspace required by the TZ
473* factorization
474*
475 LWORK = DESCA( MB_ ) * ( MP + NQ + DESCA( MB_ ) )
476 WORKFCT = LWORK + IPOSTPAD
477 WORKSIZ = WORKFCT
478*
479 IF( CHECK ) THEN
480*
481* Figure the amount of workspace required by the
482* checking routines PZLAFCHK, PZTZRZRV and
483* PZLANGE
484*
485 WORKSIZ = LWORK +
486 $ MAX( MP*DESCA( NB_ ), NQ*DESCA( MB_ )
487 $ ) + IPOSTPAD
488*
489 END IF
490*
491 END IF
492*
493* Check for adequate memory for problem size
494*
495 IERR( 1 ) = 0
496.GT. IF( IPW+WORKSIZMEMSIZ ) THEN
497.EQ. IF( IAM0 )
498 $ WRITE( NOUT, FMT = 9996 )
499 $ FACT // ' factorization',
500 $ ( IPW+WORKSIZ )*ZPLXSZ
501 IERR( 1 ) = 1
502 END IF
503*
504* Check all processes for an error
505*
506 CALL IGSUM2D( ICTXT, 'all', ' ', 1, 1, IERR, 1, -1,
507 $ 0 )
508*
509.GT. IF( IERR( 1 )0 ) THEN
510.EQ. IF( IAM0 )
511 $ WRITE( NOUT, FMT = 9997 ) 'memory'
512 KSKIP = KSKIP + 1
513 GO TO 10
514 END IF
515*
516* Generate the matrix A
517*
518 CALL PZMATGEN( ICTXT, 'n', 'n', DESCA( M_ ),
519 $ DESCA( N_ ), DESCA( MB_ ),
520 $ DESCA( NB_ ), MEM( IPA ),
521 $ DESCA( LLD_ ), DESCA( RSRC_ ),
522 $ DESCA( CSRC_ ), IASEED, 0, MP, 0, NQ,
523 $ MYROW, MYCOL, NPROW, NPCOL )
524*
525* Need the Infinity of A for checking
526*
527 IF( CHECK ) THEN
528 CALL PZFILLPAD( ICTXT, MP, NQ, MEM( IPA-IPREPAD ),
529 $ DESCA( LLD_ ), IPREPAD, IPOSTPAD,
530 $ PADVAL )
531 IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
532 CALL PZFILLPAD( ICTXT, LIPIV, 1,
533 $ MEM( IPPIV-IPREPAD ), LIPIV,
534 $ IPREPAD, IPOSTPAD, PADVAL )
535 END IF
536 CALL PZFILLPAD( ICTXT, LTAU, 1,
537 $ MEM( IPTAU-IPREPAD ), LTAU,
538 $ IPREPAD, IPOSTPAD, PADVAL )
539 CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
540 $ MEM( IPW-IPREPAD ),
541 $ WORKSIZ-IPOSTPAD,
542 $ IPREPAD, IPOSTPAD, PADVAL )
543 ANORM = PZLANGE( 'i', M, N, MEM( IPA ), 1, 1,
544 $ DESCA, MEM( IPW ) )
545 CALL PZCHEKPAD( ICTXT, 'pzlange', MP, NQ,
546 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
547 $ IPREPAD, IPOSTPAD, PADVAL )
548 CALL PZCHEKPAD( ICTXT, 'pzlange',
549 $ WORKSIZ-IPOSTPAD, 1,
550 $ MEM( IPW-IPREPAD ),
551 $ WORKSIZ-IPOSTPAD, IPREPAD,
552 $ IPOSTPAD, PADVAL )
553 IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
554 CALL PZFILLPAD( ICTXT, WORKRFCT-IPOSTPAD, 1,
555 $ MEM( IPRW-IPREPAD ),
556 $ WORKRFCT-IPOSTPAD,
557 $ IPREPAD, IPOSTPAD, PADVAL )
558 END IF
559 CALL PZFILLPAD( ICTXT, WORKFCT-IPOSTPAD, 1,
560 $ MEM( IPW-IPREPAD ),
561 $ WORKFCT-IPOSTPAD,
562 $ IPREPAD, IPOSTPAD, PADVAL )
563 END IF
564*
565 CALL SLBOOT()
566 CALL BLACS_BARRIER( ICTXT, 'all' )
567*
568* Perform QR factorizations
569*
570 IF( LSAMEN( 2, FACT, 'qr' ) ) THEN
571 CALL SLTIMER( 1 )
572 CALL PZGEQRF( M, N, MEM( IPA ), 1, 1, DESCA,
573 $ MEM( IPTAU ), MEM( IPW ), LWORK,
574 $ INFO )
575 CALL SLTIMER( 1 )
576 ELSE IF( LSAMEN( 2, FACT, 'ql' ) ) THEN
577 CALL SLTIMER( 1 )
578 CALL PZGEQLF( M, N, MEM( IPA ), 1, 1, DESCA,
579 $ MEM( IPTAU ), MEM( IPW ), LWORK,
580 $ INFO )
581 CALL SLTIMER( 1 )
582 ELSE IF( LSAMEN( 2, FACT, 'lq' ) ) THEN
583 CALL SLTIMER( 1 )
584 CALL PZGELQF( M, N, MEM( IPA ), 1, 1, DESCA,
585 $ MEM( IPTAU ), MEM( IPW ), LWORK,
586 $ INFO )
587 CALL SLTIMER( 1 )
588 ELSE IF( LSAMEN( 2, FACT, 'rq' ) ) THEN
589 CALL SLTIMER( 1 )
590 CALL PZGERQF( M, N, MEM( IPA ), 1, 1, DESCA,
591 $ MEM( IPTAU ), MEM( IPW ), LWORK,
592 $ INFO )
593 CALL SLTIMER( 1 )
594 ELSE IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
595 CALL SLTIMER( 1 )
596 CALL PZGEQPF( M, N, MEM( IPA ), 1, 1, DESCA,
597 $ MEM( IPPIV ), MEM( IPTAU ),
598 $ MEM( IPW ), LWORK, MEM( IPRW ),
599 $ LRWORK, INFO )
600 CALL SLTIMER( 1 )
601 ELSE IF( LSAMEN( 2, FACT, 'tz' ) ) THEN
602 CALL SLTIMER( 1 )
603.GE. IF( NM )
604 $ CALL PZTZRZF( M, N, MEM( IPA ), 1, 1, DESCA,
605 $ MEM( IPTAU ), MEM( IPW ), LWORK,
606 $ INFO )
607 CALL SLTIMER( 1 )
608 END IF
609*
610 IF( CHECK ) THEN
611*
612* Check for memory overwrite in factorization
613*
614 CALL PZCHEKPAD( ICTXT, ROUT, MP, NQ,
615 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
616 $ IPREPAD, IPOSTPAD, PADVAL )
617 CALL PZCHEKPAD( ICTXT, ROUT, LTAU, 1,
618 $ MEM( IPTAU-IPREPAD ), LTAU,
619 $ IPREPAD, IPOSTPAD, PADVAL )
620 IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
621 CALL PZCHEKPAD( ICTXT, ROUT, LIPIV, 1,
622 $ MEM( IPPIV-IPREPAD ), LIPIV,
623 $ IPREPAD, IPOSTPAD, PADVAL )
624 CALL PZCHEKPAD( ICTXT, ROUT, WORKRFCT-IPOSTPAD,
625 $ 1, MEM( IPRW-IPREPAD ),
626 $ WORKRFCT-IPOSTPAD,
627 $ IPREPAD, IPOSTPAD, PADVAL )
628 END IF
629 CALL PZCHEKPAD( ICTXT, ROUT, WORKFCT-IPOSTPAD, 1,
630 $ MEM( IPW-IPREPAD ),
631 $ WORKFCT-IPOSTPAD, IPREPAD,
632 $ IPOSTPAD, PADVAL )
633 CALL PZFILLPAD( ICTXT, WORKSIZ-IPOSTPAD, 1,
634 $ MEM( IPW-IPREPAD ),
635 $ WORKSIZ-IPOSTPAD,
636 $ IPREPAD, IPOSTPAD, PADVAL )
637*
638 IF( LSAMEN( 2, FACT, 'qr' ) ) THEN
639*
640* Compute residual = ||A-Q*R|| / (||A||*N*eps)
641*
642 CALL PZGEQRRV( M, N, MEM( IPA ), 1, 1, DESCA,
643 $ MEM( IPTAU ), MEM( IPW ) )
644 CALL PZLAFCHK( 'no', 'no', M, N, MEM( IPA ), 1,
645 $ 1, DESCA, IASEED, ANORM, FRESID,
646 $ MEM( IPW ) )
647 ELSE IF( LSAMEN( 2, FACT, 'ql' ) ) THEN
648*
649* Compute residual = ||A-Q*L|| / (||A||*N*eps)
650*
651 CALL PZGEQLRV( M, N, MEM( IPA ), 1, 1, DESCA,
652 $ MEM( IPTAU ), MEM( IPW ) )
653 CALL PZLAFCHK( 'no', 'no', M, N, MEM( IPA ), 1,
654 $ 1, DESCA, IASEED, ANORM, FRESID,
655 $ MEM( IPW ) )
656 ELSE IF( LSAMEN( 2, FACT, 'lq' ) ) THEN
657*
658* Compute residual = ||A-L*Q|| / (||A||*N*eps)
659*
660 CALL PZGELQRV( M, N, MEM( IPA ), 1, 1, DESCA,
661 $ MEM( IPTAU ), MEM( IPW ) )
662 CALL PZLAFCHK( 'no', 'no', M, N, MEM( IPA ), 1,
663 $ 1, DESCA, IASEED, ANORM, FRESID,
664 $ MEM( IPW ) )
665 ELSE IF( LSAMEN( 2, FACT, 'rq' ) ) THEN
666*
667* Compute residual = ||A-R*Q|| / (||A||*N*eps)
668*
669 CALL PZGERQRV( M, N, MEM( IPA ), 1, 1, DESCA,
670 $ MEM( IPTAU ), MEM( IPW ) )
671 CALL PZLAFCHK( 'no', 'no', M, N, MEM( IPA ), 1,
672 $ 1, DESCA, IASEED, ANORM, FRESID,
673 $ MEM( IPW ) )
674 ELSE IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
675*
676* Compute residual = ||AP-Q*R|| / (||A||*N*eps)
677*
678 CALL PZGEQRRV( M, N, MEM( IPA ), 1, 1, DESCA,
679 $ MEM( IPTAU ), MEM( IPW ) )
680 ELSE IF( LSAMEN( 2, FACT, 'tz' ) ) THEN
681*
682* Compute residual = ||A-T*Z|| / (||A||*N*eps)
683*
684.GE. IF( NM ) THEN
685 CALL PZTZRZRV( M, N, MEM( IPA ), 1, 1, DESCA,
686 $ MEM( IPTAU ), MEM( IPW ) )
687 END IF
688 CALL PZLAFCHK( 'no', 'no', M, N, MEM( IPA ), 1,
689 $ 1, DESCA, IASEED, ANORM, FRESID,
690 $ MEM( IPW ) )
691 END IF
692*
693* Check for memory overwrite
694*
695 CALL PZCHEKPAD( ICTXT, ROUTCHK, MP, NQ,
696 $ MEM( IPA-IPREPAD ), DESCA( LLD_ ),
697 $ IPREPAD, IPOSTPAD, PADVAL )
698 CALL PZCHEKPAD( ICTXT, ROUTCHK, LTAU, 1,
699 $ MEM( IPTAU-IPREPAD ), LTAU,
700 $ IPREPAD, IPOSTPAD, PADVAL )
701 CALL PZCHEKPAD( ICTXT, ROUTCHK, WORKSIZ-IPOSTPAD,
702 $ 1, MEM( IPW-IPREPAD ),
703 $ WORKSIZ-IPOSTPAD, IPREPAD,
704 $ IPOSTPAD, PADVAL )
705*
706 IF( LSAMEN( 2, FACT, 'qp' ) ) THEN
707*
708 CALL PZQPPIV( M, N, MEM( IPA ), 1, 1, DESCA,
709 $ MEM( IPPIV ) )
710*
711* Check for memory overwrite
712*
713 CALL PZCHEKPAD( ICTXT, 'pzqppiv', MP, NQ,
714 $ MEM( IPA-IPREPAD ),
715 $ DESCA( LLD_ ),
716 $ IPREPAD, IPOSTPAD, PADVAL )
717 CALL PZCHEKPAD( ICTXT, 'pzqppiv', LIPIV, 1,
718 $ MEM( IPPIV-IPREPAD ), LIPIV,
719 $ IPREPAD, IPOSTPAD, PADVAL )
720*
721 CALL PZLAFCHK( 'no', 'no', M, N, MEM( IPA ), 1,
722 $ 1, DESCA, IASEED, ANORM, FRESID,
723 $ MEM( IPW ) )
724*
725* Check for memory overwrite
726*
727 CALL PZCHEKPAD( ICTXT, 'pzlafchk', MP, NQ,
728 $ MEM( IPA-IPREPAD ),
729 $ DESCA( LLD_ ),
730 $ IPREPAD, IPOSTPAD, PADVAL )
731 CALL PZCHEKPAD( ICTXT, 'pzlafchk',
732 $ WORKSIZ-IPOSTPAD, 1,
733 $ MEM( IPW-IPREPAD ),
734 $ WORKSIZ-IPOSTPAD, IPREPAD,
735 $ IPOSTPAD, PADVAL )
736 END IF
737*
738* Test residual and detect NaN result
739*
740 IF( LSAMEN( 2, FACT, 'tz.AND..LT.' ) NM ) THEN
741 KSKIP = KSKIP + 1
742 PASSED = 'bypass'
743 ELSE
744.LE..AND. IF( FRESIDTHRESH
745.EQ. $ (FRESID-FRESID)0.0D+0 ) THEN
746 KPASS = KPASS + 1
747 PASSED = 'passed'
748 ELSE
749 KFAIL = KFAIL + 1
750 PASSED = 'failed'
751 END IF
752 END IF
753*
754 ELSE
755*
756* Don't perform the checking, only timing
757*
758 KPASS = KPASS + 1
759 FRESID = FRESID - FRESID
760 PASSED = 'bypass'
761*
762 END IF
763*
764* Gather maximum of all CPU and WALL clock timings
765*
766 CALL SLCOMBINE( ICTXT, 'all', '>', 'w', 1, 1, WTIME )
767 CALL SLCOMBINE( ICTXT, 'all', '>', 'c', 1, 1, CTIME )
768*
769* Print results
770*
771.EQ..AND..EQ. IF( MYROW0 MYCOL0 ) THEN
772*
773 MINMN = MIN( M, N )
774 MAXMN = MAX( M, N )
775*
776 IF( LSAMEN( 2, FACT, 'tz' ) ) THEN
777.GE. IF( MN ) THEN
778 NOPS = 0.0D+0
779 ELSE
780*
781* 9 ( M^2 N - M^3 ) + 13 M N - M^2 for
782* complete unitary factorization (M <= N).
783*
784 NOPS = 9.0D+0 * (
785 $ DBLE( N )*( DBLE( M )**2 ) -
786 $ DBLE( M )**3 ) +
787 $ 13.0D+0*DBLE( N )*DBLE( M ) -
788 $ DBLE( M )**2
789 END IF
790*
791 ELSE
792*
793* 8 M N^2 - 8/3 N^2 + 6 M N + 8 N^2 for QR type
794* factorization when M >= N.
795*
796 NOPS = 8.0D+0 * ( DBLE( MINMN )**2 ) *
797 $ ( DBLE( MAXMN )-DBLE( MINMN ) / 3.0D+0 ) +
798 $ ( 6.0D+0 * DBLE( MAXMN ) +
799 $ 8.0D+0 * DBLE( MINMN ) ) *
800 $ DBLE( MINMN )
801 END IF
802*
803* Print WALL time
804*
805.GT. IF( WTIME( 1 )0.0D+0 ) THEN
806 TMFLOPS = NOPS / ( WTIME( 1 ) * 1.0D+6 )
807 ELSE
808 TMFLOPS = 0.0D+0
809 END IF
810.GE. IF( WTIME( 1 )0.0D+0 )
811 $ WRITE( NOUT, FMT = 9993 ) 'wall', M, N, MB, NB,
812 $ NPROW, NPCOL, WTIME( 1 ), TMFLOPS,
813 $ PASSED, FRESID
814*
815* Print CPU time
816*
817.GT. IF( CTIME( 1 )0.0D+0 ) THEN
818 TMFLOPS = NOPS / ( CTIME( 1 ) * 1.0D+6 )
819 ELSE
820 TMFLOPS = 0.0D+0
821 END IF
822.GE. IF( CTIME( 1 )0.0D+0 )
823 $ WRITE( NOUT, FMT = 9993 ) 'cpu ', M, N, MB, NB,
824 $ NPROW, NPCOL, CTIME( 1 ), TMFLOPS,
825 $ PASSED, FRESID
826*
827 END IF
828*
829 10 CONTINUE
830*
831 20 CONTINUE
832*
833 CALL BLACS_GRIDEXIT( ICTXT )
834*
835 30 CONTINUE
836*
837 40 CONTINUE
838*
839* Print out ending messages and close output file
840*
841.EQ. IF( IAM0 ) THEN
842 KTESTS = KPASS + KFAIL + KSKIP
843 WRITE( NOUT, FMT = * )
844 WRITE( NOUT, FMT = 9992 ) KTESTS
845 IF( CHECK ) THEN
846 WRITE( NOUT, FMT = 9991 ) KPASS
847 WRITE( NOUT, FMT = 9989 ) KFAIL
848 ELSE
849 WRITE( NOUT, FMT = 9990 ) KPASS
850 END IF
851 WRITE( NOUT, FMT = 9988 ) KSKIP
852 WRITE( NOUT, FMT = * )
853 WRITE( NOUT, FMT = * )
854 WRITE( NOUT, FMT = 9987 )
855.NE..AND..NE. IF( NOUT6 NOUT0 )
856 $ CLOSE ( NOUT )
857 END IF
858*
859 CALL BLACS_EXIT( 0 )
860*
861 9999 FORMAT( 'illegal ', A6, ': ', A5, ' = ', I3,
862 $ '; it should be at least 1' )
863 9998 FORMAT( 'illegal grid: nprow*npcol = ', I4, '. it can be at most',
864 $ I4 )
865 9997 FORMAT( 'bad ', A6, ' parameters: going on to next test case.' )
866 9996 FORMAT( 'unable to perform ', A, ': need totmem of at least',
867 $ I11 )
868 9995 FORMAT( 'time m n mb nb p q fact time ',
869 $ ' mflops check residual' )
870 9994 FORMAT( '---- ------ ------ --- --- ----- ----- --------- ',
871 $ '----------- ------ --------' )
872 9993 FORMAT( A4, 1X, I6, 1X, I6, 1X, I3, 1X, I3, 1X, I5, 1X, I5, 1X,
873 $ F9.2, 1X, F11.2, 1X, A6, 2X, G8.1 )
874 9992 FORMAT( 'finished ', I6, ' tests, with the following results:' )
875 9991 FORMAT( I5, ' tests completed and passed residual checks.' )
876 9990 FORMAT( I5, ' tests completed without checking.' )
877 9989 FORMAT( I5, ' tests completed and failed residual checks.' )
878 9988 FORMAT( I5, ' tests skipped because of illegal input values.' )
879 9987 FORMAT( 'END OF TESTS.' )
880 9986 FORMAT( A )
881*
882 STOP
883*
884* End of PZQRDRIVER
885*
886 END
887*
888 SUBROUTINE PZQPPIV( M, N, A, IA, JA, DESCA, IPIV )
889*
890* -- ScaLAPACK routine (version 1.7) --
891* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
892* and University of California, Berkeley.
893* May 1, 1997
894*
895* .. Scalar Arguments ..
896 INTEGER IA, JA, M, N
897* ..
898* .. Array Arguments ..
899 INTEGER DESCA( * ), IPIV( * )
900 COMPLEX*16 A( * )
901* ..
902*
903* Purpose
904* =======
905*
906* PZQPPIV applies to sub( A ) = A(IA:IA+M-1,JA:JA+N-1) the pivots
907* returned by PZGEQPF in reverse order for checking purposes.
908*
909* Notes
910* =====
911*
912* Each global data object is described by an associated description
913* vector. This vector stores the information required to establish
914* the mapping between an object element and its corresponding process
915* and memory location.
916*
917* Let A be a generic term for any 2D block cyclicly distributed array.
918* Such a global array has an associated description vector DESCA.
919* In the following comments, the character _ should be read as
920* "of the global array".
921*
922* NOTATION STORED IN EXPLANATION
923* --------------- -------------- --------------------------------------
924* DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
925* DTYPE_A = 1.
926* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
927* the BLACS process grid A is distribu-
928* ted over. The context itself is glo-
929* bal, but the handle (the integer
930* value) may vary.
931* M_A (global) DESCA( M_ ) The number of rows in the global
932* array A.
933* N_A (global) DESCA( N_ ) The number of columns in the global
934* array A.
935* MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
936* the rows of the array.
937* NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
938* the columns of the array.
939* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
940* row of the array A is distributed.
941* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
942* first column of the array A is
943* distributed.
944* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
945* array. LLD_A >= MAX(1,LOCr(M_A)).
946*
947* Let K be the number of rows or columns of a distributed matrix,
948* and assume that its process grid has dimension p x q.
949* LOCr( K ) denotes the number of elements of K that a process
950* would receive if K were distributed over the p processes of its
951* process column.
952* Similarly, LOCc( K ) denotes the number of elements of K that a
953* process would receive if K were distributed over the q processes of
954* its process row.
955* The values of LOCr() and LOCc() may be determined via a call to the
956* ScaLAPACK tool function, NUMROC:
957* LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
958* LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
959* An upper bound for these quantities may be computed by:
960* LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
961* LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
962*
963* Arguments
964* =========
965*
966* M (global input) INTEGER
967* The number of rows to be operated on, i.e. the number of rows
968* of the distributed submatrix sub( A ). M >= 0.
969*
970* N (global input) INTEGER
971* The number of columns to be operated on, i.e. the number of
972* columns of the distributed submatrix sub( A ). N >= 0.
973*
974* A (local input/local output) COMPLEX*16 pointer into the
975* local memory to an array of dimension (LLD_A, LOCc(JA+N-1)).
976* On entry, the local pieces of the M-by-N distributed matrix
977* sub( A ) which is to be permuted. On exit, the local pieces
978* of the distributed permuted submatrix sub( A ) * Inv( P ).
979*
980* IA (global input) INTEGER
981* The row index in the global array A indicating the first
982* row of sub( A ).
983*
984* JA (global input) INTEGER
985* The column index in the global array A indicating the
986* first column of sub( A ).
987*
988* DESCA (global and local input) INTEGER array of dimension DLEN_.
989* The array descriptor for the distributed matrix A.
990*
991* IPIV (local input) INTEGER array, dimension LOCc(JA+N-1).
992* On exit, if IPIV(I) = K, the local i-th column of sub( A )*P
993* was the global K-th column of sub( A ). IPIV is tied to the
994* distributed matrix A.
995*
996* =====================================================================
997*
998* .. Parameters ..
999 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
1000 $ LLD_, MB_, M_, NB_, N_, RSRC_
1001 PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
1002 $ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
1003 $ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
1004* ..
1005* .. Local Scalars ..
1006 INTEGER IACOL, ICOFFA, ICTXT, IITMP, IPVT, IPCOL,
1007 $ IPROW, ITMP, J, JJ, JJA, KK, MYCOL, MYROW,
1008 $ NPCOL, NPROW, NQ
1009* ..
1010* .. External Subroutines ..
1011 EXTERNAL BLACS_GRIDINFO, IGEBR2D, IGEBS2D, IGERV2D,
1012 $ IGESD2D, IGAMN2D, INFOG1L, PZSWAP
1013* ..
1014* .. External Functions ..
1015 INTEGER INDXL2G, NUMROC
1016 EXTERNAL INDXL2G, NUMROC
1017* ..
1018* .. Intrinsic Functions ..
1019 INTRINSIC MIN, MOD
1020* ..
1021* .. Executable Statements ..
1022*
1023* Get grid parameters
1024*
1025 ICTXT = DESCA( CTXT_ )
1026 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
1027 CALL INFOG1L( JA, DESCA( NB_ ), NPCOL, MYCOL, DESCA( CSRC_ ), JJA,
1028 $ IACOL )
1029 ICOFFA = MOD( JA-1, DESCA( NB_ ) )
1030 NQ = NUMROC( N+ICOFFA, DESCA( NB_ ), MYCOL, IACOL, NPCOL )
1031.EQ. IF( MYCOLIACOL )
1032 $ NQ = NQ - ICOFFA
1033*
1034 DO 20 J = JA, JA+N-2
1035*
1036 IPVT = JA+N-1
1037 ITMP = JA+N
1038*
1039* Find first the local minimum candidate for pivoting
1040*
1041 CALL INFOG1L( J, DESCA( NB_ ), NPCOL, MYCOL, DESCA( CSRC_ ),
1042 $ JJ, IACOL )
1043 DO 10 KK = JJ, JJA+NQ-1
1044.LT. IF( IPIV( KK )IPVT )THEN
1045 IITMP = KK
1046 IPVT = IPIV( KK )
1047 END IF
1048 10 CONTINUE
1049*
1050* Find the global minimum pivot
1051*
1052 CALL IGAMN2D( ICTXT, 'Rowwise', ' ', 1, 1, IPVT, 1, IPROW,
1053 $ IPCOL, 1, -1, MYCOL )
1054*
1055* Broadcast the corresponding index to the other process columns
1056*
1057.EQ. IF( MYCOLIPCOL ) THEN
1058 ITMP = INDXL2G( IITMP, DESCA( NB_ ), MYCOL, DESCA( CSRC_ ),
1059 $ NPCOL )
1060 CALL IGEBS2D( ICTXT, 'Rowwise', ' ', 1, 1, ITMP, 1 )
1061.NE. IF( IPCOLIACOL ) THEN
1062 CALL IGERV2D( ICTXT, 1, 1, IPIV( IITMP ), 1, MYROW,
1063 $ IACOL )
1064 ELSE
1065.EQ. IF( MYCOLIACOL )
1066 $ IPIV( IITMP ) = IPIV( JJ )
1067 END IF
1068 ELSE
1069 CALL IGEBR2D( ICTXT, 'Rowwise', ' ', 1, 1, ITMP, 1, MYROW,
1070 $ IPCOL )
1071.EQ..AND..NE. IF( MYCOLIACOL IPCOLIACOL )
1072 $ CALL IGESD2D( ICTXT, 1, 1, IPIV( JJ ), 1, MYROW, IPCOL )
1073 END IF
1074*
1075* Swap the columns of A
1076*
1077 CALL PZSWAP( M, A, IA, ITMP, DESCA, 1, A, IA, J, DESCA, 1 )
1078*
1079 20 CONTINUE
1080*
1081* End of PZQPPIV
1082*
1083 END
pzlafchk
subroutine pzlafchk(aform, diag, m, n, a, ia, ja, desca, iaseed, anorm, fresid, work)
Definition pzlafchk.f:3
pzmatgen
subroutine pzmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
Definition pzmatgen.f:4
the
end diagonal values have been computed in the(sparse) matrix id.SOL
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
iceil
integer function iceil(inum, idenom)
Definition iceil.f:2
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
pzgeqpf
subroutine pzgeqpf(m, n, a, ia, ja, desca, ipiv, tau, work, lwork, info)
Definition mpi.f:1391
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
pzlange
double precision function pzlange(norm, m, n, a, ia, ja, desca, work)
Definition mpi.f:1287
descinit
subroutine descinit(desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
Definition mpi.f:777
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762
blacs_gridinfo
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754
numroc
integer function numroc(n, nb, iproc, isrcproc, nprocs)
Definition mpi.f:786
pzchekpad
subroutine pzchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
Definition pzchekpad.f:3
pzfillpad
subroutine pzfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
Definition pzfillpad.f:2
pzgelqf
subroutine pzgelqf(m, n, a, ia, ja, desca, tau, work, lwork, info)
Definition pzgelqf.f:3
pzgelqrv
subroutine pzgelqrv(m, n, a, ia, ja, desca, tau, work)
Definition pzgelqrv.f:2
pzgeqlf
subroutine pzgeqlf(m, n, a, ia, ja, desca, tau, work, lwork, info)
Definition pzgeqlf.f:3
pzgeqlrv
subroutine pzgeqlrv(m, n, a, ia, ja, desca, tau, work)
Definition pzgeqlrv.f:2
pzgeqrf
subroutine pzgeqrf(m, n, a, ia, ja, desca, tau, work, lwork, info)
Definition pzgeqrf.f:3
pzgeqrrv
subroutine pzgeqrrv(m, n, a, ia, ja, desca, tau, work)
Definition pzgeqrrv.f:2
pzgerqf
subroutine pzgerqf(m, n, a, ia, ja, desca, tau, work, lwork, info)
Definition pzgerqf.f:3
pzgerqrv
subroutine pzgerqrv(m, n, a, ia, ja, desca, tau, work)
Definition pzgerqrv.f:2
pzqppiv
subroutine pzqppiv(m, n, a, ia, ja, desca, ipiv)
Definition pzqrdriver.f:889
pzqrdriver
program pzqrdriver
Definition pzqrdriver.f:1
pzqrinfo
subroutine pzqrinfo(summry, nout, nfact, factor, ldfact, nmat, mval, ldmval, nval, ldnval, nnb, mbval, ldmbval, nbval, ldnbval, ngrids, pval, ldpval, qval, ldqval, thresh, work, iam, nprocs)
Definition pzqrinfo.f:6
pztzrzf
subroutine pztzrzf(m, n, a, ia, ja, desca, tau, work, lwork, info)
Definition pztzrzf.f:3
pztzrzrv
subroutine pztzrzrv(m, n, a, ia, ja, desca, tau, work)
Definition pztzrzrv.f:2
slboot
subroutine slboot()
Definition sltimer.f:2
sltimer
subroutine sltimer(i)
Definition sltimer.f:47
slcombine
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)
Definition sltimer.f:267