1*> \brief \b ZSYCONVF_ROOK
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZSYCONVF_ROOK + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconvf_rook.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconvf_rook.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconvf_rook.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, 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*> If parameter WAY = 'C':
38*> ZSYCONVF_ROOK converts the factorization output format used in
39*> ZSYTRF_ROOK provided on entry in parameter A into the factorization
40*> output format used in ZSYTRF_RK (or ZSYTRF_BK) that is stored
41*> on exit in parameters A and E. IPIV format for ZSYTRF_ROOK and
42*> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
43*>
44*> If parameter WAY = 'R':
45*> ZSYCONVF_ROOK performs the conversion in reverse direction, i.e.
46*> converts the factorization output format used in ZSYTRF_RK
47*> (or ZSYTRF_BK) provided on entry in parameters A and E into
48*> the factorization output format used in ZSYTRF_ROOK that is stored
49*> on exit in parameter A. IPIV format for ZSYTRF_ROOK and
50*> ZSYTRF_RK (or ZSYTRF_BK) is the same and is not converted.
51*>
52*> ZSYCONVF_ROOK can also convert in Hermitian matrix case, i.e. between
53*> formats used in ZHETRF_ROOK and ZHETRF_RK (or ZHETRF_BK).
54*> \endverbatim
55*
56*  Arguments:
57*  ==========
58*
59*> \param[in] UPLO
60*> \verbatim
61*>          UPLO is CHARACTER*1
62*>          Specifies whether the details of the factorization are
63*>          stored as an upper or lower triangular matrix A.
64*>          = 'U':  Upper triangular
65*>          = 'L':  Lower triangular
66*> \endverbatim
67*>
68*> \param[in] WAY
69*> \verbatim
70*>          WAY is CHARACTER*1
71*>          = 'C': Convert
72*>          = 'R': Revert
73*> \endverbatim
74*>
75*> \param[in] N
76*> \verbatim
77*>          N is INTEGER
78*>          The order of the matrix A.  N >= 0.
79*> \endverbatim
80*>
81*> \param[in,out] A
82*> \verbatim
83*>          A is COMPLEX*16 array, dimension (LDA,N)
84*>
85*>          1) If WAY ='C':
86*>
87*>          On entry, contains factorization details in format used in
88*>          ZSYTRF_ROOK:
89*>            a) all elements of the symmetric block diagonal
90*>               matrix D on the diagonal of A and on superdiagonal
91*>               (or subdiagonal) of A, and
92*>            b) If UPLO = 'U': multipliers used to obtain factor U
93*>               in the superdiagonal part of A.
94*>               If UPLO = 'L': multipliers used to obtain factor L
95*>               in the superdiagonal part of A.
96*>
97*>          On exit, contains factorization details in format used in
98*>          ZSYTRF_RK or ZSYTRF_BK:
99*>            a) ONLY diagonal elements of the symmetric block diagonal
100*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
101*>               (superdiagonal (or subdiagonal) elements of D
102*>                are stored on exit in array E), and
103*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
104*>               If UPLO = 'L': factor L in the subdiagonal part of A.
105*>
106*>          2) If WAY = 'R':
107*>
108*>          On entry, contains factorization details in format used in
109*>          ZSYTRF_RK or ZSYTRF_BK:
110*>            a) ONLY diagonal elements of the symmetric block diagonal
111*>               matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
112*>               (superdiagonal (or subdiagonal) elements of D
113*>                are stored on exit in array E), and
114*>            b) If UPLO = 'U': factor U in the superdiagonal part of A.
115*>               If UPLO = 'L': factor L in the subdiagonal part of A.
116*>
117*>          On exit, contains factorization details in format used in
118*>          ZSYTRF_ROOK:
119*>            a) all elements of the symmetric block diagonal
120*>               matrix D on the diagonal of A and on superdiagonal
121*>               (or subdiagonal) of A, and
122*>            b) If UPLO = 'U': multipliers used to obtain factor U
123*>               in the superdiagonal part of A.
124*>               If UPLO = 'L': multipliers used to obtain factor L
125*>               in the superdiagonal part of A.
126*> \endverbatim
127*>
128*> \param[in] LDA
129*> \verbatim
130*>          LDA is INTEGER
131*>          The leading dimension of the array A.  LDA >= max(1,N).
132*> \endverbatim
133*>
134*> \param[in,out] E
135*> \verbatim
136*>          E is COMPLEX*16 array, dimension (N)
137*>
138*>          1) If WAY ='C':
139*>
140*>          On entry, just a workspace.
141*>
142*>          On exit, contains the superdiagonal (or subdiagonal)
143*>          elements of the symmetric block diagonal matrix D
144*>          with 1-by-1 or 2-by-2 diagonal blocks, where
145*>          If UPLO = 'U': E(i) = D(i-1,i), i=2:N, E(1) is set to 0;
146*>          If UPLO = 'L': E(i) = D(i+1,i), i=1:N-1, E(N) is set to 0.
147*>
148*>          2) If WAY = 'R':
149*>
150*>          On entry, contains the superdiagonal (or subdiagonal)
151*>          elements of the symmetric block diagonal matrix D
152*>          with 1-by-1 or 2-by-2 diagonal blocks, where
153*>          If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
154*>          If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
155*>
156*>          On exit, is not changed
157*> \endverbatim
158*.
159*> \param[in] IPIV
160*> \verbatim
161*>          IPIV is INTEGER array, dimension (N)
162*>          On entry, details of the interchanges and the block
163*>          structure of D as determined:
164*>          1) by ZSYTRF_ROOK, if WAY ='C';
165*>          2) by ZSYTRF_RK (or ZSYTRF_BK), if WAY ='R'.
166*>          The IPIV format is the same for all these routines.
167*>
168*>          On exit, is not changed.
169*> \endverbatim
170*>
171*> \param[out] INFO
172*> \verbatim
173*>          INFO is INTEGER
174*>          = 0:  successful exit
175*>          < 0:  if INFO = -i, the i-th argument had an illegal value
176*> \endverbatim
177*
178*  Authors:
179*  ========
180*
181*> \author Univ. of Tennessee
182*> \author Univ. of California Berkeley
183*> \author Univ. of Colorado Denver
184*> \author NAG Ltd.
185*
186*> \ingroup complex16SYcomputational
187*
188*> \par Contributors:
189*  ==================
190*>
191*> \verbatim
192*>
193*>  November 2017,  Igor Kozachenko,
194*>                  Computer Science Division,
195*>                  University of California, Berkeley
196*>
197*> \endverbatim
198*  =====================================================================
199      SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, E, IPIV, INFO )
200*
201*  -- LAPACK computational routine --
202*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
203*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
204*
205*     .. Scalar Arguments ..
206      CHARACTER          UPLO, WAY
207      INTEGER            INFO, LDA, N
208*     ..
209*     .. Array Arguments ..
210      INTEGER            IPIV( * )
211      COMPLEX*16         A( LDA, * ), E( * )
212*     ..
213*
214*  =====================================================================
215*
216*     .. Parameters ..
217      COMPLEX*16         ZERO
218      PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
219*     ..
220*     .. External Functions ..
221      LOGICAL            LSAME
222      EXTERNAL           LSAME
223*
224*     .. External Subroutines ..
225      EXTERNAL           ZSWAP, XERBLA
226*     .. Local Scalars ..
227      LOGICAL            UPPER, CONVERT
228      INTEGER            I, IP, IP2
229*     ..
230*     .. Executable Statements ..
231*
232      INFO = 0
233      UPPER = LSAME( UPLO, 'U' )
234      CONVERT = LSAME( WAY, 'C' )
235      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
236         INFO = -1
237      ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
238         INFO = -2
239      ELSE IF( N.LT.0 ) THEN
240         INFO = -3
241      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
242         INFO = -5
243
244      END IF
245      IF( INFO.NE.0 ) THEN
246         CALL XERBLA( 'ZSYCONVF_ROOK', -INFO )
247         RETURN
248      END IF
249*
250*     Quick return if possible
251*
252      IF( N.EQ.0 )
253     $   RETURN
254*
255      IF( UPPER ) THEN
256*
257*        Begin A is UPPER
258*
259         IF ( CONVERT ) THEN
260*
261*           Convert A (A is upper)
262*
263*
264*           Convert VALUE
265*
266*           Assign superdiagonal entries of D to array E and zero out
267*           corresponding entries in input storage A
268*
269            I = N
270            E( 1 ) = ZERO
271            DO WHILE ( I.GT.1 )
272               IF( IPIV( I ).LT.0 ) THEN
273                  E( I ) = A( I-1, I )
274                  E( I-1 ) = ZERO
275                  A( I-1, I ) = ZERO
276                  I = I - 1
277               ELSE
278                  E( I ) = ZERO
279               END IF
280               I = I - 1
281            END DO
282*
283*           Convert PERMUTATIONS
284*
285*           Apply permutations to submatrices of upper part of A
286*           in factorization order where i decreases from N to 1
287*
288            I = N
289            DO WHILE ( I.GE.1 )
290               IF( IPIV( I ).GT.0 ) THEN
291*
292*                 1-by-1 pivot interchange
293*
294*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
295*
296                  IP = IPIV( I )
297                  IF( I.LT.N ) THEN
298                     IF( IP.NE.I ) THEN
299                        CALL ZSWAP( N-I, A( I, I+1 ), LDA,
300     $                              A( IP, I+1 ), LDA )
301                     END IF
302                  END IF
303*
304               ELSE
305*
306*                 2-by-2 pivot interchange
307*
308*                 Swap rows i and IPIV(i) and i-1 and IPIV(i-1)
309*                 in A(1:i,N-i:N)
310*
311                  IP = -IPIV( I )
312                  IP2 = -IPIV( I-1 )
313                  IF( I.LT.N ) THEN
314                     IF( IP.NE.I ) THEN
315                        CALL ZSWAP( N-I, A( I, I+1 ), LDA,
316     $                              A( IP, I+1 ), LDA )
317                     END IF
318                     IF( IP2.NE.(I-1) ) THEN
319                        CALL ZSWAP( N-I, A( I-1, I+1 ), LDA,
320     $                              A( IP2, I+1 ), LDA )
321                     END IF
322                  END IF
323                  I = I - 1
324*
325               END IF
326               I = I - 1
327            END DO
328*
329         ELSE
330*
331*           Revert A (A is upper)
332*
333*
334*           Revert PERMUTATIONS
335*
336*           Apply permutations to submatrices of upper part of A
337*           in reverse factorization order where i increases from 1 to N
338*
339            I = 1
340            DO WHILE ( I.LE.N )
341               IF( IPIV( I ).GT.0 ) THEN
342*
343*                 1-by-1 pivot interchange
344*
345*                 Swap rows i and IPIV(i) in A(1:i,N-i:N)
346*
347                  IP = IPIV( I )
348                  IF( I.LT.N ) THEN
349                     IF( IP.NE.I ) THEN
350                        CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
351     $                              A( I, I+1 ), LDA )
352                     END IF
353                  END IF
354*
355               ELSE
356*
357*                 2-by-2 pivot interchange
358*
359*                 Swap rows i-1 and IPIV(i-1) and i and IPIV(i)
360*                 in A(1:i,N-i:N)
361*
362                  I = I + 1
363                  IP = -IPIV( I )
364                  IP2 = -IPIV( I-1 )
365                  IF( I.LT.N ) THEN
366                     IF( IP2.NE.(I-1) ) THEN
367                        CALL ZSWAP( N-I, A( IP2, I+1 ), LDA,
368     $                              A( I-1, I+1 ), LDA )
369                     END IF
370                     IF( IP.NE.I ) THEN
371                        CALL ZSWAP( N-I, A( IP, I+1 ), LDA,
372     $                              A( I, I+1 ), LDA )
373                     END IF
374                  END IF
375*
376               END IF
377               I = I + 1
378            END DO
379*
380*           Revert VALUE
381*           Assign superdiagonal entries of D from array E to
382*           superdiagonal entries of A.
383*
384            I = N
385            DO WHILE ( I.GT.1 )
386               IF( IPIV( I ).LT.0 ) THEN
387                  A( I-1, I ) = E( I )
388                  I = I - 1
389               END IF
390               I = I - 1
391            END DO
392*
393*        End A is UPPER
394*
395         END IF
396*
397      ELSE
398*
399*        Begin A is LOWER
400*
401         IF ( CONVERT ) THEN
402*
403*           Convert A (A is lower)
404*
405*
406*           Convert VALUE
407*           Assign subdiagonal entries of D to array E and zero out
408*           corresponding entries in input storage A
409*
410            I = 1
411            E( N ) = ZERO
412            DO WHILE ( I.LE.N )
413               IF( I.LT.N .AND. IPIV(I).LT.0 ) THEN
414                  E( I ) = A( I+1, I )
415                  E( I+1 ) = ZERO
416                  A( I+1, I ) = ZERO
417                  I = I + 1
418               ELSE
419                  E( I ) = ZERO
420               END IF
421               I = I + 1
422            END DO
423*
424*           Convert PERMUTATIONS
425*
426*           Apply permutations to submatrices of lower part of A
427*           in factorization order where i increases from 1 to N
428*
429            I = 1
430            DO WHILE ( I.LE.N )
431               IF( IPIV( I ).GT.0 ) THEN
432*
433*                 1-by-1 pivot interchange
434*
435*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
436*
437                  IP = IPIV( I )
438                  IF ( I.GT.1 ) THEN
439                     IF( IP.NE.I ) THEN
440                        CALL ZSWAP( I-1, A( I, 1 ), LDA,
441     $                              A( IP, 1 ), LDA )
442                     END IF
443                  END IF
444*
445               ELSE
446*
447*                 2-by-2 pivot interchange
448*
449*                 Swap rows i and IPIV(i) and i+1 and IPIV(i+1)
450*                 in A(i:N,1:i-1)
451*
452                  IP = -IPIV( I )
453                  IP2 = -IPIV( I+1 )
454                  IF ( I.GT.1 ) THEN
455                     IF( IP.NE.I ) THEN
456                        CALL ZSWAP( I-1, A( I, 1 ), LDA,
457     $                              A( IP, 1 ), LDA )
458                     END IF
459                     IF( IP2.NE.(I+1) ) THEN
460                        CALL ZSWAP( I-1, A( I+1, 1 ), LDA,
461     $                              A( IP2, 1 ), LDA )
462                     END IF
463                  END IF
464                  I = I + 1
465*
466               END IF
467               I = I + 1
468            END DO
469*
470         ELSE
471*
472*           Revert A (A is lower)
473*
474*
475*           Revert PERMUTATIONS
476*
477*           Apply permutations to submatrices of lower part of A
478*           in reverse factorization order where i decreases from N to 1
479*
480            I = N
481            DO WHILE ( I.GE.1 )
482               IF( IPIV( I ).GT.0 ) THEN
483*
484*                 1-by-1 pivot interchange
485*
486*                 Swap rows i and IPIV(i) in A(i:N,1:i-1)
487*
488                  IP = IPIV( I )
489                  IF ( I.GT.1 ) THEN
490                     IF( IP.NE.I ) THEN
491                        CALL ZSWAP( I-1, A( IP, 1 ), LDA,
492     $                              A( I, 1 ), LDA )
493                     END IF
494                  END IF
495*
496               ELSE
497*
498*                 2-by-2 pivot interchange
499*
500*                 Swap rows i+1 and IPIV(i+1) and i and IPIV(i)
501*                 in A(i:N,1:i-1)
502*
503                  I = I - 1
504                  IP = -IPIV( I )
505                  IP2 = -IPIV( I+1 )
506                  IF ( I.GT.1 ) THEN
507                     IF( IP2.NE.(I+1) ) THEN
508                        CALL ZSWAP( I-1, A( IP2, 1 ), LDA,
509     $                              A( I+1, 1 ), LDA )
510                     END IF
511                     IF( IP.NE.I ) THEN
512                        CALL ZSWAP( I-1, A( IP, 1 ), LDA,
513     $                              A( I, 1 ), LDA )
514                     END IF
515                  END IF
516*
517               END IF
518               I = I - 1
519            END DO
520*
521*           Revert VALUE
522*           Assign subdiagonal entries of D from array E to
523*           subgiagonal entries of A.
524*
525            I = 1
526            DO WHILE ( I.LE.N-1 )
527               IF( IPIV( I ).LT.0 ) THEN
528                  A( I + 1, I ) = E( I )
529                  I = I + 1
530               END IF
531               I = I + 1
532            END DO
533*
534         END IF
535*
536*        End A is LOWER
537*
538      END IF
539
540      RETURN
541*
542*     End of ZSYCONVF_ROOK
543*
544      END
545