File:  [local] / rpl / lapack / lapack / zsyconvf.f
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Sat Jun 17 11:07:01 2017 UTC (6 years, 10 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_27, rpl-4_1_26, HEAD
Cohérence.

    1: *> \brief \b ZSYCONVF
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download ZSYCONVF + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          UPLO, WAY
   25: *       INTEGER            INFO, LDA, N
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       INTEGER            IPIV( * )
   29: *       COMPLEX*16         A( LDA, * ), E( * )
   30: *       ..
   31: *
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *> If parameter WAY = 'C':
   38: *> ZSYCONVF converts the factorization output format used in
   39: *> ZSYTRF provided on entry in parameter A into the factorization
   40: *> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
   41: *> on exit in parameters A and E. It also coverts in place details of
   42: *> the intechanges stored in IPIV from the format used in ZSYTRF into
   43: *> the format used in ZSYTRF_RK (or ZSYTRF_BK).
   44: *>
   45: *> If parameter WAY = 'R':
   46: *> ZSYCONVF performs the conversion in reverse direction, i.e.
   47: *> converts the factorization output format used in ZSYTRF_RK
   48: *> (or ZSYTRF_BK) provided on entry in parametes A and E into
   49: *> the factorization output format used in ZSYTRF that is stored
   50: *> on exit in parameter A. It also coverts in place details of
   51: *> the intechanges stored in IPIV from the format used in ZSYTRF_RK
   52: *> (or ZSYTRF_BK) into the format used in ZSYTRF.
   53: *>
   54: *> ZSYCONVF can also convert in Hermitian matrix case, i.e. between
   55: *> formats used in ZHETRF and ZHETRF_RK (or ZHETRF_BK).
   56: *> \endverbatim
   57: *
   58: *  Arguments:
   59: *  ==========
   60: *
   61: *> \param[in] UPLO
   62: *> \verbatim
   63: *>          UPLO is CHARACTER*1
   64: *>          Specifies whether the details of the factorization are
   65: *>          stored as an upper or lower triangular matrix A.
   66: *>          = 'U':  Upper triangular
   67: *>          = 'L':  Lower triangular
   68: *> \endverbatim
   69: *>
   70: *> \param[in] WAY
   71: *> \verbatim
   72: *>          WAY is CHARACTER*1
   73: *>          = 'C': Convert
   74: *>          = 'R': Revert
   75: *> \endverbatim
   76: *>
   77: *> \param[in] N
   78: *> \verbatim
   79: *>          N is INTEGER
   80: *>          The order of the matrix A.  N >= 0.
   81: *> \endverbatim
   82: *>
   83: *> \param[in,out] A
   84: *> \verbatim
   85: *>          A is COMPLEX*16 array, dimension (LDA,N)
   86: *>
   87: *>          1) If WAY ='C':
   88: *>
   89: *>          On entry, contains factorization details in format used in
   90: *>          ZSYTRF:
   91: *>            a) all elements of the symmetric block diagonal
   92: *>               matrix D on the diagonal of A and on superdiagonal
   93: *>               (or subdiagonal) of A, and
   94: *>            b) If UPLO = 'U': multipliers used to obtain factor U
   95: *>               in the superdiagonal part of A.
   96: *>               If UPLO = 'L': multipliers used to obtain factor L
   97: *>               in the superdiagonal part of A.
   98: *>
   99: *>          On exit, contains factorization details in format used in
  100: *>          ZSYTRF_RK or ZSYTRF_BK:
  101: *>            a) ONLY diagonal elements of the symmetric block diagonal
  102: *>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
  103: *>               (superdiagonal (or subdiagonal) elements of D
  104: *>                are stored on exit in array E), and
  105: *>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
  106: *>               If UPLO = 'L': factor L in the subdiagonal part of A.
  107: *>
  108: *>          2) If WAY = 'R':
  109: *>
  110: *>          On entry, contains factorization details in format used in
  111: *>          ZSYTRF_RK or ZSYTRF_BK:
  112: *>            a) ONLY diagonal elements of the symmetric block diagonal
  113: *>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
  114: *>               (superdiagonal (or subdiagonal) elements of D
  115: *>                are stored on exit in array E), and
  116: *>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
  117: *>               If UPLO = 'L': factor L in the subdiagonal part of A.
  118: *>
  119: *>          On exit, contains factorization details in format used in
  120: *>          ZSYTRF:
  121: *>            a) all elements of the symmetric block diagonal
  122: *>               matrix D on the diagonal of A and on superdiagonal
  123: *>               (or subdiagonal) of A, and
  124: *>            b) If UPLO = 'U': multipliers used to obtain factor U
  125: *>               in the superdiagonal part of A.
  126: *>               If UPLO = 'L': multipliers used to obtain factor L
  127: *>               in the superdiagonal part of A.
  128: *> \endverbatim
  129: *>
  130: *> \param[in] LDA
  131: *> \verbatim
  132: *>          LDA is INTEGER
  133: *>          The leading dimension of the array A.  LDA >= max(1,N).
  134: *> \endverbatim
  135: *>
  136: *> \param[in,out] E
  137: *> \verbatim
  138: *>          E is COMPLEX*16 array, dimension (N)
  139: *>
  140: *>          1) If WAY ='C':
  141: *>
  142: *>          On entry, just a workspace.
  143: *>
  144: *>          On exit, contains the superdiagonal (or subdiagonal)
  145: *>          elements of the symmetric block diagonal matrix D
  146: *>          with 1-by-1 or 2-by-2 diagonal blocks, where
  147: *>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
  148: *>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
  149: *>
  150: *>          2) If WAY = 'R':
  151: *>
  152: *>          On entry, contains the superdiagonal (or subdiagonal)
  153: *>          elements of the symmetric block diagonal matrix D
  154: *>          with 1-by-1 or 2-by-2 diagonal blocks, where
  155: *>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
  156: *>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
  157: *>
  158: *>          On exit, is not changed
  159: *> \endverbatim
  160: *.
  161: *> \param[in,out] IPIV
  162: *> \verbatim
  163: *>          IPIV is INTEGER array, dimension (N)
  164: *>
  165: *>          1) If WAY ='C':
  166: *>          On entry, details of the interchanges and the block
  167: *>          structure of D in the format used in ZSYTRF.
  168: *>          On exit, details of the interchanges and the block
  169: *>          structure of D in the format used in ZSYTRF_RK
  170: *>          ( or ZSYTRF_BK).
  171: *>
  172: *>          1) If WAY ='R':
  173: *>          On entry, details of the interchanges and the block
  174: *>          structure of D in the format used in ZSYTRF_RK
  175: *>          ( or ZSYTRF_BK).
  176: *>          On exit, details of the interchanges and the block
  177: *>          structure of D in the format used in ZSYTRF.
  178: *> \endverbatim
  179: *>
  180: *> \param[out] INFO
  181: *> \verbatim
  182: *>          INFO is INTEGER
  183: *>          = 0:  successful exit
  184: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  185: *> \endverbatim
  186: *
  187: *  Authors:
  188: *  ========
  189: *
  190: *> \author Univ. of Tennessee
  191: *> \author Univ. of California Berkeley
  192: *> \author Univ. of Colorado Denver
  193: *> \author NAG Ltd.
  194: *
  195: *> \date December 2016
  196: *
  197: *> \ingroup complex16SYcomputational
  198: *
  199: *> \par Contributors:
  200: *  ==================
  201: *>
  202: *> \verbatim
  203: *>
  204: *>  December 2016,  Igor Kozachenko,
  205: *>                  Computer Science Division,
  206: *>                  University of California, Berkeley
  207: *>
  208: *> \endverbatim
  209: *  =====================================================================
  210:       SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
  211: *
  212: *  -- LAPACK computational routine (version 3.7.0) --
  213: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  214: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  215: *     December 2016
  216: *
  217: *     .. Scalar Arguments ..
  218:       CHARACTER          UPLO, WAY
  219:       INTEGER            INFO, LDA, N
  220: *     ..
  221: *     .. Array Arguments ..
  222:       INTEGER            IPIV( * )
  223:       COMPLEX*16         A( LDA, * ), E( * )
  224: *     ..
  225: *
  226: *  =====================================================================
  227: *
  228: *     .. Parameters ..
  229:       COMPLEX*16         ZERO
  230:       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
  231: *     ..
  232: *     .. External Functions ..
  233:       LOGICAL            LSAME
  234:       EXTERNAL           LSAME
  235: *
  236: *     .. External Subroutines ..
  237:       EXTERNAL           ZSWAP, XERBLA
  238: *     .. Local Scalars ..
  239:       LOGICAL            UPPER, CONVERT
  240:       INTEGER            I, IP
  241: *     ..
  242: *     .. Executable Statements ..
  243: *
  244:       INFO = 0
  245:       UPPER = LSAME( UPLO, 'U' )
  246:       CONVERT = LSAME( WAY, 'C' )
  247:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  248:          INFO = -1
  249:       ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
  250:          INFO = -2
  251:       ELSE IF( N.LT.0 ) THEN
  252:          INFO = -3
  253:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  254:          INFO = -5
  255: 
  256:       END IF
  257:       IF( INFO.NE.0 ) THEN
  258:          CALL XERBLA( 'ZSYCONVF', -INFO )
  259:          RETURN
  260:       END IF
  261: *
  262: *     Quick return if possible
  263: *
  264:       IF( N.EQ.0 )
  265:      $   RETURN
  266: *
  267:       IF( UPPER ) THEN
  268: *
  269: *        Begin A is UPPER
  270: *
  271:          IF ( CONVERT ) THEN
  272: *
  273: *           Convert A (A is upper)
  274: *
  275: *
  276: *           Convert VALUE
  277: *
  278: *           Assign superdiagonal entries of D to array E and zero out
  279: *           corresponding entries in input storage A
  280: *
  281:             I = N
  282:             E( 1 ) = ZERO
  283:             DO WHILE ( I.GT.1 )
  284:                IF( IPIV( I ).LT.0 ) THEN
  285:                   E( I ) = A( I-1, I )
  286:                   E( I-1 ) = ZERO
  287:                   A( I-1, I ) = ZERO
  288:                   I = I - 1
  289:                ELSE
  290:                   E( I ) = ZERO
  291:                END IF
  292:                I = I - 1
  293:             END DO
  294: *
  295: *           Convert PERMUTATIONS and IPIV
  296: *
  297: *           Apply permutaions to submatrices of upper part of A
  298: *           in factorization order where i decreases from N to 1
  299: *
  300:             I = N
  301:             DO WHILE ( I.GE.1 )
  302:                IF( IPIV( I ).GT.0 ) THEN
  303: *
  304: *                 1-by-1 pivot interchange
  305: *
  306: *                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
  307: *
  308:                   IP = IPIV( I )
  309:                   IF( I.LT.N ) THEN
  310:                      IF( IP.NE.I ) THEN
  311:                         CALL ZSWAP( N-I, A( I, I+1 ), LDA,
  312:      $                              A( IP, I+1 ), LDA )
  313:                      END IF
  314:                   END IF
  315: *
  316:                ELSE
  317: *
  318: *                 2-by-2 pivot interchange
  319: *
  320: *                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
  321: *
  322:                   IP = -IPIV( I )
  323:                   IF( I.LT.N ) THEN
  324:                      IF( IP.NE.(I-1) ) THEN
  325:                         CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
  326:      $                              A( IP, I+1 ), LDA )
  327:                      END IF
  328:                   END IF
  329: *
  330: *                 Convert IPIV
  331: *                 There is no interchnge of rows i and and IPIV(i),
  332: *                 so this should be reflected in IPIV format for
  333: *                 *SYTRF_RK ( or *SYTRF_BK)
  334: *
  335:                   IPIV( I ) = I
  336: *
  337:                   I = I - 1
  338: *
  339:                END IF
  340:                I = I - 1
  341:             END DO
  342: *
  343:          ELSE
  344: *
  345: *           Revert A (A is upper)
  346: *
  347: *
  348: *           Revert PERMUTATIONS and IPIV
  349: *
  350: *           Apply permutaions to submatrices of upper part of A
  351: *           in reverse factorization order where i increases from 1 to N
  352: *
  353:             I = 1
  354:             DO WHILE ( I.LE.N )
  355:                IF( IPIV( I ).GT.0 ) THEN
  356: *
  357: *                 1-by-1 pivot interchange
  358: *
  359: *                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
  360: *
  361:                   IP = IPIV( I )
  362:                   IF( I.LT.N ) THEN
  363:                      IF( IP.NE.I ) THEN
  364:                         CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
  365:      $                              A( I, I+1 ), LDA )
  366:                      END IF
  367:                   END IF
  368: *
  369:                ELSE
  370: *
  371: *                 2-by-2 pivot interchange
  372: *
  373: *                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
  374: *
  375:                   I = I + 1
  376:                   IP = -IPIV( I )
  377:                   IF( I.LT.N ) THEN
  378:                      IF( IP.NE.(I-1) ) THEN
  379:                         CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
  380:      $                              A( I-1, I+1 ), LDA )
  381:                      END IF
  382:                   END IF
  383: *
  384: *                 Convert IPIV
  385: *                 There is one interchange of rows i-1 and IPIV(i-1),
  386: *                 so this should be recorded in two consecutive entries
  387: *                 in IPIV format for *SYTRF
  388: *
  389:                   IPIV( I ) = IPIV( I-1 )
  390: *
  391:                END IF
  392:                I = I + 1
  393:             END DO
  394: *
  395: *           Revert VALUE
  396: *           Assign superdiagonal entries of D from array E to
  397: *           superdiagonal entries of A.
  398: *
  399:             I = N
  400:             DO WHILE ( I.GT.1 )
  401:                IF( IPIV( I ).LT.0 ) THEN
  402:                   A( I-1, I ) = E( I )
  403:                   I = I - 1
  404:                END IF
  405:                I = I - 1
  406:             END DO
  407: *
  408: *        End A is UPPER
  409: *
  410:          END IF
  411: *
  412:       ELSE
  413: *
  414: *        Begin A is LOWER
  415: *
  416:          IF ( CONVERT ) THEN
  417: *
  418: *           Convert A (A is lower)
  419: *
  420: *
  421: *           Convert VALUE
  422: *           Assign subdiagonal entries of D to array E and zero out
  423: *           corresponding entries in input storage A
  424: *
  425:             I = 1
  426:             E( N ) = ZERO
  427:             DO WHILE ( I.LE.N )
  428:                IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
  429:                   E( I ) = A( I+1, I )
  430:                   E( I+1 ) = ZERO
  431:                   A( I+1, I ) = ZERO
  432:                   I = I + 1
  433:                ELSE
  434:                   E( I ) = ZERO
  435:                END IF
  436:                I = I + 1
  437:             END DO
  438: *
  439: *           Convert PERMUTATIONS and IPIV
  440: *
  441: *           Apply permutaions to submatrices of lower part of A
  442: *           in factorization order where k increases from 1 to N
  443: *
  444:             I = 1
  445:             DO WHILE ( I.LE.N )
  446:                IF( IPIV( I ).GT.0 ) THEN
  447: *
  448: *                 1-by-1 pivot interchange
  449: *
  450: *                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
  451: *
  452:                   IP = IPIV( I )
  453:                   IF ( I.GT.1 ) THEN
  454:                      IF( IP.NE.I ) THEN
  455:                         CALL ZSWAP( I-1, A( I, 1 ), LDA,
  456:      $                              A( IP, 1 ), LDA )
  457:                      END IF
  458:                   END IF
  459: *
  460:                ELSE
  461: *
  462: *                 2-by-2 pivot interchange
  463: *
  464: *                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
  465: *
  466:                   IP = -IPIV( I )
  467:                   IF ( I.GT.1 ) THEN
  468:                      IF( IP.NE.(I+1) ) THEN
  469:                         CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
  470:      $                              A( IP, 1 ), LDA )
  471:                      END IF
  472:                   END IF
  473: *
  474: *                 Convert IPIV
  475: *                 There is no interchnge of rows i and and IPIV(i),
  476: *                 so this should be reflected in IPIV format for
  477: *                 *SYTRF_RK ( or *SYTRF_BK)
  478: *
  479:                   IPIV( I ) = I
  480: *
  481:                   I = I + 1
  482: *
  483:                END IF
  484:                I = I + 1
  485:             END DO
  486: *
  487:          ELSE
  488: *
  489: *           Revert A (A is lower)
  490: *
  491: *
  492: *           Revert PERMUTATIONS and IPIV
  493: *
  494: *           Apply permutaions to submatrices of lower part of A
  495: *           in reverse factorization order where i decreases from N to 1
  496: *
  497:             I = N
  498:             DO WHILE ( I.GE.1 )
  499:                IF( IPIV( I ).GT.0 ) THEN
  500: *
  501: *                 1-by-1 pivot interchange
  502: *
  503: *                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
  504: *
  505:                   IP = IPIV( I )
  506:                   IF ( I.GT.1 ) THEN
  507:                      IF( IP.NE.I ) THEN
  508:                         CALL ZSWAP( I-1, A( IP, 1 ), LDA,
  509:      $                              A( I, 1 ), LDA )
  510:                      END IF
  511:                   END IF
  512: *
  513:                ELSE
  514: *
  515: *                 2-by-2 pivot interchange
  516: *
  517: *                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
  518: *
  519:                   I = I - 1
  520:                   IP = -IPIV( I )
  521:                   IF ( I.GT.1 ) THEN
  522:                      IF( IP.NE.(I+1) ) THEN
  523:                         CALL ZSWAP( I-1, A( IP, 1 ), LDA,
  524:      $                              A( I+1, 1 ), LDA )
  525:                      END IF
  526:                   END IF
  527: *
  528: *                 Convert IPIV
  529: *                 There is one interchange of rows i+1 and IPIV(i+1),
  530: *                 so this should be recorded in consecutive entries
  531: *                 in IPIV format for *SYTRF
  532: *
  533:                   IPIV( I ) = IPIV( I+1 )
  534: *
  535:                END IF
  536:                I = I - 1
  537:             END DO
  538: *
  539: *           Revert VALUE
  540: *           Assign subdiagonal entries of D from array E to
  541: *           subgiagonal entries of A.
  542: *
  543:             I = 1
  544:             DO WHILE ( I.LE.N-1 )
  545:                IF( IPIV( I ).LT.0 ) THEN
  546:                   A( I + 1, I ) = E( I )
  547:                   I = I + 1
  548:                END IF
  549:                I = I + 1
  550:             END DO
  551: *
  552:          END IF
  553: *
  554: *        End A is LOWER
  555: *
  556:       END IF
  557: 
  558:       RETURN
  559: *
  560: *     End of ZSYCONVF
  561: *
  562:       END

CVSweb interface <joel.bertrand@systella.fr>