LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-24 13:23:41 +01:00
Code Issues Releases Wiki Activity

Merge branch 'master' of github.com:scemama/quantum_package

Browse Source
This commit is contained in:
Anthony Scemama 2018-10-15 11:20:27 +02:00
commit 665ece19e5
15 changed files with 323 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -156,9 +156,10 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error)
integer, external :: add_task_to_taskserver
character(100000) :: task
character(400000) :: task
integer :: j,k,ipos
integer :: j,k,ipos,ifirst
ifirst=0
ipos=0
do i=1,N_det_generators
@ -166,19 +167,24 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error)
ipos += 1
endif
enddo
call write_int(6,sum(pt2_F),'Number of tasks')
call write_int(6,ipos,'Number of fragmented tasks')
ipos=1
do i= 1, N_det_generators
do j=1,pt2_F(pt2_J(i))
write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, pt2_J(i)
ipos += 20
if (ipos > 100000-20) then
if (ipos > 400000-20) then
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
stop 'Unable to add task to task server'
endif
ipos=1
if (ifirst == 0) then
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
endif
endif
end do
enddo
@ -204,14 +210,16 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error)
nproc_target = min(nproc_target,nproc)
endif
call omp_set_nested(.true.)
call omp_set_nested(.false.)
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) &
!$OMP PRIVATE(i)
i = omp_get_thread_num()
if (i==0) then
call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, w, error)
pt2(pt2_stoch_istate) = w(pt2_stoch_istate)
else
call pt2_slave_inproc(i)
endif
@ -259,7 +267,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer, external :: zmq_delete_tasks
integer, external :: zmq_abort
integer, external :: pt2_find_sample
integer, external :: pt2_find_sample_lr
integer :: more, n, i, p, c, t, n_tasks, U
integer, allocatable :: task_id(:)
@ -321,10 +329,10 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2, error)
x = 0d0
do p=pt2_N_teeth, 1, -1
v = pt2_u_0 + pt2_W_T * (pt2_u(c) + dble(p-1))
i = pt2_find_sample(v, pt2_cW)
i = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(p),pt2_n_0(p+1))
x += eI(pt2_stoch_istate, i) * pt2_W_T / pt2_w(i)
S(p) += x
S2(p) += x**2
S2(p) += x*x
end do
avg = E0 + S(t) / dble(c)
if ((avg /= 0.d0) .or. (n == N_det_generators) ) then
@ -371,13 +379,23 @@ end subroutine
integer function pt2_find_sample(v, w)
implicit none
double precision, intent(in) :: v, w(0:N_det_generators)
integer, external :: pt2_find_sample_lr
pt2_find_sample = pt2_find_sample_lr(v, w, 0, N_det_generators)
end function
integer function pt2_find_sample_lr(v, w, l_in, r_in)
implicit none
double precision, intent(in) :: v, w(0:N_det_generators)
integer, intent(in) :: l_in,r_in
integer :: i,l,r
l = 0
r = N_det_generators
l=l_in
r=r_in
do while(r-l > 1)
i = (r+l) / 2
i = ishft(r+l,-1)
if(w(i) < v) then
l = i
else
@ -390,33 +408,22 @@ integer function pt2_find_sample(v, w)
exit
endif
enddo
pt2_find_sample = r-1
pt2_find_sample_lr = r-1
end function
BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
&BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)]
&BEGIN_PROVIDER[ integer, pt2_R, (N_det_generators)]
BEGIN_PROVIDER [ integer, pt2_n_tasks ]
implicit none
BEGIN_DOC
! Number of parallel tasks for the Monte Carlo
END_DOC
pt2_n_tasks = N_det_generators
END_PROVIDER
BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)]
implicit none
integer :: N_c, N_j, U, t, i
double precision :: v
logical, allocatable :: d(:)
integer, external :: pt2_find_sample
allocate(d(N_det_generators))
pt2_R(:) = 0
N_c = 0
N_j = pt2_n_0(1)
d(:) = .false.
do i=1,N_j
d(i) = .true.
pt2_J(i) = i
end do
integer :: m
integer, allocatable :: seed(:)
integer :: m,i
call random_seed(size=m)
allocate(seed(m))
do i=1,m
@ -426,42 +433,86 @@ end function
deallocate(seed)
call RANDOM_NUMBER(pt2_u)
END_PROVIDER
BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)]
&BEGIN_PROVIDER[ integer, pt2_R, (N_det_generators)]
implicit none
integer :: N_c, N_j
integer :: U, t, i
double precision :: v
integer, external :: pt2_find_sample_lr
logical, allocatable :: pt2_d(:)
integer :: m,l,r,k
integer, parameter :: ncache=10000
integer, allocatable :: ii(:,:)
double precision :: dt
allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators))
pt2_R(:) = 0
pt2_d(:) = .false.
N_c = 0
N_j = pt2_n_0(1)
do i=1,N_j
pt2_d(i) = .true.
pt2_J(i) = i
end do
U = 0
do while(N_j < N_det_generators)
!ADD_COMB
N_c += 1
do t=0, pt2_N_teeth-1
v = pt2_u_0 + pt2_W_T * (dble(t) + pt2_u(N_c))
i = pt2_find_sample(v, pt2_cW)
if(.not. d(i)) then
N_j += 1
pt2_J(N_j) = i
d(i) = .true.
end if
end do
pt2_R(N_j) = N_c
!FILL_TOOTH
do while(U < N_det_generators)
U += 1
if(.not. d(U)) then
N_j += 1
pt2_J(N_j) = U
d(U) = .true.
exit;
end if
do while(N_j < pt2_n_tasks)
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(dt,v,t,k)
do k=1, ncache
dt = pt2_u_0
do t=1, pt2_N_teeth
v = dt + pt2_W_T *pt2_u(N_c+k)
dt = dt + pt2_W_T
ii(t,k) = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(t),pt2_n_0(t+1))
end do
enddo
!$OMP END PARALLEL DO
do k=1,ncache
!ADD_COMB
N_c = N_c+1
do t=1, pt2_N_teeth
i = ii(t,k)
if(.not. pt2_d(i)) then
N_j += 1
pt2_J(N_j) = i
pt2_d(i) = .true.
end if
end do
pt2_R(N_j) = N_c
!FILL_TOOTH
do while(U < N_det_generators)
U += 1
if(.not. pt2_d(U)) then
N_j += 1
pt2_J(N_j) = U
pt2_d(U) = .true.
exit
end if
end do
if (N_j >= pt2_n_tasks) exit
end do
enddo
if(N_det_generators > 1) then
pt2_R(N_det_generators-1) = 0
pt2_R(N_det_generators) = N_c
end if
deallocate(ii,pt2_d)
END_PROVIDER
BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ]
&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ]
&BEGIN_PROVIDER [ double precision, pt2_W_T ]

3
plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f
View File

@ -4,6 +4,7 @@ program selection_slave
! Helper program to compute the PT2 in distributed mode.
END_DOC
call omp_set_nested(.false.)
read_wf = .False.
distributed_davidson = .False.
SOFT_TOUCH read_wf distributed_davidson
@ -133,7 +134,7 @@ subroutine run_wf
call wall_time(t0)
if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_psi_bilinear(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) == -1) cycle
call wall_time(t1)

42
plugins/dress_zmq/alpha_factory.irp.f
View File

@ -374,22 +374,20 @@ subroutine alpha_callback_mask(delta_ij_loc, i_gen, sp, mask, bannedOrb, banned,
logical, intent(in) :: bannedOrb(mo_tot_num,2), banned(mo_tot_num, mo_tot_num)
integer(bit_kind), intent(in) :: mask(N_int, 2)
integer(bit_kind) :: alpha(N_int, 2)
integer, allocatable :: labuf(:), abuf(:)
integer, allocatable :: labuf(:), abuf(:), iorder(:)
logical :: ok
integer :: i,j,k,s,st1,st2,st3,st4
integer :: i,j,k,s,st1,st2,st3,st4,t2
integer :: lindex(mo_tot_num,2), lindex_end(mo_tot_num, 2)
integer :: s1, s2, stamo
logical,allocatable :: putten(:)
integer(bit_kind), allocatable :: det_minilist(:,:,:)
allocate(abuf(siz), labuf(N_det), putten(N_det), det_minilist(N_int, 2, N_det))
allocate(abuf(siz), labuf(N_det), iorder(siz), det_minilist(N_int, 2, N_det))
do i=1,siz
abuf(i) = psi_from_sorted_gen(rabuf(i))
end do
putten = .false.
st1 = indexes_end(0,0)-1 !!
if(st1 > 0) then
@ -419,13 +417,21 @@ subroutine alpha_callback_mask(delta_ij_loc, i_gen, sp, mask, bannedOrb, banned,
lindex_end(:,1) = indexes_end(1:, 0)-1
end if
do i=1,mo_tot_num
do j=1,2
if(lindex(i,j) > 0 .and. lindex_end(i,j) > lindex(i,j)) then
call isort(abuf(lindex(i,j)), iorder, lindex_end(i,j)-lindex(i,j)+1)
end if
end do
end do
do i=1,mo_tot_num
if(bannedOrb(i,s1)) cycle
if(lindex(i,s1) /= 0) then
st2 = st1 + 1 + lindex_end(i,s1)-lindex(i,s1)
labuf(st1:st2-1) = abuf(lindex(i,s1):lindex_end(i,s1))
do j=st1,st2-1
putten(labuf(j)) = .true.
det_minilist(:,:,j) = psi_det(:,:,labuf(j))
end do
else
@ -441,12 +447,25 @@ subroutine alpha_callback_mask(delta_ij_loc, i_gen, sp, mask, bannedOrb, banned,
do j=stamo,mo_tot_num
if(bannedOrb(j,s2) .or. banned(i,j)) cycle
if(lindex(j,s2) /= 0) then
k = lindex(j,s2)
st3 = st2
do k=lindex(j,s2), lindex_end(j,s2)
if(.not. putten(abuf(k))) then
t2 = st1
do while(k <= lindex_end(j,s2))
if(t2 >= st2) then
labuf(st3) = abuf(k)
det_minilist(:,:,st3) = psi_det(:,:,abuf(k))
st3 += 1
k += 1
else if(abuf(k) > labuf(t2)) then
t2 += 1
else if(abuf(k) < labuf(t2)) then
labuf(st3) = abuf(k)
det_minilist(:,:,st3) = psi_det(:,:,abuf(k))
st3 += 1
k += 1
else
k += 1
t2 += 1
end if
end do
else
@ -468,13 +487,6 @@ subroutine alpha_callback_mask(delta_ij_loc, i_gen, sp, mask, bannedOrb, banned,
call dress_with_alpha_buffer(N_states, N_det, N_int, delta_ij_loc, i_gen, labuf, det_minilist, st4-1, alpha, iproc)
end if
end do
if(lindex(i,s1) /= 0) then
do j=st1,st2-1
putten(labuf(j)) = .false.
end do
end if
end do
end subroutine

23
plugins/dress_zmq/dress_stoch_routines.irp.f
View File

@ -16,7 +16,8 @@ END_PROVIDER
integer :: e
e = elec_num - n_core_orb * 2
pt2_n_tasks_max = 1 + min((e*(e-1))/2, int(dsqrt(dble(N_det_generators)))/10)
do i=1,N_det_generators
pt2_F(:) = 1
do i=1,min(10000,N_det_generators)
pt2_F(i) = 1 + dble(pt2_n_tasks_max)*maxval(dsqrt(dabs(psi_coef_sorted_gen(i,1:N_states))))
enddo
@ -25,7 +26,7 @@ END_PROVIDER
pt2_N_teeth = 1
else
pt2_minDetInFirstTeeth = min(5, N_det_generators)
do pt2_N_teeth=100,2,-1
do pt2_N_teeth=50,2,-1
if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit
end do
end if
@ -127,7 +128,7 @@ END_PROVIDER
&BEGIN_PROVIDER [ integer, dress_N_cp ]
implicit none
integer :: N_c, N_j, U, t, i, m
double precision :: v
double precision :: v, dt
double precision, allocatable :: tilde_M(:)
logical, allocatable :: d(:)
integer, external :: dress_find_sample
@ -141,7 +142,7 @@ END_PROVIDER
N_j = pt2_n_0(1)
d(:) = .false.
! Set here the positions of the checkpoints
! Set here the positions of the checkpoints
! U = N_det_generators/((dress_N_cp_max**2+dress_N_cp_max)/2)+1
! do i=1, dress_N_cp_max-1
! dress_M_m(i) = U * (((i*i)+i)/2) + 10
@ -172,11 +173,13 @@ END_PROVIDER
U = 0
m = 1
! TODO Slow loop : to optimize
do while(N_j < N_det_generators)
!ADD_COMB
N_c += 1
dt = 0.d0
do t=0, pt2_N_teeth-1
v = pt2_u_0 + pt2_W_T * (dble(t) + pt2_u(N_c))
v = pt2_u_0 + pt2_W_T * (dt + pt2_u(N_c))
i = dress_find_sample(v, pt2_cW)
tilde_M(i) += 1d0
if(.not. d(i)) then
@ -184,6 +187,7 @@ END_PROVIDER
pt2_J_(N_j) = i
d(i) = .true.
end if
dt = dt + 1.d0
end do
!FILL_TOOTH
@ -193,7 +197,7 @@ END_PROVIDER
N_j += 1
pt2_J_(N_j) = U
d(U) = .true.
exit;
exit
end if
end do
@ -254,7 +258,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
state_average_weight(dress_stoch_istate) = 1.d0
TOUCH state_average_weight dress_stoch_istate
provide nproc mo_bielec_integrals_in_map mo_mono_elec_integral psi_selectors pt2_F
provide nproc mo_bielec_integrals_in_map mo_mono_elec_integral psi_selectors pt2_F pt2_N_teeth dress_M_m
print *, '========== ================= ================= ================='
print *, ' Samples Energy Stat. Error Seconds '
@ -350,8 +354,6 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
nproc_target = min(nproc_target,nproc)
endif
call omp_set_nested(.true.)
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) &
!$OMP PRIVATE(i)
i = omp_get_thread_num()
@ -372,7 +374,6 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
enddo
FREE dress_stoch_istate
state_average_weight(:) = state_average_weight_save(:)
! call omp_set_nested(.false.)
TOUCH state_average_weight
deallocate(delta,delta_s2)
@ -631,7 +632,7 @@ integer function dress_find_sample(v, w)
r = N_det_generators
do while(r-l > 1)
i = (r+l) / 2
i = ishft(r+l,-1)
if(w(i) < v) then
l = i
else

5
plugins/dress_zmq/run_dress_slave.irp.f
View File

@ -43,6 +43,7 @@ subroutine run_dress_slave(thread,iproce,energy)
integer :: ntask_tbd, task_tbd(Nproc), i_gen_tbd(Nproc), subset_tbd(Nproc)
logical :: interesting
PROVIDE dress_dot_F psi_coef dress_stoch_istate dress_e N_int
allocate(delta_det(N_states, N_det, 0:pt2_N_teeth+1, 2))
allocate(cp(N_states, N_det, dress_N_cp, 2))
@ -71,6 +72,8 @@ subroutine run_dress_slave(thread,iproce,energy)
provide psi_energy
ending = dress_N_cp+1
ntask_tbd = 0
call omp_set_nested(.true.)
!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(interesting, breve_delta_m, task_id) &
!$OMP PRIVATE(tmp,fac,m,l,t,sum_f,n_tasks) &
@ -81,6 +84,7 @@ subroutine run_dress_slave(thread,iproce,energy)
zmq_socket_push = new_zmq_push_socket(thread)
integer, external :: connect_to_taskserver
!$OMP CRITICAL
call omp_set_nested(.false.)
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
print *, irp_here, ': Unable to connect to task server'
stop -1
@ -292,6 +296,7 @@ subroutine run_dress_slave(thread,iproce,energy)
!$OMP END CRITICAL
!$OMP END PARALLEL
call omp_set_nested(.false.)
! do i=0,dress_N_cp+1
! call omp_destroy_lock(lck_sto(i))
! end do

1
plugins/shiftedbk/shifted_bk.irp.f
View File

@ -8,6 +8,7 @@ program shifted_bk
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_gen_order psi_bilinear_matrix_order
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
PROVIDE psi_bilinear_matrix_transp_order
PROVIDE psi_energy
!call diagonalize_CI()

32
plugins/shiftedbk/shifted_bk_slave.irp.f
View File

@ -50,7 +50,7 @@ subroutine run_w
PROVIDE psi_det psi_coef threshold_generators threshold_selectors state_average_weight mpi_master
PROVIDE zmq_state N_det_selectors dress_stoch_istate N_det dress_e0_denominator
PROVIDE N_det_generators N_states N_states_diag
PROVIDE N_det_generators N_states N_states_diag psi_energy
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
@ -89,8 +89,8 @@ subroutine run_w
! --------
call wall_time(t0)
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) == -1) cycle
call wall_time(t1)
@ -115,23 +115,21 @@ subroutine run_w
! Dress
! ---
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
call wall_time(t0)
if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle
if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',threshold_generators,1) == -1) cycle
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) cycle
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle
if (zmq_get_int(zmq_to_qp_run_socket,1,'dress_stoch_istate',dress_stoch_istate) == -1) cycle
if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle
psi_energy(1:N_states) = energy(1:N_states)
TOUCH psi_energy state_average_weight dress_stoch_istate threshold_selectors threshold_generators
if (mpi_master) then
@ -145,9 +143,19 @@ subroutine run_w
call wall_time(t1)
call write_double(6,(t1-t0),'Broadcast time')
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here, 'error in barrier'
endif
IRP_ENDIF
call dress_slave_tcp(0, energy)
if (.true.) then
call omp_set_nested(.True.)
call run_dress_slave(0,i,dress_e0_denominator)
endif
print *, 'PT2 done'
FREE state_average_weight
IRP_IF MPI
call MPI_BARRIER(MPI_COMM_WORLD, ierr)

