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