From 68458296dcc86c57bab25582e138ae057a66f019 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 4 Sep 2018 18:43:39 +0200 Subject: [PATCH] Almost working but still broken --- plugins/dress_zmq/alpha_factory.irp.f | 2 +- plugins/dress_zmq/dress_general.irp.f | 6 ------ plugins/dress_zmq/dress_stoch_routines.irp.f | 17 +++++++++++------ plugins/dress_zmq/dressing.irp.f | 2 +- plugins/dress_zmq/run_dress_slave.irp.f | 2 +- src/Davidson/u0Hu0.irp.f | 1 + 6 files changed, 15 insertions(+), 15 deletions(-) diff --git a/plugins/dress_zmq/alpha_factory.irp.f b/plugins/dress_zmq/alpha_factory.irp.f index ed6c7065..d59ab032 100644 --- a/plugins/dress_zmq/alpha_factory.irp.f +++ b/plugins/dress_zmq/alpha_factory.irp.f @@ -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) diff --git a/plugins/dress_zmq/dress_general.irp.f b/plugins/dress_zmq/dress_general.irp.f index b99eb1d7..8364a61f 100644 --- a/plugins/dress_zmq/dress_general.irp.f +++ b/plugins/dress_zmq/dress_general.irp.f @@ -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 ' 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 diff --git a/plugins/dress_zmq/dress_stoch_routines.irp.f b/plugins/dress_zmq/dress_stoch_routines.irp.f index 136ecb7f..846d38f0 100644 --- a/plugins/dress_zmq/dress_stoch_routines.irp.f +++ b/plugins/dress_zmq/dress_stoch_routines.irp.f @@ -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 diff --git a/plugins/dress_zmq/dressing.irp.f b/plugins/dress_zmq/dressing.irp.f index a3b18b26..40b83037 100644 --- a/plugins/dress_zmq/dressing.irp.f +++ b/plugins/dress_zmq/dressing.irp.f @@ -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) ] diff --git a/plugins/dress_zmq/run_dress_slave.irp.f b/plugins/dress_zmq/run_dress_slave.irp.f index 184ef94c..734c1f31 100644 --- a/plugins/dress_zmq/run_dress_slave.irp.f +++ b/plugins/dress_zmq/run_dress_slave.irp.f @@ -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)) diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index 3e5610c8..38e3f293 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -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