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

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: *
                    110: *> \ingroup doubleSYcomputational
                    111: *
                    112: *  =====================================================================
1.9       bertrand  113:       SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
1.1       bertrand  114: *
1.14    ! bertrand  115: *  -- LAPACK computational routine --
1.1       bertrand  116: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    117: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    118: *
                    119: *     .. Scalar Arguments ..
                    120:       CHARACTER          UPLO, WAY
                    121:       INTEGER            INFO, LDA, N
                    122: *     ..
                    123: *     .. Array Arguments ..
                    124:       INTEGER            IPIV( * )
1.9       bertrand  125:       DOUBLE PRECISION   A( LDA, * ), E( * )
1.1       bertrand  126: *     ..
                    127: *
                    128: *  =====================================================================
                    129: *
                    130: *     .. Parameters ..
                    131:       DOUBLE PRECISION   ZERO
                    132:       PARAMETER          ( ZERO = 0.0D+0 )
                    133: *     ..
                    134: *     .. External Functions ..
                    135:       LOGICAL            LSAME
                    136:       EXTERNAL           LSAME
                    137: *
                    138: *     .. External Subroutines ..
                    139:       EXTERNAL           XERBLA
                    140: *     .. Local Scalars ..
                    141:       LOGICAL            UPPER, CONVERT
                    142:       INTEGER            I, IP, J
                    143:       DOUBLE PRECISION   TEMP
                    144: *     ..
                    145: *     .. Executable Statements ..
                    146: *
                    147:       INFO = 0
                    148:       UPPER = LSAME( UPLO, 'U' )
                    149:       CONVERT = LSAME( WAY, 'C' )
                    150:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    151:          INFO = -1
                    152:       ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
                    153:          INFO = -2
                    154:       ELSE IF( N.LT.0 ) THEN
                    155:          INFO = -3
                    156:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    157:          INFO = -5
                    158: 
                    159:       END IF
                    160:       IF( INFO.NE.0 ) THEN
                    161:          CALL XERBLA( 'DSYCONV', -INFO )
                    162:          RETURN
                    163:       END IF
                    164: *
                    165: *     Quick return if possible
                    166: *
                    167:       IF( N.EQ.0 )
                    168:      $   RETURN
                    169: *
                    170:       IF( UPPER ) THEN
                    171: *
                    172: *      A is UPPER
                    173: *
                    174: *      Convert A (A is upper)
                    175: *
                    176: *        Convert VALUE
                    177: *
                    178:          IF ( CONVERT ) THEN
                    179:             I=N
1.9       bertrand  180:             E(1)=ZERO
1.1       bertrand  181:             DO WHILE ( I .GT. 1 )
                    182:                IF( IPIV(I) .LT. 0 ) THEN
1.9       bertrand  183:                   E(I)=A(I-1,I)
                    184:                   E(I-1)=ZERO
1.1       bertrand  185:                   A(I-1,I)=ZERO
                    186:                   I=I-1
                    187:                ELSE
1.9       bertrand  188:                   E(I)=ZERO
1.1       bertrand  189:                ENDIF
                    190:                I=I-1
                    191:             END DO
                    192: *
                    193: *        Convert PERMUTATIONS
1.11      bertrand  194: *
1.1       bertrand  195:          I=N
                    196:          DO WHILE ( I .GE. 1 )
                    197:             IF( IPIV(I) .GT. 0) THEN
                    198:                IP=IPIV(I)
                    199:                IF( I .LT. N) THEN
                    200:                   DO 12 J= I+1,N
                    201:                     TEMP=A(IP,J)
                    202:                     A(IP,J)=A(I,J)
                    203:                     A(I,J)=TEMP
                    204:  12            CONTINUE
                    205:                ENDIF
                    206:             ELSE
                    207:               IP=-IPIV(I)
                    208:                IF( I .LT. N) THEN
                    209:              DO 13 J= I+1,N
                    210:                  TEMP=A(IP,J)
                    211:                  A(IP,J)=A(I-1,J)
                    212:                  A(I-1,J)=TEMP
                    213:  13            CONTINUE
                    214:                 ENDIF
                    215:                 I=I-1
                    216:            ENDIF
                    217:            I=I-1
                    218:         END DO
                    219: 
                    220:          ELSE
                    221: *
                    222: *      Revert A (A is upper)
                    223: *
                    224: *
                    225: *        Revert PERMUTATIONS
