10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-23 03:07:34 +02:00

Almost working but still broken

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

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)
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) :: abuf(0:*)
integer, intent(inout) :: abuf(*)
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 :: phasemask(2,N_int*bit_kind_size)

View File

@ -29,8 +29,6 @@ subroutine run_dressing(N_st,energy)
delta_E = 1.d0
iteration = 0
do iteration=1,n_it_dress_max
N_det_delta_ij = N_det
touch N_det_delta_ij
print *, '==============================================='
print *, 'Iteration', iteration, '/', n_it_dress_max
print *, '==============================================='
@ -40,9 +38,6 @@ subroutine run_dressing(N_st,energy)
do i=1,N_st
print *, i, psi_energy(i)+nuclear_repulsion
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>'
do i=1,N_st
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)")
delta_E = dabs(delta_E)
call save_wavefunction
! call ezfio_set_dress_zmq_energy(ci_energy_dressed(1))
if (delta_E < thresh_dress) then
exit
endif

View File

@ -276,7 +276,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
call omp_set_nested(.true.)
if (.false.) then !! TODO
if (.true.) then !! TODO
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) &
!$OMP PRIVATE(i)
i = omp_get_thread_num()
@ -462,11 +462,16 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
end do
t = dress_dot_t(m)
avg = S(t) / dble(c)
eqt = (S2(t) / c) - (S(t)/c)**2
eqt = sqrt(eqt / dble(c-1))
error = eqt
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, ''
if (c > 1) then
eqt = (S2(t) / c) - (S(t)/c)**2
eqt = sqrt(eqt / dble(c-1))
error = eqt
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
if(eqt <= relative_error) then
integer, external :: zmq_put_dvector

View File

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

View File

@ -41,7 +41,7 @@ subroutine run_dress_slave(thread,iproce,energy)
! double precision, external :: omp_get_wtime
double precision :: time, time0
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(cp(N_states, N_det, dress_N_cp, 2))

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(:,:)
!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))
do k=1,N_st
call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
enddo