ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pdgeqpf.f
Go to the documentation of this file.
1  SUBROUTINE pdgeqpf( M, N, A, IA, JA, DESCA, IPIV, TAU, WORK,
2  $ LWORK, INFO )
3 *
4 * -- ScaLAPACK routine (version 2.1) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * November 20, 2019
8 *
9 * .. Scalar Arguments ..
10  INTEGER IA, JA, INFO, LWORK, M, N
11 * ..
12 * .. Array Arguments ..
13  INTEGER DESCA( * ), IPIV( * )
14  DOUBLE PRECISION A( * ), TAU( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * PDGEQPF computes a QR factorization with column pivoting of a
21 * M-by-N distributed matrix sub( A ) = A(IA:IA+M-1,JA:JA+N-1):
22 *
23 * sub( A ) * P = Q * R.
24 *
25 * Notes
26 * =====
27 *
28 * Each global data object is described by an associated description
29 * vector. This vector stores the information required to establish
30 * the mapping between an object element and its corresponding process
31 * and memory location.
32 *
33 * Let A be a generic term for any 2D block cyclicly distributed array.
34 * Such a global array has an associated description vector DESCA.
35 * In the following comments, the character _ should be read as
36 * "of the global array".
37 *
38 * NOTATION STORED IN EXPLANATION
39 * --------------- -------------- --------------------------------------
40 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
41 * DTYPE_A = 1.
42 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
43 * the BLACS process grid A is distribu-
44 * ted over. The context itself is glo-
45 * bal, but the handle (the integer
46 * value) may vary.
47 * M_A (global) DESCA( M_ ) The number of rows in the global
48 * array A.
49 * N_A (global) DESCA( N_ ) The number of columns in the global
50 * array A.
51 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
52 * the rows of the array.
53 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
54 * the columns of the array.
55 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
56 * row of the array A is distributed.
57 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
58 * first column of the array A is
59 * distributed.
60 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
61 * array. LLD_A >= MAX(1,LOCr(M_A)).
62 *
63 * Let K be the number of rows or columns of a distributed matrix,
64 * and assume that its process grid has dimension p x q.
65 * LOCr( K ) denotes the number of elements of K that a process
66 * would receive if K were distributed over the p processes of its
67 * process column.
68 * Similarly, LOCc( K ) denotes the number of elements of K that a
69 * process would receive if K were distributed over the q processes of
70 * its process row.
71 * The values of LOCr() and LOCc() may be determined via a call to the
72 * ScaLAPACK tool function, NUMROC:
73 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
74 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
75 * An upper bound for these quantities may be computed by:
76 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
77 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
78 *
79 * Arguments
80 * =========
81 *
82 * M (global input) INTEGER
83 * The number of rows to be operated on, i.e. the number of rows
84 * of the distributed submatrix sub( A ). M >= 0.
85 *
86 * N (global input) INTEGER
87 * The number of columns to be operated on, i.e. the number of
88 * columns of the distributed submatrix sub( A ). N >= 0.
89 *
90 * A (local input/local output) DOUBLE PRECISION pointer into the
91 * local memory to an array of dimension (LLD_A, LOCc(JA+N-1)).
92 * On entry, the local pieces of the M-by-N distributed matrix
93 * sub( A ) which is to be factored. On exit, the elements on
94 * and above the diagonal of sub( A ) contain the min(M,N) by N
95 * upper trapezoidal matrix R (R is upper triangular if M >= N);
96 * the elements below the diagonal, with the array TAU, repre-
97 * sent the orthogonal matrix Q as a product of elementary
98 * reflectors (see Further Details).
99 *
100 * IA (global input) INTEGER
101 * The row index in the global array A indicating the first
102 * row of sub( A ).
103 *
104 * JA (global input) INTEGER
105 * The column index in the global array A indicating the
106 * first column of sub( A ).
107 *
108 * DESCA (global and local input) INTEGER array of dimension DLEN_.
109 * The array descriptor for the distributed matrix A.
110 *
111 * IPIV (local output) INTEGER array, dimension LOCc(JA+N-1).
112 * On exit, if IPIV(I) = K, the local i-th column of sub( A )*P
113 * was the global K-th column of sub( A ). IPIV is tied to the
114 * distributed matrix A.
115 *
116 * TAU (local output) DOUBLE PRECISION array, dimension
117 * LOCc(JA+MIN(M,N)-1). This array contains the scalar factors
118 * TAU of the elementary reflectors. TAU is tied to the
119 * distributed matrix A.
120 *
121 * WORK (local workspace/local output) DOUBLE PRECISION array,
122 * dimension (LWORK)
123 * On exit, WORK(1) returns the minimal and optimal LWORK.
124 *
125 * LWORK (local or global input) INTEGER
126 * The dimension of the array WORK.
127 * LWORK is local input and must be at least
128 * LWORK >= MAX(3,Mp0 + Nq0) + LOCc(JA+N-1)+Nq0.
129 *
130 * IROFF = MOD( IA-1, MB_A ), ICOFF = MOD( JA-1, NB_A ),
131 * IAROW = INDXG2P( IA, MB_A, MYROW, RSRC_A, NPROW ),
132 * IACOL = INDXG2P( JA, NB_A, MYCOL, CSRC_A, NPCOL ),
133 * Mp0 = NUMROC( M+IROFF, MB_A, MYROW, IAROW, NPROW ),
134 * Nq0 = NUMROC( N+ICOFF, NB_A, MYCOL, IACOL, NPCOL ),
135 * LOCc(JA+N-1) = NUMROC( JA+N-1, NB_A, MYCOL, CSRC_A, NPCOL )
136 *
137 * and NUMROC, INDXG2P are ScaLAPACK tool functions;
138 * MYROW, MYCOL, NPROW and NPCOL can be determined by calling
139 * the subroutine BLACS_GRIDINFO.
140 *
141 * If LWORK = -1, then LWORK is global input and a workspace
142 * query is assumed; the routine only calculates the minimum
143 * and optimal size for all work arrays. Each of these
144 * values is returned in the first entry of the corresponding
145 * work array, and no error message is issued by PXERBLA.
146 *
147 *
148 * INFO (global output) INTEGER
149 * = 0: successful exit
150 * < 0: If the i-th argument is an array and the j-entry had
151 * an illegal value, then INFO = -(i*100+j), if the i-th
152 * argument is a scalar and had an illegal value, then
153 * INFO = -i.
154 *
155 * Further Details
156 * ===============
157 *
158 * The matrix Q is represented as a product of elementary reflectors
159 *
160 * Q = H(1) H(2) . . . H(n)
161 *
162 * Each H(i) has the form
163 *
164 * H = I - tau * v * v'
165 *
166 * where tau is a real scalar, and v is a real vector with v(1:i-1) = 0
167 * and v(i) = 1; v(i+1:m) is stored on exit in A(ia+i-1:ia+m-1,ja+i-1).
168 *
169 * The matrix P is represented in jpvt as follows: If
170 * jpvt(j) = i
171 * then the jth column of P is the ith canonical unit vector.
172 *
173 * References
174 * ==========
175 *
176 * For modifications introduced in Scalapack 2.1
177 * LAWN 295
178 * New robust ScaLAPACK routine for computing the QR factorization with column pivoting
179 * Zvonimir Bujanovic, Zlatko Drmac
180 * http://www.netlib.org/lapack/lawnspdf/lawn295.pdf
181 *
182 * =====================================================================
183 *
184 * .. Parameters ..
185  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
186  $ lld_, mb_, m_, nb_, n_, rsrc_
187  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
188  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
189  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
190  DOUBLE PRECISION ONE, ZERO
191  parameter( one = 1.0d+0, zero = 0.0d+0 )
192 * ..
193 * .. Local Scalars ..
194  LOGICAL LQUERY
195  INTEGER I, IACOL, IAROW, ICOFF, ICTXT, ICURROW,
196  $ icurcol, ii, iia, ioffa, ipn, ipcol, ipw,
197  $ iroff, itemp, j, jb, jj, jja, jjpvt, jn, kb,
198  $ k, kk, kstart, kstep, lda, ll, lwmin, mn, mp,
199  $ mycol, myrow, npcol, nprow, nq, nq0, pvt
200  DOUBLE PRECISION AJJ, ALPHA, TEMP, TEMP2, TOL3Z
201 * ..
202 * .. Local Arrays ..
203  INTEGER DESCN( DLEN_ ), IDUM1( 1 ), IDUM2( 1 )
204 * ..
205 * .. External Subroutines ..
206  EXTERNAL blacs_gridinfo, chk1mat, dcopy, descset,
207  $ dgebr2d, dgebs2d, dgerv2d,
208  $ dgesd2d, dlarfg, dswap, igerv2d,
209  $ igesd2d, infog1l, infog2l, pchk1mat, pdamax,
210  $ pdelset, pdlarf, pdlarfg, pdnrm2,
211  $ pxerbla
212 * ..
213 * .. External Functions ..
214  INTEGER ICEIL, INDXG2P, NUMROC
215  EXTERNAL iceil, indxg2p, numroc
216  DOUBLE PRECISION DLAMCH
217  EXTERNAL dlamch
218 * ..
219 * .. Intrinsic Functions ..
220  INTRINSIC abs, dble, idint, max, min, mod, sqrt
221 * ..
222 * .. Executable Statements ..
223 *
224 * Get grid parameters
225 *
226  ictxt = desca( ctxt_ )
227  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
228 *
229 * Test the input parameters
230 *
231  info = 0
232  IF( nprow.EQ.-1 ) THEN
233  info = -(600+ctxt_)
234  ELSE
235  CALL chk1mat( m, 1, n, 2, ia, ja, desca, 6, info )
236  IF( info.EQ.0 ) THEN
237  iroff = mod( ia-1, desca( mb_ ) )
238  icoff = mod( ja-1, desca( nb_ ) )
239  iarow = indxg2p( ia, desca( mb_ ), myrow, desca( rsrc_ ),
240  $ nprow )
241  iacol = indxg2p( ja, desca( nb_ ), mycol, desca( csrc_ ),
242  $ npcol )
243  mp = numroc( m+iroff, desca( mb_ ), myrow, iarow, nprow )
244  nq = numroc( n+icoff, desca( nb_ ), mycol, iacol, npcol )
245  nq0 = numroc( ja+n-1, desca( nb_ ), mycol, desca( csrc_ ),
246  $ npcol )
247  lwmin = max( 3, mp + nq ) + nq0 + nq
248 *
249  work( 1 ) = dble( lwmin )
250  lquery = ( lwork.EQ.-1 )
251  IF( lwork.LT.lwmin .AND. .NOT.lquery )
252  $ info = -10
253  END IF
254  IF( lwork.EQ.-1 ) THEN
255  idum1( 1 ) = -1
256  ELSE
257  idum1( 1 ) = 1
258  END IF
259  idum2( 1 ) = 10
260  CALL pchk1mat( m, 1, n, 2, ia, ja, desca, 6, 1, idum1, idum2,
261  $ info )
262  END IF
263 *
264  IF( info.NE.0 ) THEN
265  CALL pxerbla( ictxt, 'PDGEQPF', -info )
266  RETURN
267  ELSE IF( lquery ) THEN
268  RETURN
269  END IF
270 *
271 * Quick return if possible
272 *
273  IF( m.EQ.0 .OR. n.EQ.0 )
274  $ RETURN
275 *
276  CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, iia, jja,
277  $ iarow, iacol )
278  IF( myrow.EQ.iarow )
279  $ mp = mp - iroff
280  IF( mycol.EQ.iacol )
281  $ nq = nq - icoff
282  mn = min( m, n )
283  tol3z = sqrt( dlamch('Epsilon') )
284 *
285 * Initialize the array of pivots
286 *
287  lda = desca( lld_ )
288  jn = min( iceil( ja, desca( nb_ ) ) * desca( nb_ ), ja+n-1 )
289  kstep = npcol * desca( nb_ )
290 *
291  IF( mycol.EQ.iacol ) THEN
292 *
293 * Handle first block separately
294 *
295  jb = jn - ja + 1
296  DO 10 ll = jja, jja+jb-1
297  ipiv( ll ) = ja + ll - jja
298  10 CONTINUE
299  kstart = jn + kstep - desca( nb_ )
300 *
301 * Loop over remaining block of columns
302 *
303  DO 30 kk = jja+jb, jja+nq-1, desca( nb_ )
304  kb = min( jja+nq-kk, desca( nb_ ) )
305  DO 20 ll = kk, kk+kb-1
306  ipiv( ll ) = kstart+ll-kk+1
307  20 CONTINUE
308  kstart = kstart + kstep
309  30 CONTINUE
310  ELSE
311  kstart = jn + ( mod( mycol-iacol+npcol, npcol )-1 )*
312  $ desca( nb_ )
313  DO 50 kk = jja, jja+nq-1, desca( nb_ )
314  kb = min( jja+nq-kk, desca( nb_ ) )
315  DO 40 ll = kk, kk+kb-1
316  ipiv( ll ) = kstart+ll-kk+1
317  40 CONTINUE
318  kstart = kstart + kstep
319  50 CONTINUE
320  END IF
321 *
322 * Initialize partial column norms, handle first block separately
323 *
324  CALL descset( descn, 1, desca( n_ ), 1, desca( nb_ ), myrow,
325  $ desca( csrc_ ), ictxt, 1 )
326 *
327  ipn = 1
328  ipw = ipn + nq0 + nq
329  jj = ipn + jja - 1
330  IF( mycol.EQ.iacol ) THEN
331  DO 60 kk = 0, jb-1
332  CALL pdnrm2( m, work( jj+kk ), a, ia, ja+kk, desca, 1 )
333  work( nq+jj+kk ) = work( jj+kk )
334  60 CONTINUE
335  jj = jj + jb
336  END IF
337  icurcol = mod( iacol+1, npcol )
338 *
339 * Loop over the remaining blocks of columns
340 *
341  DO 80 j = jn+1, ja+n-1, desca( nb_ )
342  jb = min( ja+n-j, desca( nb_ ) )
343 *
344  IF( mycol.EQ.icurcol ) THEN
345  DO 70 kk = 0, jb-1
346  CALL pdnrm2( m, work( jj+kk ), a, ia, j+kk, desca, 1 )
347  work( nq+jj+kk ) = work( jj+kk )
348  70 CONTINUE
349  jj = jj + jb
350  END IF
351  icurcol = mod( icurcol+1, npcol )
352  80 CONTINUE
353 *
354 * Compute factorization
355 *
356  DO 120 j = ja, ja+mn-1
357  i = ia + j - ja
358 *
359  CALL infog1l( j, desca( nb_ ), npcol, mycol, desca( csrc_ ),
360  $ jj, icurcol )
361  k = ja + n - j
362  IF( k.GT.1 ) THEN
363  CALL pdamax( k, temp, pvt, work( ipn ), 1, j, descn,
364  $ descn( m_ ) )
365  ELSE
366  pvt = j
367  END IF
368  IF( j.NE.pvt ) THEN
369  CALL infog1l( pvt, desca( nb_ ), npcol, mycol,
370  $ desca( csrc_ ), jjpvt, ipcol )
371  IF( icurcol.EQ.ipcol ) THEN
372  IF( mycol.EQ.icurcol ) THEN
373  CALL dswap( mp, a( iia+(jj-1)*lda ), 1,
374  $ a( iia+(jjpvt-1)*lda ), 1 )
375  itemp = ipiv( jjpvt )
376  ipiv( jjpvt ) = ipiv( jj )
377  ipiv( jj ) = itemp
378  work( ipn+jjpvt-1 ) = work( ipn+jj-1 )
379  work( ipn+nq+jjpvt-1 ) = work( ipn+nq+jj-1 )
380  END IF
381  ELSE
382  IF( mycol.EQ.icurcol ) THEN
383 *
384  CALL dgesd2d( ictxt, mp, 1, a( iia+(jj-1)*lda ), lda,
385  $ myrow, ipcol )
386  work( ipw ) = dble( ipiv( jj ) )
387  work( ipw+1 ) = work( ipn + jj - 1 )
388  work( ipw+2 ) = work( ipn + nq + jj - 1 )
389  CALL dgesd2d( ictxt, 3, 1, work( ipw ), 3, myrow,
390  $ ipcol )
391 *
392  CALL dgerv2d( ictxt, mp, 1, a( iia+(jj-1)*lda ), lda,
393  $ myrow, ipcol )
394  CALL igerv2d( ictxt, 1, 1, ipiv( jj ), 1, myrow,
395  $ ipcol )
396 *
397  ELSE IF( mycol.EQ.ipcol ) THEN
398 *
399  CALL dgesd2d( ictxt, mp, 1, a( iia+(jjpvt-1)*lda ),
400  $ lda, myrow, icurcol )
401  CALL igesd2d( ictxt, 1, 1, ipiv( jjpvt ), 1, myrow,
402  $ icurcol )
403 *
404  CALL dgerv2d( ictxt, mp, 1, a( iia+(jjpvt-1)*lda ),
405  $ lda, myrow, icurcol )
406  CALL dgerv2d( ictxt, 3, 1, work( ipw ), 3, myrow,
407  $ icurcol )
408  ipiv( jjpvt ) = idint( work( ipw ) )
409  work( ipn+jjpvt-1 ) = work( ipw+1 )
410  work( ipn+nq+jjpvt-1 ) = work( ipw+2 )
411 *
412  END IF
413 *
414  END IF
415 *
416  END IF
417 *
418 * Generate elementary reflector H(i)
419 *
420  CALL infog1l( i, desca( mb_ ), nprow, myrow, desca( rsrc_ ),
421  $ ii, icurrow )
422  IF( desca( m_ ).EQ.1 ) THEN
423  IF( myrow.EQ.icurrow ) THEN
424  IF( mycol.EQ.icurcol ) THEN
425  ioffa = ii+(jj-1)*desca( lld_ )
426  ajj = a( ioffa )
427  CALL dlarfg( 1, ajj, a( ioffa ), 1, tau( jj ) )
428  IF( n.GT.1 ) THEN
429  alpha = one - tau( jj )
430  CALL dgebs2d( ictxt, 'Rowwise', ' ', 1, 1, alpha,
431  $ 1 )
432  CALL dscal( nq-jj, alpha, a( ioffa+desca( lld_ ) ),
433  $ desca( lld_ ) )
434  END IF
435  CALL dgebs2d( ictxt, 'Columnwise', ' ', 1, 1,
436  $ tau( jj ), 1 )
437  a( ioffa ) = ajj
438  ELSE
439  IF( n.GT.1 ) THEN
440  CALL dgebr2d( ictxt, 'Rowwise', ' ', 1, 1, alpha,
441  $ 1, icurrow, icurcol )
442  CALL dscal( nq-jj+1, alpha, a( i ), desca( lld_ ) )
443  END IF
444  END IF
445  ELSE IF( mycol.EQ.icurcol ) THEN
446  CALL dgebr2d( ictxt, 'Columnwise', ' ', 1, 1, tau( jj ),
447  $ 1, icurrow, icurcol )
448  END IF
449 *
450  ELSE
451 *
452  CALL pdlarfg( m-j+ja, ajj, i, j, a, min( i+1, ia+m-1 ), j,
453  $ desca, 1, tau )
454  IF( j.LT.ja+n-1 ) THEN
455 *
456 * Apply H(i) to A(ia+j-ja:ia+m-1,j+1:ja+n-1) from the left
457 *
458  CALL pdelset( a, i, j, desca, one )
459  CALL pdlarf( 'Left', m-j+ja, ja+n-1-j, a, i, j, desca,
460  $ 1, tau, a, i, j+1, desca, work( ipw ) )
461  END IF
462  CALL pdelset( a, i, j, desca, ajj )
463 *
464  END IF
465 *
466 * Update partial columns norms
467 *
468  IF( mycol.EQ.icurcol )
469  $ jj = jj + 1
470  IF( mod( j, desca( nb_ ) ).EQ.0 )
471  $ icurcol = mod( icurcol+1, npcol )
472  IF( (jja+nq-jj).GT.0 ) THEN
473  IF( myrow.EQ.icurrow ) THEN
474  CALL dgebs2d( ictxt, 'Columnwise', ' ', 1, jja+nq-jj,
475  $ a( ii+( min( jja+nq-1, jj )-1 )*lda ),
476  $ lda )
477  CALL dcopy( jja+nq-jj, a( ii+( min( jja+nq-1, jj )
478  $ -1)*lda ), lda, work( ipw+min( jja+nq-1,
479  $ jj )-1 ), 1 )
480  ELSE
481  CALL dgebr2d( ictxt, 'Columnwise', ' ', jja+nq-jj, 1,
482  $ work( ipw+min( jja+nq-1, jj )-1 ),
483  $ max( 1, nq ), icurrow, mycol )
484  END IF
485  END IF
486 *
487  jn = min( iceil( j+1, desca( nb_ ) ) * desca( nb_ ),
488  $ ja + n - 1 )
489  IF( mycol.EQ.icurcol ) THEN
490  DO 90 ll = jj-1, jj + jn - j - 2
491  IF( work( ipn+ll ).NE.zero ) THEN
492  temp = abs( work( ipw+ll ) ) / work( ipn+ll )
493  temp = max( zero, ( one+temp )*( one-temp ) )
494  temp2 = temp*( work( ipn+ll ) / work( ipn+nq+ll ) )**2
495  IF( temp2.LE.tol3z ) THEN
496  IF( ia+m-1.GT.i ) THEN
497  CALL pdnrm2( ia+m-i-1, work( ipn+ll ), a, i+1,
498  $ j+ll-jj+2, desca, 1 )
499  work( ipn+nq+ll ) = work( ipn+ll )
500  ELSE
501  work( ipn+ll ) = zero
502  work( ipn+nq+ll ) = zero
503  END IF
504  ELSE
505  work( ipn+ll ) = work( ipn+ll ) * sqrt( temp )
506  END IF
507  END IF
508  90 CONTINUE
509  jj = jj + jn - j
510  END IF
511  icurcol = mod( icurcol+1, npcol )
512 *
513  DO 110 k = jn+1, ja+n-1, desca( nb_ )
514  kb = min( ja+n-k, desca( nb_ ) )
515 *
516  IF( mycol.EQ.icurcol ) THEN
517  DO 100 ll = jj-1, jj+kb-2
518  IF( work( ipn+ll ).NE.zero ) THEN
519  temp = abs( work( ipw+ll ) ) / work( ipn+ll )
520  temp = max( zero, ( one+temp )*( one-temp ) )
521  temp2 = temp*
522  $ ( work( ipn+ll ) / work( ipn+nq+ll ) )**2
523  IF( temp2.LE.tol3z ) THEN
524  IF( ia+m-1.GT.i ) THEN
525  CALL pdnrm2( ia+m-i-1, work( ipn+ll ), a,
526  $ i+1, k+ll-jj+1, desca, 1 )
527  work( ipn+nq+ll ) = work( ipn+ll )
528  ELSE
529  work( ipn+ll ) = zero
530  work( ipn+nq+ll ) = zero
531  END IF
532  ELSE
533  work( ipn+ll ) = work( ipn+ll ) * sqrt( temp )
534  END IF
535  END IF
536  100 CONTINUE
537  jj = jj + kb
538  END IF
539  icurcol = mod( icurcol+1, npcol )
540 *
541  110 CONTINUE
542 *
543  120 CONTINUE
544 *
545  work( 1 ) = dble( lwmin )
546 *
547  RETURN
548 *
549 * End of PDGEQPF
550 *
551  END
pdlarf
subroutine pdlarf(SIDE, M, N, V, IV, JV, DESCV, INCV, TAU, C, IC, JC, DESCC, WORK)
Definition: pdlarf.f:3
max
#define max(A, B)
Definition: pcgemr.c:180
infog1l
subroutine infog1l(GINDX, NB, NPROCS, MYROC, ISRCPROC, LINDX, ROCSRC)
Definition: infog1l.f:3
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.f:3
pchk1mat
subroutine pchk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:3
descset
subroutine descset(DESC, M, N, MB, NB, IRSRC, ICSRC, ICTXT, LLD)
Definition: descset.f:3
chk1mat
subroutine chk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, INFO)
Definition: chk1mat.f:3
pdgeqpf
subroutine pdgeqpf(M, N, A, IA, JA, DESCA, IPIV, TAU, WORK, LWORK, INFO)
Definition: pdgeqpf.f:3
pxerbla
subroutine pxerbla(ICTXT, SRNAME, INFO)
Definition: pxerbla.f:2
pdlarfg
subroutine pdlarfg(N, ALPHA, IAX, JAX, X, IX, JX, DESCX, INCX, TAU)
Definition: pdlarfg.f:3
pdelset
subroutine pdelset(A, IA, JA, DESCA, ALPHA)
Definition: pdelset.f:2
min
#define min(A, B)
Definition: pcgemr.c:181