65
scripts/make_binary.sh
View File

@ -1,4 +1,4 @@
#!/bin/bash
#!/bin/bash -x
#
# Creates a self-contained binary distribution in the form of a tar.gz file
#
@ -22,7 +22,7 @@ if [[ -f quantum_package.rc \
&& -d ocaml \
&& -d scripts ]]
then
head -1 README.md | grep "Quantum package" > /dev/null
head -1 README.md | grep "IMPORTANT" > /dev/null
if [[ $? -ne 0 ]]
then
echo "This doesn't look like a quantum_package directory (README.md)"
@ -35,25 +35,11 @@ fi
# Build all sources
for dir in ${QP_ROOT}/{src}
do
pushd $dir
ninja
if [[ $? -ne 0 ]]
then
echo "Error building ${dir}"
fi
popd
done
for dir in ${QP_ROOT}/{ocaml}
do
make -C ${dir}
if [[ $? -ne 0 ]]
then
echo "Error building ${dir}"
fi
done
ninja
if [[ $? -ne 0 ]]
then
echo "Error building ${dir}"
fi
# Copy the files in the static directory
@ -79,10 +65,10 @@ echo "Creating root of static directory"
# ---------------------------------
rm -rf -- ${QPACKAGE_STATIC}
mkdir -p -- ${QPACKAGE_STATIC}/{bin,lib,extra_lib,data}
mkdir -p -- ${QPACKAGE_STATIC}/{bin,lib,extra_lib,data,install}
if [[ $? -ne 0 ]] ;
then
echo "Error creating ${QPACKAGE_STATIC}/{bin,lib,extra_lib,data}"
echo "Error creating ${QPACKAGE_STATIC}/{bin,lib,extra_lib,data,install}"
exit 1
fi
@ -108,7 +94,7 @@ fi
cp -- ${FORTRAN_EXEC} ${OCAML_EXEC} ${QPACKAGE_STATIC}/bin
if [[ $? -ne 0 ]] ;
then
echo 'cp -- ${FORTRAN_EXEC} ${OCAML_EXEC} ${QPACKAGE_STATIC}/bin'
cp -- ${FORTRAN_EXEC} ${OCAML_EXEC} ${QPACKAGE_STATIC}/bin
exit 1
fi
@ -154,10 +140,10 @@ cp -- ${QPACKAGE_STATIC}/extra_lib/lib{[gi]omp*,mkl*,lapack*,blas*,z*} ${QPACKAG
echo "Copying EMSL_Basis directory"
# ----------------------------
cp -r -- ${QP_ROOT}/EMSL_Basis ${QPACKAGE_STATIC}/
cp -r -- ${QP_ROOT}/install/emsl ${QPACKAGE_STATIC}/install
if [[ $? -ne 0 ]] ;
then
echo 'cp -r -- ${QP_ROOT}/EMSL_Basis ${QPACKAGE_STATIC}/'
echo 'cp -r -- ${QP_ROOT}/install/emsl ${QPACKAGE_STATIC}/'
exit 1
fi
@ -180,12 +166,27 @@ echo "Creating quantum_package.rc"
cat << EOF > ${QPACKAGE_STATIC}/quantum_package.rc
export QP_ROOT=\$( cd \$(dirname "\${BASH_SOURCE}") ; pwd -P )
export LD_LIBRARY_PATH="\${QP_ROOT}"/lib:\${LD_LIBRARY_PATH}
export LIBRARY_PATH="\${QP_ROOT}"/lib:\${LIBRARY_PATH}
export PYTHONPATH="\${QP_ROOT}"/scripts:\${PYTHONPATH}
export PATH="\${QP_ROOT}"/scripts:\${PATH}
export PATH="\${QP_ROOT}"/bin:\${PATH}
export PATH="\${QP_ROOT}"/ocaml:\${PATH}
export QP_EZFIO=\${QP_ROOT}/install/EZFIO
export QP_PYTHON=\${QP_ROOT}/scripts:\${QP_ROOT}/scripts/ezfio_interface:\${QP_ROOT}/scripts/utility:\${QP_ROOT}/scripts/module:\${QP_ROOT}/scripts/pseudo:\${QP_ROOT}/scripts/compilation:\${QP_ROOT}/install/bats:\${QP_ROOT}/install/Downloads:\${QP_ROOT}/install/eigen:\${QP_ROOT}/install/p_graphviz:\${QP_ROOT}/install/gmp:\${QP_ROOT}/install/resultsFile:\${QP_ROOT}/install/_build:\${QP_ROOT}/install/emsl:\${QP_ROOT}/install/scripts:\${QP_ROOT}/install/docopt:\${QP_ROOT}/install/irpf90:\${QP_ROOT}/install/zlib:\${QP_ROOT}/install/EZFIO
export IRPF90=\${QP_ROOT}/bin/irpf90
export NINJA=\${QP_ROOT}/bin/ninja
function qp_prepend_export () {
eval "value_1="\\\${\$1}""
if [[ -z \$value_1 ]] ; then
echo "\${2}:"
else
echo "\${2}:\${value_1}"
fi
}
export PYTHONPATH=\$(qp_prepend_export "PYTHONPATH" "\${QP_EZFIO}/Python":"\${QP_PYTHON}")
export PATH=\$(qp_prepend_export "PATH" "\${QP_PYTHON}":"\${QP_ROOT}"/bin:"\${QP_ROOT}"/ocaml)
export LD_LIBRARY_PATH=\$(qp_prepend_export "LD_LIBRARY_PATH" "\${QP_ROOT}"/lib:"\${QP_ROOT}"/extra_lib:"\${QP_ROOT}"/lib64)
export LIBRARY_PATH=\$(qp_prepend_export "LIBRARY_PATH" "\${QP_ROOT}"/lib:"\${QP_ROOT}"/extra_lib:"\${QP_ROOT}"/lib64)
export C_INCLUDE_PATH=\$(qp_prepend_export "C_INCLUDE_PATH" "\${QP_ROOT}"/include)
# export QP_NIC=ib0
EOF
#exit 0

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

@ -309,7 +309,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then
stop 'Unable to put N_states_diag on ZMQ server'
endif
if (zmq_put_psi_bilinear(zmq_to_qp_run_socket,1) == -1) then
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
stop 'Unable to put psi on ZMQ server'
endif
energy = 0.d0
@ -323,7 +323,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
integer :: istep, imin, imax, ishift, ipos
integer, external :: add_task_to_taskserver
integer, parameter :: tasksize=10000
integer, parameter :: tasksize=40000
character*(100000) :: task
istep=1
ishift=0
@ -331,7 +331,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
ipos=1
do imin=1,N_det,10000
do imin=1,N_det,tasksize
imax = min(N_det,imin-1+tasksize)
do ishift=0,istep-1
write(task(ipos:ipos+50),'(4(I11,1X),1X,1A)') imin, imax, ishift, istep, '|'
@ -352,12 +352,6 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
ipos=1
endif
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
allocate(u_t(N_st,N_det))
do k=1,N_st
call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
@ -378,7 +372,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
integer*8 :: rc8
double precision :: energy(N_st)
integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag, zmq_put_psi_bilinear
integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag
integer, external :: zmq_put_dmatrix
if (size(u_t) < 8388608) then
@ -396,6 +390,10 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
deallocate(u_t)
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
v_0 = 0.d0
s_0 = 0.d0
@ -411,11 +409,22 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'davidson')
!$OMP PARALLEL
!$OMP SINGLE
do k=1,N_st
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
call dset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
!$OMP END TASK
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
call dset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
!$OMP END TASK
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
call dset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
!$OMP END TASK
enddo
!$OMP END SINGLE
!$OMP TASKWAIT
!$OMP END PARALLEL
end

