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

Fixed MPI

Browse Source
This commit is contained in:
Anthony Scemama 2018-09-09 12:20:33 +02:00
parent 4098b05202
commit f8bda54c75
16 changed files with 141 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
plugins/Full_CI_ZMQ/run_pt2_slave.irp.f
View File

@ -77,6 +77,7 @@ subroutine run_pt2_slave(thread,iproc,energy)
! Try to adjust n_tasks around 1 second per job
n_tasks = min(n_tasks,int( 1.d0*dble(n_tasks) / (time1 - time0 + 1.d-9)))+1
! n_tasks = n_tasks+1
end do
integer, external :: disconnect_from_taskserver

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

@ -13,9 +13,10 @@ program selection_slave
end
subroutine provide_everything
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context n_states_diag
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
PROVIDE pt2_e0_denominator mo_tot_num N_int ci_energy mpi_master zmq_state zmq_context
PROVIDE psi_det psi_coef
PROVIDE psi_det psi_coef threshold_generators threshold_selectors state_average_weight
PROVIDE N_det_selectors pt2_stoch_istate N_det
end
subroutine run_wf
@ -39,8 +40,6 @@ subroutine run_wf
integer, external :: zmq_get_psi, zmq_get_N_det_selectors
integer, external :: zmq_get_N_states_diag
call provide_everything
zmq_context = f77_zmq_ctx_new ()
states(1) = 'selection'
states(2) = 'davidson'
@ -49,6 +48,10 @@ subroutine run_wf
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
PROVIDE psi_det psi_coef threshold_generators threshold_selectors state_average_weight mpi_master
PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator
PROVIDE N_det_generators N_states N_states_diag
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
do
if (mpi_master) then
@ -62,6 +65,10 @@ subroutine run_wf
print *, trim(zmq_state)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
call MPI_BCAST (zmq_state, 128, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then

2
plugins/Full_CI_ZMQ/target_pt2_ratio_zmq.irp.f
View File

@ -1,4 +1,4 @@
program fci_zmq
program target_pt2_ratio
implicit none
integer :: i,j,k
logical, external :: detEq

2
plugins/Full_CI_ZMQ/target_pt2_zmq.irp.f
View File

@ -1,4 +1,4 @@
program fci_zmq
program target_pt2
implicit none
integer :: i,j,k
logical, external :: detEq

4
plugins/Selectors_Utils/zmq.irp.f
View File

@ -72,6 +72,10 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
10 continue
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

4
scripts/ezfio_interface/ezfio_generate_provider.py
View File

@ -32,6 +32,10 @@ BEGIN_PROVIDER [ %(type)s, %(name)s %(size)s ]
stop 1
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

24
src/Bitmask/bitmasks.irp.f
View File

@ -127,6 +127,10 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask ]
ASSERT (N_generators_bitmask > 0)
call write_int(6,N_generators_bitmask,'N_generators_bitmask')
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -170,6 +174,10 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask_restart ]
ASSERT (N_generators_bitmask_restart > 0)
call write_int(6,N_generators_bitmask_restart,'N_generators_bitmask_restart')
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -244,6 +252,10 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_gen
enddo
enddo
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -313,6 +325,10 @@ if (mpi_master) then
enddo
enddo
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -354,6 +370,10 @@ BEGIN_PROVIDER [ integer, N_cas_bitmask ]
call write_int(6,N_cas_bitmask,'N_cas_bitmask')
endif
ASSERT (N_cas_bitmask > 0)
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -407,6 +427,10 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
enddo
write(*,*) 'Read CAS bitmask'
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

4
src/Bitmask/mpi.irp.f
View File

@ -26,6 +26,10 @@ subroutine broadcast_chunks_bit_kind(A, LDA)
BEGIN_DOC
! Broadcast with chunks of ~2GB
END_DOC
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: i, sze, ierr

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

@ -13,7 +13,6 @@ end
subroutine davidson_slave_tcp(i)
implicit none
integer, intent(in) :: i
call davidson_run_slave(0,i)
end
@ -36,6 +35,10 @@ subroutine davidson_run_slave(thread,iproc)
integer, external :: connect_to_taskserver
include 'mpif.h'
integer ierr
if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
endif
@ -86,11 +89,13 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
allocate (energy(N_st))
if (zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'u_t', u_t, size(u_t)) == -1) then
print *, irp_here, ': Unable to get u_t'
deallocate(u_t,energy)
return
endif
if (zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size(energy)) == -1) then
print *, irp_here, ': Unable to get energy'
deallocate(u_t,energy)
return
endif
@ -467,10 +472,13 @@ integer function zmq_get_N_states_diag(zmq_to_qp_run_socket, worker_id)
if (rc /= 4) go to 10
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST (zmq_get_N_states_diag, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast N_states'
@ -484,6 +492,7 @@ integer function zmq_get_N_states_diag(zmq_to_qp_run_socket, worker_id)
endif
endif
IRP_ENDIF
TOUCH N_states_diag
return

4
src/Davidson/ezfio.irp.f → src/Davidson/input.irp.f
View File

@ -17,6 +17,10 @@ BEGIN_PROVIDER [ integer, n_states_diag ]
endif
n_states_diag = max(N_states, N_states_diag)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

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

@ -45,6 +45,10 @@ BEGIN_PROVIDER [ integer, N_det ]
endif
call write_int(6,N_det,'Number of determinants')
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -89,6 +93,10 @@ BEGIN_PROVIDER [ integer, psi_det_size ]
psi_det_size = max(psi_det_size,100000)
call write_int(6,psi_det_size,'Dimension of the psi arrays')
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -154,6 +162,10 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ]
enddo
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -212,6 +224,10 @@ BEGIN_PROVIDER [ double precision, psi_coef, (psi_det_size,N_states) ]
endif
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

12
src/Determinants/zmq.irp.f
View File

@ -112,6 +112,10 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
endif
10 continue
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -297,6 +301,10 @@ integer function zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
endif
10 continue
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -346,6 +354,10 @@ integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
10 continue
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

16
src/MO_Basis/mos.irp.f
View File

@ -9,6 +9,10 @@ BEGIN_PROVIDER [ integer, mo_tot_num ]
if (mpi_master) then
call ezfio_has_mo_basis_mo_tot_num(has)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -71,6 +75,10 @@ BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_tot_num) ]
! Coefs
call ezfio_has_mo_basis_mo_coef(exists)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -136,6 +144,10 @@ BEGIN_PROVIDER [ character*(64), mo_label ]
endif
write(*,*) '* mo_label ', trim(mo_label)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -198,6 +210,10 @@ BEGIN_PROVIDER [ double precision, mo_occ, (mo_tot_num) ]
endif
write(*,*) 'Read mo_occ'
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

5
src/MPI/mpi.irp.f
View File

@ -70,6 +70,10 @@ subroutine broadcast_chunks_$double(A, LDA)
BEGIN_DOC
! Broadcast with chunks of ~2GB
END_DOC
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: i, sze, ierr
@ -80,6 +84,7 @@ subroutine broadcast_chunks_$double(A, LDA)
print *, irp_here//': Unable to broadcast chunks $double ', i
stop -1
endif
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
enddo
IRP_ENDIF
end

12
src/Nuclei/nuclei.irp.f
View File

@ -54,6 +54,10 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -159,6 +163,10 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ]
endif
print*, 'Read nuclear_repulsion'
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
@ -228,6 +236,10 @@ END_PROVIDER
close(10)
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr

25
src/ZMQ/put_get.irp.f
View File

@ -60,17 +60,20 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
if (rc /= len(trim(msg))) then
zmq_get_dvector = -1
print *, irp_here, 'rc /= len(trim(msg))', rc, len(trim(msg))
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
if (msg(1:14) /= 'get_data_reply') then
print *, irp_here, 'msg(1:14) /= get_data_reply', msg(1:14)
zmq_get_dvector = -1
go to 10
endif
rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0)
if (rc /= size_x*8) then
print *, irp_here, 'rc /= size_x*8', rc, size_x*8
zmq_get_dvector = -1
go to 10
endif
@ -78,6 +81,10 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
10 continue
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
integer :: ierr
include 'mpif.h'
@ -86,11 +93,8 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
print *, irp_here//': Unable to broadcast zmq_get_dvector'
stop -1
endif
call MPI_BCAST (x, size_x, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast dvector'
stop -1
endif
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
call broadcast_chunks_double(x, size_x)
IRP_ENDIF
end
@ -177,6 +181,10 @@ integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_
10 continue
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
integer :: ierr
include 'mpif.h'
@ -185,11 +193,8 @@ integer function zmq_get_ivector(zmq_to_qp_run_socket, worker_id, name, x, size_
print *, irp_here//': Unable to broadcast zmq_get_ivector'
stop -1
endif
call MPI_BCAST (x, size_x, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
print *, irp_here//': Unable to broadcast ivector'
stop -1
endif
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
call broadcast_chunks_integer(x, size_x)
IRP_ENDIF
end