@@ -48,16 +48,24 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
48
48
info = info - 1 ;
49
49
}
50
50
} else if ( matrix_layout == LAPACK_ROW_MAJOR ) {
51
- lapack_int lda_t = MAX (1 ,k );
51
+ lapack_int nrowsA , ncolsA , nrowsV ;
52
+ if ( side == 'L' ) { nrowsA = k ; ncolsA = n ; nrowsV = m ; }
53
+ else if ( side == 'R' ) { nrowsA = m ; ncolsA = k ; nrowsV = n ; }
54
+ else {
55
+ info = -2 ;
56
+ LAPACKE_xerbla ( "LAPACKE_dtpmqrt_work" , info );
57
+ return info ;
58
+ }
59
+ lapack_int lda_t = MAX (1 ,nrowsA );
52
60
lapack_int ldb_t = MAX (1 ,m );
53
- lapack_int ldt_t = MAX (1 ,ldt );
54
- lapack_int ldv_t = MAX (1 ,ldv );
61
+ lapack_int ldt_t = MAX (1 ,nb );
62
+ lapack_int ldv_t = MAX (1 ,nrowsV );
55
63
double * v_t = NULL ;
56
64
double * t_t = NULL ;
57
65
double * a_t = NULL ;
58
66
double * b_t = NULL ;
59
67
/* Check leading dimension(s) */
60
- if ( lda < m ) {
68
+ if ( lda < ncolsA ) {
61
69
info = -14 ;
62
70
LAPACKE_xerbla ( "LAPACKE_dtpmqrt_work" , info );
63
71
return info ;
@@ -67,7 +75,7 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
67
75
LAPACKE_xerbla ( "LAPACKE_dtpmqrt_work" , info );
68
76
return info ;
69
77
}
70
- if ( ldt < nb ) {
78
+ if ( ldt < k ) {
71
79
info = -12 ;
72
80
LAPACKE_xerbla ( "LAPACKE_dtpmqrt_work" , info );
73
81
return info ;
@@ -83,12 +91,12 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
83
91
info = LAPACK_TRANSPOSE_MEMORY_ERROR ;
84
92
goto exit_level_0 ;
85
93
}
86
- t_t = (double * )LAPACKE_malloc ( sizeof (double ) * ldt_t * MAX (1 ,nb ) );
94
+ t_t = (double * )LAPACKE_malloc ( sizeof (double ) * ldt_t * MAX (1 ,k ) );
87
95
if ( t_t == NULL ) {
88
96
info = LAPACK_TRANSPOSE_MEMORY_ERROR ;
89
97
goto exit_level_1 ;
90
98
}
91
- a_t = (double * )LAPACKE_malloc ( sizeof (double ) * lda_t * MAX (1 ,m ) );
99
+ a_t = (double * )LAPACKE_malloc ( sizeof (double ) * lda_t * MAX (1 ,ncolsA ) );
92
100
if ( a_t == NULL ) {
93
101
info = LAPACK_TRANSPOSE_MEMORY_ERROR ;
94
102
goto exit_level_2 ;
@@ -99,19 +107,19 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
99
107
goto exit_level_3 ;
100
108
}
101
109
/* Transpose input matrices */
102
- LAPACKE_dge_trans ( matrix_layout , ldv , k , v , ldv , v_t , ldv_t );
103
- LAPACKE_dge_trans ( matrix_layout , ldt , nb , t , ldt , t_t , ldt_t );
104
- LAPACKE_dge_trans ( matrix_layout , k , m , a , lda , a_t , lda_t );
105
- LAPACKE_dge_trans ( matrix_layout , m , n , b , ldb , b_t , ldb_t );
110
+ LAPACKE_dge_trans ( LAPACK_ROW_MAJOR , nrowsV , k , v , ldv , v_t , ldv_t );
111
+ LAPACKE_dge_trans ( LAPACK_ROW_MAJOR , nb , k , t , ldt , t_t , ldt_t );
112
+ LAPACKE_dge_trans ( LAPACK_ROW_MAJOR , nrowsA , ncolsA , a , lda , a_t , lda_t );
113
+ LAPACKE_dge_trans ( LAPACK_ROW_MAJOR , m , n , b , ldb , b_t , ldb_t );
106
114
/* Call LAPACK function and adjust info */
107
115
LAPACK_dtpmqrt ( & side , & trans , & m , & n , & k , & l , & nb , v_t , & ldv_t , t_t ,
108
116
& ldt_t , a_t , & lda_t , b_t , & ldb_t , work , & info );
109
117
if ( info < 0 ) {
110
118
info = info - 1 ;
111
119
}
112
120
/* Transpose output matrices */
113
- LAPACKE_dge_trans ( LAPACK_COL_MAJOR , k , m , a_t , lda_t , a , lda );
114
- LAPACKE_dge_trans ( LAPACK_COL_MAJOR , m , n , b_t , ldb_t , b , ldb );
121
+ LAPACKE_dge_trans ( LAPACK_COL_MAJOR , ncolsA , nrowsA , a_t , lda_t , a , lda );
122
+ LAPACKE_dge_trans ( LAPACK_COL_MAJOR , n , m , b_t , ldb_t , b , ldb );
115
123
/* Release memory and exit */
116
124
LAPACKE_free ( b_t );
117
125
exit_level_3 :
0 commit comments