LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-31 16:45:54 +01:00
Code Issues Releases Wiki Activity

Merge branch 'develop' of github.com:scemama/quantum_package into develop

Browse Source
This commit is contained in:
Anthony Scemama 2017-12-01 13:28:43 +01:00
commit 05ea4f54a9
13 changed files with 105 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ocaml/GaussianPrimitive.ml
View File

@ -8,7 +8,7 @@ type t =
let to_string p =
let { sym = s ; expo = e } = p in
Printf.sprintf "(%s, %f)"
Printf.sprintf "(%s, %22e)"
(Symmetry.to_string s)
(AO_expo.to_float e)

4
ocaml/Pseudo.ml
View File

@ -23,7 +23,7 @@ end = struct
{ expo = dz ; r_power = n }
let to_string p =
Printf.sprintf "(%d, %f)"
Printf.sprintf "(%d, %22e)"
(R_power.to_int p.r_power)
(AO_expo.to_float p.expo)
end
@ -52,7 +52,7 @@ end = struct
{ expo = dz ; r_power = n ; proj = p }
let to_string p =
Printf.sprintf "(%d, %f, %d)"
Printf.sprintf "(%d, %22e, %d)"
(R_power.to_int p.r_power)
(AO_expo.to_float p.expo)
(Positive_int.to_int p.proj)

36
ocaml/qp_overlap_of_wf.ml
View File

@ -16,7 +16,8 @@ let () =
"Syntax : %s EZFIO1 EZFIO2" Sys.argv.(0)))
in
let fetch_wf filename =
let fetch_wf ~state filename =
(* State 0 is the ground state *)
Ezfio.set_file filename;
let mo_tot_num =
Ezfio.get_mo_basis_mo_tot_num ()
@ -28,6 +29,9 @@ let () =
let n_det =
Det_number.to_int d.Determinants_by_hand.n_det
in
let state_shift =
state*n_det
in
let keys =
Array.map (Determinant.to_string ~mo_tot_num)
d.Determinants_by_hand.psi_det
@ -40,7 +44,7 @@ let () =
in
for i=0 to n_det-1
do
Hashtbl.add hash keys.(i) values.(i);
Hashtbl.add hash keys.(i) values.(state_shift+i);
done;
hash
in
@ -60,14 +64,30 @@ let () =
result /. (sqrt (norm *. norm'))
in
let wf, wf' =
fetch_wf ezfio,
fetch_wf ezfio'
let n_st1 =
Ezfio.set_file ezfio;
Ezfio.get_determinants_n_states ()
and n_st2 =
Ezfio.set_file ezfio';
Ezfio.get_determinants_n_states ()
in
Array.init n_st2 (fun i -> i)
|> Array.iter (fun state_j ->
Printf.printf "%d " (state_j+1);
let wf' =
fetch_wf ~state:state_j ezfio'
in
Array.init n_st1 (fun i -> i)
|> Array.iter (fun state_i ->
let wf =
fetch_wf ~state:state_i ezfio
in
let o =
overlap wf wf'
in
print_float (abs_float o) ;
print_newline ()
Printf.printf "%f %!" (abs_float o)
);
Printf.printf "\n%!"
)

5
plugins/CAS_SD_ZMQ/selection.irp.f
View File

@ -1251,7 +1251,10 @@ subroutine ZMQ_selection(N_in, pt2)
stop 'Unable to add task to task server'
endif
endif
call zmq_set_running(zmq_to_qp_run_socket)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
i = omp_get_thread_num()

16
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -118,7 +118,11 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
endif
endif
call zmq_set_running(zmq_to_qp_run_socket)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) &
!$OMP PRIVATE(i)
@ -294,7 +298,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_
if (firstTBDcomb > Ncomb) then
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
stop 'Error in sending abort signal'
call sleep(1)
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Error in sending abort signal (1)'
endif
endif
exit pullLoop
endif
@ -322,7 +329,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_
error(pt2_stoch_istate) = eqt
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, ''
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
stop 'Error in sending abort signal'
call sleep(1)
if (zmq_abort(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Error in sending abort signal (2)'
endif
endif
else
if (Nabove(tooth) > Nabove_old) then

6
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -70,7 +70,11 @@ subroutine ZMQ_selection(N_in, pt2)
ASSERT (associated(b%det))
ASSERT (associated(b%val))
call zmq_set_running(zmq_to_qp_run_socket)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
i = omp_get_thread_num()
if (i==0) then

2
plugins/mrcepa0/dressing_slave.irp.f
View File

@ -208,7 +208,7 @@ subroutine mrsc2_dressing_slave(thread,iproc)
deallocate(delta)
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1)
if (disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) == -1) then
continue
endif
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)

