Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

sormr3 (3p)

Name

sormr3 - multiply a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm)

Synopsis

SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,  WORK,
INFO )


CHARACTER*1 SIDE, TRANS

INTEGER INFO, K, L, LDA, LDC, M, N

REAL A(LDA,*), C(LDC,*), TAU(*), WORK(*)


SUBROUTINE  SORMR3_64(  SIDE,  TRANS,  M, N, K, L, A, LDA, TAU, C, LDC,
WORK, INFO )


CHARACTER*1 SIDE, TRANS

INTEGER*8 INFO, K, L, LDA, LDC, M, N

REAL A(LDA,*), C(LDC,*), TAU(*), WORK(*)


F95 INTERFACE
SUBROUTINE ORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C,  LDC,  WORK,
INFO )


REAL, DIMENSION(:,:) :: A, C

INTEGER :: M, N, K, L, LDA, LDC, INFO

CHARACTER(LEN=1) :: SIDE, TRANS

REAL, DIMENSION(:) :: TAU, WORK


SUBROUTINE  ORMR3_64(  SIDE,  TRANS,  M,  N, K, L, A, LDA, TAU, C, LDC,
WORK, INFO )


REAL, DIMENSION(:,:) :: A, C

INTEGER(8) :: M, N, K, L, LDA, LDC, INFO

CHARACTER(LEN=1) :: SIDE, TRANS

REAL, DIMENSION(:) :: TAU, WORK


C INTERFACE
#include <sunperf.h>

void sormr3 (char side, char trans, int m, int n, int k, int  l,  float
*a, int lda, float *tau, float *c, int ldc, int *info);


void  sormr3_64 (char side, char trans, long m, long n, long k, long l,
float *a, long lda, float *tau,  float  *c,  long  ldc,  long
*info);

Description

Oracle Solaris Studio Performance Library                           sormr3(3P)



NAME
       sormr3  -  multiply a general matrix by the orthogonal matrix from a RZ
       factorization determined by stzrzf (unblocked algorithm)


SYNOPSIS
       SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,  WORK,
                 INFO )


       CHARACTER*1 SIDE, TRANS

       INTEGER INFO, K, L, LDA, LDC, M, N

       REAL A(LDA,*), C(LDC,*), TAU(*), WORK(*)


       SUBROUTINE  SORMR3_64(  SIDE,  TRANS,  M, N, K, L, A, LDA, TAU, C, LDC,
                 WORK, INFO )


       CHARACTER*1 SIDE, TRANS

       INTEGER*8 INFO, K, L, LDA, LDC, M, N

       REAL A(LDA,*), C(LDC,*), TAU(*), WORK(*)


   F95 INTERFACE
       SUBROUTINE ORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C,  LDC,  WORK,
                 INFO )


       REAL, DIMENSION(:,:) :: A, C

       INTEGER :: M, N, K, L, LDA, LDC, INFO

       CHARACTER(LEN=1) :: SIDE, TRANS

       REAL, DIMENSION(:) :: TAU, WORK


       SUBROUTINE  ORMR3_64(  SIDE,  TRANS,  M,  N, K, L, A, LDA, TAU, C, LDC,
                 WORK, INFO )


       REAL, DIMENSION(:,:) :: A, C

       INTEGER(8) :: M, N, K, L, LDA, LDC, INFO

       CHARACTER(LEN=1) :: SIDE, TRANS

       REAL, DIMENSION(:) :: TAU, WORK


   C INTERFACE
       #include <sunperf.h>

       void sormr3 (char side, char trans, int m, int n, int k, int  l,  float
                 *a, int lda, float *tau, float *c, int ldc, int *info);


       void  sormr3_64 (char side, char trans, long m, long n, long k, long l,
                 float *a, long lda, float *tau,  float  *c,  long  ldc,  long
                 *info);


PURPOSE
       sormr3 overwrites the general real m by n matrix C with

       Q * C  if SIDE = 'L' and TRANS = 'N', or

       Q**T* C  if SIDE = 'L' and TRANS = 'C', or

       C * Q  if SIDE = 'R' and TRANS = 'N', or

       C * Q**T if SIDE = 'R' and TRANS = 'C',

       where Q is a real orthogonal matrix defined as the product of k elemen-
       tary reflectors

       Q = H(1) H(2) . . . H(k)

       as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n  if
       SIDE = 'R'.


ARGUMENTS
       SIDE (input)
                 SIDE is CHARACTER*1
                 = 'L': apply Q or Q**T from the Left
                 = 'R': apply Q or Q**T from the Right


       TRANS (input)
                 TRANS is CHARACTER*1
                 = 'N': apply Q  (No transpose)
                 = 'T': apply Q**T (Transpose)


       M (input)
                 M is INTEGER
                 The number of rows of the matrix C. M >= 0.


       N (input)
                 N is INTEGER
                 The number of columns of the matrix C. N >= 0.


       K (input)
                 K is INTEGER
                 The number of elementary reflectors whose product defines
                 the matrix Q.
                 If SIDE = 'L', M >= K >= 0;
                 if SIDE = 'R', N >= K >= 0.


       L (input)
                 L is INTEGER
                 The number of columns of the matrix A containing
                 the meaningful part of the Householder reflectors.
                 If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.


       A (input)
                 A is REAL array, dimension
                 (LDA,M) if SIDE = 'L',
                 (LDA,N) if SIDE = 'R'
                 The i-th row must contain the vector which defines the
                 elementary reflector H(i), for i = 1,2,...,k, as returned by
                 STZRZF in the last k rows of its array argument A.
                 A is modified by the routine but restored on exit.


       LDA (input)
                 LDA is INTEGER
                 The leading dimension of the array A. LDA >= max(1,K).


       TAU (input)
                 TAU is REAL array, dimension (K)
                 TAU(i) must contain the scalar factor of the elementary
                 reflector H(i), as returned by STZRZF.


       C (input/output)
                 C is REAL array, dimension (LDC,N)
                 On entry, the m-by-n matrix C.
                 On  exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.


       LDC (input)
                 LDC is INTEGER
                 The leading dimension of the array C. LDC >= max(1,M).


       WORK (output)
                 WORK is REAL array, dimension
                 (N) if SIDE = 'L',
                 (M) if SIDE = 'R'


       INFO (output)
                 INFO is INTEGER
                 = 0: successful exit
                 < 0: if INFO = -i, the i-th argument had an illegal value




                                  7 Nov 2015                        sormr3(3P)