@@ -91,6 +91,88 @@ void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB
91
91
cblas_zgemm ( UNDEFINED , transa , transb , * m , * n , * k , alpha , a , * lda ,
92
92
b , * ldb , beta , c , * ldc );
93
93
}
94
+
95
+
96
+ void F77_zgemmtr (CBLAS_INT * layout , char * uplop , char * transpa , char * transpb , CBLAS_INT * n ,
97
+ CBLAS_INT * k , CBLAS_TEST_ZOMPLEX * alpha , CBLAS_TEST_ZOMPLEX * a , CBLAS_INT * lda ,
98
+ CBLAS_TEST_ZOMPLEX * b , CBLAS_INT * ldb , CBLAS_TEST_ZOMPLEX * beta ,
99
+ CBLAS_TEST_ZOMPLEX * c , CBLAS_INT * ldc ) {
100
+
101
+ CBLAS_TEST_ZOMPLEX * A , * B , * C ;
102
+ CBLAS_INT i ,j ,LDA , LDB , LDC ;
103
+ CBLAS_TRANSPOSE transa , transb ;
104
+ CBLAS_UPLO uplo ;
105
+
106
+ get_transpose_type (transpa , & transa );
107
+ get_transpose_type (transpb , & transb );
108
+ get_uplo_type (uplop , & uplo );
109
+
110
+ if (* layout == TEST_ROW_MJR ) {
111
+ if (transa == CblasNoTrans ) {
112
+ LDA = * k + 1 ;
113
+ A = (CBLAS_TEST_ZOMPLEX * )malloc ((* n )* LDA * sizeof (CBLAS_TEST_ZOMPLEX ));
114
+ for ( i = 0 ; i < * n ; i ++ )
115
+ for ( j = 0 ; j < * k ; j ++ ) {
116
+ A [i * LDA + j ].real = a [j * (* lda )+ i ].real ;
117
+ A [i * LDA + j ].imag = a [j * (* lda )+ i ].imag ;
118
+ }
119
+ }
120
+ else {
121
+ LDA = * n + 1 ;
122
+ A = (CBLAS_TEST_ZOMPLEX * )malloc (LDA * (* k )* sizeof (CBLAS_TEST_ZOMPLEX ));
123
+ for ( i = 0 ; i < * k ; i ++ )
124
+ for ( j = 0 ; j < * n ; j ++ ) {
125
+ A [i * LDA + j ].real = a [j * (* lda )+ i ].real ;
126
+ A [i * LDA + j ].imag = a [j * (* lda )+ i ].imag ;
127
+ }
128
+ }
129
+
130
+ if (transb == CblasNoTrans ) {
131
+ LDB = * n + 1 ;
132
+ B = (CBLAS_TEST_ZOMPLEX * )malloc ((* k )* LDB * sizeof (CBLAS_TEST_ZOMPLEX ) );
133
+ for ( i = 0 ; i < * k ; i ++ )
134
+ for ( j = 0 ; j < * n ; j ++ ) {
135
+ B [i * LDB + j ].real = b [j * (* ldb )+ i ].real ;
136
+ B [i * LDB + j ].imag = b [j * (* ldb )+ i ].imag ;
137
+ }
138
+ }
139
+ else {
140
+ LDB = * k + 1 ;
141
+ B = (CBLAS_TEST_ZOMPLEX * )malloc (LDB * (* n )* sizeof (CBLAS_TEST_ZOMPLEX ));
142
+ for ( i = 0 ; i < * n ; i ++ )
143
+ for ( j = 0 ; j < * k ; j ++ ) {
144
+ B [i * LDB + j ].real = b [j * (* ldb )+ i ].real ;
145
+ B [i * LDB + j ].imag = b [j * (* ldb )+ i ].imag ;
146
+ }
147
+ }
148
+
149
+ LDC = * n + 1 ;
150
+ C = (CBLAS_TEST_ZOMPLEX * )malloc ((* n )* LDC * sizeof (CBLAS_TEST_ZOMPLEX ));
151
+ for ( j = 0 ; j < * n ; j ++ )
152
+ for ( i = 0 ; i < * n ; i ++ ) {
153
+ C [i * LDC + j ].real = c [j * (* ldc )+ i ].real ;
154
+ C [i * LDC + j ].imag = c [j * (* ldc )+ i ].imag ;
155
+ }
156
+ cblas_cgemmtr ( CblasRowMajor , uplo , transa , transb , * n , * k , alpha , A , LDA ,
157
+ B , LDB , beta , C , LDC );
158
+ for ( j = 0 ; j < * n ; j ++ )
159
+ for ( i = 0 ; i < * n ; i ++ ) {
160
+ c [j * (* ldc )+ i ].real = C [i * LDC + j ].real ;
161
+ c [j * (* ldc )+ i ].imag = C [i * LDC + j ].imag ;
162
+ }
163
+ free (A );
164
+ free (B );
165
+ free (C );
166
+ }
167
+ else if (* layout == TEST_COL_MJR )
168
+ cblas_zgemmtr ( CblasColMajor , uplo , transa , transb , * n , * k , alpha , a , * lda ,
169
+ b , * ldb , beta , c , * ldc );
170
+ else
171
+ cblas_zgemmtr ( UNDEFINED , uplo , transa , transb , * n , * k , alpha , a , * lda ,
172
+ b , * ldb , beta , c , * ldc );
173
+ }
174
+
175
+
94
176
void F77_zhemm (CBLAS_INT * layout , char * rtlf , char * uplow , CBLAS_INT * m , CBLAS_INT * n ,
95
177
CBLAS_TEST_ZOMPLEX * alpha , CBLAS_TEST_ZOMPLEX * a , CBLAS_INT * lda ,
96
178
CBLAS_TEST_ZOMPLEX * b , CBLAS_INT * ldb , CBLAS_TEST_ZOMPLEX * beta ,
0 commit comments