Annotation of rpl/lapack/lapack/zsyconvf.f, revision 1.6

1.1       bertrand    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: *
1.3       bertrand   21: *       SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
1.1       bertrand   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
1.6     ! bertrand   41: *> on exit in parameters A and E. It also converts in place details of
1.1       bertrand   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
1.3       bertrand   48: *> (or ZSYTRF_BK) provided on entry in parameters A and E into
1.1       bertrand   49: *> the factorization output format used in ZSYTRF that is stored
1.6     ! bertrand   50: *> on exit in parameter A. It also converts in place details of
1.1       bertrand   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: *> \ingroup complex16SYcomputational
                    196: *
                    197: *> \par Contributors:
                    198: *  ==================
                    199: *>
                    200: *> \verbatim
                    201: *>
1.3       bertrand  202: *>  November 2017,  Igor Kozachenko,
1.1       bertrand  203: *>                  Computer Science Division,
                    204: *>                  University of California, Berkeley
                    205: *>
                    206: *> \endverbatim
                    207: *  =====================================================================
                    208:       SUBROUTINE ZSYCONVF( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
                    209: *
1.6     ! bertrand  210: *  -- LAPACK computational routine --
1.1       bertrand  211: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    212: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    213: *
                    214: *     .. Scalar Arguments ..
                    215:       CHARACTER          UPLO, WAY
                    216:       INTEGER            INFO, LDA, N
                    217: *     ..
                    218: *     .. Array Arguments ..
                    219:       INTEGER            IPIV( * )
                    220:       COMPLEX*16         A( LDA, * ), E( * )
                    221: *     ..
                    222: *
                    223: *  =====================================================================
                    224: *
                    225: *     .. Parameters ..
                    226:       COMPLEX*16         ZERO
                    227:       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
                    228: *     ..
                    229: *     .. External Functions ..
                    230:       LOGICAL            LSAME
                    231:       EXTERNAL           LSAME
                    232: *
                    233: *     .. External Subroutines ..
                    234:       EXTERNAL           ZSWAP, XERBLA
                    235: *     .. Local Scalars ..
                    236:       LOGICAL            UPPER, CONVERT
                    237:       INTEGER            I, IP
                    238: *     ..
                    239: *     .. Executable Statements ..
                    240: *
                    241:       INFO = 0
                    242:       UPPER = LSAME( UPLO, 'U' )
                    243:       CONVERT = LSAME( WAY, 'C' )
                    244:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    245:          INFO = -1
                    246:       ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
                    247:          INFO = -2
                    248:       ELSE IF( N.LT.0 ) THEN
                    249:          INFO = -3
                    250:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    251:          INFO = -5
                    252: 
                    253:       END IF
                    254:       IF( INFO.NE.0 ) THEN
                    255:          CALL XERBLA( 'ZSYCONVF', -INFO )
                    256:          RETURN
                    257:       END IF
                    258: *
                    259: *     Quick return if possible
                    260: *
                    261:       IF( N.EQ.0 )
                    262:      $   RETURN
                    263: *
                    264:       IF( UPPER ) THEN
                    265: *
                    266: *        Begin A is UPPER
                    267: *
                    268:          IF ( CONVERT ) THEN
                    269: *
                    270: *           Convert A (A is upper)
                    271: *
                    272: *
                    273: *           Convert VALUE
                    274: *
                    275: *           Assign superdiagonal entries of D to array E and zero out
                    276: *           corresponding entries in input storage A
                    277: *
                    278:             I = N
                    279:             E( 1 ) = ZERO
                    280:             DO WHILE ( I.GT.1 )
                    281:                IF( IPIV( I ).LT.0 ) THEN
                    282:                   E( I ) = A( I-1, I )
                    283:                   E( I-1 ) = ZERO
                    284:                   A( I-1, I ) = ZERO
                    285:                   I = I - 1
                    286:                ELSE
                    287:                   E( I ) = ZERO
                    288:                END IF
                    289:                I = I - 1
                    290:             END DO
                    291: *
                    292: *           Convert PERMUTATIONS and IPIV
                    293: *
1.5       bertrand  294: *           Apply permutations to submatrices of upper part of A
1.1       bertrand  295: *           in factorization order where i decreases from N to 1
                    296: *
                    297:             I = N
                    298:             DO WHILE ( I.GE.1 )
                    299:                IF( IPIV( I ).GT.0 ) THEN
                    300: *
                    301: *                 1-by-1 pivot interchange
                    302: *
                    303: *                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
                    304: *
                    305:                   IP = IPIV( I )
                    306:                   IF( I.LT.N ) THEN
                    307:                      IF( IP.NE.I ) THEN
                    308:                         CALL ZSWAP( N-I, A( I, I+1 ), LDA,
                    309:      $                              A( IP, I+1 ), LDA )
                    310:                      END IF
                    311:                   END IF
                    312: *
                    313:                ELSE
                    314: *
                    315: *                 2-by-2 pivot interchange
                    316: *
                    317: *                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
                    318: *
                    319:                   IP = -IPIV( I )
                    320:                   IF( I.LT.N ) THEN
                    321:                      IF( IP.NE.(I-1) ) THEN
                    322:                         CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
                    323:      $                              A( IP, I+1 ), LDA )
                    324:                      END IF
                    325:                   END IF
                    326: *
                    327: *                 Convert IPIV
                    328: *                 There is no interchnge of rows i and and IPIV(i),
                    329: *                 so this should be reflected in IPIV format for
                    330: *                 *SYTRF_RK ( or *SYTRF_BK)
                    331: *
                    332:                   IPIV( I ) = I
                    333: *
                    334:                   I = I - 1
                    335: *
                    336:                END IF
                    337:                I = I - 1
                    338:             END DO
                    339: *
                    340:          ELSE
                    341: *
                    342: *           Revert A (A is upper)
                    343: *
                    344: *
                    345: *           Revert PERMUTATIONS and IPIV
                    346: *
