SRC/zsyconv.f

   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