LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 lapack_int LAPACKE_zgejsv ( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, lapack_complex_double * a, lapack_int lda, double * sva, lapack_complex_double * u, lapack_int ldu, lapack_complex_double * v, lapack_int ldv, double * stat, lapack_int * istat )

Definition at line 36 of file lapacke_zgejsv.c.

41 {
42  lapack_int info = 0;
43  lapack_int lwork = (
44  // 1.1
45  ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
46  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? 2*n+1 :
47
48  //1.2
49  ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
50  !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? n*n+3*n :
51
52  //2.1
53  ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
54  (!( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) )&&
55  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
56
57
58  //2.2
59  ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
60  !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
61  !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
62
63  //3.1
64  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' )) &&
65  !( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' )) &&
66  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
67
68  //3.2
69  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' )) &&
70  !(LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' )) &&
71  !(LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n :
72
73  //4.1
74  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
75  ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
76  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 5*n+2*n*n :
77
78  //4.2
79  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
80  ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
81  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 4*n*n:
82  1) ) ) ) ) ) ) ) );
83  lapack_int lrwork = (
84  // 1.1
85  ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
86  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,n+2*m) :
87
88  //1.2
89  ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) &&
90  !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,2*n) :
91
92  //2.1
93  ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
94  (!( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) ) &&
95  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) :
96
97
98  //2.2
99  ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
100  !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
101  !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
102
103  //3.1
104  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' )) &&
105  !( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' )) &&
106  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) :
107
108  //3.2
109  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' )) &&
110  !(LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' )) &&
111  !(LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
112
113  //4.1
114  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
115  ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
116  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) :
117
118  //4.2
119  ( ( ( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) &&
120  ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) &&
121  ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) :
122  7) ) ) ) ) ) ) ) );
123  lapack_int* iwork = NULL;
124  double* rwork = NULL;
125  lapack_complex_double* cwork = NULL;
126  lapack_int i;
127  lapack_int nu, nv;
128  if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
129  LAPACKE_xerbla( "LAPACKE_zgejsv", -1 );
130  return -1;
131  }
132 #ifndef LAPACK_DISABLE_NAN_CHECK
133  /* Optionally check input matrices for NaNs */
134  nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
135  nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
136  if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
137  return -10;
138  }
139 #endif
140  /* Allocate memory for working array(s) */
141  iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+2*n) );
142  if( iwork == NULL ) {
144  goto exit_level_0;
145  }
146  lwork = MAX( lwork, 1 );
147  { /* FIXUP LWORK */
148  int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' );
149  int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' );
150  int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' );
151  if( !want_u && !want_v && !want_sce ) lwork = MAX( lwork, 2*n+1 ); // 1.1
152  if( !want_u && !want_v && want_sce ) lwork = MAX( lwork, n*n+3*n ); // 1.2
153  if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 5*n+2*n*n ); // 4.1
154  if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX( lwork, 4*n+n*n ); // 4.2
155  }
156  cwork = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
157  if( cwork == NULL ) {
159  goto exit_level_1;
160  }
161  lrwork = MAX3( lrwork, 7, n+2*m );
162  rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork );
163  if( rwork == NULL ) {
165  goto exit_level_2;
166  }
167  /* Call middle-level interface */
168  info = LAPACKE_zgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt,
169  jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork,
170  lwork, rwork, lrwork, iwork );
171  /* Backup significant data from working array(s) */
172  for( i=0; i<7; i++ ) {
173  stat[i] = rwork[i];
174  }
175  for( i=0; i<3; i++ ) {
176  istat[i] = iwork[i];
177  }
178  /* Release memory and exit */
179  LAPACKE_free( cwork );
180 exit_level_2:
181  LAPACKE_free( rwork );
182 exit_level_1:
183  LAPACKE_free( iwork );
184 exit_level_0:
185  if( info == LAPACK_WORK_MEMORY_ERROR ) {
186  LAPACKE_xerbla( "LAPACKE_zgejsv", info );
187  }
188  return info;
189 }
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:119
#define LAPACK_WORK_MEMORY_ERROR
Definition: lapacke.h:122
#define lapack_complex_double
Definition: lapacke.h:90
#define MAX3(x, y, z)
Definition: lapacke_utils.h:53
#define MAX(x, y)
Definition: lapacke_utils.h:47
#define LAPACKE_free(p)
Definition: lapacke.h:113
#define LAPACKE_malloc(size)
Definition: lapacke.h:110
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:36
#define LAPACK_COL_MAJOR
Definition: lapacke.h:120
void LAPACKE_xerbla(const char *name, lapack_int info)
#define lapack_int
Definition: lapacke.h:47
lapack_int LAPACKE_zgejsv_work(int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, lapack_complex_double *a, lapack_int lda, double *sva, lapack_complex_double *u, lapack_int ldu, lapack_complex_double *v, lapack_int ldv, lapack_complex_double *cwork, lapack_int lwork, double *work, lapack_int lrwork, lapack_int *iwork)
lapack_logical LAPACKE_zge_nancheck(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda)

Here is the call graph for this function: