1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-23 04:44:03 +01:00

Added local energy. #41

This commit is contained in:
v1j4y 2021-10-11 18:39:18 +02:00
parent 131e510291
commit 1be1317210

View File

@ -135,7 +135,7 @@ int main() {
The following arrays are stored in the context: The following arrays are stored in the context:
|------------------+------------------------------------------------+------------------------------------| ||
Computed data: Computed data:
@ -748,6 +748,228 @@ end function qmckl_compute_potential_energy_f
end function qmckl_compute_potential_energy end function qmckl_compute_potential_energy
#+end_src #+end_src
*** Test
** Local energy
:PROPERTIES:
:Name: qmckl_compute_local_energy
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
*** Get
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code qmckl_get_local_energy(qmckl_context context, double* const local_energy);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_get_local_energy(qmckl_context context, double * const local_energy) {
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_exit_code rc;
if(!qmckl_electron_provided(context)) return QMCKL_NOT_PROVIDED;
if(!qmckl_nucleus_provided(context)) return QMCKL_NOT_PROVIDED;
rc = qmckl_provide_ao_vgl(context);
if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_mo_vgl(context);
if (rc != QMCKL_SUCCESS) return rc;
rc = qmckl_provide_local_energy(context);
if (rc != QMCKL_SUCCESS) return rc;
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL);
size_t sze = ctx->electron.walk_num * sizeof(double);
memcpy(local_energy, ctx->local_energy.e_kin, sze);
return QMCKL_SUCCESS;
}
#+end_src
*** Provide
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
qmckl_exit_code qmckl_provide_local_energy(qmckl_context context);
#+end_src
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code qmckl_provide_local_energy(qmckl_context context) {
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
assert (ctx != NULL);
if(!(ctx->nucleus.provided)) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_electron",
NULL);
}
if(!(ctx->electron.provided)) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_electron",
NULL);
}
if (!ctx->ao_basis.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_ao_basis",
NULL);
}
if (!ctx->mo_basis.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_mo_basis",
NULL);
}
if (!ctx->det.provided) {
return qmckl_failwith( context,
QMCKL_NOT_PROVIDED,
"qmckl_mo_basis",
NULL);
}
/* Compute if necessary */
if (ctx->electron.coord_new_date > ctx->local_energy.e_kin_date) {
/* Allocate array */
if (ctx->local_energy.e_kin == NULL) {
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
mem_info.size = ctx->electron.walk_num * sizeof(double);
double* e_kin = (double*) qmckl_malloc(context, mem_info);
if (e_kin == NULL) {
return qmckl_failwith( context,
QMCKL_ALLOCATION_FAILED,
"qmckl_e_kin",
NULL);
}
ctx->local_energy.e_kin = e_kin;
}
qmckl_exit_code rc;
if (ctx->det.type == 'G') {
rc = qmckl_compute_local_energy(context,
ctx->det.walk_num,
ctx->local_energy.e_kin,
ctx->local_energy.e_pot,
ctx->local_energy.e_local);
} else {
return qmckl_failwith( context,
QMCKL_FAILURE,
"compute_local_energy",
"Not yet implemented");
}
if (rc != QMCKL_SUCCESS) {
return rc;
}
ctx->local_energy.e_kin_date = ctx->date;
}
return QMCKL_SUCCESS;
}
#+end_src
*** Compute local enregy
:PROPERTIES:
:Name: qmckl_compute_local_energy
:CRetType: qmckl_exit_code
:FRetType: qmckl_exit_code
:END:
#+NAME: qmckl_compute_local_energy_args
| ~qmckl_context~ | ~context~ | in | Global state |
| ~int64_t~ | ~walk_num~ | in | Number of walkers |
| ~double~ | ~e_kin[walk_num]~ | in | e kinetic |
| ~double~ | ~e_pot[walk_num]~ | in | e potential |
| ~double~ | ~e_local[walk_num]~ | out | local energy |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_local_energy_f(context, walk_num, &
e_kin, e_pot, e_local) &
result(info)
use qmckl
implicit none
integer(qmckl_context) , intent(in) :: context
integer*8, intent(in) :: walk_num
double precision, intent(in) :: e_kin(walk_num)
double precision, intent(in) :: e_pot(walk_num)
double precision, intent(inout) :: e_local(walk_num)
integer*8 :: idet, iwalk, ielec, mo_id, imo
info = QMCKL_SUCCESS
if (context == QMCKL_NULL_CONTEXT) then
info = QMCKL_INVALID_CONTEXT
return
endif
if (walk_num <= 0) then
info = QMCKL_INVALID_ARG_2
return
endif
do iwalk = 1, walk_num
e_local(iwalk) = e_local(iwalk) + e_kin(iwalk) + e_pot(iwalk)
end do
end function qmckl_compute_local_energy_f
#+end_src
#+CALL: generate_c_header(table=qmckl_compute_local_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_local_energy"))
#+RESULTS:
#+begin_src c :tangle (eval h_func) :comments org
qmckl_exit_code qmckl_compute_local_energy (
const qmckl_context context,
const int64_t walk_num,
const double* e_kin,
const double* e_pot,
double* const e_local );
#+end_src
#+CALL: generate_c_interface(table=qmckl_compute_local_energy_args,rettyp=get_value("CRetType"),fname="qmckl_compute_local_energy"))
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_compute_local_energy &
(context, walk_num, e_kin, e_pot, e_local) &
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 :: walk_num
real (c_double ) , intent(in) :: e_kin(walk_num)
real (c_double ) , intent(in) :: e_pot(walk_num)
real (c_double ) , intent(out) :: e_local(walk_num)
integer(c_int32_t), external :: qmckl_compute_local_energy_f
info = qmckl_compute_local_energy_f &
(context, walk_num, e_kin, e_pot, e_local)
end function qmckl_compute_local_energy
#+end_src
*** Test *** Test
* End of files :noexport: * End of files :noexport: