LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ LAPACKE_ztf_nancheck()

lapack_logical LAPACKE_ztf_nancheck ( int  matrix_layout,
char  transr,
char  uplo,
char  diag,
lapack_int  n,
const lapack_complex_double a 
)

Definition at line 37 of file lapacke_ztf_nancheck.c.

41 {
42  lapack_int len;
43  lapack_logical rowmaj, ntr, lower, unit;
44  lapack_int n1, n2, k;
45 
46  if( a == NULL ) return (lapack_logical) 0;
47 
48  rowmaj = (matrix_layout == LAPACK_ROW_MAJOR);
49  ntr = LAPACKE_lsame( transr, 'n' );
50  lower = LAPACKE_lsame( uplo, 'l' );
51  unit = LAPACKE_lsame( diag, 'u' );
52 
53  if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) ||
54  ( !ntr && !LAPACKE_lsame( transr, 't' )
55  && !LAPACKE_lsame( transr, 'c' ) ) ||
56  ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
57  ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
58  /* Just exit if any of input parameters are wrong */
59  return (lapack_logical) 0;
60  }
61 
62  if( unit ) {
63  /* Unit case, diagonal should be excluded from the check for NaN.
64  * Decoding RFP and checking both triangulars and rectangular
65  * for NaNs.
66  */
67  if( lower ) {
68  n2 = n / 2;
69  n1 = n - n2;
70  } else {
71  n1 = n / 2;
72  n2 = n - n1;
73  }
74  if( n % 2 == 1 ) {
75  /* N is odd */
76  if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) {
77  /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */
78  if( lower ) {
79  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
80  n1, &a[0], n )
82  &a[n1], n )
84  n2, &a[n], n );
85  } else {
86  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
87  n1, &a[n2], n )
89  &a[0], n )
91  n2, &a[n1], n );
92  }
93  } else {
94  /* N is odd and
95  * ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR )
96  */
97  if( lower ) {
98  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
99  n1, &a[0], n1 )
101  &a[1], n1 )
103  n2, &a[1], n1 );
104  } else {
105  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
106  n1, &a[(size_t)n2*n2], n2 )
108  &a[0], n2 )
110  n2, &a[(size_t)n1*n2], n2 );
111  }
112  }
113  } else {
114  /* N is even */
115  k = n / 2;
116  if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) {
117  /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */
118  if( lower ) {
119  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
120  k, &a[1], n+1 )
122  &a[k+1], n+1 )
124  k, &a[0], n+1 );
125  } else {
126  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u',
127  k, &a[k+1], n+1 )
129  &a[0], n+1 )
131  k, &a[k], n+1 );
132  }
133  } else {
134  /* N is even and
135  ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */
136  if( lower ) {
137  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
138  k, &a[k], k )
140  &a[(size_t)k*(k+1)], k )
142  k, &a[0], k );
143  } else {
144  return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u',
145  k, &a[(size_t)k*(k+1)], k )
147  &a[0], k )
149  k, &a[(size_t)k*k], k );
150  }
151  }
152  }
153  } else {
154  /* Non-unit case - just check whole array for NaNs. */
155  len = n*(n+1)/2;
156  return LAPACKE_zge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len );
157  }
158 }
#define lapack_logical
Definition: lapacke.h:51
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:119
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:36
lapack_logical LAPACKE_ztr_nancheck(int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *a, lapack_int lda)
#define LAPACK_COL_MAJOR
Definition: lapacke.h:120
#define lapack_int
Definition: lapacke.h:47
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:
Here is the caller graph for this function: