LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01: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 = let find in_channel element =
In_channel.seek in_channel 0L; In_channel.seek in_channel 0L;
let element_read, old_pos = let loop, element_read, old_pos =
ref Element.X, ref true,
ref None,
ref (In_channel.pos in_channel) ref (In_channel.pos in_channel)
in in
while !element_read <> element
while !loop
do do
try
let buffer = let buffer =
old_pos := In_channel.pos in_channel; old_pos := In_channel.pos in_channel;
match In_channel.input_line in_channel with match In_channel.input_line in_channel with
| Some line -> String.split ~on:' ' line | Some line -> String.split ~on:' ' line
|> List.hd_exn |> List.hd_exn
| None -> "" | None -> raise End_of_file
in in
try element_read := Some (Element.of_string buffer);
element_read := Element.of_string buffer loop := !element_read <> (Some element)
with with
| Element.ElementError _ -> () | Element.ElementError _ -> ()
| End_of_file -> loop := false
done ; done ;
In_channel.seek in_channel !old_pos; In_channel.seek in_channel !old_pos;
!element_read !element_read
@ -148,8 +152,9 @@ let find in_channel element =
(** Read the Pseudopotential in GAMESS format *) (** Read the Pseudopotential in GAMESS format *)
let read_element in_channel element = 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 = let rec read result =
match In_channel.input_line in_channel with match In_channel.input_line in_channel with
| None -> result | None -> result
@ -264,7 +269,8 @@ let read_element in_channel element =
decode_first_line data decode_first_line data
|> decode_local |> decode_local
|> decode_non_local |> decode_non_local
end
| _ -> empty element

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

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