1.11      bertrand  226: *
1.1       bertrand  227:             I=1
                    228:             DO WHILE ( I .LE. N )
                    229:                IF( IPIV(I) .GT. 0 ) THEN
                    230:                   IP=IPIV(I)
                    231:                   IF( I .LT. N) THEN
                    232:                   DO J= I+1,N
                    233:                     TEMP=A(IP,J)
                    234:                     A(IP,J)=A(I,J)
                    235:                     A(I,J)=TEMP
                    236:                   END DO
                    237:                   ENDIF
                    238:                ELSE
                    239:                  IP=-IPIV(I)
                    240:                  I=I+1
                    241:                  IF( I .LT. N) THEN
                    242:                     DO J= I+1,N
                    243:                        TEMP=A(IP,J)
                    244:                        A(IP,J)=A(I-1,J)
                    245:                        A(I-1,J)=TEMP
                    246:                     END DO
                    247:                  ENDIF
                    248:                ENDIF
                    249:                I=I+1
                    250:             END DO
                    251: *
                    252: *        Revert VALUE
                    253: *
                    254:             I=N
                    255:             DO WHILE ( I .GT. 1 )
                    256:                IF( IPIV(I) .LT. 0 ) THEN
1.9       bertrand  257:                   A(I-1,I)=E(I)
1.1       bertrand  258:                   I=I-1
                    259:                ENDIF
                    260:                I=I-1
                    261:             END DO
                    262:          END IF
                    263:       ELSE
                    264: *
                    265: *      A is LOWER
                    266: *
                    267:          IF ( CONVERT ) THEN
                    268: *
                    269: *      Convert A (A is lower)
                    270: *
                    271: *
                    272: *        Convert VALUE
                    273: *
                    274:             I=1
1.9       bertrand  275:             E(N)=ZERO
1.1       bertrand  276:             DO WHILE ( I .LE. N )
                    277:                IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
1.9       bertrand  278:                   E(I)=A(I+1,I)
                    279:                   E(I+1)=ZERO
1.1       bertrand  280:                   A(I+1,I)=ZERO
                    281:                   I=I+1
                    282:                ELSE
1.9       bertrand  283:                   E(I)=ZERO
1.1       bertrand  284:                ENDIF
                    285:                I=I+1
                    286:             END DO
                    287: *
                    288: *        Convert PERMUTATIONS
                    289: *
                    290:          I=1
                    291:          DO WHILE ( I .LE. N )
                    292:             IF( IPIV(I) .GT. 0 ) THEN
                    293:                IP=IPIV(I)
                    294:                IF (I .GT. 1) THEN
                    295:                DO 22 J= 1,I-1
                    296:                  TEMP=A(IP,J)
                    297:                  A(IP,J)=A(I,J)
                    298:                  A(I,J)=TEMP
                    299:  22            CONTINUE
                    300:                ENDIF
                    301:             ELSE
                    302:               IP=-IPIV(I)
                    303:               IF (I .GT. 1) THEN
                    304:               DO 23 J= 1,I-1
                    305:                  TEMP=A(IP,J)
                    306:                  A(IP,J)=A(I+1,J)
                    307:                  A(I+1,J)=TEMP
                    308:  23           CONTINUE
                    309:               ENDIF
                    310:               I=I+1
                    311:            ENDIF
                    312:            I=I+1
                    313:         END DO
                    314:          ELSE
                    315: *
                    316: *      Revert A (A is lower)
                    317: *
                    318: *
                    319: *        Revert PERMUTATIONS
                    320: *
                    321:             I=N
                    322:             DO WHILE ( I .GE. 1 )
                    323:                IF( IPIV(I) .GT. 0 ) THEN
                    324:                   IP=IPIV(I)
                    325:                   IF (I .GT. 1) THEN
                    326:                      DO J= 1,I-1
                    327:                         TEMP=A(I,J)
                    328:                         A(I,J)=A(IP,J)
                    329:                         A(IP,J)=TEMP
                    330:                      END DO
                    331:                   ENDIF
                    332:                ELSE
                    333:                   IP=-IPIV(I)
                    334:                   I=I-1
                    335:                   IF (I .GT. 1) THEN
                    336:                      DO J= 1,I-1
                    337:                         TEMP=A(I+1,J)
                    338:                         A(I+1,J)=A(IP,J)
                    339:                         A(IP,J)=TEMP
                    340:                      END DO
                    341:                   ENDIF
                    342:                ENDIF
                    343:                I=I-1
                    344:             END DO
                    345: *
                    346: *        Revert VALUE
                    347: *
                    348:             I=1
                    349:             DO WHILE ( I .LE. N-1 )
1.9       bertrand  350:                IF( IPIV(I) .LT. 0 ) THEN
                    351:                   A(I+1,I)=E(I)
1.1       bertrand  352:                   I=I+1
                    353:                ENDIF
                    354:                I=I+1
                    355:             END DO
                    356:          END IF
                    357:       END IF
                    358: 
                    359:       RETURN
                    360: *
                    361: *     End of DSYCONV
                    362: *
                    363:       END

CVSweb interface <joel.bertrand@systella.fr>