2
src/Davidson/u0Hu0.irp.f
View File

@ -491,6 +491,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
deallocate(u_1)
endif
double precision :: norm
!$OMP PARALLEL DO PRIVATE(i,norm) DEFAULT(SHARED)
do i=1,N_st
norm = u_dot_u(u_0(1,i),n)
if (norm /= 0.d0) then
@ -499,6 +500,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
e_0(i) = 0.d0
endif
enddo
!$OMP END PARALLEL DO
deallocate (s_0, v_0)
end

1
src/Determinants/determinants.irp.f
View File

@ -338,6 +338,7 @@ end subroutine
call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, &
psi_det_sorted_bit, psi_coef_sorted_bit, N_states)
END_PROVIDER
subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, det_out, coef_out, N_st)

27
src/Determinants/spindeterminants.irp.f
View File

@ -36,6 +36,7 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det_alpha, (N_int,psi_det_size) ]
psi_det_alpha(k,i) = psi_det(k,1,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_beta, (N_int,psi_det_size) ]
@ -70,11 +71,14 @@ BEGIN_TEMPLATE
logical,allocatable :: duplicate(:)
allocate ( iorder(N_det), bit_tmp(N_det), duplicate(N_det) )
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i)
do i=1,N_det
iorder(i) = i
bit_tmp(i) = spin_det_search_key(psi_det_$alpha(1,i),N_int)
enddo
!$OMP END PARALLEL DO
call i8sort(bit_tmp,iorder,N_det)
@ -126,6 +130,7 @@ BEGIN_TEMPLATE
N_det_$alpha_unique = j
deallocate (iorder, bit_tmp, duplicate)
END_PROVIDER
SUBST [ alpha ]
@ -430,11 +435,19 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states)
enddo
!$OMP END PARALLEL DO
call i8sort(to_sort, psi_bilinear_matrix_order, N_det)
!$OMP PARALLEL
!$OMP SINGLE
call iset_order(psi_bilinear_matrix_rows,psi_bilinear_matrix_order,N_det)
!$OMP END SINGLE
!$OMP SINGLE
call iset_order(psi_bilinear_matrix_columns,psi_bilinear_matrix_order,N_det)
!$OMP END SINGLE
!$OMP DO
do l=1,N_states
call dset_order(psi_bilinear_matrix_values(1,l),psi_bilinear_matrix_order,N_det)
enddo
!$OMP END DO
!$OMP END PARALLEL
deallocate(to_sort)
ASSERT (minval(psi_bilinear_matrix_rows) == 1)
ASSERT (minval(psi_bilinear_matrix_columns) == 1)
@ -442,6 +455,7 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states)
ASSERT (maxval(psi_bilinear_matrix_rows) == N_det_alpha_unique)
ASSERT (maxval(psi_bilinear_matrix_columns) == N_det_beta_unique)
ASSERT (maxval(psi_bilinear_matrix_order) == N_det)
END_PROVIDER
@ -477,6 +491,7 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns_loc, (N_det_beta_unique+1)
l = psi_bilinear_matrix_columns(1)
psi_bilinear_matrix_columns_loc(l) = 1
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(k,l)
do k=2,N_det
if (psi_bilinear_matrix_columns(k) == psi_bilinear_matrix_columns(k-1)) then
cycle
@ -488,9 +503,11 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns_loc, (N_det_beta_unique+1)
stop '(psi_bilinear_matrix_columns(k) < 1)'
endif
enddo
!$OMP END PARALLEL DO
psi_bilinear_matrix_columns_loc(N_det_beta_unique+1) = N_det+1
ASSERT (minval(psi_bilinear_matrix_columns_loc) == 1)
ASSERT (maxval(psi_bilinear_matrix_columns_loc) == N_det+1)
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_states) ]
@ -508,7 +525,6 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_
END_DOC
integer :: i,j,k,l
PROVIDE psi_coef_sorted_bit
integer*8, allocatable :: to_sort(:)
@ -542,9 +558,11 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_
call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1)
call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det)
call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det)
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l)
do l=1,N_states
call dset_order(psi_bilinear_matrix_transp_values(1,l),psi_bilinear_matrix_transp_order,N_det)
enddo
!$OMP END PARALLEL DO
deallocate(to_sort)
ASSERT (minval(psi_bilinear_matrix_transp_columns) == 1)
ASSERT (minval(psi_bilinear_matrix_transp_rows) == 1)
@ -552,6 +570,7 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_
ASSERT (maxval(psi_bilinear_matrix_transp_columns) == N_det_beta_unique)
ASSERT (maxval(psi_bilinear_matrix_transp_rows) == N_det_alpha_unique)
ASSERT (maxval(psi_bilinear_matrix_transp_order) == N_det)
END_PROVIDER
BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows_loc, (N_det_alpha_unique+1) ]
@ -564,6 +583,7 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows_loc, (N_det_alpha_uniq
l = psi_bilinear_matrix_transp_rows(1)
psi_bilinear_matrix_transp_rows_loc(l) = 1
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(k,l)
do k=2,N_det
if (psi_bilinear_matrix_transp_rows(k) == psi_bilinear_matrix_transp_rows(k-1)) then
cycle
@ -572,9 +592,11 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows_loc, (N_det_alpha_uniq
psi_bilinear_matrix_transp_rows_loc(l) = k
endif
enddo
!$OMP END PARALLEL DO
psi_bilinear_matrix_transp_rows_loc(N_det_alpha_unique+1) = N_det+1
ASSERT (minval(psi_bilinear_matrix_transp_rows_loc) == 1)
ASSERT (maxval(psi_bilinear_matrix_transp_rows_loc) == N_det+1)
END_PROVIDER
BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order_transp_reverse , (N_det) ]
@ -584,7 +606,6 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order_transp_reverse , (N_det) ]
! Order which allows to go from psi_bilinear_matrix_order_transp to psi_bilinear_matrix
END_DOC
integer :: k
psi_bilinear_matrix_order_transp_reverse = -1
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(k)
do k=1,N_det

