Annotation of rpl/lapack/lapack/dsyconv.f, revision 1.11

1.4       bertrand    1: *> \brief \b DSYCONV
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.11    ! bertrand    5: * Online html documentation available at
        !             6: *            http://www.netlib.org/lapack/explore-html/
1.4       bertrand    7: *
                      8: *> \htmlonly
1.11    ! bertrand    9: *> Download DSYCONV + dependencies
        !            10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyconv.f">
        !            11: *> [TGZ]</a>
        !            12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyconv.f">
        !            13: *> [ZIP]</a>
        !            14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyconv.f">
1.4       bertrand   15: *> [TXT]</a>
1.11    ! bertrand   16: *> \endhtmlonly
1.4       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
1.9       bertrand   21: *       SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
1.11    ! bertrand   22: *
1.4       bertrand   23: *       .. Scalar Arguments ..
                     24: *       CHARACTER          UPLO, WAY
                     25: *       INTEGER            INFO, LDA, N
                     26: *       ..
                     27: *       .. Array Arguments ..
                     28: *       INTEGER            IPIV( * )
1.9       bertrand   29: *       DOUBLE PRECISION   A( LDA, * ), E( * )
1.4       bertrand   30: *       ..
1.11    ! bertrand   31: *
1.4       bertrand   32: *
                     33: *> \par Purpose:
                     34: *  =============
                     35: *>
                     36: *> \verbatim
                     37: *>
                     38: *> DSYCONV convert A given by TRF into L and D and vice-versa.
1.11    ! bertrand   39: *> Get Non-diag elements of D (returned in workspace) and
1.4       bertrand   40: *> apply or reverse permutation done in TRF.
                     41: *> \endverbatim
                     42: *
                     43: *  Arguments:
                     44: *  ==========
                     45: *
                     46: *> \param[in] UPLO
                     47: *> \verbatim
                     48: *>          UPLO is CHARACTER*1
                     49: *>          Specifies whether the details of the factorization are stored
                     50: *>          as an upper or lower triangular matrix.
                     51: *>          = 'U':  Upper triangular, form is A = U*D*U**T;
                     52: *>          = 'L':  Lower triangular, form is A = L*D*L**T.
                     53: *> \endverbatim
                     54: *>
                     55: *> \param[in] WAY
                     56: *> \verbatim
                     57: *>          WAY is CHARACTER*1
1.11    ! bertrand   58: *>          = 'C': Convert
1.4       bertrand   59: *>          = 'R': Revert
                     60: *> \endverbatim
                     61: *>
                     62: *> \param[in] N
                     63: *> \verbatim
                     64: *>          N is INTEGER
                     65: *>          The order of the matrix A.  N >= 0.
                     66: *> \endverbatim
                     67: *>
1.9       bertrand   68: *> \param[in,out] A
1.4       bertrand   69: *> \verbatim
                     70: *>          A is DOUBLE PRECISION array, dimension (LDA,N)
                     71: *>          The block diagonal matrix D and the multipliers used to
                     72: *>          obtain the factor U or L as computed by DSYTRF.
                     73: *> \endverbatim
                     74: *>
                     75: *> \param[in] LDA
                     76: *> \verbatim
                     77: *>          LDA is INTEGER
                     78: *>          The leading dimension of the array A.  LDA >= max(1,N).
                     79: *> \endverbatim
                     80: *>
                     81: *> \param[in] IPIV
                     82: *> \verbatim
                     83: *>          IPIV is INTEGER array, dimension (N)
                     84: *>          Details of the interchanges and the block structure of D
                     85: *>          as determined by DSYTRF.
                     86: *> \endverbatim
                     87: *>
1.9       bertrand   88: *> \param[out] E
1.4       bertrand   89: *> \verbatim
1.9       bertrand   90: *>          E is DOUBLE PRECISION array, dimension (N)
                     91: *>          E stores the supdiagonal/subdiagonal of the symmetric 1-by-1
                     92: *>          or 2-by-2 block diagonal matrix D in LDLT.
1.4       bertrand   93: *> \endverbatim
                     94: *>
                     95: *> \param[out] INFO
                     96: *> \verbatim
                     97: *>          INFO is INTEGER
                     98: *>          = 0:  successful exit
                     99: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
                    100: *> \endverbatim
                    101: *
                    102: *  Authors:
                    103: *  ========
                    104: *
1.11    ! bertrand  105: *> \author Univ. of Tennessee
        !           106: *> \author Univ. of California Berkeley
        !           107: *> \author Univ. of Colorado Denver
        !           108: *> \author NAG Ltd.
1.4       bertrand  109: *
1.11    ! bertrand  110: *> \date December 2016
1.4       bertrand  111: *
                    112: *> \ingroup doubleSYcomputational
                    113: *
                    114: *  =====================================================================
