mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-22 20:35:19 +01:00
Merge branch 'develop' of github.com:scemama/quantum_package into develop
This commit is contained in:
commit
05ea4f54a9
@ -8,7 +8,7 @@ type t =
|
|||||||
|
|
||||||
let to_string p =
|
let to_string p =
|
||||||
let { sym = s ; expo = e } = p in
|
let { sym = s ; expo = e } = p in
|
||||||
Printf.sprintf "(%s, %f)"
|
Printf.sprintf "(%s, %22e)"
|
||||||
(Symmetry.to_string s)
|
(Symmetry.to_string s)
|
||||||
(AO_expo.to_float e)
|
(AO_expo.to_float e)
|
||||||
|
|
||||||
|
@ -23,7 +23,7 @@ end = struct
|
|||||||
{ expo = dz ; r_power = n }
|
{ expo = dz ; r_power = n }
|
||||||
|
|
||||||
let to_string p =
|
let to_string p =
|
||||||
Printf.sprintf "(%d, %f)"
|
Printf.sprintf "(%d, %22e)"
|
||||||
(R_power.to_int p.r_power)
|
(R_power.to_int p.r_power)
|
||||||
(AO_expo.to_float p.expo)
|
(AO_expo.to_float p.expo)
|
||||||
end
|
end
|
||||||
@ -52,7 +52,7 @@ end = struct
|
|||||||
{ expo = dz ; r_power = n ; proj = p }
|
{ expo = dz ; r_power = n ; proj = p }
|
||||||
|
|
||||||
let to_string p =
|
let to_string p =
|
||||||
Printf.sprintf "(%d, %f, %d)"
|
Printf.sprintf "(%d, %22e, %d)"
|
||||||
(R_power.to_int p.r_power)
|
(R_power.to_int p.r_power)
|
||||||
(AO_expo.to_float p.expo)
|
(AO_expo.to_float p.expo)
|
||||||
(Positive_int.to_int p.proj)
|
(Positive_int.to_int p.proj)
|
||||||
|
@ -16,7 +16,8 @@ let () =
|
|||||||
"Syntax : %s EZFIO1 EZFIO2" Sys.argv.(0)))
|
"Syntax : %s EZFIO1 EZFIO2" Sys.argv.(0)))
|
||||||
in
|
in
|
||||||
|
|
||||||
let fetch_wf filename =
|
let fetch_wf ~state filename =
|
||||||
|
(* State 0 is the ground state *)
|
||||||
Ezfio.set_file filename;
|
Ezfio.set_file filename;
|
||||||
let mo_tot_num =
|
let mo_tot_num =
|
||||||
Ezfio.get_mo_basis_mo_tot_num ()
|
Ezfio.get_mo_basis_mo_tot_num ()
|
||||||
@ -28,6 +29,9 @@ let () =
|
|||||||
let n_det =
|
let n_det =
|
||||||
Det_number.to_int d.Determinants_by_hand.n_det
|
Det_number.to_int d.Determinants_by_hand.n_det
|
||||||
in
|
in
|
||||||
|
let state_shift =
|
||||||
|
state*n_det
|
||||||
|
in
|
||||||
let keys =
|
let keys =
|
||||||
Array.map (Determinant.to_string ~mo_tot_num)
|
Array.map (Determinant.to_string ~mo_tot_num)
|
||||||
d.Determinants_by_hand.psi_det
|
d.Determinants_by_hand.psi_det
|
||||||
@ -40,7 +44,7 @@ let () =
|
|||||||
in
|
in
|
||||||
for i=0 to n_det-1
|
for i=0 to n_det-1
|
||||||
do
|
do
|
||||||
Hashtbl.add hash keys.(i) values.(i);
|
Hashtbl.add hash keys.(i) values.(state_shift+i);
|
||||||
done;
|
done;
|
||||||
hash
|
hash
|
||||||
in
|
in
|
||||||
@ -60,14 +64,30 @@ let () =
|
|||||||
result /. (sqrt (norm *. norm'))
|
result /. (sqrt (norm *. norm'))
|
||||||
in
|
in
|
||||||
|
|
||||||
let wf, wf' =
|
let n_st1 =
|
||||||
fetch_wf ezfio,
|
Ezfio.set_file ezfio;
|
||||||
fetch_wf 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
|
in
|
||||||
|
|
||||||
let o =
|
let o =
|
||||||
overlap wf wf'
|
overlap wf wf'
|
||||||
in
|
in
|
||||||
print_float (abs_float o) ;
|
Printf.printf "%f %!" (abs_float o)
|
||||||
print_newline ()
|
);
|
||||||
|
Printf.printf "\n%!"
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -1251,7 +1251,10 @@ subroutine ZMQ_selection(N_in, pt2)
|
|||||||
stop 'Unable to add task to task server'
|
stop 'Unable to add task to task server'
|
||||||
endif
|
endif
|
||||||
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)
|
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
|
@ -118,7 +118,11 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
|
|||||||
endif
|
endif
|
||||||
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 PARALLEL DEFAULT(shared) NUM_THREADS(nproc+1) &
|
||||||
!$OMP PRIVATE(i)
|
!$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 (firstTBDcomb > Ncomb) then
|
||||||
if (zmq_abort(zmq_to_qp_run_socket) == -1) 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
|
endif
|
||||||
exit pullLoop
|
exit pullLoop
|
||||||
endif
|
endif
|
||||||
@ -322,7 +329,10 @@ subroutine pt2_collector(zmq_socket_pull, E, b, tbc, comb, Ncomb, computed, pt2_
|
|||||||
error(pt2_stoch_istate) = eqt
|
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, ''
|
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
|
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
|
endif
|
||||||
else
|
else
|
||||||
if (Nabove(tooth) > Nabove_old) then
|
if (Nabove(tooth) > Nabove_old) then
|
||||||
|
@ -70,7 +70,11 @@ subroutine ZMQ_selection(N_in, pt2)
|
|||||||
ASSERT (associated(b%det))
|
ASSERT (associated(b%det))
|
||||||
ASSERT (associated(b%val))
|
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)
|
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
if (i==0) then
|
if (i==0) then
|
||||||
|
@ -208,7 +208,7 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
|
|
||||||
deallocate(delta)
|
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
|
continue
|
||||||
endif
|
endif
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
|
@ -369,8 +369,12 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
v_0 = 0.d0
|
v_0 = 0.d0
|
||||||
s_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 omp_set_nested(.True.)
|
||||||
call zmq_set_running(zmq_to_qp_run_socket)
|
|
||||||
!$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
|
!$OMP PARALLEL NUM_THREADS(2) PRIVATE(ithread)
|
||||||
ithread = omp_get_thread_num()
|
ithread = omp_get_thread_num()
|
||||||
if (ithread == 0 ) then
|
if (ithread == 0 ) then
|
||||||
|
@ -380,7 +380,10 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
|||||||
enddo
|
enddo
|
||||||
deallocate(task)
|
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
|
PROVIDE nproc
|
||||||
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
|
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
|
||||||
|
@ -122,7 +122,7 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ]
|
|||||||
call four_index_transform_block(ao_integrals_map,mo_integrals_map, &
|
call four_index_transform_block(ao_integrals_map,mo_integrals_map, &
|
||||||
mo_coef, size(mo_coef,1), &
|
mo_coef, size(mo_coef,1), &
|
||||||
1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
|
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, &
|
! call four_index_transform(ao_integrals_map,mo_integrals_map, &
|
||||||
! mo_coef, size(mo_coef,1), &
|
! mo_coef, size(mo_coef,1), &
|
||||||
|
@ -105,6 +105,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num,ao_num)]
|
|||||||
pseudo_n_k_transp (1,k), &
|
pseudo_n_k_transp (1,k), &
|
||||||
pseudo_dz_k_transp(1,k), &
|
pseudo_dz_k_transp(1,k), &
|
||||||
A_center,power_A,alpha,B_center,power_B,beta,C_center)
|
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
|
enddo
|
||||||
ao_pseudo_integral_local(i,j) = ao_pseudo_integral_local(i,j) +&
|
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
|
ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i)*c
|
||||||
|
@ -35,6 +35,24 @@ BEGIN_PROVIDER [ integer, mo_tot_num ]
|
|||||||
|
|
||||||
END_PROVIDER
|
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) ]
|
BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -148,12 +148,12 @@ function new_zmq_to_qp_run_socket()
|
|||||||
stop 'Unable to create zmq req socket'
|
stop 'Unable to create zmq req socket'
|
||||||
endif
|
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
|
if (rc /= 0) then
|
||||||
stop 'Unable to set send timeout in new_zmq_to_qp_run_socket'
|
stop 'Unable to set send timeout in new_zmq_to_qp_run_socket'
|
||||||
endif
|
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
|
if (rc /= 0) then
|
||||||
stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket'
|
stop 'Unable to set recv timeout in new_zmq_to_qp_run_socket'
|
||||||
endif
|
endif
|
||||||
@ -347,12 +347,12 @@ IRP_ENDIF
|
|||||||
! stop 'Unable to set ZMQ_SNDBUF on push socket'
|
! stop 'Unable to set ZMQ_SNDBUF on push socket'
|
||||||
! endif
|
! 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
|
if (rc /= 0) then
|
||||||
stop 'Unable to set ZMQ_IMMEDIATE on push socket'
|
stop 'Unable to set ZMQ_IMMEDIATE on push socket'
|
||||||
endif
|
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
|
if (rc /= 0) then
|
||||||
stop 'Unable to set send timout in new_zmq_push_socket'
|
stop 'Unable to set send timout in new_zmq_push_socket'
|
||||||
endif
|
endif
|
||||||
@ -565,7 +565,7 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine zmq_set_running(zmq_to_qp_run_socket)
|
integer function zmq_set_running(zmq_to_qp_run_socket)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -576,22 +576,21 @@ subroutine zmq_set_running(zmq_to_qp_run_socket)
|
|||||||
character*(512) :: message
|
character*(512) :: message
|
||||||
integer :: rc, sze
|
integer :: rc, sze
|
||||||
|
|
||||||
|
zmq_set_running = 0
|
||||||
message = 'set_running'
|
message = 'set_running'
|
||||||
sze = len(trim(message))
|
sze = len(trim(message))
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)
|
rc = f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)
|
||||||
if (rc /= sze) then
|
if (rc /= sze) then
|
||||||
print *, irp_here, ':f77_zmq_send(zmq_to_qp_run_socket,message,sze,0)'
|
zmq_set_running = -1
|
||||||
stop 'error'
|
return
|
||||||
endif
|
endif
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0)
|
||||||
message = trim(message(1:rc))
|
message = trim(message(1:rc))
|
||||||
if (message(1:2) /= 'ok') then
|
if (message(1:2) /= 'ok') then
|
||||||
print *, trim(message(1:rc))
|
zmq_set_running = -1
|
||||||
print *, 'Unable to set qp_run to Running'
|
return
|
||||||
stop 1
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -616,11 +615,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
|
|||||||
stop 'Wrong end of job'
|
stop 'Wrong end of job'
|
||||||
endif
|
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_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)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 512, 0)
|
||||||
if (trim(message(1:13)) == 'error waiting') then
|
if (trim(message(1:13)) == 'error waiting') then
|
||||||
print *, trim(message(1:rc))
|
|
||||||
call sleep(1)
|
call sleep(1)
|
||||||
cycle
|
cycle
|
||||||
else if (message(1:2) == 'ok') then
|
else if (message(1:2) == 'ok') then
|
||||||
|
Loading…
Reference in New Issue
Block a user