42
src/Integrals_Bielec/test_integrals.irp.f
View File

@ -61,6 +61,20 @@ program bench_maps
cpu = (cpu1 - cpu0)/count_rate
print *, 'loop ijkl : ', cpu/dble(ii)
call system_clock(cpu0, count_rate, count_max)
do ii=1,100000_8
call random_number(r)
i = int(r*mo_tot_num)+1
call random_number(r)
j = int(r*mo_tot_num)+1
call random_number(r)
k = int(r*mo_tot_num)+1
call random_number(r)
l = int(r*mo_tot_num)+1
call get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
enddo
call system_clock(cpu1, count_rate, count_max)
ii=0
call system_clock(cpu0, count_rate, count_max)
do jj=1,10
@ -79,6 +93,20 @@ program bench_maps
cpu = (cpu1 - cpu0)/count_rate
print *, 'loop ikjl : ', cpu/dble(ii)
call system_clock(cpu0, count_rate, count_max)
do ii=1,100000_8
call random_number(r)
i = int(r*mo_tot_num)+1
call random_number(r)
j = int(r*mo_tot_num)+1
call random_number(r)
k = int(r*mo_tot_num)+1
call random_number(r)
l = int(r*mo_tot_num)+1
call get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
enddo
call system_clock(cpu1, count_rate, count_max)
ii=0
call system_clock(cpu0, count_rate, count_max)
do jj=1,10
@ -97,6 +125,20 @@ program bench_maps
cpu = (cpu1 - cpu0)/count_rate
print *, 'loop ijlk : ', cpu/dble(ii)
call system_clock(cpu0, count_rate, count_max)
do ii=1,100000_8
call random_number(r)
i = int(r*mo_tot_num)+1
call random_number(r)
j = int(r*mo_tot_num)+1
call random_number(r)
k = int(r*mo_tot_num)+1
call random_number(r)
l = int(r*mo_tot_num)+1
call get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
enddo
call system_clock(cpu1, count_rate, count_max)
ii=0
call system_clock(cpu0, count_rate, count_max)
do jj=1,10

