nmatrix-lapacke 0.2.1 → 0.2.3

Sign up to get free protection for your applications and to get access to all the features.
Files changed (49) hide show
  1. checksums.yaml +4 -4
  2. data/ext/nmatrix/data/data.h +7 -8
  3. data/ext/nmatrix/data/ruby_object.h +1 -4
  4. data/ext/nmatrix/math/asum.h +10 -31
  5. data/ext/nmatrix/math/cblas_templates_core.h +10 -10
  6. data/ext/nmatrix/math/getrf.h +2 -2
  7. data/ext/nmatrix/math/imax.h +12 -9
  8. data/ext/nmatrix/math/laswp.h +3 -3
  9. data/ext/nmatrix/math/long_dtype.h +16 -3
  10. data/ext/nmatrix/math/magnitude.h +54 -0
  11. data/ext/nmatrix/math/nrm2.h +19 -14
  12. data/ext/nmatrix/math/trsm.h +40 -36
  13. data/ext/nmatrix/math/util.h +14 -0
  14. data/ext/nmatrix/nmatrix.h +39 -1
  15. data/ext/nmatrix/storage/common.h +9 -3
  16. data/ext/nmatrix/storage/yale/class.h +1 -1
  17. data/ext/nmatrix_lapacke/extconf.rb +3 -136
  18. data/ext/nmatrix_lapacke/lapacke.cpp +104 -84
  19. data/ext/nmatrix_lapacke/lapacke/src/lapacke_cgeqrf.c +77 -0
  20. data/ext/nmatrix_lapacke/lapacke/src/lapacke_cgeqrf_work.c +89 -0
  21. data/ext/nmatrix_lapacke/lapacke/src/lapacke_cunmqr.c +88 -0
  22. data/ext/nmatrix_lapacke/lapacke/src/lapacke_cunmqr_work.c +111 -0
  23. data/ext/nmatrix_lapacke/lapacke/src/lapacke_dgeqrf.c +75 -0
  24. data/ext/nmatrix_lapacke/lapacke/src/lapacke_dgeqrf_work.c +87 -0
  25. data/ext/nmatrix_lapacke/lapacke/src/lapacke_dormqr.c +86 -0
  26. data/ext/nmatrix_lapacke/lapacke/src/lapacke_dormqr_work.c +109 -0
  27. data/ext/nmatrix_lapacke/lapacke/src/lapacke_sgeqrf.c +75 -0
  28. data/ext/nmatrix_lapacke/lapacke/src/lapacke_sgeqrf_work.c +87 -0
  29. data/ext/nmatrix_lapacke/lapacke/src/lapacke_sormqr.c +86 -0
  30. data/ext/nmatrix_lapacke/lapacke/src/lapacke_sormqr_work.c +109 -0
  31. data/ext/nmatrix_lapacke/lapacke/src/lapacke_zgeqrf.c +77 -0
  32. data/ext/nmatrix_lapacke/lapacke/src/lapacke_zgeqrf_work.c +89 -0
  33. data/ext/nmatrix_lapacke/lapacke/src/lapacke_zunmqr.c +88 -0
  34. data/ext/nmatrix_lapacke/lapacke/src/lapacke_zunmqr_work.c +111 -0
  35. data/ext/nmatrix_lapacke/lapacke/utils/lapacke_c_nancheck.c +51 -0
  36. data/ext/nmatrix_lapacke/lapacke/utils/lapacke_d_nancheck.c +51 -0
  37. data/ext/nmatrix_lapacke/lapacke/utils/lapacke_s_nancheck.c +51 -0
  38. data/ext/nmatrix_lapacke/lapacke/utils/lapacke_z_nancheck.c +51 -0
  39. data/ext/nmatrix_lapacke/math_lapacke.cpp +149 -17
  40. data/ext/nmatrix_lapacke/math_lapacke/lapacke_templates.h +76 -0
  41. data/lib/nmatrix/lapacke.rb +118 -0
  42. data/spec/00_nmatrix_spec.rb +50 -1
  43. data/spec/02_slice_spec.rb +21 -21
  44. data/spec/blas_spec.rb +25 -3
  45. data/spec/math_spec.rb +233 -5
  46. data/spec/plugins/lapacke/lapacke_spec.rb +187 -0
  47. data/spec/shortcuts_spec.rb +145 -5
  48. data/spec/spec_helper.rb +24 -1
  49. metadata +38 -8
