LCPQ
/
qp2
mirror of https://github.com/QuantumPackage/qp2.git
9
1
Fork 0
Code Releases Activity

Removed dependency to cblas

This commit is contained in:
Anthony Scemama 2021-04-28 00:19:46 +02:00
parent 83f2f996d1
commit 8da63eeb7d
4 changed files with 26 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/cipsi/run_pt2_slave.irp.f
View File

@ -254,11 +254,11 @@ subroutine run_pt2_slave_large(thread,iproc,energy)
call omp_unset_lock(global_selection_buffer_lock)
if ( iproc == 1 ) then
call omp_set_lock(global_selection_buffer_lock)
call push_pt2_results_async_send(zmq_socket_push, i_generator, pt2_data, global_selection_buffer, task_id, 1,sending)
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending)
global_selection_buffer%cur = 0
call omp_unset_lock(global_selection_buffer_lock)
else
call push_pt2_results_async_send(zmq_socket_push, i_generator, pt2_data, b, task_id, 1,sending)
call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending)
endif
call pt2_dealloc(pt2_data)

16
src/csf/cfgCI_interface.f90
View File

@ -46,4 +46,18 @@ module cfunctions
real (kind=C_DOUBLE ),intent(out) :: csftodetmatrix(rowsmax,colsmax)
end subroutine getCSFtoDETTransformationMatrix
end interface
end module cfunctions
end module cfunctions
subroutine f_dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC) &
bind(C, name='f_dgemm')
use iso_c_binding
implicit none
character, intent(in), value :: TRANSA, TRANSB
integer, intent(in), value :: M,N,K,LDA,LDB,LDC
double precision, intent(in), value :: ALPHA, BETA
double precision, intent(in) :: A(LDA,*), B(LDB,*)
double precision, intent(out) :: C(LDC,*)
call dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
end subroutine

13
src/csf/tree_utils.c
View File

@ -267,6 +267,7 @@ void callBlasMatxMat(double *A, int rowA, int colA, double *B, int rowB, int col
double alpha = 1.0;
double beta = 0.0;
int val = 0;
if (transA) val |= 0x1;
if (transB) val |= 0x2;
@ -275,15 +276,13 @@ void callBlasMatxMat(double *A, int rowA, int colA, double *B, int rowB, int col
m = rowA;
n = colB;
k = colA;
cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
m, n, k, alpha, A, k, B, n, beta, C, n);
f_dgemm('N', 'N', n, m, k, alpha, B, n, A, k, beta, C, n);
break;
case 1: // transA, notransB
m = colA;
n = colB;
k = rowA;
cblas_dgemm(CblasRowMajor, CblasTrans, CblasNoTrans,
m, n, k, alpha, A, colA, B, n, beta, C, n);
f_dgemm('N', 'T', n, m, k, alpha, B, n, A, colA, beta, C, n);
break;
case 2: // notransA, transB
//m = rowA;
@ -292,15 +291,13 @@ void callBlasMatxMat(double *A, int rowA, int colA, double *B, int rowB, int col
m = rowA;
n = rowB;
k = colA;
cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
m, n, k, alpha, A, k, B, colB, beta, C, n);
f_dgemm('T', 'N', n, m, k, alpha, B, colB, A, k, beta, C, n);
break;
case 3: // transA, transB
m = colA;
n = rowB;
k = rowA;
cblas_dgemm(CblasRowMajor, CblasTrans, CblasTrans,
m, n, k, alpha, A, colA, B, colB, beta, C, n);
f_dgemm('T', 'T', n, m, k, alpha, B, colB, A, colA, beta, C, n);
break;
default:
printf("Impossible !!!!\n");

12
src/csf/tree_utils.h
View File

@ -22,14 +22,10 @@ struct bin_tree {
int NBF;
};
typedef enum {CblasRowMajor=101, CblasColMajor=102} CBLAS_LAYOUT;
typedef enum {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113} CBLAS_TRANSPOSE;
typedef CBLAS_LAYOUT CBLAS_ORDER;
void cblas_dgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA,
CBLAS_TRANSPOSE TransB, const int M, 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);
void f_dgemm(const char transb, const char transa, const int n, const int m, const int k,
const double alpha, const double* B, const int ldb, const double* A,
const int lda, const double beta, double* C, const int ldc);
#define MAX_SOMO 32