1.5       bertrand  347: *           Apply permutations to submatrices of upper part of A
1.1       bertrand  348: *           in reverse factorization order where i increases from 1 to N
                    349: *
                    350:             I = 1
                    351:             DO WHILE ( I.LE.N )
                    352:                IF( IPIV( I ).GT.0 ) THEN
                    353: *
                    354: *                 1-by-1 pivot interchange
                    355: *
                    356: *                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
                    357: *
                    358:                   IP = IPIV( I )
                    359:                   IF( I.LT.N ) THEN
                    360:                      IF( IP.NE.I ) THEN
                    361:                         CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
                    362:      $                              A( I, I+1 ), LDA )
                    363:                      END IF
                    364:                   END IF
                    365: *
                    366:                ELSE
                    367: *
                    368: *                 2-by-2 pivot interchange
                    369: *
                    370: *                 Swap rows i-1 and IPIV(i) in A(1:i,N-i:N)
                    371: *
                    372:                   I = I + 1
                    373:                   IP = -IPIV( I )
                    374:                   IF( I.LT.N ) THEN
                    375:                      IF( IP.NE.(I-1) ) THEN
                    376:                         CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
                    377:      $                              A( I-1, I+1 ), LDA )
                    378:                      END IF
                    379:                   END IF
                    380: *
                    381: *                 Convert IPIV
                    382: *                 There is one interchange of rows i-1 and IPIV(i-1),
                    383: *                 so this should be recorded in two consecutive entries
                    384: *                 in IPIV format for *SYTRF
                    385: *
                    386:                   IPIV( I ) = IPIV( I-1 )
                    387: *
                    388:                END IF
                    389:                I = I + 1
                    390:             END DO
                    391: *
                    392: *           Revert VALUE
                    393: *           Assign superdiagonal entries of D from array E to
                    394: *           superdiagonal entries of A.
                    395: *
                    396:             I = N
                    397:             DO WHILE ( I.GT.1 )
                    398:                IF( IPIV( I ).LT.0 ) THEN
                    399:                   A( I-1, I ) = E( I )
                    400:                   I = I - 1
                    401:                END IF
                    402:                I = I - 1
                    403:             END DO
                    404: *
                    405: *        End A is UPPER
                    406: *
                    407:          END IF
                    408: *
                    409:       ELSE
                    410: *
                    411: *        Begin A is LOWER
                    412: *
                    413:          IF ( CONVERT ) THEN
                    414: *
                    415: *           Convert A (A is lower)
                    416: *
                    417: *
                    418: *           Convert VALUE
                    419: *           Assign subdiagonal entries of D to array E and zero out
                    420: *           corresponding entries in input storage A
                    421: *
                    422:             I = 1
                    423:             E( N ) = ZERO
                    424:             DO WHILE ( I.LE.N )
                    425:                IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
                    426:                   E( I ) = A( I+1, I )
                    427:                   E( I+1 ) = ZERO
                    428:                   A( I+1, I ) = ZERO
                    429:                   I = I + 1
                    430:                ELSE
                    431:                   E( I ) = ZERO
                    432:                END IF
                    433:                I = I + 1
                    434:             END DO
                    435: *
                    436: *           Convert PERMUTATIONS and IPIV
                    437: *
