libflame  revision_anchor
Functions
bl1_syr2k.c File Reference

(r)

Functions

void bl1_ssyr2k (uplo1_t uplo, trans1_t trans, int m, int k, float *alpha, float *a, int a_rs, int a_cs, float *b, int b_rs, int b_cs, float *beta, float *c, int c_rs, int c_cs)
 
void bl1_dsyr2k (uplo1_t uplo, trans1_t trans, int m, int k, double *alpha, double *a, int a_rs, int a_cs, double *b, int b_rs, int b_cs, double *beta, double *c, int c_rs, int c_cs)
 
void bl1_csyr2k (uplo1_t uplo, trans1_t trans, int m, int k, scomplex *alpha, scomplex *a, int a_rs, int a_cs, scomplex *b, int b_rs, int b_cs, scomplex *beta, scomplex *c, int c_rs, int c_cs)
 
void bl1_zsyr2k (uplo1_t uplo, trans1_t trans, int m, int k, dcomplex *alpha, dcomplex *a, int a_rs, int a_cs, dcomplex *b, int b_rs, int b_cs, dcomplex *beta, dcomplex *c, int c_rs, int c_cs)
 
void bl1_ssyr2k_blas (uplo1_t uplo, trans1_t trans, int m, int k, float *alpha, float *a, int lda, float *b, int ldb, float *beta, float *c, int ldc)
 
void bl1_dsyr2k_blas (uplo1_t uplo, trans1_t trans, int m, int k, double *alpha, double *a, int lda, double *b, int ldb, double *beta, double *c, int ldc)
 
void bl1_csyr2k_blas (uplo1_t uplo, trans1_t trans, int m, int k, scomplex *alpha, scomplex *a, int lda, scomplex *b, int ldb, scomplex *beta, scomplex *c, int ldc)
 
void bl1_zsyr2k_blas (uplo1_t uplo, trans1_t trans, int m, int k, dcomplex *alpha, dcomplex *a, int lda, dcomplex *b, int ldb, dcomplex *beta, dcomplex *c, int ldc)
 

Function Documentation

◆ bl1_csyr2k()

void bl1_csyr2k ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
scomplex alpha,
scomplex a,
int  a_rs,
int  a_cs,
scomplex b,
int  b_rs,
int  b_cs,
scomplex beta,
scomplex c,
int  c_rs,
int  c_cs 
)

References bl1_callocm(), bl1_ccopymt(), bl1_ccreate_contigmr(), bl1_ccreate_contigmt(), bl1_cfree(), bl1_cfree_contigm(), bl1_cfree_saved_contigmr(), bl1_csyr2k_blas(), bl1_is_col_storage(), bl1_set_dims_with_trans(), bl1_zero_dim2(), and BLIS1_NO_TRANSPOSE.

Referenced by FLA_Syr2k_external().

