LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ LAPACKE_dgbbrd_work()

lapack_int LAPACKE_dgbbrd_work ( int  matrix_layout,
char  vect,
lapack_int  m,
lapack_int  n,
lapack_int  ncc,
lapack_int  kl,
lapack_int  ku,
double *  ab,
lapack_int  ldab,
double *  d,
double *  e,
double *  q,
lapack_int  ldq,
double *  pt,
lapack_int  ldpt,
double *  c,
lapack_int  ldc,
double *  work 
)

Definition at line 35 of file lapacke_dgbbrd_work.c.

41 {
42  lapack_int info = 0;
43  if( matrix_layout == LAPACK_COL_MAJOR ) {
44  /* Call LAPACK function and adjust info */
45  LAPACK_dgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab, &ldab, d, e, q, &ldq,
46  pt, &ldpt, c, &ldc, work, &info );
47  if( info < 0 ) {
48  info = info - 1;
49  }
50  } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
51  lapack_int ldab_t = MAX(1,kl+ku+1);
52  lapack_int ldc_t = MAX(1,m);
53  lapack_int ldpt_t = MAX(1,n);
54  lapack_int ldq_t = MAX(1,m);
55  double* ab_t = NULL;
56  double* q_t = NULL;
57  double* pt_t = NULL;
58  double* c_t = NULL;
59  /* Check leading dimension(s) */
60  if( ldab < n ) {
61  info = -9;
62  LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
63  return info;
64  }
65  if( ldc < ncc ) {
66  info = -17;
67  LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
68  return info;
69  }
70  if( ldpt < n ) {
71  info = -15;
72  LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
73  return info;
74  }
75  if( ldq < m ) {
76  info = -13;
77  LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
78  return info;
79  }
80  /* Allocate memory for temporary array(s) */
81  ab_t = (double*)LAPACKE_malloc( sizeof(double) * ldab_t * MAX(1,n) );
82  if( ab_t == NULL ) {
84  goto exit_level_0;
85  }
86  if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
87  q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,m) );
88  if( q_t == NULL ) {
90  goto exit_level_1;
91  }
92  }
93  if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
94  pt_t = (double*)
95  LAPACKE_malloc( sizeof(double) * ldpt_t * MAX(1,n) );
96  if( pt_t == NULL ) {
98  goto exit_level_2;
99  }
100  }
101  if( ncc != 0 ) {
102  c_t = (double*)
103  LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,ncc) );
104  if( c_t == NULL ) {
106  goto exit_level_3;
107  }
108  }
109  /* Transpose input matrices */
110  LAPACKE_dgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t );
111  if( ncc != 0 ) {
112  LAPACKE_dge_trans( matrix_layout, m, ncc, c, ldc, c_t, ldc_t );
113  }
114  /* Call LAPACK function and adjust info */
115  LAPACK_dgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t,
116  &ldq_t, pt_t, &ldpt_t, c_t, &ldc_t, work, &info );
117  if( info < 0 ) {
118  info = info - 1;
119  }
120  /* Transpose output matrices */
121  LAPACKE_dgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab,
122  ldab );
123  if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
124  LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq );
125  }
126  if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
127  LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt );
128  }
129  if( ncc != 0 ) {
130  LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc );
131  }
132  /* Release memory and exit */
133  if( ncc != 0 ) {
134  LAPACKE_free( c_t );
135  }
136 exit_level_3:
137  if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) {
138  LAPACKE_free( pt_t );
139  }
140 exit_level_2:
141  if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) {
142  LAPACKE_free( q_t );
143  }
144 exit_level_1:
145  LAPACKE_free( ab_t );
146 exit_level_0:
147  if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
148  LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
149  }
150  } else {
151  info = -1;
152  LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info );
153  }
154  return info;
155 }
#define lapack_int
Definition: lapack.h:83
#define LAPACK_dgbbrd(...)
Definition: lapack.h:502
#define LAPACK_COL_MAJOR
Definition: lapacke.h:53
#define LAPACKE_free(p)
Definition: lapacke.h:46
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:52
#define LAPACKE_malloc(size)
Definition: lapacke.h:43
#define LAPACK_TRANSPOSE_MEMORY_ERROR
Definition: lapacke.h:56
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:35
void LAPACKE_xerbla(const char *name, lapack_int info)
#define MAX(x, y)
Definition: lapacke_utils.h:46
void LAPACKE_dgb_trans(int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double *in, lapack_int ldin, double *out, lapack_int ldout)
void LAPACKE_dge_trans(int matrix_layout, lapack_int m, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout)
Here is the call graph for this function:
Here is the caller graph for this function: