File:  [local] / rpl / lapack / lapack / zsyconv.f
Revision 1.6: download - view: text, annotated - select for diffs - revision graph
Wed Aug 22 09:48:40 2012 UTC (11 years, 8 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_9, rpl-4_1_10, HEAD
Cohérence

    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, WORK, 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, * ), WORK( * )
   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] 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] WORK
   89: *> \verbatim
   90: *>          WORK is COMPLEX*16 array, dimension (N)
   91: *> \endverbatim
   92: *>
   93: *> \param[out] INFO
   94: *> \verbatim
   95: *>          INFO is INTEGER
   96: *>          = 0:  successful exit
   97: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
   98: *> \endverbatim
   99: *
  100: *  Authors:
  101: *  ========
  102: *
  103: *> \author Univ. of Tennessee 
  104: *> \author Univ. of California Berkeley 
  105: *> \author Univ. of Colorado Denver 
  106: *> \author NAG Ltd. 
  107: *
  108: *> \date November 2011
  109: *
  110: *> \ingroup complex16SYcomputational
  111: *
  112: *  =====================================================================
  113:       SUBROUTINE ZSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
  114: *
  115: *  -- LAPACK computational routine (version 3.4.0) --
  116: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  117: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  118: *     November 2011
  119: *
  120: *     .. Scalar Arguments ..
  121:       CHARACTER          UPLO, WAY
  122:       INTEGER            INFO, LDA, N
  123: *     ..
  124: *     .. Array Arguments ..
  125:       INTEGER            IPIV( * )
  126:       COMPLEX*16         A( LDA, * ), WORK( * )
  127: *     ..
  128: *
  129: *  =====================================================================
  130: *
  131: *     .. Parameters ..
  132:       COMPLEX*16         ZERO
  133:       PARAMETER          ( ZERO = (0.0D+0,0.0D+0) )
  134: *     ..
  135: *     .. External Functions ..
  136:       LOGICAL            LSAME
  137:       EXTERNAL           LSAME
  138: *
  139: *     .. External Subroutines ..
  140:       EXTERNAL           XERBLA
  141: *     .. Local Scalars ..
  142:       LOGICAL            UPPER, CONVERT
  143:       INTEGER            I, IP, J
  144:       COMPLEX*16         TEMP
  145: *     ..
  146: *     .. Executable Statements ..
  147: *
  148:       INFO = 0
  149:       UPPER = LSAME( UPLO, 'U' )
  150:       CONVERT = LSAME( WAY, 'C' )
  151:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  152:          INFO = -1
  153:       ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
  154:          INFO = -2
  155:       ELSE IF( N.LT.0 ) THEN
  156:          INFO = -3
  157:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  158:          INFO = -5
  159: 
  160:       END IF
  161:       IF( INFO.NE.0 ) THEN
  162:          CALL XERBLA( 'ZSYCONV', -INFO )
  163:          RETURN
  164:       END IF
  165: *
  166: *     Quick return if possible
  167: *
  168:       IF( N.EQ.0 )
  169:      $   RETURN
  170: *
  171:       IF( UPPER ) THEN
  172: *
  173: *        A is UPPER
  174: *
  175:          IF ( CONVERT ) THEN
  176: *
  177: *           Convert A (A is upper)
  178: *
  179: *           Convert VALUE
  180: *
  181:             I=N
  182:             WORK(1)=ZERO
  183:             DO WHILE ( I .GT. 1 )
  184:                IF( IPIV(I) .LT. 0 ) THEN
  185:                   WORK(I)=A(I-1,I)
  186:                   A(I-1,I)=ZERO
  187:                   I=I-1
  188:                ELSE
  189:                   WORK(I)=ZERO
  190:                ENDIF
  191:                I=I-1
  192:             END DO
  193: *
  194: *           Convert PERMUTATIONS
  195: *  
  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
  226: *  
  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
  257:                   A(I-1,I)=WORK(I)
  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
  275:             WORK(N)=ZERO
  276:             DO WHILE ( I .LE. N )
  277:                IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
  278:                   WORK(I)=A(I+1,I)
  279:                   A(I+1,I)=ZERO
  280:                   I=I+1
  281:                ELSE
  282:                   WORK(I)=ZERO
  283:                ENDIF
  284:                I=I+1
  285:             END DO
  286: *
  287: *           Convert PERMUTATIONS
  288: *
  289:             I=1
  290:             DO WHILE ( I .LE. N )
  291:                IF( IPIV(I) .GT. 0 ) THEN
  292:                   IP=IPIV(I)
  293:                   IF (I .GT. 1) THEN
  294:                      DO 22 J= 1,I-1
  295:                         TEMP=A(IP,J)
  296:                         A(IP,J)=A(I,J)
  297:                         A(I,J)=TEMP
  298:  22                  CONTINUE
  299:                   ENDIF
  300:                ELSE
  301:                   IP=-IPIV(I)
  302:                   IF (I .GT. 1) THEN
  303:                      DO 23 J= 1,I-1
  304:                         TEMP=A(IP,J)
  305:                         A(IP,J)=A(I+1,J)
  306:                         A(I+1,J)=TEMP
  307:  23                  CONTINUE
  308:                   ENDIF
  309:                   I=I+1
  310:                ENDIF
  311:                I=I+1
  312:             END DO
  313: *
  314:          ELSE
  315: *
  316: *           Revert A (A is lower)
  317: *
  318: *           Revert PERMUTATIONS
  319: *
  320:             I=N
  321:             DO WHILE ( I .GE. 1 )
  322:                IF( IPIV(I) .GT. 0 ) THEN
  323:                   IP=IPIV(I)
  324:                   IF (I .GT. 1) THEN
  325:                      DO J= 1,I-1
  326:                         TEMP=A(I,J)
  327:                         A(I,J)=A(IP,J)
  328:                         A(IP,J)=TEMP
  329:                      END DO
  330:                   ENDIF
  331:                ELSE
  332:                   IP=-IPIV(I)
  333:                   I=I-1
  334:                   IF (I .GT. 1) THEN
  335:                      DO J= 1,I-1
  336:                         TEMP=A(I+1,J)
  337:                         A(I+1,J)=A(IP,J)
  338:                         A(IP,J)=TEMP
  339:                      END DO
  340:                   ENDIF
  341:                ENDIF
  342:                I=I-1
  343:             END DO
  344: *
  345: *           Revert VALUE
  346: *
  347:             I=1
  348:             DO WHILE ( I .LE. N-1 )
  349:                IF( IPIV(I) .LT. 0 ) THEN
  350:                   A(I+1,I)=WORK(I)
  351:                   I=I+1
  352:                ENDIF
  353:                I=I+1
  354:             END DO
  355:          END IF
  356:       END IF
  357: *
  358:       RETURN
  359: *
  360: *     End of ZSYCONV
  361: *
  362:       END

CVSweb interface <joel.bertrand@systella.fr>