LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zunm22 ( character  SIDE,
character  TRANS,
integer  M,
integer  N,
integer  N1,
integer  N2,
complex*16, dimension( ldq, * )  Q,
integer  LDQ,
complex*16, dimension( ldc, * )  C,
integer  LDC,
complex*16, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

ZUNM22 multiplies a general matrix by a banded unitary matrix.

Download ZUNM22 + dependencies [TGZ] [ZIP] [TXT]

Purpose 
  ZUNM22 overwrites the general complex M-by-N matrix C with

                  SIDE = 'L'     SIDE = 'R'
  TRANS = 'N':      Q * C          C * Q
  TRANS = 'C':      Q**H * C       C * Q**H

  where Q is a complex unitary matrix of order NQ, with NQ = M if
  SIDE = 'L' and NQ = N if SIDE = 'R'.
  The unitary matrix Q processes a 2-by-2 block structure

         [  Q11  Q12  ]
     Q = [            ]
         [  Q21  Q22  ],

  where Q12 is an N1-by-N1 lower triangular matrix and Q21 is an
  N2-by-N2 upper triangular matrix.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': apply Q or Q**H from the Left;
          = 'R': apply Q or Q**H from the Right.
[in]TRANS
          TRANS is CHARACTER*1
          = 'N':  apply Q (No transpose);
          = 'C':  apply Q**H (Conjugate transpose).
[in]M
          M is INTEGER
          The number of rows of the matrix C. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix C. N >= 0.
[in]N1
[in]N2
          N1 is INTEGER
          N2 is INTEGER
          The dimension of Q12 and Q21, respectively. N1, N2 >= 0.
          The following requirement must be satisfied:
          N1 + N2 = M if SIDE = 'L' and N1 + N2 = N if SIDE = 'R'.
[in]Q
          Q is COMPLEX*16 array, dimension
                              (LDQ,M) if SIDE = 'L'
                              (LDQ,N) if SIDE = 'R'
[in]LDQ
          LDQ is INTEGER
          The leading dimension of the array Q.
          LDQ >= max(1,M) if SIDE = 'L'; LDQ >= max(1,N) if SIDE = 'R'.
[in,out]C
          C is COMPLEX*16 array, dimension (LDC,N)
          On entry, the M-by-N matrix C.
          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[out]WORK
          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If SIDE = 'L', LWORK >= max(1,N);
          if SIDE = 'R', LWORK >= max(1,M).
          For optimum performance LWORK >= M*N.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
January 2015

Definition at line 164 of file zunm22.f.

164 *
165 * -- LAPACK computational routine (version 3.6.0) --
166 * -- LAPACK is a software package provided by Univ. of Tennessee, --
167 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
168 * January 2015
169 *
170  IMPLICIT NONE
171 *
172 * .. Scalar Arguments ..
173  CHARACTER side, trans
174  INTEGER m, n, n1, n2, ldq, ldc, lwork, info
175 * ..
176 * .. Array Arguments ..
177  COMPLEX*16 q( ldq, * ), c( ldc, * ), work( * )
178 * ..
179 *
180 * =====================================================================
181 *
182 * .. Parameters ..
183  COMPLEX*16 one
184  parameter ( one = ( 1.0d+0, 0.0d+0 ) )
185 *
186 * .. Local Scalars ..
187  LOGICAL left, lquery, notran
188  INTEGER i, ldwork, len, lwkopt, nb, nq, nw
189 * ..
190 * .. External Functions ..
191  LOGICAL lsame
192  EXTERNAL lsame
193 * ..
194 * .. External Subroutines ..
195  EXTERNAL zgemm, zlacpy, ztrmm, xerbla
196 * ..
197 * .. Intrinsic Functions ..
198  INTRINSIC dcmplx, max, min
199 * ..
200 * .. Executable Statements ..
201 *
202 * Test the input arguments
203 *
204  info = 0
205  left = lsame( side, 'L' )
206  notran = lsame( trans, 'N' )
207  lquery = ( lwork.EQ.-1 )
208 *
209 * NQ is the order of Q;
210 * NW is the minimum dimension of WORK.
211 *
212  IF( left ) THEN
213  nq = m
214  ELSE
215  nq = n
216  END IF
217  nw = nq
218  IF( n1.EQ.0 .OR. n2.EQ.0 ) nw = 1
219  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
220  info = -1
221  ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.lsame( trans, 'C' ) )
222  $ THEN
223  info = -2
224  ELSE IF( m.LT.0 ) THEN
225  info = -3
226  ELSE IF( n.LT.0 ) THEN
227  info = -4
228  ELSE IF( n1.LT.0 .OR. n1+n2.NE.nq ) THEN
229  info = -5
230  ELSE IF( n2.LT.0 ) THEN
231  info = -6
232  ELSE IF( ldq.LT.max( 1, nq ) ) THEN
233  info = -8
234  ELSE IF( ldc.LT.max( 1, m ) ) THEN
235  info = -10
236  ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
237  info = -12
238  END IF
239 *
240  IF( info.EQ.0 ) THEN
241  lwkopt = m*n
242  work( 1 ) = dcmplx( lwkopt )
243  END IF
244 *
245  IF( info.NE.0 ) THEN
246  CALL xerbla( 'ZUNM22', -info )
247  RETURN
248  ELSE IF( lquery ) THEN
249  RETURN
250  END IF
251 *
252 * Quick return if possible
253 *
254  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
255  work( 1 ) = 1
256  RETURN
257  END IF
258 *
259 * Degenerate cases (N1 = 0 or N2 = 0) are handled using ZTRMM.
260 *
261  IF( n1.EQ.0 ) THEN
262  CALL ztrmm( side, 'Upper', trans, 'Non-Unit', m, n, one,
263  $ q, ldq, c, ldc )
264  work( 1 ) = one
265  RETURN
266  ELSE IF( n2.EQ.0 ) THEN
267  CALL ztrmm( side, 'Lower', trans, 'Non-Unit', m, n, one,
268  $ q, ldq, c, ldc )
269  work( 1 ) = one
270  RETURN
271  END IF
272 *
273 * Compute the largest chunk size available from the workspace.
274 *
275  nb = max( 1, min( lwork, lwkopt ) / nq )
276 *
277  IF( left ) THEN
278  IF( notran ) THEN
279  DO i = 1, n, nb
280  len = min( nb, n-i+1 )
281  ldwork = m
282 *
283 * Multiply bottom part of C by Q12.
284 *
285  CALL zlacpy( 'All', n1, len, c( n2+1, i ), ldc, work,
286  $ ldwork )
287  CALL ztrmm( 'Left', 'Lower', 'No Transpose', 'Non-Unit',
288  $ n1, len, one, q( 1, n2+1 ), ldq, work,
289  $ ldwork )
290 *
291 * Multiply top part of C by Q11.
292 *
293  CALL zgemm( 'No Transpose', 'No Transpose', n1, len, n2,
294  $ one, q, ldq, c( 1, i ), ldc, one, work,
295  $ ldwork )
296 *
297 * Multiply top part of C by Q21.
298 *
299  CALL zlacpy( 'All', n2, len, c( 1, i ), ldc,
300  $ work( n1+1 ), ldwork )
301  CALL ztrmm( 'Left', 'Upper', 'No Transpose', 'Non-Unit',
302  $ n2, len, one, q( n1+1, 1 ), ldq,
303  $ work( n1+1 ), ldwork )
304 *
305 * Multiply bottom part of C by Q22.
306 *
307  CALL zgemm( 'No Transpose', 'No Transpose', n2, len, n1,
308  $ one, q( n1+1, n2+1 ), ldq, c( n2+1, i ), ldc,
309  $ one, work( n1+1 ), ldwork )
310 *
311 * Copy everything back.
312 *
313  CALL zlacpy( 'All', m, len, work, ldwork, c( 1, i ),
314  $ ldc )
315  END DO
316  ELSE
317  DO i = 1, n, nb
318  len = min( nb, n-i+1 )
319  ldwork = m
320 *
321 * Multiply bottom part of C by Q21**H.
322 *
323  CALL zlacpy( 'All', n2, len, c( n1+1, i ), ldc, work,
324  $ ldwork )
325  CALL ztrmm( 'Left', 'Upper', 'Conjugate', 'Non-Unit',
326  $ n2, len, one, q( n1+1, 1 ), ldq, work,
327  $ ldwork )
328 *
329 * Multiply top part of C by Q11**H.
330 *
331  CALL zgemm( 'Conjugate', 'No Transpose', n2, len, n1,
332  $ one, q, ldq, c( 1, i ), ldc, one, work,
333  $ ldwork )
334 *
335 * Multiply top part of C by Q12**H.
336 *
337  CALL zlacpy( 'All', n1, len, c( 1, i ), ldc,
338  $ work( n2+1 ), ldwork )
339  CALL ztrmm( 'Left', 'Lower', 'Conjugate', 'Non-Unit',
340  $ n1, len, one, q( 1, n2+1 ), ldq,
341  $ work( n2+1 ), ldwork )
342 *
343 * Multiply bottom part of C by Q22**H.
344 *
345  CALL zgemm( 'Conjugate', 'No Transpose', n1, len, n2,
346  $ one, q( n1+1, n2+1 ), ldq, c( n1+1, i ), ldc,
347  $ one, work( n2+1 ), ldwork )
348 *
349 * Copy everything back.
350 *
351  CALL zlacpy( 'All', m, len, work, ldwork, c( 1, i ),
352  $ ldc )
353  END DO
354  END IF
355  ELSE
356  IF( notran ) THEN
357  DO i = 1, m, nb
358  len = min( nb, m-i+1 )
359  ldwork = len
360 *
361 * Multiply right part of C by Q21.
362 *
363  CALL zlacpy( 'All', len, n2, c( i, n1+1 ), ldc, work,
364  $ ldwork )
365  CALL ztrmm( 'Right', 'Upper', 'No Transpose', 'Non-Unit',
366  $ len, n2, one, q( n1+1, 1 ), ldq, work,
367  $ ldwork )
368 *
369 * Multiply left part of C by Q11.
370 *
371  CALL zgemm( 'No Transpose', 'No Transpose', len, n2, n1,
372  $ one, c( i, 1 ), ldc, q, ldq, one, work,
373  $ ldwork )
374 *
375 * Multiply left part of C by Q12.
376 *
377  CALL zlacpy( 'All', len, n1, c( i, 1 ), ldc,
378  $ work( 1 + n2*ldwork ), ldwork )
379  CALL ztrmm( 'Right', 'Lower', 'No Transpose', 'Non-Unit',
380  $ len, n1, one, q( 1, n2+1 ), ldq,
381  $ work( 1 + n2*ldwork ), ldwork )
382 *
383 * Multiply right part of C by Q22.
384 *
385  CALL zgemm( 'No Transpose', 'No Transpose', len, n1, n2,
386  $ one, c( i, n1+1 ), ldc, q( n1+1, n2+1 ), ldq,
387  $ one, work( 1 + n2*ldwork ), ldwork )
388 *
389 * Copy everything back.
390 *
391  CALL zlacpy( 'All', len, n, work, ldwork, c( i, 1 ),
392  $ ldc )
393  END DO
394  ELSE
395  DO i = 1, m, nb
396  len = min( nb, m-i+1 )
397  ldwork = len
398 *
399 * Multiply right part of C by Q12**H.
400 *
401  CALL zlacpy( 'All', len, n1, c( i, n2+1 ), ldc, work,
402  $ ldwork )
403  CALL ztrmm( 'Right', 'Lower', 'Conjugate', 'Non-Unit',
404  $ len, n1, one, q( 1, n2+1 ), ldq, work,
405  $ ldwork )
406 *
407 * Multiply left part of C by Q11**H.
408 *
409  CALL zgemm( 'No Transpose', 'Conjugate', len, n1, n2,
410  $ one, c( i, 1 ), ldc, q, ldq, one, work,
411  $ ldwork )
412 *
413 * Multiply left part of C by Q21**H.
414 *
415  CALL zlacpy( 'All', len, n2, c( i, 1 ), ldc,
416  $ work( 1 + n1*ldwork ), ldwork )
417  CALL ztrmm( 'Right', 'Upper', 'Conjugate', 'Non-Unit',
418  $ len, n2, one, q( n1+1, 1 ), ldq,
419  $ work( 1 + n1*ldwork ), ldwork )
420 *
421 * Multiply right part of C by Q22**H.
422 *
423  CALL zgemm( 'No Transpose', 'Conjugate', len, n2, n1,
424  $ one, c( i, n2+1 ), ldc, q( n1+1, n2+1 ), ldq,
425  $ one, work( 1 + n1*ldwork ), ldwork )
426 *
427 * Copy everything back.
428 *
429  CALL zlacpy( 'All', len, n, work, ldwork, c( i, 1 ),
430  $ ldc )
431  END DO
432  END IF
433  END IF
434 *
435  work( 1 ) = dcmplx( lwkopt )
436  RETURN
437 *
438 * End of ZUNM22
439 *
zlacpy
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
zgemm
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
ztrmm
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
Definition: ztrmm.f:179
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: