From 43c7696001dc4efc3a836ff088a633d9a985bc9c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Fri, 11 Sep 2020 11:31:45 -0500 Subject: [PATCH] pass is_complex as argument to pt2_type_size --- src/cipsi/pt2_stoch_routines.irp.f | 6 +++--- src/cipsi/run_pt2_slave.irp.f | 4 ++-- src/cipsi/run_selection_slave.irp.f | 4 ++-- src/cipsi/selection.irp.f | 4 ++-- src/cipsi/selection_types.f90 | 13 +++++++++++-- src/cipsi/zmq_selection.irp.f | 7 ------- 6 files changed, 20 insertions(+), 18 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index c555fe0b..6bd0c50a 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -266,8 +266,8 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) mem_collector = 8.d0 * & ! bytes ( 1.d0*pt2_n_tasks_max & ! task_id, index + 0.635d0*N_det_generators & ! f,d - + pt2_n_tasks_max*pt2_type_size(N_states) & ! pt2_data_task - + N_det_generators*pt2_type_size(N_states) & ! pt2_data_I + + pt2_n_tasks_max*pt2_type_size(N_states,is_complex) & ! pt2_data_task + + N_det_generators*pt2_type_size(N_states,is_complex) & ! pt2_data_I + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 + 1.d0*(N_int*2.d0*N + N) & ! selection buffer + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer @@ -282,7 +282,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) nproc_target * 8.d0 * & ! bytes ( 0.5d0*pt2_n_tasks_max & ! task_id + 64.d0*pt2_n_tasks_max & ! task - + pt2_type_size(N_states)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap + + pt2_type_size(N_states,is_complex)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap + 1.d0*pt2_n_tasks_max & ! i_generator, subset + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index d3f4d45d..7c296c50 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -339,7 +339,7 @@ subroutine push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task endif - allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) ) + allocate(pt2_serialized (pt2_type_size(N_states,is_complex),n_tasks) ) do i=1,n_tasks call pt2_serialize(pt2_data(i),N_states,pt2_serialized(1,i)) enddo @@ -480,7 +480,7 @@ subroutine pull_pt2_results(zmq_socket_pull, index, pt2_data, task_id, n_tasks, stop 'pull' endif - allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) ) + allocate(pt2_serialized (pt2_type_size(N_states,is_complex),n_tasks) ) rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized)*n_tasks, 0) if (rc == -1) then n_tasks = 1 diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f index 0d06d1d0..f31a5bc0 100644 --- a/src/cipsi/run_selection_slave.irp.f +++ b/src/cipsi/run_selection_slave.irp.f @@ -145,7 +145,7 @@ subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntasks) endif - allocate(pt2_serialized (pt2_type_size(N_states)) ) + allocate(pt2_serialized (pt2_type_size(N_states,is_complex)) ) call pt2_serialize(pt2_data,N_states,pt2_serialized) rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE) @@ -213,7 +213,7 @@ subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_i print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)' endif - allocate(pt2_serialized (pt2_type_size(N_states)) ) + allocate(pt2_serialized (pt2_type_size(N_states,is_complex)) ) rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized), 0) if (rc == -1) then ntasks = 1 diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index f34be9cf..7b1a58b0 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -2096,7 +2096,7 @@ subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num) double precision, intent(in) :: fock_diag_tmp(mo_num) double precision, intent(in) :: E0(N_states) - type(pt2_type), intent(inout) :: pt2_date + type(pt2_type), intent(inout) :: pt2_data type(selection_buffer), intent(inout) :: buf logical :: ok integer :: s1, s2, p1, p2, ib, j, istate, jstate @@ -2209,7 +2209,7 @@ subroutine fill_buffer_double_complex(i_generator, sp, h1, h2, bannedOrb, banned e_pert(istate) = 0.5d0 * (tmp - delta_E) !TODO: check conjugate for coef if (cdabs(alpha_h_psi) > 1.d-4) then - coef(istate) = e_pert / alpha_h_psi + coef(istate) = e_pert(istate) / alpha_h_psi else coef(istate) = alpha_h_psi / delta_E endif diff --git a/src/cipsi/selection_types.f90 b/src/cipsi/selection_types.f90 index 53250b57..b6854ed1 100644 --- a/src/cipsi/selection_types.f90 +++ b/src/cipsi/selection_types.f90 @@ -11,14 +11,23 @@ module selection_types double precision, allocatable :: rpt2(:) double precision, allocatable :: variance(:) double precision, allocatable :: overlap(:,:) + double precision, allocatable :: overlap_imag(:,:) endtype contains - integer function pt2_type_size(N) + integer function pt2_type_size(N,has_imag) implicit none integer, intent(in) :: N - if (is_complex) then + logical, intent(in), optional :: has_imag + logical :: has_imag_tmp + if(present(has_imag)) then + has_imag_tmp = has_imag + else + has_imag_tmp = .False. + endif + + if (has_imag_tmp) then pt2_type_size = (3*n + 2*n*n) else pt2_type_size = (3*n + n*n) diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f index 5ac1d6fb..17acdb97 100644 --- a/src/cipsi/zmq_selection.irp.f +++ b/src/cipsi/zmq_selection.irp.f @@ -105,12 +105,6 @@ subroutine ZMQ_selection(N_in, pt2_data) f(:) = 1.d0 if (.not.do_pt2) then -<<<<<<< HEAD - double precision :: f(N_states), u_dot_u - do k=1,min(N_det,N_states) - f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors) - enddo -======= double precision :: f(N_states), u_dot_u if (is_complex) then double precision :: u_dot_u_complex @@ -122,7 +116,6 @@ subroutine ZMQ_selection(N_in, pt2_data) f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors) enddo endif ->>>>>>> origin/cleaning_kpts endif !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2_data) PRIVATE(i) NUM_THREADS(nproc_target+1)