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

1.4       bertrand    1: *> \brief \b ZSYCONV
                      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 ZSYCONV + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconv.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconv.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconv.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 ZSYCONV( 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: *       COMPLEX*16         A( LDA, * ), E( * )
1.4       bertrand   30: *       ..
1.11      bertrand   31: *
1.4       bertrand   32: *
                     33: *> \par Purpose:
                     34: *  =============
                     35: *>
                     36: *> \verbatim
                     37: *>
                     38: *> ZSYCONV converts A given by ZHETRF into L and D or vice-versa.
1.11      bertrand   39: *> Get nondiagonal 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 COMPLEX*16 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 ZSYTRF.
                     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 ZSYTRF.
                     86: *> \endverbatim
                     87: *>
1.9       bertrand   88: *> \param[out] E
1.4       bertrand   89: *> \verbatim
1.9       bertrand   90: *>          E is COMPLEX*16 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 complex16SYcomputational
1.1       bertrand  111: *
1.4       bertrand  112: *  =====================================================================
1.9       bertrand  113:       SUBROUTINE ZSYCONV( 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:       COMPLEX*16         A( LDA, * ), E( * )
1.1       bertrand  126: *     ..
                    127: *
                    128: *  =====================================================================
                    129: *
                    130: *     .. Parameters ..
1.4       bertrand  131:       COMPLEX*16         ZERO
1.1       bertrand  132:       PARAMETER          ( ZERO = (0.0D+0,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
1.4       bertrand  143:       COMPLEX*16         TEMP
1.1       bertrand  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( 'ZSYCONV', -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:          IF ( CONVERT ) THEN
                    175: *
                    176: *           Convert A (A is upper)
                    177: *
                    178: *           Convert VALUE
                    179: *
                    180:             I=N
1.9       bertrand  181:             E(1)=ZERO
1.1       bertrand  182:             DO WHILE ( I .GT. 1 )
                    183:                IF( IPIV(I) .LT. 0 ) THEN
1.9       bertrand  184:                   E(I)=A(I-1,I)
                    185:                   E(I-1)=ZERO
1.1       bertrand  186:                   A(I-1,I)=ZERO
                    187:                   I=I-1
                    188:                ELSE
1.9       bertrand  189:                   E(I)=ZERO
1.1       bertrand  190:                ENDIF
                    191:                I=I-1
                    192:             END DO
                    193: *
                    194: *           Convert PERMUTATIONS
1.11      bertrand  195: *
1.1       bertrand  196:             I=N
                    197:             DO WHILE ( I .GE. 1 )
                    198:                IF( IPIV(I) .GT. 0) THEN
                    199:                   IP=IPIV(I)
                    200:                   IF( I .LT. N) THEN
                    201:                      DO 12 J= I+1,N
                    202:                        TEMP=A(IP,J)
                    203:                        A(IP,J)=A(I,J)
                    204:                        A(I,J)=TEMP
                    205:  12                  CONTINUE
                    206:                   ENDIF
                    207:                ELSE
                    208:                   IP=-IPIV(I)
                    209:                   IF( I .LT. N) THEN
                    210:                      DO 13 J= I+1,N
                    211:                         TEMP=A(IP,J)
                    212:                         A(IP,J)=A(I-1,J)
                    213:                         A(I-1,J)=TEMP
                    214:  13                  CONTINUE
                    215:                   ENDIF
                    216:                   I=I-1
                    217:                ENDIF
                    218:                I=I-1
                    219:             END DO
                    220: *
                    221:          ELSE
                    222: *
                    223: *           Revert A (A is upper)
                    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: *
                    264:       ELSE
                    265: *
                    266: *        A is LOWER
                    267: *
                    268:          IF ( CONVERT ) THEN
                    269: *
                    270: *           Convert A (A is lower)
                    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: *
                    315:          ELSE
                    316: *
                    317: *           Revert A (A is lower)
                    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 )
                    350:                IF( IPIV(I) .LT. 0 ) THEN
1.9       bertrand  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 ZSYCONV
                    362: *
                    363:       END

CVSweb interface <joel.bertrand@systella.fr>