1.5       bertrand  438: *           Apply permutations to submatrices of lower part of A
1.1       bertrand  439: *           in factorization order where k increases from 1 to N
                    440: *
                    441:             I = 1
                    442:             DO WHILE ( I.LE.N )
                    443:                IF( IPIV( I ).GT.0 ) THEN
                    444: *
                    445: *                 1-by-1 pivot interchange
                    446: *
                    447: *                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
                    448: *
                    449:                   IP = IPIV( I )
                    450:                   IF ( I.GT.1 ) THEN
                    451:                      IF( IP.NE.I ) THEN
                    452:                         CALL ZSWAP( I-1, A( I, 1 ), LDA,
                    453:      $                              A( IP, 1 ), LDA )
                    454:                      END IF
                    455:                   END IF
                    456: *
                    457:                ELSE
                    458: *
                    459: *                 2-by-2 pivot interchange
                    460: *
                    461: *                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
                    462: *
                    463:                   IP = -IPIV( I )
                    464:                   IF ( I.GT.1 ) THEN
                    465:                      IF( IP.NE.(I+1) ) THEN
                    466:                         CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
                    467:      $                              A( IP, 1 ), LDA )
                    468:                      END IF
                    469:                   END IF
                    470: *
                    471: *                 Convert IPIV
                    472: *                 There is no interchnge of rows i and and IPIV(i),
                    473: *                 so this should be reflected in IPIV format for
                    474: *                 *SYTRF_RK ( or *SYTRF_BK)
                    475: *
                    476:                   IPIV( I ) = I
                    477: *
                    478:                   I = I + 1
                    479: *
                    480:                END IF
                    481:                I = I + 1
                    482:             END DO
                    483: *
                    484:          ELSE
                    485: *
                    486: *           Revert A (A is lower)
                    487: *
                    488: *
                    489: *           Revert PERMUTATIONS and IPIV
                    490: *
1.5       bertrand  491: *           Apply permutations to submatrices of lower part of A
1.1       bertrand  492: *           in reverse factorization order where i decreases from N to 1
                    493: *
                    494:             I = N
                    495:             DO WHILE ( I.GE.1 )
                    496:                IF( IPIV( I ).GT.0 ) THEN
                    497: *
                    498: *                 1-by-1 pivot interchange
                    499: *
                    500: *                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
                    501: *
                    502:                   IP = IPIV( I )
                    503:                   IF ( I.GT.1 ) THEN
                    504:                      IF( IP.NE.I ) THEN
                    505:                         CALL ZSWAP( I-1, A( IP, 1 ), LDA,
                    506:      $                              A( I, 1 ), LDA )
                    507:                      END IF
                    508:                   END IF
                    509: *
                    510:                ELSE
                    511: *
                    512: *                 2-by-2 pivot interchange
                    513: *
                    514: *                 Swap rows i+1 and IPIV(i) in A(i:N,1:i-1)
                    515: *
                    516:                   I = I - 1
                    517:                   IP = -IPIV( I )
                    518:                   IF ( I.GT.1 ) THEN
                    519:                      IF( IP.NE.(I+1) ) THEN
                    520:                         CALL ZSWAP( I-1, A( IP, 1 ), LDA,
                    521:      $                              A( I+1, 1 ), LDA )
                    522:                      END IF
                    523:                   END IF
                    524: *
                    525: *                 Convert IPIV
                    526: *                 There is one interchange of rows i+1 and IPIV(i+1),
                    527: *                 so this should be recorded in consecutive entries
                    528: *                 in IPIV format for *SYTRF
                    529: *
                    530:                   IPIV( I ) = IPIV( I+1 )
                    531: *
                    532:                END IF
                    533:                I = I - 1
                    534:             END DO
                    535: *
                    536: *           Revert VALUE
                    537: *           Assign subdiagonal entries of D from array E to
                    538: *           subgiagonal entries of A.
                    539: *
                    540:             I = 1
                    541:             DO WHILE ( I.LE.N-1 )
                    542:                IF( IPIV( I ).LT.0 ) THEN
                    543:                   A( I + 1, I ) = E( I )
                    544:                   I = I + 1
                    545:                END IF
                    546:                I = I + 1
                    547:             END DO
                    548: *
                    549:          END IF
                    550: *
                    551: *        End A is LOWER
                    552: *
                    553:       END IF
                    554: 
                    555:       RETURN
                    556: *
                    557: *     End of ZSYCONVF
                    558: *
                    559:       END

CVSweb interface <joel.bertrand@systella.fr>