@@ -0,0 +1,111 @@
1
+ /*****************************************************************************
2
+ Copyright (c) 2014, Intel Corp.
3
+ All rights reserved.
4
+
5
+ Redistribution and use in source and binary forms, with or without
6
+ modification, are permitted provided that the following conditions are met:
7
+
8
+ * Redistributions of source code must retain the above copyright notice,
9
+ this list of conditions and the following disclaimer.
10
+ * Redistributions in binary form must reproduce the above copyright
11
+ notice, this list of conditions and the following disclaimer in the
12
+ documentation and/or other materials provided with the distribution.
13
+ * Neither the name of Intel Corporation nor the names of its contributors
14
+ may be used to endorse or promote products derived from this software
15
+ without specific prior written permission.
16
+
17
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27
+ THE POSSIBILITY OF SUCH DAMAGE.
28
+ *****************************************************************************
29
+ * Contents: Native middle-level C interface to LAPACK function cunmqr
30
+ * Author: Intel Corporation
31
+ * Generated November 2015
32
+ *****************************************************************************/
33
+
34
+ #include "lapacke_utils.h"
35
+
36
+ lapack_int LAPACKE_cunmqr_work( int matrix_layout, char side, char trans,
37
+ lapack_int m, lapack_int n, lapack_int k,
38
+ const lapack_complex_float* a, lapack_int lda,
39
+ const lapack_complex_float* tau,
40
+ lapack_complex_float* c, lapack_int ldc,
41
+ lapack_complex_float* work, lapack_int lwork )
42
+ {
43
+ lapack_int info = 0;
44
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
45
+ /* Call LAPACK function and adjust info */
46
+ LAPACK_cunmqr( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
47
+ &lwork, &info );
48
+ if( info < 0 ) {
49
+ info = info - 1;
50
+ }
51
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
52
+ lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
53
+ lapack_int lda_t = MAX(1,r);
54
+ lapack_int ldc_t = MAX(1,m);
55
+ lapack_complex_float* a_t = NULL;
56
+ lapack_complex_float* c_t = NULL;
57
+ /* Check leading dimension(s) */
58
+ if( lda < k ) {
59
+ info = -8;
60
+ LAPACKE_xerbla( "LAPACKE_cunmqr_work", info );
61
+ return info;
62
+ }
63
+ if( ldc < n ) {
64
+ info = -11;
65
+ LAPACKE_xerbla( "LAPACKE_cunmqr_work", info );
66
+ return info;
67
+ }
68
+ /* Query optimal working array(s) size if requested */
69
+ if( lwork == -1 ) {
70
+ LAPACK_cunmqr( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
71
+ work, &lwork, &info );
72
+ return (info < 0) ? (info - 1) : info;
73
+ }
74
+ /* Allocate memory for temporary array(s) */
75
+ a_t = (lapack_complex_float*)
76
+ LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,k) );
77
+ if( a_t == NULL ) {
78
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
79
+ goto exit_level_0;
80
+ }
81
+ c_t = (lapack_complex_float*)
82
+ LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) );
83
+ if( c_t == NULL ) {
84
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
85
+ goto exit_level_1;
86
+ }
87
+ /* Transpose input matrices */
88
+ LAPACKE_cge_trans( matrix_layout, r, k, a, lda, a_t, lda_t );
89
+ LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
90
+ /* Call LAPACK function and adjust info */
91
+ LAPACK_cunmqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
92
+ work, &lwork, &info );
93
+ if( info < 0 ) {
94
+ info = info - 1;
95
+ }
96
+ /* Transpose output matrices */
97
+ LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
98
+ /* Release memory and exit */
99
+ LAPACKE_free( c_t );
100
+ exit_level_1:
101
+ LAPACKE_free( a_t );
102
+ exit_level_0:
103
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
104
+ LAPACKE_xerbla( "LAPACKE_cunmqr_work", info );
105
+ }
106
+ } else {
107
+ info = -1;
108
+ LAPACKE_xerbla( "LAPACKE_cunmqr_work", info );
109
+ }
110
+ return info;
111
+ }
@@ -0,0 +1,75 @@
1
+ /*****************************************************************************
2
+ Copyright (c) 2014, Intel Corp.
3
+ All rights reserved.
4
+
5
+ Redistribution and use in source and binary forms, with or without
6
+ modification, are permitted provided that the following conditions are met:
7
+
8
+ * Redistributions of source code must retain the above copyright notice,
9
+ this list of conditions and the following disclaimer.
10
+ * Redistributions in binary form must reproduce the above copyright
11
+ notice, this list of conditions and the following disclaimer in the
12
+ documentation and/or other materials provided with the distribution.
13
+ * Neither the name of Intel Corporation nor the names of its contributors
14
+ may be used to endorse or promote products derived from this software
15
+ without specific prior written permission.
16
+
17
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27
+ THE POSSIBILITY OF SUCH DAMAGE.
28
+ *****************************************************************************
29
+ * Contents: Native high-level C interface to LAPACK function dgeqrf
30
+ * Author: Intel Corporation
31
+ * Generated November 2015
32
+ *****************************************************************************/
33
+
34
+ #include "lapacke_utils.h"
35
+
36
+ lapack_int LAPACKE_dgeqrf( int matrix_layout, lapack_int m, lapack_int n,
37
+ double* a, lapack_int lda, double* tau )
38
+ {
39
+ lapack_int info = 0;
40
+ lapack_int lwork = -1;
41
+ double* work = NULL;
42
+ double work_query;
43
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
44
+ LAPACKE_xerbla( "LAPACKE_dgeqrf", -1 );
45
+ return -1;
46
+ }
47
+ #ifndef LAPACK_DISABLE_NAN_CHECK
48
+ /* Optionally check input matrices for NaNs */
49
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
50
+ return -4;
51
+ }
52
+ #endif
53
+ /* Query optimal working array(s) size */
54
+ info = LAPACKE_dgeqrf_work( matrix_layout, m, n, a, lda, tau, &work_query,
55
+ lwork );
56
+ if( info != 0 ) {
57
+ goto exit_level_0;
58
+ }
59
+ lwork = (lapack_int)work_query;
60
+ /* Allocate memory for work arrays */
61
+ work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
62
+ if( work == NULL ) {
63
+ info = LAPACK_WORK_MEMORY_ERROR;
64
+ goto exit_level_0;
65
+ }
66
+ /* Call middle-level interface */
67
+ info = LAPACKE_dgeqrf_work( matrix_layout, m, n, a, lda, tau, work, lwork );
68
+ /* Release memory and exit */
69
+ LAPACKE_free( work );
70
+ exit_level_0:
71
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
72
+ LAPACKE_xerbla( "LAPACKE_dgeqrf", info );
73
+ }
74
+ return info;
75
+ }
@@ -0,0 +1,87 @@
1
+ /*****************************************************************************
2
+ Copyright (c) 2014, Intel Corp.
3
+ All rights reserved.
4
+
5
+ Redistribution and use in source and binary forms, with or without
6
+ modification, are permitted provided that the following conditions are met:
7
+
8
+ * Redistributions of source code must retain the above copyright notice,
9
+ this list of conditions and the following disclaimer.
10
+ * Redistributions in binary form must reproduce the above copyright
11
+ notice, this list of conditions and the following disclaimer in the
12
+ documentation and/or other materials provided with the distribution.
13
+ * Neither the name of Intel Corporation nor the names of its contributors
14
+ may be used to endorse or promote products derived from this software
15
+ without specific prior written permission.
16
+
17
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27
+ THE POSSIBILITY OF SUCH DAMAGE.
28
+ *****************************************************************************
29
+ * Contents: Native middle-level C interface to LAPACK function dgeqrf
30
+ * Author: Intel Corporation
31
+ * Generated November 2015
32
+ *****************************************************************************/
33
+
34
+ #include "lapacke_utils.h"
35
+
36
+ lapack_int LAPACKE_dgeqrf_work( int matrix_layout, lapack_int m, lapack_int n,
37
+ double* a, lapack_int lda, double* tau,
38
+ double* work, lapack_int lwork )
39
+ {
40
+ lapack_int info = 0;
41
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
42
+ /* Call LAPACK function and adjust info */
43
+ LAPACK_dgeqrf( &m, &n, a, &lda, tau, work, &lwork, &info );
44
+ if( info < 0 ) {
45
+ info = info - 1;
46
+ }
47
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
48
+ lapack_int lda_t = MAX(1,m);
49
+ double* a_t = NULL;
50
+ /* Check leading dimension(s) */
51
+ if( lda < n ) {
52
+ info = -5;
53
+ LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info );
54
+ return info;
55
+ }
56
+ /* Query optimal working array(s) size if requested */
57
+ if( lwork == -1 ) {
58
+ LAPACK_dgeqrf( &m, &n, a, &lda_t, tau, work, &lwork, &info );
59
+ return (info < 0) ? (info - 1) : info;
60
+ }
61
+ /* Allocate memory for temporary array(s) */
62
+ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
63
+ if( a_t == NULL ) {
64
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
65
+ goto exit_level_0;
66
+ }
67
+ /* Transpose input matrices */
68
+ LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
69
+ /* Call LAPACK function and adjust info */
70
+ LAPACK_dgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info );
71
+ if( info < 0 ) {
72
+ info = info - 1;
73
+ }
74
+ /* Transpose output matrices */
75
+ LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
76
+ /* Release memory and exit */
77
+ LAPACKE_free( a_t );
78
+ exit_level_0:
79
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
80
+ LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info );
81
+ }
82
+ } else {
83
+ info = -1;
84
+ LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info );
85
+ }
86
+ return info;
87
+ }
@@ -0,0 +1,86 @@
1
+ /*****************************************************************************
2
+ Copyright (c) 2014, Intel Corp.
3
+ All rights reserved.
4
+
5
+ Redistribution and use in source and binary forms, with or without
6
+ modification, are permitted provided that the following conditions are met:
7
+
8
+ * Redistributions of source code must retain the above copyright notice,
9
+ this list of conditions and the following disclaimer.
10
+ * Redistributions in binary form must reproduce the above copyright
11
+ notice, this list of conditions and the following disclaimer in the
12
+ documentation and/or other materials provided with the distribution.
13
+ * Neither the name of Intel Corporation nor the names of its contributors
14
+ may be used to endorse or promote products derived from this software
15
+ without specific prior written permission.
16
+
17
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27
+ THE POSSIBILITY OF SUCH DAMAGE.
28
+ *****************************************************************************
29
+ * Contents: Native high-level C interface to LAPACK function dormqr
30
+ * Author: Intel Corporation
31
+ * Generated November 2015
32
+ *****************************************************************************/
33
+
34
+ #include "lapacke_utils.h"
35
+
36
+ lapack_int LAPACKE_dormqr( int matrix_layout, char side, char trans,
37
+ lapack_int m, lapack_int n, lapack_int k,
38
+ const double* a, lapack_int lda, const double* tau,
39
+ double* c, lapack_int ldc )
40
+ {
41
+ lapack_int info = 0;
42
+ lapack_int lwork = -1;
43
+ double* work = NULL;
44
+ double work_query;
45
+ lapack_int r;
46
+ if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
47
+ LAPACKE_xerbla( "LAPACKE_dormqr", -1 );
48
+ return -1;
49
+ }
50
+ #ifndef LAPACK_DISABLE_NAN_CHECK
51
+ /* Optionally check input matrices for NaNs */
52
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
53
+ if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) {
54
+ return -7;
55
+ }
56
+ if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
57
+ return -10;
58
+ }
59
+ if( LAPACKE_d_nancheck( k, tau, 1 ) ) {
60
+ return -9;
61
+ }
62
+ #endif
63
+ /* Query optimal working array(s) size */
64
+ info = LAPACKE_dormqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau,
65
+ c, ldc, &work_query, lwork );
66
+ if( info != 0 ) {
67
+ goto exit_level_0;
68
+ }
69
+ lwork = (lapack_int)work_query;
70
+ /* Allocate memory for work arrays */
71
+ work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
72
+ if( work == NULL ) {
73
+ info = LAPACK_WORK_MEMORY_ERROR;
74
+ goto exit_level_0;
75
+ }
76
+ /* Call middle-level interface */
77
+ info = LAPACKE_dormqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau,
78
+ c, ldc, work, lwork );
79
+ /* Release memory and exit */
80
+ LAPACKE_free( work );
81
+ exit_level_0:
82
+ if( info == LAPACK_WORK_MEMORY_ERROR ) {
83
+ LAPACKE_xerbla( "LAPACKE_dormqr", info );
84
+ }
85
+ return info;
86
+ }
@@ -0,0 +1,109 @@
1
+ /*****************************************************************************
2
+ Copyright (c) 2014, Intel Corp.
3
+ All rights reserved.
4
+
5
+ Redistribution and use in source and binary forms, with or without
6
+ modification, are permitted provided that the following conditions are met:
7
+
8
+ * Redistributions of source code must retain the above copyright notice,
9
+ this list of conditions and the following disclaimer.
10
+ * Redistributions in binary form must reproduce the above copyright
11
+ notice, this list of conditions and the following disclaimer in the
12
+ documentation and/or other materials provided with the distribution.
13
+ * Neither the name of Intel Corporation nor the names of its contributors
14
+ may be used to endorse or promote products derived from this software
15
+ without specific prior written permission.
16
+
17
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20
+ ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21
+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22
+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23
+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24
+ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25
+ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26
+ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27
+ THE POSSIBILITY OF SUCH DAMAGE.
28
+ *****************************************************************************
29
+ * Contents: Native middle-level C interface to LAPACK function dormqr
30
+ * Author: Intel Corporation
31
+ * Generated November 2015
32
+ *****************************************************************************/
33
+
34
+ #include "lapacke_utils.h"
35
+
36
+ lapack_int LAPACKE_dormqr_work( int matrix_layout, char side, char trans,
37
+ lapack_int m, lapack_int n, lapack_int k,
38
+ const double* a, lapack_int lda,
39
+ const double* tau, double* c, lapack_int ldc,
40
+ double* work, lapack_int lwork )
41
+ {
42
+ lapack_int info = 0;
43
+ lapack_int r;
44
+ lapack_int lda_t, ldc_t;
45
+ double *a_t = NULL, *c_t = NULL;
46
+ if( matrix_layout == LAPACK_COL_MAJOR ) {
47
+ /* Call LAPACK function and adjust info */
48
+ LAPACK_dormqr( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
49
+ &lwork, &info );
50
+ if( info < 0 ) {
51
+ info = info - 1;
52
+ }
53
+ } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
54
+ r = LAPACKE_lsame( side, 'l' ) ? m : n;
55
+ lda_t = MAX(1,r);
56
+ ldc_t = MAX(1,m);
57
+ /* Check leading dimension(s) */
58
+ if( lda < k ) {
59
+ info = -8;
60
+ LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
61
+ return info;
62
+ }
63
+ if( ldc < n ) {
64
+ info = -11;
65
+ LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
66
+ return info;
67
+ }
68
+ /* Query optimal working array(s) size if requested */
69
+ if( lwork == -1 ) {
70
+ LAPACK_dormqr( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
71
+ work, &lwork, &info );
72
+ return (info < 0) ? (info - 1) : info;
73
+ }
74
+ /* Allocate memory for temporary array(s) */
75
+ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,k) );
76
+ if( a_t == NULL ) {
77
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
78
+ goto exit_level_0;
79
+ }
80
+ c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
81
+ if( c_t == NULL ) {
82
+ info = LAPACK_TRANSPOSE_MEMORY_ERROR;
83
+ goto exit_level_1;
84
+ }
85
+ /* Transpose input matrices */
86
+ LAPACKE_dge_trans( matrix_layout, r, k, a, lda, a_t, lda_t );
87
+ LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
88
+ /* Call LAPACK function and adjust info */
89
+ LAPACK_dormqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
90
+ work, &lwork, &info );
91
+ if( info < 0 ) {
92
+ info = info - 1;
93
+ }
94
+ /* Transpose output matrices */
95
+ LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
96
+ /* Release memory and exit */
97
+ LAPACKE_free( c_t );
98
+ exit_level_1:
99
+ LAPACKE_free( a_t );
100
+ exit_level_0:
101
+ if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
102
+ LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
103
+ }
104
+ } else {
105
+ info = -1;
106
+ LAPACKE_xerbla( "LAPACKE_dormqr_work", info );
107
+ }
108
+ return info;
109
+ }