LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ dsyconvf_rook()

subroutine dsyconvf_rook ( character  UPLO,
character  WAY,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  E,
integer, dimension( * )  IPIV,
integer  INFO 
)

DSYCONVF_ROOK

Download DSYCONVF_ROOK + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 If parameter WAY = 'C':
 DSYCONVF_ROOK converts the factorization output format used in
 DSYTRF_ROOK provided on entry in parameter A into the factorization
 output format used in DSYTRF_RK (or DSYTRF_BK) that is stored
 on exit in parameters A and E. IPIV format for DSYTRF_ROOK and
 DSYTRF_RK (or DSYTRF_BK) is the same and is not converted.

 If parameter WAY = 'R':
 DSYCONVF_ROOK performs the conversion in reverse direction, i.e.
 converts the factorization output format used in DSYTRF_RK
 (or DSYTRF_BK) provided on entry in parameters A and E into
 the factorization output format used in DSYTRF_ROOK that is stored
 on exit in parameter A. IPIV format for DSYTRF_ROOK and
 DSYTRF_RK (or DSYTRF_BK) is the same and is not converted.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the details of the factorization are
          stored as an upper or lower triangular matrix A.
          = 'U':  Upper triangular
          = 'L':  Lower triangular
[in]WAY
          WAY is CHARACTER*1
          = 'C': Convert
          = 'R': Revert
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA,N)

          1) If WAY ='C':

          On entry, contains factorization details in format used in
          DSYTRF_ROOK:
            a) all elements of the symmetric block diagonal
               matrix D on the diagonal of A and on superdiagonal
               (or subdiagonal) of A, and
            b) If UPLO = 'U': multipliers used to obtain factor U
               in the superdiagonal part of A.
               If UPLO = 'L': multipliers used to obtain factor L
               in the superdiagonal part of A.

          On exit, contains factorization details in format used in
          DSYTRF_RK or DSYTRF_BK:
            a) ONLY diagonal elements of the symmetric block diagonal
               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
               (superdiagonal (or subdiagonal) elements of D
                are stored on exit in array E), and
            b) If UPLO = 'U': factor U in the superdiagonal part of A.
               If UPLO = 'L': factor L in the subdiagonal part of A.

          2) If WAY = 'R':

          On entry, contains factorization details in format used in
          DSYTRF_RK or DSYTRF_BK:
            a) ONLY diagonal elements of the symmetric block diagonal
               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
               (superdiagonal (or subdiagonal) elements of D
                are stored on exit in array E), and
            b) If UPLO = 'U': factor U in the superdiagonal part of A.
               If UPLO = 'L': factor L in the subdiagonal part of A.

          On exit, contains factorization details in format used in
          DSYTRF_ROOK:
            a) all elements of the symmetric block diagonal
               matrix D on the diagonal of A and on superdiagonal
               (or subdiagonal) of A, and
            b) If UPLO = 'U': multipliers used to obtain factor U
               in the superdiagonal part of A.
               If UPLO = 'L': multipliers used to obtain factor L
               in the superdiagonal part of A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[in,out]E
          E is DOUBLE PRECISION array, dimension (N)

          1) If WAY ='C':

          On entry, just a workspace.

          On exit, contains the superdiagonal (or subdiagonal)
          elements of the symmetric block diagonal matrix D
          with 1-by-1 or 2-by-2 diagonal blocks, where
          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.

          2) If WAY = 'R':

          On entry, contains the superdiagonal (or subdiagonal)
          elements of the symmetric block diagonal matrix D
          with 1-by-1 or 2-by-2 diagonal blocks, where
          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.

          On exit, is not changed
[in]IPIV
          IPIV is INTEGER array, dimension (N)
          On entry, details of the interchanges and the block
          structure of D as determined:
          1) by DSYTRF_ROOK, if WAY ='C';
          2) by DSYTRF_RK (or DSYTRF_BK), if WAY ='R'.
          The IPIV format is the same for all these routines.

          On exit, is not changed.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2017
Contributors:
  November 2017,  Igor Kozachenko,
                  Computer Science Division,
                  University of California, Berkeley

Definition at line 199 of file dsyconvf_rook.f.

199 *
200 * -- LAPACK computational routine (version 3.8.0) --
201 * -- LAPACK is a software package provided by Univ. of Tennessee, --
202 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
203 * November 2017
204 *
205 * .. Scalar Arguments ..
206  CHARACTER uplo, way
207  INTEGER info, lda, n
208 * ..
209 * .. Array Arguments ..
210  INTEGER ipiv( * )
211  DOUBLE PRECISION a( lda, * ), e( * )
212 * ..
213 *
214 * =====================================================================
215 *
216 * .. Parameters ..
217  DOUBLE PRECISION zero
218  parameter( zero = 0.0d+0 )
219 * ..
220 * .. External Functions ..
221  LOGICAL lsame
222  EXTERNAL lsame
223 *
224 * .. External Subroutines ..
225  EXTERNAL dswap, xerbla
226 * .. Local Scalars ..
227  LOGICAL upper, convert
228  INTEGER i, ip, ip2
229 * ..
230 * .. Executable Statements ..
231 *
232  info = 0
233  upper = lsame( uplo, 'U' )
234  convert = lsame( way, 'C' )
235  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
236  info = -1
237  ELSE IF( .NOT.convert .AND. .NOT.lsame( way, 'R' ) ) THEN
238  info = -2
239  ELSE IF( n.LT.0 ) THEN
240  info = -3
241  ELSE IF( lda.LT.max( 1, n ) ) THEN
242  info = -5
243 
244  END IF
245  IF( info.NE.0 ) THEN
246  CALL xerbla( 'DSYCONVF_ROOK', -info )
247  RETURN
248  END IF
249 *
250 * Quick return if possible
251 *
252  IF( n.EQ.0 )
253  $ RETURN
254 *
255  IF( upper ) THEN
256 *
257 * Begin A is UPPER
258 *
259  IF ( convert ) THEN
260 *
261 * Convert A (A is upper)
262 *
263 *
264 * Convert VALUE
265 *
266 * Assign superdiagonal entries of D to array E and zero out
267 * corresponding entries in input storage A
268 *
269  i = n
270  e( 1 ) = zero
271  DO WHILE ( i.GT.1 )
272  IF( ipiv( i ).LT.0 ) THEN
273  e( i ) = a( i-1, i )
274  e( i-1 ) = zero
275  a( i-1, i ) = zero
276  i = i - 1
277  ELSE
278  e( i ) = zero
279  END IF
280  i = i - 1
281  END DO
282 *
283 * Convert PERMUTATIONS
284 *
285 * Apply permutaions to submatrices of upper part of A
286 * in factorization order where i decreases from N to 1
287 *
288  i = n
289  DO WHILE ( i.GE.1 )
290  IF( ipiv( i ).GT.0 ) THEN
291 *
292 * 1-by-1 pivot interchange
293 *
294 * Swap rows i and IPIV(i) in A(1:i,N-i:N)
295 *
296  ip = ipiv( i )
297  IF( i.LT.n ) THEN
298  IF( ip.NE.i ) THEN
299  CALL dswap( n-i, a( i, i+1 ), lda,
300  $ a( ip, i+1 ), lda )
301  END IF
302  END IF
303 *
304  ELSE
305 *
306 * 2-by-2 pivot interchange
307 *
308 * Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
309 * in A(1:i,N-i:N)
310 *
311  ip = -ipiv( i )
312  ip2 = -ipiv( i-1 )
313  IF( i.LT.n ) THEN
314  IF( ip.NE.i ) THEN
315  CALL dswap( n-i, a( i, i+1 ), lda,
316  $ a( ip, i+1 ), lda )
317  END IF
318  IF( ip2.NE.(i-1) ) THEN
319  CALL dswap( n-i, a( i-1, i+1 ), lda,
320  $ a( ip2, i+1 ), lda )
321  END IF
322  END IF
323  i = i - 1
324 *
325  END IF
326  i = i - 1
327  END DO
328 *
329  ELSE
330 *
331 * Revert A (A is upper)
332 *
333 *
334 * Revert PERMUTATIONS
335 *
336 * Apply permutaions to submatrices of upper part of A
337 * in reverse factorization order where i increases from 1 to N
338 *
339  i = 1
340  DO WHILE ( i.LE.n )
341  IF( ipiv( i ).GT.0 ) THEN
342 *
343 * 1-by-1 pivot interchange
344 *
345 * Swap rows i and IPIV(i) in A(1:i,N-i:N)
346 *
347  ip = ipiv( i )
348  IF( i.LT.n ) THEN
349  IF( ip.NE.i ) THEN
350  CALL dswap( n-i, a( ip, i+1 ), lda,
351  $ a( i, i+1 ), lda )
352  END IF
353  END IF
354 *
355  ELSE
356 *
357 * 2-by-2 pivot interchange
358 *
359 * Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
360 * in A(1:i,N-i:N)
361 *
362  i = i + 1
363  ip = -ipiv( i )
364  ip2 = -ipiv( i-1 )
365  IF( i.LT.n ) THEN
366  IF( ip2.NE.(i-1) ) THEN
367  CALL dswap( n-i, a( ip2, i+1 ), lda,
368  $ a( i-1, i+1 ), lda )
369  END IF
370  IF( ip.NE.i ) THEN
371  CALL dswap( n-i, a( ip, i+1 ), lda,
372  $ a( i, i+1 ), lda )
373  END IF
374  END IF
375 *
376  END IF
377  i = i + 1
378  END DO
379 *
380 * Revert VALUE
381 * Assign superdiagonal entries of D from array E to
382 * superdiagonal entries of A.
383 *
384  i = n
385  DO WHILE ( i.GT.1 )
386  IF( ipiv( i ).LT.0 ) THEN
387  a( i-1, i ) = e( i )
388  i = i - 1
389  END IF
390  i = i - 1
391  END DO
392 *
393 * End A is UPPER
394 *
395  END IF
396 *
397  ELSE
398 *
399 * Begin A is LOWER
400 *
401  IF ( convert ) THEN
402 *
403 * Convert A (A is lower)
404 *
405 *
406 * Convert VALUE
407 * Assign subdiagonal entries of D to array E and zero out
408 * corresponding entries in input storage A
409 *
410  i = 1
411  e( n ) = zero
412  DO WHILE ( i.LE.n )
413  IF( i.LT.n .AND. ipiv(i).LT.0 ) THEN
414  e( i ) = a( i+1, i )
415  e( i+1 ) = zero
416  a( i+1, i ) = zero
417  i = i + 1
418  ELSE
419  e( i ) = zero
420  END IF
421  i = i + 1
422  END DO
423 *
424 * Convert PERMUTATIONS
425 *
426 * Apply permutaions to submatrices of lower part of A
427 * in factorization order where i increases from 1 to N
428 *
429  i = 1
430  DO WHILE ( i.LE.n )
431  IF( ipiv( i ).GT.0 ) THEN
432 *
433 * 1-by-1 pivot interchange
434 *
435 * Swap rows i and IPIV(i) in A(i:N,1:i-1)
436 *
437  ip = ipiv( i )
438  IF ( i.GT.1 ) THEN
439  IF( ip.NE.i ) THEN
440  CALL dswap( i-1, a( i, 1 ), lda,
441  $ a( ip, 1 ), lda )
442  END IF
443  END IF
444 *
445  ELSE
446 *
447 * 2-by-2 pivot interchange
448 *
449 * Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
450 * in A(i:N,1:i-1)
451 *
452  ip = -ipiv( i )
453  ip2 = -ipiv( i+1 )
454  IF ( i.GT.1 ) THEN
455  IF( ip.NE.i ) THEN
456  CALL dswap( i-1, a( i, 1 ), lda,
457  $ a( ip, 1 ), lda )
458  END IF
459  IF( ip2.NE.(i+1) ) THEN
460  CALL dswap( i-1, a( i+1, 1 ), lda,
461  $ a( ip2, 1 ), lda )
462  END IF
463  END IF
464  i = i + 1
465 *
466  END IF
467  i = i + 1
468  END DO
469 *
470  ELSE
471 *
472 * Revert A (A is lower)
473 *
474 *
475 * Revert PERMUTATIONS
476 *
477 * Apply permutaions to submatrices of lower part of A
478 * in reverse factorization order where i decreases from N to 1
479 *
480  i = n
481  DO WHILE ( i.GE.1 )
482  IF( ipiv( i ).GT.0 ) THEN
483 *
484 * 1-by-1 pivot interchange
485 *
486 * Swap rows i and IPIV(i) in A(i:N,1:i-1)
487 *
488  ip = ipiv( i )
489  IF ( i.GT.1 ) THEN
490  IF( ip.NE.i ) THEN
491  CALL dswap( i-1, a( ip, 1 ), lda,
492  $ a( i, 1 ), lda )
493  END IF
494  END IF
495 *
496  ELSE
497 *
498 * 2-by-2 pivot interchange
499 *
500 * Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
501 * in A(i:N,1:i-1)
502 *
503  i = i - 1
504  ip = -ipiv( i )
505  ip2 = -ipiv( i+1 )
506  IF ( i.GT.1 ) THEN
507  IF( ip2.NE.(i+1) ) THEN
508  CALL dswap( i-1, a( ip2, 1 ), lda,
509  $ a( i+1, 1 ), lda )
510  END IF
511  IF( ip.NE.i ) THEN
512  CALL dswap( i-1, a( ip, 1 ), lda,
513  $ a( i, 1 ), lda )
514  END IF
515  END IF
516 *
517  END IF
518  i = i - 1
519  END DO
520 *
521 * Revert VALUE
522 * Assign subdiagonal entries of D from array E to
523 * subgiagonal entries of A.
524 *
525  i = 1
526  DO WHILE ( i.LE.n-1 )
527  IF( ipiv( i ).LT.0 ) THEN
528  a( i + 1, i ) = e( i )
529  i = i + 1
530  END IF
531  i = i + 1
532  END DO
533 *
534  END IF
535 *
536 * End A is LOWER
537 *
538  END IF
539 
540  RETURN
541 *
542 * End of DSYCONVF_ROOK
543 *
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:84
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
Here is the call graph for this function:
Here is the caller graph for this function: