LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-29 16:34:50 +02:00
Code Issues Releases Wiki Activity

Fixed Pseudo and dummy atoms

Browse Source
This commit is contained in:
Anthony Scemama 2016-11-29 16:43:36 +01:00
parent 5e1b077576
commit 2dcb4eba0d
2 changed files with 135 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
ocaml/Pseudo.ml
View File

@ -124,23 +124,27 @@ let to_string t =
let find in_channel element =
In_channel.seek in_channel 0L;
let element_read, old_pos =
ref Element.X,
let loop, element_read, old_pos =
ref true,
ref None,
ref (In_channel.pos in_channel)
in
while !element_read <> element
while !loop
do
try
let buffer =
old_pos := In_channel.pos in_channel;
match In_channel.input_line in_channel with
| Some line -> String.split ~on:' ' line
|> List.hd_exn
| None -> ""
| None -> raise End_of_file
in
try
element_read := Element.of_string buffer
element_read := Some (Element.of_string buffer);
loop := !element_read <> (Some element)
with
| Element.ElementError _ -> ()
| End_of_file -> loop := false
done ;
In_channel.seek in_channel !old_pos;
!element_read
@ -148,8 +152,9 @@ let find in_channel element =
(** Read the Pseudopotential in GAMESS format *)
let read_element in_channel element =
ignore (find in_channel element);
match find in_channel element with
| Some e when e = element ->
begin
let rec read result =
match In_channel.input_line in_channel with
| None -> result
@ -264,7 +269,8 @@ let read_element in_channel element =
decode_first_line data
|> decode_local
|> decode_non_local
end
| _ -> empty element

16
plugins/QmcChem/e_curve_qmc.irp.f
View File

@ -1,7 +1,7 @@
program e_curve
use bitmasks
implicit none
integer :: i,j,k, nab, m, l
integer :: i,j,k, kk, nab, m, l
double precision :: norm, E, hij, num, ci, cj
integer, allocatable :: iorder(:)
double precision , allocatable :: norm_sort(:)
@ -60,7 +60,7 @@ program e_curve
num = 0.d0
norm = 0.d0
m = 0
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l,det_i,det_j,ci,cj,hij) REDUCTION(+:norm,m,num)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,kk,l,det_i,det_j,ci,cj,hij) REDUCTION(+:norm,m,num)
allocate( det_i(N_int,2), det_j(N_int,2))
!$OMP DO SCHEDULE(guided)
do k=1,n_det
@ -68,15 +68,19 @@ program e_curve
cycle
endif
ci = psi_bilinear_matrix_values(k,1)
det_i(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(k))
det_i(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(k))
do kk=1,N_int
det_i(kk,1) = psi_det_alpha_unique(kk,psi_bilinear_matrix_rows(k))
det_i(kk,2) = psi_det_beta_unique(kk,psi_bilinear_matrix_columns(k))
enddo
do l=1,n_det
if (psi_bilinear_matrix_values(l,1) == 0.d0) then
cycle
endif
cj = psi_bilinear_matrix_values(l,1)
det_j(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(l))
det_j(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(l))
do kk=1,N_int
det_j(kk,1) = psi_det_alpha_unique(kk,psi_bilinear_matrix_rows(l))
det_j(kk,2) = psi_det_beta_unique(kk,psi_bilinear_matrix_columns(l))
enddo
call i_h_j(det_i, det_j, N_int, hij)
num = num + ci*cj*hij
enddo