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

Almost working but still broken

Browse Source
This commit is contained in:
Anthony Scemama 2018-09-04 18:43:39 +02:00
parent 9ebb88cbf3
commit 68458296dc
6 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -637,7 +637,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, indexes, ab
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel)
logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
integer, intent(inout) :: indexes(0:mo_tot_num, 0:mo_tot_num) integer, intent(inout) :: indexes(0:mo_tot_num, 0:mo_tot_num)
integer, intent(inout) :: abuf(0:*) integer, intent(inout) :: abuf(*)
integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt, s integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt, s
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
integer :: phasemask(2,N_int*bit_kind_size) integer :: phasemask(2,N_int*bit_kind_size)

6
plugins/dress_zmq/dress_general.irp.f
View File

@ -29,8 +29,6 @@ subroutine run_dressing(N_st,energy)
delta_E = 1.d0 delta_E = 1.d0
iteration = 0 iteration = 0
do iteration=1,n_it_dress_max do iteration=1,n_it_dress_max
N_det_delta_ij = N_det
touch N_det_delta_ij
print *, '===============================================' print *, '==============================================='
print *, 'Iteration', iteration, '/', n_it_dress_max print *, 'Iteration', iteration, '/', n_it_dress_max
print *, '===============================================' print *, '==============================================='
@ -40,9 +38,6 @@ subroutine run_dressing(N_st,energy)
do i=1,N_st do i=1,N_st
print *, i, psi_energy(i)+nuclear_repulsion print *, i, psi_energy(i)+nuclear_repulsion
enddo enddo
!print *, "DELTA IJ", delta_ij(1,1,1)
PROVIDE delta_ij_tmp
if(.true.) call delta_ij_done()
print *, 'Dressed energy <Psi|H+Delta|Psi>' print *, 'Dressed energy <Psi|H+Delta|Psi>'
do i=1,N_st do i=1,N_st
print *, i, ci_energy_dressed(i) print *, i, ci_energy_dressed(i)
@ -56,7 +51,6 @@ subroutine run_dressing(N_st,energy)
call write_double(6,delta_E,"delta_E (undressed)") call write_double(6,delta_E,"delta_E (undressed)")
delta_E = dabs(delta_E) delta_E = dabs(delta_E)
call save_wavefunction call save_wavefunction
! call ezfio_set_dress_zmq_energy(ci_energy_dressed(1))
if (delta_E < thresh_dress) then if (delta_E < thresh_dress) then
exit exit
endif endif

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

@ -276,7 +276,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
call omp_set_nested(.true.) call omp_set_nested(.true.)
if (.false.) then !! TODO if (.true.) then !! TODO
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) & !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) &
!$OMP PRIVATE(i) !$OMP PRIVATE(i)
i = omp_get_thread_num() i = omp_get_thread_num()
@ -462,11 +462,16 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
end do end do
t = dress_dot_t(m) t = dress_dot_t(m)
avg = S(t) / dble(c) avg = S(t) / dble(c)
eqt = (S2(t) / c) - (S(t)/c)**2 if (c > 1) then
eqt = sqrt(eqt / dble(c-1)) eqt = (S2(t) / c) - (S(t)/c)**2
error = eqt eqt = sqrt(eqt / dble(c-1))
time = omp_get_wtime() error = eqt
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, '' time = omp_get_wtime()
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, ''
else
eqt = 1.d0
error = eqt
endif
m += 1 m += 1
if(eqt <= relative_error) then if(eqt <= relative_error) then
integer, external :: zmq_put_dvector integer, external :: zmq_put_dvector

2
plugins/dress_zmq/dressing.irp.f
View File

@ -65,7 +65,7 @@ END_PROVIDER
BEGIN_PROVIDER [ integer , N_det_delta_ij ] BEGIN_PROVIDER [ integer , N_det_delta_ij ]
implicit none implicit none
N_det_delta_ij = 1 N_det_delta_ij = N_det
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ double precision, delta_ij, (N_states, N_det, 2) ] BEGIN_PROVIDER [ double precision, delta_ij, (N_states, N_det, 2) ]

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

@ -41,7 +41,7 @@ subroutine run_dress_slave(thread,iproce,energy)
! double precision, external :: omp_get_wtime ! double precision, external :: omp_get_wtime
double precision :: time, time0 double precision :: time, time0
integer :: ntask_tbd, task_tbd(Nproc), i_gen_tbd(Nproc), subset_tbd(Nproc) integer :: ntask_tbd, task_tbd(Nproc), i_gen_tbd(Nproc), subset_tbd(Nproc)
if(iproce /= 0) stop "RUN DRESS SLAVE is OMP" ! if(iproce /= 0) stop "RUN DRESS SLAVE is OMP"
allocate(delta_det(N_states, N_det, 0:pt2_N_teeth+1, 2)) allocate(delta_det(N_states, N_det, 0:pt2_N_teeth+1, 2))
allocate(cp(N_states, N_det, dress_N_cp, 2)) allocate(cp(N_states, N_det, dress_N_cp, 2))

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

@ -28,6 +28,7 @@ subroutine H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze)
double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
allocate(u_t(N_st,N_det),v_t(N_st,N_det),s_t(N_st,N_det)) allocate(u_t(N_st,N_det),v_t(N_st,N_det),s_t(N_st,N_det))
do k=1,N_st do k=1,N_st
call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det) call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
enddo enddo