OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lapacke_zstemr.c File Reference
#include "lapacke_utils.h"

Go to the source code of this file.

Functions

lapack_int LAPACKE_zstemr (int matrix_layout, char jobz, char range, lapack_int n, double *d, double *e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int *m, double *w, lapack_complex_double *z, lapack_int ldz, lapack_int nzc, lapack_int *isuppz, lapack_logical *tryrac)

Function Documentation

◆ LAPACKE_zstemr()

lapack_int LAPACKE_zstemr ( int matrix_layout,
char jobz,
char range,
lapack_int n,
double * d,
double * e,
double vl,
double vu,
lapack_int il,
lapack_int iu,
lapack_int * m,
double * w,
lapack_complex_double * z,
lapack_int ldz,
lapack_int nzc,
lapack_int * isuppz,
lapack_logical * tryrac )

Definition at line 35 of file lapacke_zstemr.c.

41{
42 lapack_int info = 0;
43 lapack_int liwork = -1;
44 lapack_int lwork = -1;
45 lapack_int* iwork = NULL;
46 double* work = NULL;
47 lapack_int iwork_query;
48 double work_query;
49 if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
50 LAPACKE_xerbla( "LAPACKE_zstemr", -1 );
51 return -1;
52 }
53#ifndef LAPACK_DISABLE_NAN_CHECK
54 if( LAPACKE_get_nancheck() ) {
55 /* Optionally check input matrices for NaNs */
56 if( LAPACKE_d_nancheck( n, d, 1 ) ) {
57 return -5;
58 }
59 if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
60 return -6;
61 }
62 if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
63 return -7;
64 }
65 if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
66 return -8;
67 }
68 }
69#endif
70 /* Query optimal working array(s) size */
71 info = LAPACKE_zstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il,
72 iu, m, w, z, ldz, nzc, isuppz, tryrac,
73 &work_query, lwork, &iwork_query, liwork );
74 if( info != 0 ) {
75 goto exit_level_0;
76 }
77 liwork = iwork_query;
78 lwork = (lapack_int)work_query;
79 /* Allocate memory for work arrays */
80 iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
81 if( iwork == NULL ) {
83 goto exit_level_0;
84 }
85 work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
86 if( work == NULL ) {
88 goto exit_level_1;
89 }
90 /* Call middle-level interface */
91 info = LAPACKE_zstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il,
92 iu, m, w, z, ldz, nzc, isuppz, tryrac, work,
93 lwork, iwork, liwork );
94 /* Release memory and exit */
95 LAPACKE_free( work );
96exit_level_1:
97 LAPACKE_free( iwork );
98exit_level_0:
99 if( info == LAPACK_WORK_MEMORY_ERROR ) {
100 LAPACKE_xerbla( "LAPACKE_zstemr", info );
101 }
102 return info;
103}
#define lapack_int
Definition lapack.h:83
#define LAPACK_WORK_MEMORY_ERROR
Definition lapacke.h:55
#define LAPACK_COL_MAJOR
Definition lapacke.h:53
#define LAPACKE_free(p)
Definition lapacke.h:46
lapack_int LAPACKE_zstemr_work(int matrix_layout, char jobz, char range, lapack_int n, double *d, double *e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int *m, double *w, lapack_complex_double *z, lapack_int ldz, lapack_int nzc, lapack_int *isuppz, lapack_logical *tryrac, double *work, lapack_int lwork, lapack_int *iwork, lapack_int liwork)
#define LAPACK_ROW_MAJOR
Definition lapacke.h:52
int LAPACKE_get_nancheck(void)
#define LAPACKE_malloc(size)
Definition lapacke.h:43
void LAPACKE_xerbla(const char *name, lapack_int info)
lapack_logical LAPACKE_d_nancheck(lapack_int n, const double *x, lapack_int incx)
n