TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-07-17 16:33:59 +02:00
Code Issues Projects Releases Wiki Activity

tmp_c done

Browse Source
This commit is contained in:
Gianfranco Abrusci 2022-03-17 17:46:21 +01:00
parent b222ee3156
commit 6b45157212
1 changed files with 67 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
org/qmckl_jastrow.org
View File

@ -5330,6 +5330,73 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, &
end function qmckl_compute_tmp_c_f end function qmckl_compute_tmp_c_f
#+end_src #+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes
qmckl_exit_code qmckl_compute_tmp_c (
const qmckl_context context,
const int64_t cord_num,
const int64_t elec_num,
const int64_t nucl_num,
const int64_t walk_num,
const double* een_rescaled_e,
const double* een_rescaled_n,
double* const tmp_c ) {
qmckl_exit_code info;
int i, j, a, l, kk, p, lmax, nw;
char TransA, TransB;
double alpha, beta;
int M, N, K, LDA, LDB, LDC;
TransA = 'N';
TransB = 'N';
alpha = 1.0;
beta = 0.0;
if (context == QMCKL_NULL_CONTEXT) {
return QMCKL_INVALID_CONTEXT;
}
if (cord_num <= 0) {
return QMCKL_INVALID_ARG_2;
}
if (elec_num <= 0) {
return QMCKL_INVALID_ARG_3;
}
if (nucl_num <= 0) {
return QMCKL_INVALID_ARG_4;
}
M = elec_num;
N = nucl_num*(cord_num + 1);
K = elec_num;
LDA = sizeof(een_rescaled_e)/sizeof(double);
LDB = sizeof(een_rescaled_n)/sizeof(double);
LDC = sizeof(tmp_c)/sizeof(double);
// DOING
for (int nw=0; nw < walk_num; ++nw) {
for (int i=0; i<cord_num; ++i){
info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, \
// &een_rescaled_e[0+0*elec_num+i*elec_num*elec_num+nw*elec_num*elec_num*(cord_num+1)],
&een_rescaled_e[ i*elec_num*elec_num+nw*elec_num*elec_num*(cord_num+1)], \
LDA, \
// &een_rescaled_n[0+0*elec_num+0*elec_num*nucl_num+nw*elec_num*nucl_num*(cord_num+1)],
&een_rescaled_n[ nw*elec_num*nucl_num*(cord_num+1)], \
LDB, \
beta, \
// &tmp_c[0+0*elec_num+0*elec_num*nucl_num+i*elec_num*nucl_num*(cord_num+1)+nw*elec_num*nucl_num*(cord_num+1)*cord_num],
&tmp_c[ i*elec_num*nucl_num*(cord_num+1)+nw*elec_num*nucl_num*(cord_num+1)*cord_num], \
LDC);
}
}
return info;
}
#+end_src
#+CALL: generate_c_header(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname=get_value("Name")) #+CALL: generate_c_header(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
#+RESULTS: #+RESULTS:
@ -5346,33 +5413,6 @@ end function qmckl_compute_tmp_c_f
#+end_src #+end_src
#+CALL: generate_c_interface(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_compute_tmp_c &
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: cord_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
real (c_double ) , intent(out) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num)
integer(c_int32_t), external :: qmckl_compute_tmp_c_f
info = qmckl_compute_tmp_c_f &
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c)
end function qmckl_compute_tmp_c
#+end_src
*** Compute dtmp_c *** Compute dtmp_c
:PROPERTIES: :PROPERTIES:
:Name: qmckl_compute_dtmp_c :Name: qmckl_compute_dtmp_c