File:  [local] / rpl / lapack / lapack / zsyconv.f
Revision 1.10: download - view: text, annotated - select for diffs - revision graph
Sat Aug 27 15:35:07 2016 UTC (7 years, 8 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_25, HEAD
Cohérence Lapack.

    1: *> \brief \b ZSYCONV
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    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"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZSYCONV( 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: *>
   38: *> ZSYCONV converts A given by ZHETRF into L and D or vice-versa.
   39: *> Get nondiagonal elements of D (returned in workspace) and 
   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
   58: *>          = 'C': Convert 
   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: *>
   68: *> \param[in,out] A
   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: *>
   88: *> \param[out] E
   89: *> \verbatim
   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.
   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: *
  105: *> \author Univ. of Tennessee 
  106: *> \author Univ. of California Berkeley 
  107: *> \author Univ. of Colorado Denver 
  108: *> \author NAG Ltd. 
  109: *
  110: *> \date November 2015
  111: *
  112: *> \ingroup complex16SYcomputational
  113: *
  114: *  =====================================================================
  115:       SUBROUTINE ZSYCONV( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
  116: *
  117: *  -- LAPACK computational routine (version 3.6.0) --
  118: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  119: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  120: *     November 2015
  121: *
  122: *     .. Scalar Arguments ..
  123:       CHARACTER          UPLO, WAY
  124:       INTEGER            INFO, LDA, N
  125: *     ..
  126: *     .. Array Arguments ..
  127:       INTEGER            IPIV( * )
  128:       COMPLEX*16         A( LDA, * ), E( * )
  129: *     ..
  130: *
  131: *  =====================================================================
  132: *
  133: *     .. Parameters ..
  134:       COMPLEX*16         ZERO
  135:       PARAMETER          ( ZERO = (0.0D+0,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:       COMPLEX*16         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( 'ZSYCONV', -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:          IF ( CONVERT ) THEN
  178: *
  179: *           Convert A (A is upper)
  180: *
  181: *           Convert VALUE
  182: *
  183:             I=N
  184:             E(1)=ZERO
  185:             DO WHILE ( I .GT. 1 )
  186:                IF( IPIV(I) .LT. 0 ) THEN
  187:                   E(I)=A(I-1,I)
  188:                   E(I-1)=ZERO
  189:                   A(I-1,I)=ZERO
  190:                   I=I-1
  191:                ELSE
  192:                   E(I)=ZERO
  193:                ENDIF
  194:                I=I-1
  195:             END DO
  196: *
  197: *           Convert PERMUTATIONS
  198: *  
  199:             I=N
  200:             DO WHILE ( I .GE. 1 )
  201:                IF( IPIV(I) .GT. 0) THEN
  202:                   IP=IPIV(I)
  203:                   IF( I .LT. N) THEN
  204:                      DO 12 J= I+1,N
  205:                        TEMP=A(IP,J)
  206:                        A(IP,J)=A(I,J)
  207:                        A(I,J)=TEMP
  208:  12                  CONTINUE
  209:                   ENDIF
  210:                ELSE
  211:                   IP=-IPIV(I)
  212:                   IF( I .LT. N) THEN
  213:                      DO 13 J= I+1,N
  214:                         TEMP=A(IP,J)
  215:                         A(IP,J)=A(I-1,J)
  216:                         A(I-1,J)=TEMP
  217:  13                  CONTINUE
  218:                   ENDIF
  219:                   I=I-1
  220:                ENDIF
  221:                I=I-1
  222:             END DO
  223: *
  224:          ELSE
  225: *
  226: *           Revert A (A is upper)
  227: *
  228: *           Revert PERMUTATIONS
  229: *  
  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
  260:                   A(I-1,I)=E(I)
  261:                   I=I-1
  262:                ENDIF
  263:                I=I-1
  264:             END DO
  265:          END IF
  266: *
  267:       ELSE
  268: *
  269: *        A is LOWER
  270: *
  271:          IF ( CONVERT ) THEN
  272: *
  273: *           Convert A (A is lower)
  274: *
  275: *           Convert VALUE
  276: *
  277:             I=1
  278:             E(N)=ZERO
  279:             DO WHILE ( I .LE. N )
  280:                IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
  281:                   E(I)=A(I+1,I)
  282:                   E(I+1)=ZERO
  283:                   A(I+1,I)=ZERO
  284:                   I=I+1
  285:                ELSE
  286:                   E(I)=ZERO
  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: *
  318:          ELSE
  319: *
  320: *           Revert A (A is lower)
  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 )
  353:                IF( IPIV(I) .LT. 0 ) THEN
  354:                   A(I+1,I)=E(I)
  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 ZSYCONV
  365: *
  366:       END

CVSweb interface <joel.bertrand@systella.fr>