466 {
467  uplo1_t uplo_save = uplo;
468  int m_save = m;
469  scomplex* a_save = a;
470  scomplex* b_save = b;
471  scomplex* c_save = c;
472  int a_rs_save = a_rs;
473  int a_cs_save = a_cs;
474  int b_rs_save = b_rs;
475  int b_cs_save = b_cs;
476  int c_rs_save = c_rs;
477  int c_cs_save = c_cs;
478  scomplex* a_copy;
479  scomplex* b_copy;
480  int lda, inca;
481  int ldb, incb;
482  int ldc, incc;
483  int lda_copy, inca_copy;
484  int ldb_copy, incb_copy;
485  int syr2k_needs_copya = FALSE;
486  int syr2k_needs_copyb = FALSE;
487 
488  // Return early if possible.
489  if ( bl1_zero_dim2( m, k ) ) return;
490 
491  // If necessary, allocate, initialize, and use a temporary contiguous
492  // copy of each matrix rather than the original matrices.
493  bl1_ccreate_contigmt( trans,
494  m,
495  k,
496  a_save, a_rs_save, a_cs_save,
497  &a, &a_rs, &a_cs );
498 
499  bl1_ccreate_contigmt( trans,
500  m,
501  k,
502  b_save, b_rs_save, b_cs_save,
503  &b, &b_rs, &b_cs );
504 
505  bl1_ccreate_contigmr( uplo,
506  m,
507  m,
508  c_save, c_rs_save, c_cs_save,
509  &c, &c_rs, &c_cs );
510 
511  // Initialize with values assuming column-major storage.
512  lda = a_cs;
513  inca = a_rs;
514  ldb = b_cs;
515  incb = b_rs;
516  ldc = c_cs;
517  incc = c_rs;
518 
519  // Adjust the parameters based on the storage of each matrix.
520  if ( bl1_is_col_storage( c_rs, c_cs ) )
521  {
522  if ( bl1_is_col_storage( a_rs, a_cs ) )
523  {
524  if ( bl1_is_col_storage( b_rs, b_cs ) )
525  {
526  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
527  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
528  }
529  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
530  {
531  // requested operation: uplo( C_c ) += A_c * B_r' + B_r * A_c'
532  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
533  syr2k_needs_copyb = TRUE;
534  }
535  }
536  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
537  {
538  if ( bl1_is_col_storage( b_rs, b_cs ) )
539  {
540  // requested operation: uplo( C_c ) += A_r * B_c' + B_c * A_r'
541  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
542  syr2k_needs_copya = TRUE;
543  }
544  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
545  {
546  // requested operation: uplo( C_c ) += A_r * B_r' + B_r * A_r'
547  // requested operation: uplo( C_c ) += conj( A_c' * B_c + B_c' * A_c )
548  bl1_swap_ints( lda, inca );
549  bl1_swap_ints( ldb, incb );
550 
551  bl1_toggle_trans( trans );
552  }
553  }
554  }
555  else // if ( bl1_is_row_storage( c_rs, c_cs ) )
556  {
557  if ( bl1_is_col_storage( a_rs, a_cs ) )
558  {
559  if ( bl1_is_col_storage( b_rs, b_cs ) )
560  {
561  // requested operation: uplo( C_r ) += A_c * B_c' + B_c * A_c'
562  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
563  bl1_swap_ints( ldc, incc );
564 
565  bl1_toggle_uplo( uplo );
566  }
567  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
568  {
569  // requested operation: uplo( C_r ) += A_c * B_r' + B_r * A_c'
570  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
571  syr2k_needs_copyb = TRUE;
572 
573  bl1_swap_ints( ldc, incc );
574 
575  bl1_toggle_uplo( uplo );
576  }
577  }
578  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
579  {
580  if ( bl1_is_col_storage( b_rs, b_cs ) )
581  {
582  // requested operation: uplo( C_r ) += A_r * B_c' + B_c * A_r'
583  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
584  syr2k_needs_copya = TRUE;
585 
586  bl1_swap_ints( ldc, incc );
587 
588  bl1_toggle_uplo( uplo );
589  }
590  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
591  {
592  // requested operation: uplo( C_r ) += A_r * B_r' + B_r * A_r'
593  // requested operation: ~uplo( C_c ) += A_c' * B_c + B_c' * A_c
594  bl1_swap_ints( ldc, incc );
595  bl1_swap_ints( lda, inca );
596  bl1_swap_ints( ldb, incb );
597 
598  bl1_toggle_uplo( uplo );
599  bl1_toggle_trans( trans );
600  }
601  }
602  }
603 
604  a_copy = a;
605  lda_copy = lda;
606  inca_copy = inca;
607 
608  // There are two cases where we need to copy A column-major storage.
609  // We handle those two cases here.
610  if ( syr2k_needs_copya )
611  {
612  int m_a;
613  int n_a;
614 
615  // Determine the dimensions of A according to the value of trans. We
616  // need this in order to set the leading dimension of the copy of A.
617  bl1_set_dims_with_trans( trans, m, k, &m_a, &n_a );
618 
619  // We need a temporary matrix to hold a column-major copy of A.
620  a_copy = bl1_callocm( m, k );
621  lda_copy = m_a;
622  inca_copy = 1;
623 
624  // Copy the contents of A into A_copy.
626  m_a,
627  n_a,
628  a, inca, lda,
629  a_copy, inca_copy, lda_copy );
630  }
631 
632  b_copy = b;
633  ldb_copy = ldb;
634  incb_copy = incb;
635 
636  // There are two cases where we need to copy B column-major storage.
637  // We handle those two cases here.
638  if ( syr2k_needs_copyb )
639  {
640  int m_b;
641  int n_b;
642 
643  // Determine the dimensions of B according to the value of trans. We
644  // need this in order to set the leading dimension of the copy of B.
645  bl1_set_dims_with_trans( trans, m, k, &m_b, &n_b );
646 
647  // We need a temporary matrix to hold a column-major copy of B.
648  b_copy = bl1_callocm( m, k );
649  ldb_copy = m_b;
650  incb_copy = 1;
651 
652  // Copy the contents of B into B_copy.
654  m_b,
655  n_b,
656  b, incb, ldb,
657  b_copy, incb_copy, ldb_copy );
658  }
659 
660  bl1_csyr2k_blas( uplo,
661  trans,
662  m,
663  k,
664  alpha,
665  a_copy, lda_copy,
666  b_copy, ldb_copy,
667  beta,
668  c, ldc );
669 
670  if ( syr2k_needs_copya )
671  bl1_cfree( a_copy );
672 
673  if ( syr2k_needs_copyb )
674  bl1_cfree( b_copy );
675 
676  // Free any temporary contiguous matrices, copying the result back to
677  // the original matrix.
678  bl1_cfree_contigm( a_save, a_rs_save, a_cs_save,
679  &a, &a_rs, &a_cs );
680 
681  bl1_cfree_contigm( b_save, b_rs_save, b_cs_save,
682  &b, &b_rs, &b_cs );
683 
684  bl1_cfree_saved_contigmr( uplo_save,
685  m_save,
686  m_save,
687  c_save, c_rs_save, c_cs_save,
688  &c, &c_rs, &c_cs );
689 }
uplo1_t
Definition: blis_type_defs.h:60
int bl1_zero_dim2(int m, int n)
Definition: bl1_is.c:118
void bl1_ccreate_contigmr(uplo1_t uplo, int m, int n, scomplex *a_save, int a_rs_save, int a_cs_save, scomplex **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmr.c:77
void bl1_ccreate_contigmt(trans1_t trans_dims, int m, int n, scomplex *a_save, int a_rs_save, int a_cs_save, scomplex **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmt.c:89
int bl1_is_col_storage(int rs, int cs)
Definition: bl1_is.c:90
Definition: blis_type_defs.h:54
void bl1_set_dims_with_trans(trans1_t trans, int m, int n, int *m_new, int *n_new)
Definition: bl1_set_dims.c:13
void bl1_ccopymt(trans1_t trans, int m, int n, scomplex *a, int a_rs, int a_cs, scomplex *b, int b_rs, int b_cs)
Definition: bl1_copymt.c:215
Definition: blis_type_defs.h:132
void bl1_cfree_saved_contigmr(uplo1_t uplo, int m, int n, scomplex *a_save, int a_rs_save, int a_cs_save, scomplex **a, int *a_rs, int *a_cs)
Definition: bl1_free_saved_contigmr.c:59
scomplex * bl1_callocm(unsigned int m, unsigned int n)
Definition: bl1_allocm.c:40
void bl1_csyr2k_blas(uplo1_t uplo, trans1_t trans, int m, int k, scomplex *alpha, scomplex *a, int lda, scomplex *b, int ldb, scomplex *beta, scomplex *c, int ldc)
Definition: bl1_syr2k.c:1013
void bl1_cfree(scomplex *p)
Definition: bl1_free.c:40
void bl1_cfree_contigm(scomplex *a_save, int a_rs_save, int a_cs_save, scomplex **a, int *a_rs, int *a_cs)
Definition: bl1_free_contigm.c:45

◆ bl1_csyr2k_blas()

void bl1_csyr2k_blas ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
scomplex alpha,
scomplex a,
int  lda,
scomplex b,
int  ldb,
scomplex beta,
scomplex c,
int  ldc 
)

References bl1_is_conjtrans(), bl1_param_map_to_netlib_trans(), bl1_param_map_to_netlib_uplo(), BLIS1_TRANSPOSE, cblas_csyr2k(), CblasColMajor, and F77_csyr2k().

Referenced by bl1_csyr2k().

1014 {
1015 #ifdef BLIS1_ENABLE_CBLAS_INTERFACES
1016  enum CBLAS_ORDER cblas_order = CblasColMajor;
1017  enum CBLAS_UPLO cblas_uplo;
1018  enum CBLAS_TRANSPOSE cblas_trans;
1019 
1020  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
1021  // so we have to map it down to regular transposition.
1022  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
1023 
1024  bl1_param_map_to_netlib_uplo( uplo, &cblas_uplo );
1025  bl1_param_map_to_netlib_trans( trans, &cblas_trans );
1026 
1027  cblas_csyr2k( cblas_order,
1028  cblas_uplo,
1029  cblas_trans,
1030  m,
1031  k,
1032  alpha,
1033  a, lda,
1034  b, ldb,
1035  beta,
1036  c, ldc );
1037 #else
1038  char blas_uplo;
1039  char blas_trans;
1040 
1041  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
1042  // so we have to map it down to regular transposition.
1043  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
1044 
1045  bl1_param_map_to_netlib_uplo( uplo, &blas_uplo );
1046  bl1_param_map_to_netlib_trans( trans, &blas_trans );
1047 
1048  F77_csyr2k( &blas_uplo,
1049  &blas_trans,
1050  &m,
1051  &k,
1052  alpha,
1053  a, &lda,
1054  b, &ldb,
1055  beta,
1056  c, &ldc );
1057 #endif
1058 }
CBLAS_ORDER
Definition: blis_prototypes_cblas.h:17
int bl1_is_conjtrans(trans1_t trans)
Definition: bl1_is.c:30
CBLAS_TRANSPOSE
Definition: blis_prototypes_cblas.h:18
void bl1_param_map_to_netlib_trans(trans1_t blis_trans, void *blas_trans)
Definition: bl1_param_map.c:15
Definition: blis_type_defs.h:55
void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void *alpha, const void *A, const int lda, const void *B, const int ldb, const void *beta, void *C, const int ldc)
CBLAS_UPLO
Definition: blis_prototypes_cblas.h:19
Definition: blis_prototypes_cblas.h:17
void bl1_param_map_to_netlib_uplo(uplo1_t blis_uplo, void *blas_uplo)
Definition: bl1_param_map.c:47
void F77_csyr2k(char *uplo, char *transa, int *n, int *k, scomplex *alpha, scomplex *a, int *lda, scomplex *b, int *ldb, scomplex *beta, scomplex *c, int *ldc)

◆ bl1_dsyr2k()

void bl1_dsyr2k ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
double *  alpha,
double *  a,
int  a_rs,
int  a_cs,
double *  b,
int  b_rs,
int  b_cs,
double *  beta,
double *  c,
int  c_rs,
int  c_cs 
)

References bl1_dallocm(), bl1_dcopymt(), bl1_dcreate_contigmr(), bl1_dcreate_contigmt(), bl1_dfree(), bl1_dfree_contigm(), bl1_dfree_saved_contigmr(), bl1_dsyr2k_blas(), bl1_is_col_storage(), bl1_set_dims_with_trans(), bl1_zero_dim2(), and BLIS1_NO_TRANSPOSE.

Referenced by bl1_dher2k(), FLA_Her2k_external(), and FLA_Syr2k_external().

240 {
241  uplo1_t uplo_save = uplo;
242  int m_save = m;
243  double* a_save = a;
244  double* b_save = b;
245  double* c_save = c;
246  int a_rs_save = a_rs;
247  int a_cs_save = a_cs;
248  int b_rs_save = b_rs;
249  int b_cs_save = b_cs;
250  int c_rs_save = c_rs;
251  int c_cs_save = c_cs;
252  double* a_copy;
253  double* b_copy;
254  int lda, inca;
255  int ldb, incb;
256  int ldc, incc;
257  int lda_copy, inca_copy;
258  int ldb_copy, incb_copy;
259  int syr2k_needs_copya = FALSE;
260  int syr2k_needs_copyb = FALSE;
261 
262  // Return early if possible.
263  if ( bl1_zero_dim2( m, k ) ) return;
264 
265  // If necessary, allocate, initialize, and use a temporary contiguous
266  // copy of each matrix rather than the original matrices.
267  bl1_dcreate_contigmt( trans,
268  m,
269  k,
270  a_save, a_rs_save, a_cs_save,
271  &a, &a_rs, &a_cs );
272 
273  bl1_dcreate_contigmt( trans,
274  m,
275  k,
276  b_save, b_rs_save, b_cs_save,
277  &b, &b_rs, &b_cs );
278 
279  bl1_dcreate_contigmr( uplo,
280  m,
281  m,
282  c_save, c_rs_save, c_cs_save,
283  &c, &c_rs, &c_cs );
284 
285  // Initialize with values assuming column-major storage.
286  lda = a_cs;
287  inca = a_rs;
288  ldb = b_cs;
289  incb = b_rs;
290  ldc = c_cs;
291  incc = c_rs;
292 
293  // Adjust the parameters based on the storage of each matrix.
294  if ( bl1_is_col_storage( c_rs, c_cs ) )
295  {
296  if ( bl1_is_col_storage( a_rs, a_cs ) )
297  {
298  if ( bl1_is_col_storage( b_rs, b_cs ) )
299  {
300  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
301  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
302  }
303  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
304  {
305  // requested operation: uplo( C_c ) += A_c * B_r' + B_r * A_c'
306  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
307  syr2k_needs_copyb = TRUE;
308  }
309  }
310  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
311  {
312  if ( bl1_is_col_storage( b_rs, b_cs ) )
313  {
314  // requested operation: uplo( C_c ) += A_r * B_c' + B_c * A_r'
315  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
316  syr2k_needs_copya = TRUE;
317  }
318  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
319  {
320  // requested operation: uplo( C_c ) += A_r * B_r' + B_r * A_r'
321  // requested operation: uplo( C_c ) += conj( A_c' * B_c + B_c' * A_c )
322  bl1_swap_ints( lda, inca );
323  bl1_swap_ints( ldb, incb );
324 
325  bl1_toggle_trans( trans );
326  }
327  }
328  }
329  else // if ( bl1_is_row_storage( c_rs, c_cs ) )
330  {
331  if ( bl1_is_col_storage( a_rs, a_cs ) )
332  {
333  if ( bl1_is_col_storage( b_rs, b_cs ) )
334  {
335  // requested operation: uplo( C_r ) += A_c * B_c' + B_c * A_c'
336  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
337  bl1_swap_ints( ldc, incc );
338 
339  bl1_toggle_uplo( uplo );
340  }
341  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
342  {
343  // requested operation: uplo( C_r ) += A_c * B_r' + B_r * A_c'
344  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
345  syr2k_needs_copyb = TRUE;
346 
347  bl1_swap_ints( ldc, incc );
348 
349  bl1_toggle_uplo( uplo );
350  }
351  }
352  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
353  {
354  if ( bl1_is_col_storage( b_rs, b_cs ) )
355  {
356  // requested operation: uplo( C_r ) += A_r * B_c' + B_c * A_r'
357  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
358  syr2k_needs_copya = TRUE;
359 
360  bl1_swap_ints( ldc, incc );
361 
362  bl1_toggle_uplo( uplo );
363  }
364  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
365  {
366  // requested operation: uplo( C_r ) += A_r * B_r' + B_r * A_r'
367  // requested operation: ~uplo( C_c ) += A_c' * B_c + B_c' * A_c
368  bl1_swap_ints( ldc, incc );
369  bl1_swap_ints( lda, inca );
370  bl1_swap_ints( ldb, incb );
371 
372  bl1_toggle_uplo( uplo );
373  bl1_toggle_trans( trans );
374  }
375  }
376  }
377 
378  a_copy = a;
379  lda_copy = lda;
380  inca_copy = inca;
381 
382  // There are two cases where we need to copy A column-major storage.
383  // We handle those two cases here.
384  if ( syr2k_needs_copya )
385  {
386  int m_a;
387  int n_a;
388 
389  // Determine the dimensions of A according to the value of trans. We
390  // need this in order to set the leading dimension of the copy of A.
391  bl1_set_dims_with_trans( trans, m, k, &m_a, &n_a );
392 
393  // We need a temporary matrix to hold a column-major copy of A.
394  a_copy = bl1_dallocm( m, k );
395  lda_copy = m_a;
396  inca_copy = 1;
397 
398  // Copy the contents of A into A_copy.
400  m_a,
401  n_a,
402  a, inca, lda,
403  a_copy, inca_copy, lda_copy );
404  }
405 
406  b_copy = b;
407  ldb_copy = ldb;
408  incb_copy = incb;
409 
410  // There are two cases where we need to copy B column-major storage.
411  // We handle those two cases here.
412  if ( syr2k_needs_copyb )
413  {
414  int m_b;
415  int n_b;
416 
417  // Determine the dimensions of B according to the value of trans. We
418  // need this in order to set the leading dimension of the copy of B.
419  bl1_set_dims_with_trans( trans, m, k, &m_b, &n_b );
420 
421  // We need a temporary matrix to hold a column-major copy of B.
422  b_copy = bl1_dallocm( m, k );
423  ldb_copy = m_b;
424  incb_copy = 1;
425 
426  // Copy the contents of B into B_copy.
428  m_b,
429  n_b,
430  b, incb, ldb,
431  b_copy, incb_copy, ldb_copy );
432  }
433 
434  bl1_dsyr2k_blas( uplo,
435  trans,
436  m,
437  k,
438  alpha,
439  a_copy, lda_copy,
440  b_copy, ldb_copy,
441  beta,
442  c, ldc );
443 
444  if ( syr2k_needs_copya )
445  bl1_dfree( a_copy );
446 
447  if ( syr2k_needs_copyb )
448  bl1_dfree( b_copy );
449 
450  // Free any temporary contiguous matrices, copying the result back to
451  // the original matrix.
452  bl1_dfree_contigm( a_save, a_rs_save, a_cs_save,
453  &a, &a_rs, &a_cs );
454 
455  bl1_dfree_contigm( b_save, b_rs_save, b_cs_save,
456  &b, &b_rs, &b_cs );
457 
458  bl1_dfree_saved_contigmr( uplo_save,
459  m_save,
460  m_save,
461  c_save, c_rs_save, c_cs_save,
462  &c, &c_rs, &c_cs );
463 }
uplo1_t
Definition: blis_type_defs.h:60
int bl1_zero_dim2(int m, int n)
Definition: bl1_is.c:118
void bl1_dfree(double *p)
Definition: bl1_free.c:35
void bl1_dfree_saved_contigmr(uplo1_t uplo, int m, int n, double *a_save, int a_rs_save, int a_cs_save, double **a, int *a_rs, int *a_cs)
Definition: bl1_free_saved_contigmr.c:36
void bl1_dcopymt(trans1_t trans, int m, int n, double *a, int a_rs, int a_cs, double *b, int b_rs, int b_cs)
Definition: bl1_copymt.c:148
void bl1_dsyr2k_blas(uplo1_t uplo, trans1_t trans, int m, int k, double *alpha, double *a, int lda, double *b, int ldb, double *beta, double *c, int ldc)
Definition: bl1_syr2k.c:966
void bl1_dcreate_contigmt(trans1_t trans_dims, int m, int n, double *a_save, int a_rs_save, int a_cs_save, double **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmt.c:51
int bl1_is_col_storage(int rs, int cs)
Definition: bl1_is.c:90
Definition: blis_type_defs.h:54
void bl1_set_dims_with_trans(trans1_t trans, int m, int n, int *m_new, int *n_new)
Definition: bl1_set_dims.c:13
void bl1_dfree_contigm(double *a_save, int a_rs_save, int a_cs_save, double **a, int *a_rs, int *a_cs)
Definition: bl1_free_contigm.c:29
double * bl1_dallocm(unsigned int m, unsigned int n)
Definition: bl1_allocm.c:35
void bl1_dcreate_contigmr(uplo1_t uplo, int m, int n, double *a_save, int a_rs_save, int a_cs_save, double **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmr.c:45

◆ bl1_dsyr2k_blas()

void bl1_dsyr2k_blas ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
double *  alpha,
double *  a,
int  lda,
double *  b,
int  ldb,
double *  beta,
double *  c,
int  ldc 
)

References bl1_is_conjtrans(), bl1_param_map_to_netlib_trans(), bl1_param_map_to_netlib_uplo(), BLIS1_TRANSPOSE, cblas_dsyr2k(), CblasColMajor, and F77_dsyr2k().

Referenced by bl1_dsyr2k().

967 {
968 #ifdef BLIS1_ENABLE_CBLAS_INTERFACES
969  enum CBLAS_ORDER cblas_order = CblasColMajor;
970  enum CBLAS_UPLO cblas_uplo;
971  enum CBLAS_TRANSPOSE cblas_trans;
972 
973  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
974  // so we have to map it down to regular transposition.
975  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
976 
977  bl1_param_map_to_netlib_uplo( uplo, &cblas_uplo );
978  bl1_param_map_to_netlib_trans( trans, &cblas_trans );
979 
980  cblas_dsyr2k( cblas_order,
981  cblas_uplo,
982  cblas_trans,
983  m,
984  k,
985  *alpha,
986  a, lda,
987  b, ldb,
988  *beta,
989  c, ldc );
990 #else
991  char blas_uplo;
992  char blas_trans;
993 
994  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
995  // so we have to map it down to regular transposition.
996  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
997 
998  bl1_param_map_to_netlib_uplo( uplo, &blas_uplo );
999  bl1_param_map_to_netlib_trans( trans, &blas_trans );
1000 
1001  F77_dsyr2k( &blas_uplo,
1002  &blas_trans,
1003  &m,
1004  &k,
1005  alpha,
1006  a, &lda,
1007  b, &ldb,
1008  beta,
1009  c, &ldc );
1010 #endif
1011 }
CBLAS_ORDER
Definition: blis_prototypes_cblas.h:17
int bl1_is_conjtrans(trans1_t trans)
Definition: bl1_is.c:30
void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const double alpha, const double *A, const int lda, const double *B, const int ldb, const double beta, double *C, const int ldc)
CBLAS_TRANSPOSE
Definition: blis_prototypes_cblas.h:18
void bl1_param_map_to_netlib_trans(trans1_t blis_trans, void *blas_trans)
Definition: bl1_param_map.c:15
Definition: blis_type_defs.h:55
void F77_dsyr2k(char *uplo, char *transa, int *n, int *k, double *alpha, double *a, int *lda, double *b, int *ldb, double *beta, double *c, int *ldc)
CBLAS_UPLO
Definition: blis_prototypes_cblas.h:19
Definition: blis_prototypes_cblas.h:17
void bl1_param_map_to_netlib_uplo(uplo1_t blis_uplo, void *blas_uplo)
Definition: bl1_param_map.c:47

◆ bl1_ssyr2k()

void bl1_ssyr2k ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
float *  alpha,
float *  a,
int  a_rs,
int  a_cs,
float *  b,
int  b_rs,
int  b_cs,
float *  beta,
float *  c,
int  c_rs,
int  c_cs 
)

References bl1_is_col_storage(), bl1_sallocm(), bl1_scopymt(), bl1_screate_contigmr(), bl1_screate_contigmt(), bl1_set_dims_with_trans(), bl1_sfree(), bl1_sfree_contigm(), bl1_sfree_saved_contigmr(), bl1_ssyr2k_blas(), bl1_zero_dim2(), and BLIS1_NO_TRANSPOSE.

Referenced by bl1_sher2k(), FLA_Her2k_external(), and FLA_Syr2k_external().

14 {
15  uplo1_t uplo_save = uplo;
16  int m_save = m;
17  float* a_save = a;
18  float* b_save = b;
19  float* c_save = c;
20  int a_rs_save = a_rs;
21  int a_cs_save = a_cs;
22  int b_rs_save = b_rs;
23  int b_cs_save = b_cs;
24  int c_rs_save = c_rs;
25  int c_cs_save = c_cs;
26  float* a_copy;
27  float* b_copy;
28  int lda, inca;
29  int ldb, incb;
30  int ldc, incc;
31  int lda_copy, inca_copy;
32  int ldb_copy, incb_copy;
33  int syr2k_needs_copya = FALSE;
34  int syr2k_needs_copyb = FALSE;
35 
36  // Return early if possible.
37  if ( bl1_zero_dim2( m, k ) ) return;
38 
39  // If necessary, allocate, initialize, and use a temporary contiguous
40  // copy of each matrix rather than the original matrices.
41  bl1_screate_contigmt( trans,
42  m,
43  k,
44  a_save, a_rs_save, a_cs_save,
45  &a, &a_rs, &a_cs );
46 
47  bl1_screate_contigmt( trans,
48  m,
49  k,
50  b_save, b_rs_save, b_cs_save,
51  &b, &b_rs, &b_cs );
52 
54  m,
55  m,
56  c_save, c_rs_save, c_cs_save,
57  &c, &c_rs, &c_cs );
58 
59  // Initialize with values assuming column-major storage.
60  lda = a_cs;
61  inca = a_rs;
62  ldb = b_cs;
63  incb = b_rs;
64  ldc = c_cs;
65  incc = c_rs;
66 
67  // Adjust the parameters based on the storage of each matrix.
68  if ( bl1_is_col_storage( c_rs, c_cs ) )
69  {
70  if ( bl1_is_col_storage( a_rs, a_cs ) )
71  {
72  if ( bl1_is_col_storage( b_rs, b_cs ) )
73  {
74  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
75  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
76  }
77  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
78  {
79  // requested operation: uplo( C_c ) += A_c * B_r' + B_r * A_c'
80  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
81  syr2k_needs_copyb = TRUE;
82  }
83  }
84  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
85  {
86  if ( bl1_is_col_storage( b_rs, b_cs ) )
87  {
88  // requested operation: uplo( C_c ) += A_r * B_c' + B_c * A_r'
89  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
90  syr2k_needs_copya = TRUE;
91  }
92  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
93  {
94  // requested operation: uplo( C_c ) += A_r * B_r' + B_r * A_r'
95  // requested operation: uplo( C_c ) += conj( A_c' * B_c + B_c' * A_c )
96  bl1_swap_ints( lda, inca );
97  bl1_swap_ints( ldb, incb );
98 
99  bl1_toggle_trans( trans );
100  }
101  }
102  }
103  else // if ( bl1_is_row_storage( c_rs, c_cs ) )
104  {
105  if ( bl1_is_col_storage( a_rs, a_cs ) )
106  {
107  if ( bl1_is_col_storage( b_rs, b_cs ) )
108  {
109  // requested operation: uplo( C_r ) += A_c * B_c' + B_c * A_c'
110  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
111  bl1_swap_ints( ldc, incc );
112 
113  bl1_toggle_uplo( uplo );
114  }
115  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
116  {
117  // requested operation: uplo( C_r ) += A_c * B_r' + B_r * A_c'
118  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
119  syr2k_needs_copyb = TRUE;
120 
121  bl1_swap_ints( ldc, incc );
122 
123  bl1_toggle_uplo( uplo );
124  }
125  }
126  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
127  {
128  if ( bl1_is_col_storage( b_rs, b_cs ) )
129  {
130  // requested operation: uplo( C_r ) += A_r * B_c' + B_c * A_r'
131  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
132  syr2k_needs_copya = TRUE;
133 
134  bl1_swap_ints( ldc, incc );
135 
136  bl1_toggle_uplo( uplo );
137  }
138  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
139  {
140  // requested operation: uplo( C_r ) += A_r * B_r' + B_r * A_r'
141  // requested operation: ~uplo( C_c ) += A_c' * B_c + B_c' * A_c
142  bl1_swap_ints( ldc, incc );
143  bl1_swap_ints( lda, inca );
144  bl1_swap_ints( ldb, incb );
145 
146  bl1_toggle_uplo( uplo );
147  bl1_toggle_trans( trans );
148  }
149  }
150  }
151 
152  a_copy = a;
153  lda_copy = lda;
154  inca_copy = inca;
155 
156  // There are two cases where we need to copy A column-major storage.
157  // We handle those two cases here.
158  if ( syr2k_needs_copya )
159  {
160  int m_a;
161  int n_a;
162 
163  // Determine the dimensions of A according to the value of trans. We
164  // need this in order to set the leading dimension of the copy of A.
165  bl1_set_dims_with_trans( trans, m, k, &m_a, &n_a );
166 
167  // We need a temporary matrix to hold a column-major copy of A.
168  a_copy = bl1_sallocm( m, k );
169  lda_copy = m_a;
170  inca_copy = 1;
171 
172  // Copy the contents of A into A_copy.
174  m_a,
175  n_a,
176  a, inca, lda,
177  a_copy, inca_copy, lda_copy );
178  }
179 
180  b_copy = b;
181  ldb_copy = ldb;
182  incb_copy = incb;
183 
184  // There are two cases where we need to copy B column-major storage.
185  // We handle those two cases here.
186  if ( syr2k_needs_copyb )
187  {
188  int m_b;
189  int n_b;
190 
191  // Determine the dimensions of B according to the value of trans. We
192  // need this in order to set the leading dimension of the copy of B.
193  bl1_set_dims_with_trans( trans, m, k, &m_b, &n_b );
194 
195  // We need a temporary matrix to hold a column-major copy of B.
196  b_copy = bl1_sallocm( m, k );
197  ldb_copy = m_b;
198  incb_copy = 1;
199 
200  // Copy the contents of B into B_copy.
202  m_b,
203  n_b,
204  b, incb, ldb,
205  b_copy, incb_copy, ldb_copy );
206  }
207 
208  bl1_ssyr2k_blas( uplo,
209  trans,
210  m,
211  k,
212  alpha,
213  a_copy, lda_copy,
214  b_copy, ldb_copy,
215  beta,
216  c, ldc );
217 
218  if ( syr2k_needs_copya )
219  bl1_sfree( a_copy );
220 
221  if ( syr2k_needs_copyb )
222  bl1_sfree( b_copy );
223 
224  // Free any temporary contiguous matrices, copying the result back to
225  // the original matrix.
226  bl1_sfree_contigm( a_save, a_rs_save, a_cs_save,
227  &a, &a_rs, &a_cs );
228 
229  bl1_sfree_contigm( b_save, b_rs_save, b_cs_save,
230  &b, &b_rs, &b_cs );
231 
232  bl1_sfree_saved_contigmr( uplo_save,
233  m_save,
234  m_save,
235  c_save, c_rs_save, c_cs_save,
236  &c, &c_rs, &c_cs );
237 }
void bl1_sfree_saved_contigmr(uplo1_t uplo, int m, int n, float *a_save, int a_rs_save, int a_cs_save, float **a, int *a_rs, int *a_cs)
Definition: bl1_free_saved_contigmr.c:13
uplo1_t
Definition: blis_type_defs.h:60
float * bl1_sallocm(unsigned int m, unsigned int n)
Definition: bl1_allocm.c:30
void bl1_sfree(float *p)
Definition: bl1_free.c:30
int bl1_zero_dim2(int m, int n)
Definition: bl1_is.c:118
int bl1_is_col_storage(int rs, int cs)
Definition: bl1_is.c:90
void bl1_sfree_contigm(float *a_save, int a_rs_save, int a_cs_save, float **a, int *a_rs, int *a_cs)
Definition: bl1_free_contigm.c:13
Definition: blis_type_defs.h:54
void bl1_set_dims_with_trans(trans1_t trans, int m, int n, int *m_new, int *n_new)
Definition: bl1_set_dims.c:13
void bl1_ssyr2k_blas(uplo1_t uplo, trans1_t trans, int m, int k, float *alpha, float *a, int lda, float *b, int ldb, float *beta, float *c, int ldc)
Definition: bl1_syr2k.c:919
void bl1_screate_contigmt(trans1_t trans_dims, int m, int n, float *a_save, int a_rs_save, int a_cs_save, float **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmt.c:13
void bl1_scopymt(trans1_t trans, int m, int n, float *a, int a_rs, int a_cs, float *b, int b_rs, int b_cs)
Definition: bl1_copymt.c:81
void bl1_screate_contigmr(uplo1_t uplo, int m, int n, float *a_save, int a_rs_save, int a_cs_save, float **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmr.c:13

◆ bl1_ssyr2k_blas()

void bl1_ssyr2k_blas ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
float *  alpha,
float *  a,
int  lda,
float *  b,
int  ldb,
float *  beta,
float *  c,
int  ldc 
)

References bl1_is_conjtrans(), bl1_param_map_to_netlib_trans(), bl1_param_map_to_netlib_uplo(), BLIS1_TRANSPOSE, cblas_ssyr2k(), CblasColMajor, and F77_ssyr2k().

Referenced by bl1_ssyr2k().

920 {
921 #ifdef BLIS1_ENABLE_CBLAS_INTERFACES
922  enum CBLAS_ORDER cblas_order = CblasColMajor;
923  enum CBLAS_UPLO cblas_uplo;
924  enum CBLAS_TRANSPOSE cblas_trans;
925 
926  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
927  // so we have to map it down to regular transposition.
928  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
929 
930  bl1_param_map_to_netlib_uplo( uplo, &cblas_uplo );
931  bl1_param_map_to_netlib_trans( trans, &cblas_trans );
932 
933  cblas_ssyr2k( cblas_order,
934  cblas_uplo,
935  cblas_trans,
936  m,
937  k,
938  *alpha,
939  a, lda,
940  b, ldb,
941  *beta,
942  c, ldc );
943 #else
944  char blas_uplo;
945  char blas_trans;
946 
947  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
948  // so we have to map it down to regular transposition.
949  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
950 
951  bl1_param_map_to_netlib_uplo( uplo, &blas_uplo );
952  bl1_param_map_to_netlib_trans( trans, &blas_trans );
953 
954  F77_ssyr2k( &blas_uplo,
955  &blas_trans,
956  &m,
957  &k,
958  alpha,
959  a, &lda,
960  b, &ldb,
961  beta,
962  c, &ldc );
963 #endif
964 }
CBLAS_ORDER
Definition: blis_prototypes_cblas.h:17
int bl1_is_conjtrans(trans1_t trans)
Definition: bl1_is.c:30
CBLAS_TRANSPOSE
Definition: blis_prototypes_cblas.h:18
void F77_ssyr2k(char *uplo, char *transa, int *n, int *k, float *alpha, float *a, int *lda, float *b, int *ldb, float *beta, float *c, int *ldc)
void bl1_param_map_to_netlib_trans(trans1_t blis_trans, void *blas_trans)
Definition: bl1_param_map.c:15
Definition: blis_type_defs.h:55
void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const float alpha, const float *A, const int lda, const float *B, const int ldb, const float beta, float *C, const int ldc)
CBLAS_UPLO
Definition: blis_prototypes_cblas.h:19
Definition: blis_prototypes_cblas.h:17
void bl1_param_map_to_netlib_uplo(uplo1_t blis_uplo, void *blas_uplo)
Definition: bl1_param_map.c:47

◆ bl1_zsyr2k()

void bl1_zsyr2k ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
dcomplex alpha,
dcomplex a,
int  a_rs,
int  a_cs,
dcomplex b,
int  b_rs,
int  b_cs,
dcomplex beta,
dcomplex c,
int  c_rs,
int  c_cs 
)

References bl1_is_col_storage(), bl1_set_dims_with_trans(), bl1_zallocm(), bl1_zcopymt(), bl1_zcreate_contigmr(), bl1_zcreate_contigmt(), bl1_zero_dim2(), bl1_zfree(), bl1_zfree_contigm(), bl1_zfree_saved_contigmr(), bl1_zsyr2k_blas(), and BLIS1_NO_TRANSPOSE.

Referenced by FLA_Syr2k_external().

692 {
693  uplo1_t uplo_save = uplo;
694  int m_save = m;
695  dcomplex* a_save = a;
696  dcomplex* b_save = b;
697  dcomplex* c_save = c;
698  int a_rs_save = a_rs;
699  int a_cs_save = a_cs;
700  int b_rs_save = b_rs;
701  int b_cs_save = b_cs;
702  int c_rs_save = c_rs;
703  int c_cs_save = c_cs;
704  dcomplex* a_copy;
705  dcomplex* b_copy;
706  int lda, inca;
707  int ldb, incb;
708  int ldc, incc;
709  int lda_copy, inca_copy;
710  int ldb_copy, incb_copy;
711  int syr2k_needs_copya = FALSE;
712  int syr2k_needs_copyb = FALSE;
713 
714  // Return early if possible.
715  if ( bl1_zero_dim2( m, k ) ) return;
716 
717  // If necessary, allocate, initialize, and use a temporary contiguous
718  // copy of each matrix rather than the original matrices.
719  bl1_zcreate_contigmt( trans,
720  m,
721  k,
722  a_save, a_rs_save, a_cs_save,
723  &a, &a_rs, &a_cs );
724 
725  bl1_zcreate_contigmt( trans,
726  m,
727  k,
728  b_save, b_rs_save, b_cs_save,
729  &b, &b_rs, &b_cs );
730 
731  bl1_zcreate_contigmr( uplo,
732  m,
733  m,
734  c_save, c_rs_save, c_cs_save,
735  &c, &c_rs, &c_cs );
736 
737  // Initialize with values assuming column-major storage.
738  lda = a_cs;
739  inca = a_rs;
740  ldb = b_cs;
741  incb = b_rs;
742  ldc = c_cs;
743  incc = c_rs;
744 
745  // Adjust the parameters based on the storage of each matrix.
746  if ( bl1_is_col_storage( c_rs, c_cs ) )
747  {
748  if ( bl1_is_col_storage( a_rs, a_cs ) )
749  {
750  if ( bl1_is_col_storage( b_rs, b_cs ) )
751  {
752  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
753  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
754  }
755  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
756  {
757  // requested operation: uplo( C_c ) += A_c * B_r' + B_r * A_c'
758  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
759  syr2k_needs_copyb = TRUE;
760  }
761  }
762  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
763  {
764  if ( bl1_is_col_storage( b_rs, b_cs ) )
765  {
766  // requested operation: uplo( C_c ) += A_r * B_c' + B_c * A_r'
767  // requested operation: uplo( C_c ) += A_c * B_c' + B_c * A_c'
768  syr2k_needs_copya = TRUE;
769  }
770  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
771  {
772  // requested operation: uplo( C_c ) += A_r * B_r' + B_r * A_r'
773  // requested operation: uplo( C_c ) += conj( A_c' * B_c + B_c' * A_c )
774  bl1_swap_ints( lda, inca );
775  bl1_swap_ints( ldb, incb );
776 
777  bl1_toggle_trans( trans );
778  }
779  }
780  }
781  else // if ( bl1_is_row_storage( c_rs, c_cs ) )
782  {
783  if ( bl1_is_col_storage( a_rs, a_cs ) )
784  {
785  if ( bl1_is_col_storage( b_rs, b_cs ) )
786  {
787  // requested operation: uplo( C_r ) += A_c * B_c' + B_c * A_c'
788  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
789  bl1_swap_ints( ldc, incc );
790 
791  bl1_toggle_uplo( uplo );
792  }
793  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
794  {
795  // requested operation: uplo( C_r ) += A_c * B_r' + B_r * A_c'
796  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
797  syr2k_needs_copyb = TRUE;
798 
799  bl1_swap_ints( ldc, incc );
800 
801  bl1_toggle_uplo( uplo );
802  }
803  }
804  else // if ( bl1_is_row_storage( a_rs, a_cs ) )
805  {
806  if ( bl1_is_col_storage( b_rs, b_cs ) )
807  {
808  // requested operation: uplo( C_r ) += A_r * B_c' + B_c * A_r'
809  // requested operation: ~uplo( C_c ) += conj( A_c * B_c' + B_c * A_c' )
810  syr2k_needs_copya = TRUE;
811 
812  bl1_swap_ints( ldc, incc );
813 
814  bl1_toggle_uplo( uplo );
815  }
816  else // if ( bl1_is_row_storage( b_rs, b_cs ) )
817  {
818  // requested operation: uplo( C_r ) += A_r * B_r' + B_r * A_r'
819  // requested operation: ~uplo( C_c ) += A_c' * B_c + B_c' * A_c
820  bl1_swap_ints( ldc, incc );
821  bl1_swap_ints( lda, inca );
822  bl1_swap_ints( ldb, incb );
823 
824  bl1_toggle_uplo( uplo );
825  bl1_toggle_trans( trans );
826  }
827  }
828  }
829 
830  a_copy = a;
831  lda_copy = lda;
832  inca_copy = inca;
833 
834  // There are two cases where we need to copy A column-major storage.
835  // We handle those two cases here.
836  if ( syr2k_needs_copya )
837  {
838  int m_a;
839  int n_a;
840 
841  // Determine the dimensions of A according to the value of trans. We
842  // need this in order to set the leading dimension of the copy of A.
843  bl1_set_dims_with_trans( trans, m, k, &m_a, &n_a );
844 
845  // We need a temporary matrix to hold a column-major copy of A.
846  a_copy = bl1_zallocm( m, k );
847  lda_copy = m_a;
848  inca_copy = 1;
849 
850  // Copy the contents of A into A_copy.
852  m_a,
853  n_a,
854  a, inca, lda,
855  a_copy, inca_copy, lda_copy );
856  }
857 
858  b_copy = b;
859  ldb_copy = ldb;
860  incb_copy = incb;
861 
862  // There are two cases where we need to copy B column-major storage.
863  // We handle those two cases here.
864  if ( syr2k_needs_copyb )
865  {
866  int m_b;
867  int n_b;
868 
869  // Determine the dimensions of B according to the value of trans. We
870  // need this in order to set the leading dimension of the copy of B.
871  bl1_set_dims_with_trans( trans, m, k, &m_b, &n_b );
872 
873  // We need a temporary matrix to hold a column-major copy of B.
874  b_copy = bl1_zallocm( m, k );
875  ldb_copy = m_b;
876  incb_copy = 1;
877 
878  // Copy the contents of B into B_copy.
880  m_b,
881  n_b,
882  b, incb, ldb,
883  b_copy, incb_copy, ldb_copy );
884  }
885 
886  bl1_zsyr2k_blas( uplo,
887  trans,
888  m,
889  k,
890  alpha,
891  a_copy, lda_copy,
892  b_copy, ldb_copy,
893  beta,
894  c, ldc );
895 
896  if ( syr2k_needs_copya )
897  bl1_zfree( a_copy );
898 
899  if ( syr2k_needs_copyb )
900  bl1_zfree( b_copy );
901 
902  // Free any temporary contiguous matrices, copying the result back to
903  // the original matrix.
904  bl1_zfree_contigm( a_save, a_rs_save, a_cs_save,
905  &a, &a_rs, &a_cs );
906 
907  bl1_zfree_contigm( b_save, b_rs_save, b_cs_save,
908  &b, &b_rs, &b_cs );
909 
910  bl1_zfree_saved_contigmr( uplo_save,
911  m_save,
912  m_save,
913  c_save, c_rs_save, c_cs_save,
914  &c, &c_rs, &c_cs );
915 }
void bl1_zsyr2k_blas(uplo1_t uplo, trans1_t trans, int m, int k, dcomplex *alpha, dcomplex *a, int lda, dcomplex *b, int ldb, dcomplex *beta, dcomplex *c, int ldc)
Definition: bl1_syr2k.c:1060
void bl1_zcreate_contigmr(uplo1_t uplo, int m, int n, dcomplex *a_save, int a_rs_save, int a_cs_save, dcomplex **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmr.c:109
uplo1_t
Definition: blis_type_defs.h:60
void bl1_zcreate_contigmt(trans1_t trans_dims, int m, int n, dcomplex *a_save, int a_rs_save, int a_cs_save, dcomplex **a, int *a_rs, int *a_cs)
Definition: bl1_create_contigmt.c:127
int bl1_zero_dim2(int m, int n)
Definition: bl1_is.c:118
dcomplex * bl1_zallocm(unsigned int m, unsigned int n)
Definition: bl1_allocm.c:45
void bl1_zfree_saved_contigmr(uplo1_t uplo, int m, int n, dcomplex *a_save, int a_rs_save, int a_cs_save, dcomplex **a, int *a_rs, int *a_cs)
Definition: bl1_free_saved_contigmr.c:82
void bl1_zfree(dcomplex *p)
Definition: bl1_free.c:45
int bl1_is_col_storage(int rs, int cs)
Definition: bl1_is.c:90
Definition: blis_type_defs.h:54
void bl1_set_dims_with_trans(trans1_t trans, int m, int n, int *m_new, int *n_new)
Definition: bl1_set_dims.c:13
void bl1_zcopymt(trans1_t trans, int m, int n, dcomplex *a, int a_rs, int a_cs, dcomplex *b, int b_rs, int b_cs)
Definition: bl1_copymt.c:286
void bl1_zfree_contigm(dcomplex *a_save, int a_rs_save, int a_cs_save, dcomplex **a, int *a_rs, int *a_cs)
Definition: bl1_free_contigm.c:61
Definition: blis_type_defs.h:137

◆ bl1_zsyr2k_blas()

void bl1_zsyr2k_blas ( uplo1_t  uplo,
trans1_t  trans,
int  m,
int  k,
dcomplex alpha,
dcomplex a,
int  lda,
dcomplex b,
int  ldb,
dcomplex beta,
dcomplex c,
int  ldc 
)

References bl1_is_conjtrans(), bl1_param_map_to_netlib_trans(), bl1_param_map_to_netlib_uplo(), BLIS1_TRANSPOSE, cblas_zsyr2k(), CblasColMajor, and F77_zsyr2k().

Referenced by bl1_zsyr2k().

1061 {
1062 #ifdef BLIS1_ENABLE_CBLAS_INTERFACES
1063  enum CBLAS_ORDER cblas_order = CblasColMajor;
1064  enum CBLAS_UPLO cblas_uplo;
1065  enum CBLAS_TRANSPOSE cblas_trans;
1066 
1067  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
1068  // so we have to map it down to regular transposition.
1069  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
1070 
1071  bl1_param_map_to_netlib_uplo( uplo, &cblas_uplo );
1072  bl1_param_map_to_netlib_trans( trans, &cblas_trans );
1073 
1074  cblas_zsyr2k( cblas_order,
1075  cblas_uplo,
1076  cblas_trans,
1077  m,
1078  k,
1079  alpha,
1080  a, lda,
1081  b, ldb,
1082  beta,
1083  c, ldc );
1084 #else
1085  char blas_uplo;
1086  char blas_trans;
1087 
1088  // BLAS doesn't recognize the conjugate-transposition constant for syr2k,
1089  // so we have to map it down to regular transposition.
1090  if ( bl1_is_conjtrans( trans ) ) trans = BLIS1_TRANSPOSE;
1091 
1092  bl1_param_map_to_netlib_uplo( uplo, &blas_uplo );
1093  bl1_param_map_to_netlib_trans( trans, &blas_trans );
1094 
1095  F77_zsyr2k( &blas_uplo,
1096  &blas_trans,
1097  &m,
1098  &k,
1099  alpha,
1100  a, &lda,
1101  b, &ldb,
1102  beta,
1103  c, &ldc );
1104 #endif
1105 }
CBLAS_ORDER
Definition: blis_prototypes_cblas.h:17
int bl1_is_conjtrans(trans1_t trans)
Definition: bl1_is.c:30
CBLAS_TRANSPOSE
Definition: blis_prototypes_cblas.h:18
void bl1_param_map_to_netlib_trans(trans1_t blis_trans, void *blas_trans)
Definition: bl1_param_map.c:15
Definition: blis_type_defs.h:55
CBLAS_UPLO
Definition: blis_prototypes_cblas.h:19
Definition: blis_prototypes_cblas.h:17
void bl1_param_map_to_netlib_uplo(uplo1_t blis_uplo, void *blas_uplo)
Definition: bl1_param_map.c:47
void F77_zsyr2k(char *uplo, char *transa, int *n, int *k, dcomplex *alpha, dcomplex *a, int *lda, dcomplex *b, int *ldb, dcomplex *beta, dcomplex *c, int *ldc)
void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE Trans, const int N, const int K, const void *alpha, const void *A, const int lda, const void *B, const int ldb, const void *beta, void *C, const int ldc)