6
src/Davidson/davidson_parallel.irp.f
View File

@ -369,8 +369,12 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
v_0 = 0.d0
s_0 = 0.d0
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
call omp_set_nested(.True.)
call zmq_set_running(zmq_to_qp_run_socket)
!$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
ithread = omp_get_thread_num()
if (ithread == 0 ) then

5
src/Integrals_Bielec/ao_bi_integrals.irp.f
View File

@ -380,7 +380,10 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
enddo
deallocate(task)
call zmq_set_running(zmq_to_qp_run_socket)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)

2
src/Integrals_Bielec/mo_bi_integrals.irp.f
View File

@ -122,7 +122,7 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ]
call four_index_transform_block(ao_integrals_map,mo_integrals_map, &
mo_coef, size(mo_coef,1), &
1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
1, 1, 1, 1, mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num)
1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num)
!
! call four_index_transform(ao_integrals_map,mo_integrals_map, &
! mo_coef, size(mo_coef,1), &

8
src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f
View File

@ -105,6 +105,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num,ao_num)]
pseudo_n_k_transp (1,k), &
pseudo_dz_k_transp(1,k), &
A_center,power_A,alpha,B_center,power_B,beta,C_center)
!if ((k==nucl_num).and.(num_A == nucl_num).and.(num_B == nucl_num)) then
!print *, pseudo_klocmax,pseudo_v_k_transp (1,k),pseudo_n_k_transp (1,k),pseudo_dz_k_transp(1,k)
!print *, A_center(1:3), power_A
!print *, B_center(1:3), power_B
!print *, C_center(1:3)
!print *, c
!endif
enddo
ao_pseudo_integral_local(i,j) = ao_pseudo_integral_local(i,j) +&
ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i)*c

18
src/MO_Basis/mos.irp.f
View File

@ -35,6 +35,24 @@ BEGIN_PROVIDER [ integer, mo_tot_num ]
END_PROVIDER
BEGIN_PROVIDER [ integer, mo_num ]
implicit none
BEGIN_DOC
! mo_tot_num without the highest deleted MOs
END_DOC
mo_num = mo_tot_num
integer :: i
mo_num = mo_tot_num
do i=mo_tot_num,1,-1
if (mo_class(i) == 'Deleted') then
mo_num -= 1
else
exit
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_tot_num) ]
implicit none

24
src/ZMQ/utils.irp.f
View File

@ -148,12 +148,12 @@ function new_zmq_to_qp_run_socket()
stop 'Unable to create zmq req socket'
endif
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 10000, 4)
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 30000, 4)
if (rc /= 0) then
stop 'Unable to set send timeout in new_zmq_to_qp_run_socket'
endif
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 10000, 4)
rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 30000, 4)
if (rc /= 0) then
stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket'
endif
@ -347,12 +347,12 @@ IRP_ENDIF
! stop 'Unable to set ZMQ_SNDBUF on push socket'
! endif
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,0,4)
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_IMMEDIATE,1,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_IMMEDIATE on push socket'
endif
rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 10000, 4)
rc = f77_zmq_setsockopt(new_zmq_push_socket, ZMQ_SNDTIMEO, 30000, 4)
if (rc /= 0) then
stop 'Unable to set send timout in new_zmq_push_socket'
endif
@ -565,7 +565,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
end
subroutine zmq_set_running(zmq_to_qp_run_socket)
integer function zmq_set_running(zmq_to_qp_run_socket)
use f77_zmq
implicit none
BEGIN_DOC
@ -576,22 +576,21 @@ subroutine zmq_set_running(zmq_to_qp_run_socket)
character*(512) :: message
integer :: rc, sze
zmq_set_running = 0
message = 'set_running'
sze = len(trim(message))
rc = f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)
if (rc /= sze) then
print *, irp_here, ':f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)'
stop 'error'
zmq_set_running = -1
return
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
message = trim(message(1:rc))
if (message(1:2) /= 'ok') then
print *, trim(message(1:rc))
print *, 'Unable to set qp_run to Running'
stop 1
zmq_set_running = -1
return
endif
end
@ -616,11 +615,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
stop 'Wrong end of job'
endif
do i=6,1,-1
do i=10,1,-1
rc = f77_zmq_send(zmq_to_qp_run_socket, 'end_job '//trim(zmq_state),8+len(trim(zmq_state)),0)
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0)
if (trim(message(1:13)) == 'error waiting') then
print *, trim(message(1:rc))
call sleep(1)
cycle
else if (message(1:2) == 'ok') then