1.9       bertrand  115:       SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
1.1       bertrand  116: *
1.11    ! bertrand  117: *  -- LAPACK computational routine (version 3.7.0) --
1.1       bertrand  118: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    119: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.11    ! bertrand  120: *     December 2016
1.1       bertrand  121: *
                    122: *     .. Scalar Arguments ..
                    123:       CHARACTER          UPLO, WAY
                    124:       INTEGER            INFO, LDA, N
                    125: *     ..
                    126: *     .. Array Arguments ..
                    127:       INTEGER            IPIV( * )
1.9       bertrand  128:       DOUBLE PRECISION   A( LDA, * ), E( * )
1.1       bertrand  129: *     ..
                    130: *
                    131: *  =====================================================================
                    132: *
                    133: *     .. Parameters ..
                    134:       DOUBLE PRECISION   ZERO
                    135:       PARAMETER          ( ZERO = 0.0D+0 )
                    136: *     ..
                    137: *     .. External Functions ..
                    138:       LOGICAL            LSAME
                    139:       EXTERNAL           LSAME
                    140: *
                    141: *     .. External Subroutines ..
                    142:       EXTERNAL           XERBLA
                    143: *     .. Local Scalars ..
                    144:       LOGICAL            UPPER, CONVERT
                    145:       INTEGER            I, IP, J
                    146:       DOUBLE PRECISION   TEMP
                    147: *     ..
                    148: *     .. Executable Statements ..
                    149: *
                    150:       INFO = 0
                    151:       UPPER = LSAME( UPLO, 'U' )
                    152:       CONVERT = LSAME( WAY, 'C' )
                    153:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    154:          INFO = -1
                    155:       ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
                    156:          INFO = -2
                    157:       ELSE IF( N.LT.0 ) THEN
                    158:          INFO = -3
                    159:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    160:          INFO = -5
                    161: 
                    162:       END IF
                    163:       IF( INFO.NE.0 ) THEN
                    164:          CALL XERBLA( 'DSYCONV', -INFO )
                    165:          RETURN
                    166:       END IF
                    167: *
                    168: *     Quick return if possible
                    169: *
                    170:       IF( N.EQ.0 )
                    171:      $   RETURN
                    172: *
                    173:       IF( UPPER ) THEN
                    174: *
                    175: *      A is UPPER
                    176: *
                    177: *      Convert A (A is upper)
                    178: *
                    179: *        Convert VALUE
                    180: *
                    181:          IF ( CONVERT ) THEN
                    182:             I=N
1.9       bertrand  183:             E(1)=ZERO
1.1       bertrand  184:             DO WHILE ( I .GT. 1 )
                    185:                IF( IPIV(I) .LT. 0 ) THEN
1.9       bertrand  186:                   E(I)=A(I-1,I)
                    187:                   E(I-1)=ZERO
1.1       bertrand  188:                   A(I-1,I)=ZERO
                    189:                   I=I-1
                    190:                ELSE
1.9       bertrand  191:                   E(I)=ZERO
1.1       bertrand  192:                ENDIF
                    193:                I=I-1
                    194:             END DO
                    195: *
                    196: *        Convert PERMUTATIONS
1.11    ! bertrand  197: *
1.1       bertrand  198:          I=N
                    199:          DO WHILE ( I .GE. 1 )
                    200:             IF( IPIV(I) .GT. 0) THEN
                    201:                IP=IPIV(I)
                    202:                IF( I .LT. N) THEN
                    203:                   DO 12 J= I+1,N
                    204:                     TEMP=A(IP,J)
                    205:                     A(IP,J)=A(I,J)
                    206:                     A(I,J)=TEMP
                    207:  12            CONTINUE
                    208:                ENDIF
                    209:             ELSE
                    210:               IP=-IPIV(I)
                    211:                IF( I .LT. N) THEN
                    212:              DO 13 J= I+1,N
                    213:                  TEMP=A(IP,J)
                    214:                  A(IP,J)=A(I-1,J)
                    215:                  A(I-1,J)=TEMP
                    216:  13            CONTINUE
                    217:                 ENDIF
                    218:                 I=I-1
                    219:            ENDIF
                    220:            I=I-1
                    221:         END DO
                    222: 
                    223:          ELSE
                    224: *
                    225: *      Revert A (A is upper)
                    226: *
                    227: *
                    228: *        Revert PERMUTATIONS
1.11    ! bertrand  229: *
1.1       bertrand  230:             I=1
                    231:             DO WHILE ( I .LE. N )
                    232:                IF( IPIV(I) .GT. 0 ) THEN
                    233:                   IP=IPIV(I)
                    234:                   IF( I .LT. N) THEN
                    235:                   DO J= I+1,N
                    236:                     TEMP=A(IP,J)
                    237:                     A(IP,J)=A(I,J)
                    238:                     A(I,J)=TEMP
                    239:                   END DO
                    240:                   ENDIF
                    241:                ELSE
                    242:                  IP=-IPIV(I)
                    243:                  I=I+1
                    244:                  IF( I .LT. N) THEN
                    245:                     DO J= I+1,N
                    246:                        TEMP=A(IP,J)
                    247:                        A(IP,J)=A(I-1,J)
                    248:                        A(I-1,J)=TEMP
                    249:                     END DO
                    250:                  ENDIF
                    251:                ENDIF
                    252:                I=I+1
                    253:             END DO
                    254: *
                    255: *        Revert VALUE
                    256: *
                    257:             I=N
                    258:             DO WHILE ( I .GT. 1 )
                    259:                IF( IPIV(I) .LT. 0 ) THEN
1.9       bertrand  260:                   A(I-1,I)=E(I)
1.1       bertrand  261:                   I=I-1
                    262:                ENDIF
                    263:                I=I-1
                    264:             END DO
                    265:          END IF
                    266:       ELSE
                    267: *
                    268: *      A is LOWER
                    269: *
                    270:          IF ( CONVERT ) THEN
                    271: *
                    272: *      Convert A (A is lower)
                    273: *
                    274: *
                    275: *        Convert VALUE
                    276: *
                    277:             I=1
1.9       bertrand  278:             E(N)=ZERO
1.1       bertrand  279:             DO WHILE ( I .LE. N )
                    280:                IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
1.9       bertrand  281:                   E(I)=A(I+1,I)
                    282:                   E(I+1)=ZERO
1.1       bertrand  283:                   A(I+1,I)=ZERO
                    284:                   I=I+1
                    285:                ELSE
1.9       bertrand  286:                   E(I)=ZERO
1.1       bertrand  287:                ENDIF
                    288:                I=I+1
                    289:             END DO
                    290: *
                    291: *        Convert PERMUTATIONS
                    292: *
                    293:          I=1
                    294:          DO WHILE ( I .LE. N )
                    295:             IF( IPIV(I) .GT. 0 ) THEN
                    296:                IP=IPIV(I)
                    297:                IF (I .GT. 1) THEN
                    298:                DO 22 J= 1,I-1
                    299:                  TEMP=A(IP,J)
                    300:                  A(IP,J)=A(I,J)
                    301:                  A(I,J)=TEMP
                    302:  22            CONTINUE
                    303:                ENDIF
                    304:             ELSE
                    305:               IP=-IPIV(I)
                    306:               IF (I .GT. 1) THEN
                    307:               DO 23 J= 1,I-1
                    308:                  TEMP=A(IP,J)
                    309:                  A(IP,J)=A(I+1,J)
                    310:                  A(I+1,J)=TEMP
                    311:  23           CONTINUE
                    312:               ENDIF
                    313:               I=I+1
                    314:            ENDIF
                    315:            I=I+1
                    316:         END DO
                    317:          ELSE
                    318: *
                    319: *      Revert A (A is lower)
                    320: *
                    321: *
                    322: *        Revert PERMUTATIONS
                    323: *
                    324:             I=N
                    325:             DO WHILE ( I .GE. 1 )
                    326:                IF( IPIV(I) .GT. 0 ) THEN
                    327:                   IP=IPIV(I)
                    328:                   IF (I .GT. 1) THEN
                    329:                      DO J= 1,I-1
                    330:                         TEMP=A(I,J)
                    331:                         A(I,J)=A(IP,J)
                    332:                         A(IP,J)=TEMP
                    333:                      END DO
                    334:                   ENDIF
                    335:                ELSE
                    336:                   IP=-IPIV(I)
                    337:                   I=I-1
                    338:                   IF (I .GT. 1) THEN
                    339:                      DO J= 1,I-1
                    340:                         TEMP=A(I+1,J)
                    341:                         A(I+1,J)=A(IP,J)
                    342:                         A(IP,J)=TEMP
                    343:                      END DO
                    344:                   ENDIF
                    345:                ENDIF
                    346:                I=I-1
                    347:             END DO
                    348: *
                    349: *        Revert VALUE
                    350: *
                    351:             I=1
                    352:             DO WHILE ( I .LE. N-1 )
1.9       bertrand  353:                IF( IPIV(I) .LT. 0 ) THEN
                    354:                   A(I+1,I)=E(I)
1.1       bertrand  355:                   I=I+1
                    356:                ENDIF
                    357:                I=I+1
                    358:             END DO
                    359:          END IF
                    360:       END IF
                    361: 
                    362:       RETURN
                    363: *
                    364: *     End of DSYCONV
                    365: *
                    366:       END

CVSweb interface <joel.bertrand@systella.fr>