12
src/Utils/sort.irp.f
View File

@ -37,7 +37,11 @@ BEGIN_TEMPLATE
integer,intent(in) :: isize
$type,intent(inout) :: x(isize)
integer,intent(inout) :: iorder(isize)
!$OMP PARALLEL
!$OMP SINGLE
call rec_$X_quicksort(x,iorder,isize,1,isize)
!$OMP END SINGLE
!$OMP END PARALLEL
end
recursive subroutine rec_$X_quicksort(x, iorder, isize, first, last)
@ -70,11 +74,16 @@ BEGIN_TEMPLATE
j=j-1
enddo
if (first < i-1) then
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,first,i) if (i-first > 100000)
call rec_$X_quicksort(x, iorder, isize, first, i-1)
!$OMP END TASK
endif
if (j+1 < last) then
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,last,j) if (last-j > 100000)
call rec_$X_quicksort(x, iorder, isize, j+1, last)
!$OMP END TASK
endif
!$OMP TASKWAIT
end
subroutine heap_$Xsort(x,iorder,isize)
@ -281,7 +290,8 @@ BEGIN_TEMPLATE
$type,intent(inout) :: x(isize)
integer,intent(inout) :: iorder(isize)
integer :: n
call $Xradix_sort(x,iorder,isize,-1)
! call $Xradix_sort(x,iorder,isize,-1)
call quick_$Xsort(x,iorder,isize)
end subroutine $Xsort
SUBST [ X, type ]

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

@ -246,7 +246,7 @@ IRP_ENDIF
! stop 'Unable to set ZMQ_RCVBUF on pull socket'
! endif
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,2,4)
rc = f77_zmq_setsockopt(new_zmq_pull_socket,ZMQ_RCVHWM,10,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_RCVHWM on pull socket'
endif
@ -323,7 +323,7 @@ IRP_ENDIF
stop 'Unable to set ZMQ_LINGER on push socket'
endif
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,2,4)
rc = f77_zmq_setsockopt(new_zmq_push_socket,ZMQ_SNDHWM,10,4)
if (rc /= 0) then
stop 'Unable to set ZMQ_SNDHWM on push socket'
endif
@ -783,21 +783,31 @@ integer function zmq_abort(zmq_to_qp_run_socket)
! Aborts a running parallel computation
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
integer :: rc, sze
integer :: rc, sze, i
integer, parameter :: count_max=60
character*(512) :: message
zmq_abort = 0
write(message,*) 'abort '
sze = len(trim(message))
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
do i=1,count_max
rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
if (rc == sze) exit
call sleep(1)
enddo
if (rc /= sze) then
print *, 'zmq_abort: rc /= sze', rc, sze
zmq_abort = -1
return
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
do i=1,count_max
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
if (trim(message(1:rc)) == 'ok') exit
call sleep(1)
enddo
if (trim(message(1:rc)) /= 'ok') then
print *, 'zmq_abort: ', rc, ':', trim(message(1:rc))
zmq_abort = -1