From c476aa11599bf8036cf9fbca8d9a61091de4a2d9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 28 Nov 2017 14:20:17 +0100 Subject: [PATCH] MPI with I/O --- plugins/Full_CI_ZMQ/broadcast.irp.f | 72 ------------------- .../selection_davidson_slave.irp.f | 46 ++++++------ plugins/Full_CI_ZMQ/zmq_selection.irp.f | 2 +- plugins/Selectors_Utils/zmq.irp.f | 12 ++++ .../ezfio_generate_provider.py | 17 +++-- src/Bitmask/bitmasks.irp.f | 28 +++----- src/Davidson/davidson_parallel.irp.f | 12 +++- src/Determinants/determinants.irp.f | 33 +++------ src/Determinants/zmq.irp.f | 37 +++++++++- src/Ezfio_files/output.irp.f | 12 ++++ src/MO_Basis/mos.irp.f | 63 ++++++++++------ src/MPI/mpi.irp.f | 9 ++- src/Nuclei/nuclei.irp.f | 49 ++++++------- src/ZMQ/put_get.irp.f | 10 +++ 14 files changed, 208 insertions(+), 194 deletions(-) delete mode 100644 plugins/Full_CI_ZMQ/broadcast.irp.f diff --git a/plugins/Full_CI_ZMQ/broadcast.irp.f b/plugins/Full_CI_ZMQ/broadcast.irp.f deleted file mode 100644 index 0d40f351..00000000 --- a/plugins/Full_CI_ZMQ/broadcast.irp.f +++ /dev/null @@ -1,72 +0,0 @@ -subroutine mpi_bcast_psi(energy, size_energy) - implicit none - BEGIN_DOC -! Broadcast the wave function via MPI - END_DOC - integer, intent(in) :: size_energy - double precision, intent(inout) :: energy(size_energy) - PROVIDE mpi_initialized - - IRP_IF MPI - include 'mpif.h' - integer :: ierr - - call MPI_BCAST (N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here//': Unable to broadcast N_states' - stop -1 - endif - - call MPI_BCAST (N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here//': Unable to broadcast N_det' - stop -1 - endif - - call MPI_BCAST (psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here//': Unable to broadcast psi_det_size' - stop -1 - endif - - if (.not.mpi_master) then - TOUCH psi_det_size N_det N_states - endif - - - call broadcast_chunks_bit_kind(psi_det,N_det*N_int*2) - - call broadcast_chunks_double(psi_coef,N_states*N_det) - - if (.not.mpi_master) then - TOUCH psi_det psi_coef - endif - - call MPI_BCAST (N_det_generators, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here//': Unable to broadcast N_det_generators' - stop -1 - endif - - if (.not.mpi_master) then - TOUCH N_det_generators - endif - - call MPI_BCAST (N_det_selectors, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here//': Unable to broadcast N_det_selectors' - stop -1 - endif - - if (.not.mpi_master) then - TOUCH N_det_selectors - endif - - call MPI_BCAST (energy, size(energy), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here//': Unable to broadcast energy' - stop -1 - endif - - IRP_ENDIF -end diff --git a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f index 6af42f33..581e707c 100644 --- a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f +++ b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f @@ -13,9 +13,9 @@ program selection_slave end subroutine provide_everything - PROVIDE mpi_master - 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 - PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count + 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 fragment_count ci_energy mpi_master zmq_state zmq_context + PROVIDE psi_det psi_coef end subroutine run_wf @@ -31,6 +31,7 @@ subroutine run_wf double precision :: energy(N_states) character*(64) :: states(4) integer :: rc, i, ierr + double precision :: t0, t1 call provide_everything @@ -55,11 +56,14 @@ subroutine run_wf ! --------- print *, 'Selection' - if (mpi_master) then - call zmq_get_psi(zmq_to_qp_run_socket,1) - call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) - endif - call mpi_bcast_psi(energy,N_states) + call wall_time(t0) + call zmq_get_psi(zmq_to_qp_run_socket,1) + call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) + call zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) + call zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) + + call wall_time(t1) + call write_double(6,(t1-t0),'Broadcast time') !$OMP PARALLEL PRIVATE(i) i = omp_get_thread_num() @@ -79,14 +83,11 @@ subroutine run_wf ! -------- print *, 'Davidson' - if (mpi_master) then - call zmq_get_psi(zmq_to_qp_run_socket,1) - call zmq_get_N_states_diag(zmq_to_qp_run_socket,1) - call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) - endif - double precision :: t0, t1 call wall_time(t0) - call mpi_bcast_psi(energy,N_states_diag) + call zmq_get_psi(zmq_to_qp_run_socket,1) + call zmq_get_N_states_diag(zmq_to_qp_run_socket,1) + call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) + call wall_time(t1) call write_double(6,(t1-t0),'Broadcast time') @@ -108,12 +109,15 @@ subroutine run_wf ! --- print *, 'PT2' - if (mpi_master) then - call zmq_get_psi(zmq_to_qp_run_socket,1) - call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) - endif - call mpi_bcast_psi(energy,N_states) - + call wall_time(t0) + call zmq_get_psi(zmq_to_qp_run_socket,1) + call zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) + call zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) + call zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) + + call wall_time(t1) + call write_double(6,(t1-t0),'Broadcast time') + logical :: lstop lstop = .False. !$OMP PARALLEL PRIVATE(i) diff --git a/plugins/Full_CI_ZMQ/zmq_selection.irp.f b/plugins/Full_CI_ZMQ/zmq_selection.irp.f index 5ef0f407..ffa16781 100644 --- a/plugins/Full_CI_ZMQ/zmq_selection.irp.f +++ b/plugins/Full_CI_ZMQ/zmq_selection.irp.f @@ -67,7 +67,7 @@ subroutine ZMQ_selection(N_in, pt2) if (N_in > 0) then call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) call copy_H_apply_buffer_to_wf() - if (s2_eig) then + if (s2_eig.or.(N_states > 1) ) then call make_s2_eigenfunction endif call save_wavefunction diff --git a/plugins/Selectors_Utils/zmq.irp.f b/plugins/Selectors_Utils/zmq.irp.f index 313f2ca8..82f972f4 100644 --- a/plugins/Selectors_Utils/zmq.irp.f +++ b/plugins/Selectors_Utils/zmq.irp.f @@ -64,6 +64,18 @@ subroutine zmq_get_$X(zmq_to_qp_run_socket, worker_id) print *, irp_here, ': Error getting $X' stop 'error' endif + + IRP_IF MPI + include 'mpif.h' + integer :: ierr + + call MPI_BCAST ($X, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + print *, irp_here//': Unable to broadcast N_det_generators' + stop -1 + endif + IRP_ENDIF + end SUBST [ X ] diff --git a/scripts/ezfio_interface/ezfio_generate_provider.py b/scripts/ezfio_interface/ezfio_generate_provider.py index 6b515645..24b10e0e 100755 --- a/scripts/ezfio_interface/ezfio_generate_provider.py +++ b/scripts/ezfio_interface/ezfio_generate_provider.py @@ -81,15 +81,22 @@ END_PROVIDER self.test_null_size = "" def set_write(self): - self.write = "" + output = self.output + name = self.name + l_write = ["", + " call write_time(%(output)s)", + " if (mpi_master) then", + " write(%(output)s, *) 'Read %(name)s'", + " endif", + ""] + + self.write = "\n".join(l_write) % locals() self.type_mpi = self.mpi_correspondance[self.type] if "size" in self.__dict__: return else: - if self.type in self.mpi_correspondance: + if self.type in self.write_correspondance: write = self.write_correspondance[self.type] - output = self.output - name = self.name l_write = ["", " call write_time(%(output)s)", @@ -97,8 +104,6 @@ END_PROVIDER " '%(name)s')", ""] - self.write = "\n".join(l_write) % locals() - def set_type(self, t): self.type = t.lower() diff --git a/src/Bitmask/bitmasks.irp.f b/src/Bitmask/bitmasks.irp.f index 6c44def0..5f3fc7f5 100644 --- a/src/Bitmask/bitmasks.irp.f +++ b/src/Bitmask/bitmasks.irp.f @@ -122,6 +122,7 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask ] N_generators_bitmask = 1 endif ASSERT (N_generators_bitmask > 0) + call write_int(6,N_generators_bitmask,'N_generators_bitmask') endif IRP_IF MPI include 'mpif.h' @@ -130,14 +131,6 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask ] if (ierr /= MPI_SUCCESS) then stop 'Unable to read N_generators_bitmask with MPI' endif - call MPI_BCAST( bit_kind, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read bit_kind with MPI' - endif - call MPI_BCAST( N_int, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read N_int with MPI' - endif IRP_ENDIF @@ -150,7 +143,7 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask_restart ] ! Number of bitmasks for generators END_DOC logical :: exists - PROVIDE ezfio_filename + PROVIDE ezfio_filename N_int if (mpi_master) then call ezfio_has_bitmasks_N_mask_gen(exists) @@ -172,14 +165,11 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask_restart ] N_generators_bitmask_restart = 1 endif ASSERT (N_generators_bitmask_restart > 0) + call write_int(6,N_generators_bitmask_restart,'N_generators_bitmask_restart') endif IRP_IF MPI include 'mpif.h' integer :: ierr - call MPI_BCAST( bit_kind, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read bit_kind with MPI' - endif call MPI_BCAST( N_generators_bitmask_restart, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then stop 'Unable to read N_generators_bitmask_restart with MPI' @@ -214,7 +204,8 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_gen ! END_DOC logical :: exists - PROVIDE ezfio_filename + PROVIDE ezfio_filename full_ijkl_bitmask N_generators_bitmask N_int + PROVIDE generators_bitmask_restart if (mpi_master) then call ezfio_has_bitmasks_generators(exists) @@ -284,7 +275,7 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_ ! END_DOC logical :: exists - PROVIDE ezfio_filename + PROVIDE ezfio_filename full_ijkl_bitmask N_generators_bitmask if (mpi_master) then call ezfio_has_bitmasks_generators(exists) @@ -337,7 +328,7 @@ BEGIN_PROVIDER [ integer, N_cas_bitmask ] END_DOC logical :: exists PROVIDE ezfio_filename - + PROVIDE N_cas_bitmask N_int if (mpi_master) then call ezfio_has_bitmasks_N_mask_cas(exists) if (exists) then @@ -357,6 +348,7 @@ BEGIN_PROVIDER [ integer, N_cas_bitmask ] else N_cas_bitmask = 1 endif + call write_int(6,N_cas_bitmask,'N_cas_bitmask') endif ASSERT (N_cas_bitmask > 0) IRP_IF MPI @@ -377,7 +369,8 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ] END_DOC logical :: exists integer :: i,i_part,i_gen,j,k - PROVIDE ezfio_filename + PROVIDE ezfio_filename generators_bitmask_restart full_ijkl_bitmask + PROVIDE n_generators_bitmask HF_bitmask if (mpi_master) then call ezfio_has_bitmasks_cas(exists) @@ -409,6 +402,7 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ] enddo enddo enddo + write(*,*) 'Read CAS bitmask' endif IRP_IF MPI include 'mpif.h' diff --git a/src/Davidson/davidson_parallel.irp.f b/src/Davidson/davidson_parallel.irp.f index 59f3e759..483577bf 100644 --- a/src/Davidson/davidson_parallel.irp.f +++ b/src/Davidson/davidson_parallel.irp.f @@ -411,7 +411,7 @@ subroutine zmq_get_N_states_diag(zmq_to_qp_run_socket, worker_id) integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket integer, intent(in) :: worker_id integer :: rc - character*(64) :: msg + character*(256) :: msg write(msg,'(A8,1X,I8,1X,A230)') 'get_data', worker_id, 'N_states_diag' rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) @@ -433,4 +433,14 @@ subroutine zmq_get_N_states_diag(zmq_to_qp_run_socket, worker_id) stop 'error' endif + IRP_IF MPI + include 'mpif.h' + integer :: ierr + + call MPI_BCAST (N_states_diag, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + print *, irp_here//': Unable to broadcast N_states' + stop -1 + endif + IRP_ENDIF end diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 9f312103..51e9da76 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -24,8 +24,7 @@ BEGIN_PROVIDER [ integer, N_det ] END_DOC logical :: exists character*(64) :: label - PROVIDE ezfio_filename - PROVIDE nproc + PROVIDE read_wf mo_label ezfio_filename nproc if (mpi_master) then if (read_wf) then call ezfio_has_determinants_n_det(exists) @@ -44,6 +43,7 @@ BEGIN_PROVIDER [ integer, N_det ] else N_det = 1 endif + call write_int(output_determinants,N_det,'Number of determinants') endif IRP_IF MPI include 'mpif.h' @@ -54,7 +54,6 @@ BEGIN_PROVIDER [ integer, N_det ] endif IRP_ENDIF - call write_int(output_determinants,N_det,'Number of determinants') ASSERT (N_det > 0) END_PROVIDER @@ -78,7 +77,7 @@ BEGIN_PROVIDER [ integer, psi_det_size ] BEGIN_DOC ! Size of the psi_det/psi_coef arrays END_DOC - PROVIDE ezfio_filename + PROVIDE ezfio_filename output_determinants logical :: exists if (mpi_master) then call ezfio_has_determinants_n_det(exists) @@ -112,6 +111,7 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ] logical :: exists character*(64) :: label + PROVIDE read_wf N_det mo_label ezfio_filename HF_bitmask mo_coef psi_det = 0_bit_kind if (mpi_master) then if (read_wf) then @@ -152,11 +152,12 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ] psi_det(i,2,1) = HF_bitmask(i,2) enddo endif + print *, 'Read psi_det' endif IRP_IF MPI include 'mpif.h' integer :: ierr - call MPI_BCAST( psi_det, N_int*2*N_det, MPI_BIT_KIND, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST( psi_det, N_int*2*N_det, MPI_BIT_KIND, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then stop 'Unable to read psi_det with MPI' endif @@ -176,15 +177,15 @@ BEGIN_PROVIDER [ double precision, psi_coef, (psi_det_size,N_states) ] integer :: i,k, N_int2 logical :: exists - double precision, allocatable :: psi_coef_read(:,:) character*(64) :: label - if (mpi_master) then + PROVIDE read_wf N_det mo_label ezfio_filename psi_coef = 0.d0 do i=1,min(N_states,psi_det_size) psi_coef(i,i) = 1.d0 enddo + if (mpi_master) then if (read_wf) then call ezfio_has_determinants_psi_coef(exists) if (exists) then @@ -194,26 +195,17 @@ BEGIN_PROVIDER [ double precision, psi_coef, (psi_det_size,N_states) ] exists = (label == mo_label) endif endif - if (exists) then - - allocate (psi_coef_read(N_det,N_states)) - call ezfio_get_determinants_psi_coef(psi_coef_read) - do k=1,N_states - do i=1,N_det - psi_coef(i,k) = psi_coef_read(i,k) - enddo - enddo - deallocate(psi_coef_read) - + call ezfio_get_determinants_psi_coef(psi_coef) endif endif + print *, 'Read psi_coef' endif IRP_IF MPI include 'mpif.h' integer :: ierr - call MPI_BCAST( psi_coef, N_states*psi_det_size, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST( psi_coef, N_states*psi_det_size, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then stop 'Unable to read psi_coef with MPI' endif @@ -449,9 +441,6 @@ subroutine read_dets(det,Nint,Ndet) N_int2 = (Nint*bit_kind)/8 allocate (psi_det_read(N_int2,2,Ndet)) call ezfio_get_determinants_psi_det (psi_det_read) -! print*,'N_int2 = ',N_int2,N_int -! print*,'k',k,bit_kind -! print*,'psi_det_read = ',Ndet do i=1,Ndet do k=1,N_int2 det_8(k) = psi_det_read(k,1,i) diff --git a/src/Determinants/zmq.irp.f b/src/Determinants/zmq.irp.f index 20fb7d63..cb8b515c 100644 --- a/src/Determinants/zmq.irp.f +++ b/src/Determinants/zmq.irp.f @@ -175,11 +175,42 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id) call zmq_get_N_states(zmq_to_qp_run_socket, worker_id) call zmq_get_N_det(zmq_to_qp_run_socket, worker_id) call zmq_get_psi_det_size(zmq_to_qp_run_socket, worker_id) + IRP_IF MPI + include 'mpif.h' + integer :: ierr + + call MPI_BCAST (N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + print *, irp_here//': Unable to broadcast N_states' + stop -1 + endif + + call MPI_BCAST (N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + print *, irp_here//': Unable to broadcast N_det' + stop -1 + endif + + call MPI_BCAST (psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + print *, irp_here//': Unable to broadcast psi_det_size' + stop -1 + endif + IRP_ENDIF + TOUCH psi_det_size N_det N_states - call zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) - call zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) - TOUCH psi_det psi_coef + if (mpi_master) then + call zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) + call zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) + endif + + IRP_IF MPI + call broadcast_chunks_bit_kind(psi_det,N_det*N_int*2) + call broadcast_chunks_double(psi_coef,N_states*N_det) + IRP_ENDIF + + SOFT_TOUCH psi_det psi_coef end diff --git a/src/Ezfio_files/output.irp.f b/src/Ezfio_files/output.irp.f index ac693caf..25f862bd 100644 --- a/src/Ezfio_files/output.irp.f +++ b/src/Ezfio_files/output.irp.f @@ -46,6 +46,9 @@ subroutine write_time(iunit) END_DOC integer, intent(in) :: iunit double precision :: wt, ct + if (.not.mpi_master) then + return + endif call cpu_time(ct) call wall_time(wt) write(iunit,*) @@ -60,6 +63,9 @@ subroutine write_double(iunit,value,label) BEGIN_DOC ! Write a double precision value in output END_DOC + if (.not.mpi_master) then + return + endif integer, intent(in) :: iunit double precision :: value character*(*) :: label @@ -75,6 +81,9 @@ subroutine write_int(iunit,value,label) BEGIN_DOC ! Write an integer value in output END_DOC + if (.not.mpi_master) then + return + endif integer, intent(in) :: iunit integer :: value character*(*) :: label @@ -90,6 +99,9 @@ subroutine write_bool(iunit,value,label) BEGIN_DOC ! Write an logical value in output END_DOC + if (.not.mpi_master) then + return + endif integer, intent(in) :: iunit logical :: value character*(*) :: label diff --git a/src/MO_Basis/mos.irp.f b/src/MO_Basis/mos.irp.f index 04689bcd..ef27cd01 100644 --- a/src/MO_Basis/mos.irp.f +++ b/src/MO_Basis/mos.irp.f @@ -5,25 +5,31 @@ BEGIN_PROVIDER [ integer, mo_tot_num ] END_DOC logical :: has - PROVIDE ezfio_filename + PROVIDE ezfio_filename if (mpi_master) then call ezfio_has_mo_basis_mo_tot_num(has) - if (has) then - mo_tot_num = ao_ortho_canonical_num - else - print *, 'mo_basis/mo_tot_num not found in EZFIO file' - stop 1 - endif endif IRP_IF MPI include 'mpif.h' integer :: ierr - call MPI_BCAST( mo_tot_num, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST( has, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then stop 'Unable to read mo_tot_num with MPI' endif IRP_ENDIF - + if (.not.has) then + mo_tot_num = ao_ortho_canonical_num + else + if (mpi_master) then + call ezfio_get_mo_basis_mo_tot_num(mo_tot_num) + endif + IRP_IF MPI + call MPI_BCAST( mo_tot_num, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_tot_num with MPI' + endif + IRP_ENDIF + endif call write_int(6,mo_tot_num,'mo_tot_num') ASSERT (mo_tot_num > 0) @@ -40,32 +46,42 @@ BEGIN_PROVIDER [ double precision, mo_coef, (ao_num,mo_tot_num) ] integer :: i, j double precision, allocatable :: buffer(:,:) logical :: exists - PROVIDE ezfio_filename + PROVIDE ezfio_filename if (mpi_master) then ! Coefs call ezfio_has_mo_basis_mo_coef(exists) - if (exists) then - call ezfio_get_mo_basis_mo_coef(mo_coef) - else - ! Orthonormalized AO basis - do i=1,mo_tot_num - do j=1,ao_num - mo_coef(j,i) = ao_ortho_canonical_coef(j,i) - enddo - enddo - endif endif IRP_IF MPI include 'mpif.h' integer :: ierr - call MPI_BCAST( mo_coef, mo_tot_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) if (ierr /= MPI_SUCCESS) then stop 'Unable to read mo_coef with MPI' endif IRP_ENDIF + if (exists) then + if (mpi_master) then + call ezfio_get_mo_basis_mo_coef(mo_coef) + write(*,*) 'Read mo_coef' + endif + IRP_IF MPI + call MPI_BCAST( mo_coef, mo_tot_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read mo_coef with MPI' + endif + IRP_ENDIF + else + ! Orthonormalized AO basis + do i=1,mo_tot_num + do j=1,ao_num + mo_coef(j,i) = ao_ortho_canonical_coef(j,i) + enddo + enddo + endif + END_PROVIDER BEGIN_PROVIDER [ double precision, mo_coef_in_ao_ortho_basis, (ao_num, mo_tot_num) ] @@ -96,9 +112,11 @@ BEGIN_PROVIDER [ character*(64), mo_label ] call ezfio_has_mo_basis_mo_label(exists) if (exists) then call ezfio_get_mo_basis_mo_label(mo_label) + mo_label = trim(mo_label) else mo_label = 'no_label' endif + write(*,*) '* mo_label ', trim(mo_label) endif IRP_IF MPI include 'mpif.h' @@ -144,7 +162,7 @@ BEGIN_PROVIDER [ double precision, mo_occ, (mo_tot_num) ] BEGIN_DOC ! MO occupation numbers END_DOC - PROVIDE ezfio_filename + PROVIDE ezfio_filename elec_beta_num elec_alpha_num if (mpi_master) then logical :: exists call ezfio_has_mo_basis_mo_occ(exists) @@ -160,6 +178,7 @@ BEGIN_PROVIDER [ double precision, mo_occ, (mo_tot_num) ] mo_occ(i) = 1.d0 enddo endif + write(*,*) 'Read mo_occ' endif IRP_IF MPI include 'mpif.h' diff --git a/src/MPI/mpi.irp.f b/src/MPI/mpi.irp.f index dbc2caa9..f24a2923 100644 --- a/src/MPI/mpi.irp.f +++ b/src/MPI/mpi.irp.f @@ -43,10 +43,6 @@ END_PROVIDER mpi_rank = 0 mpi_size = 1 IRP_ENDIF - if (mpi_size > 1) then - call write_int(6,mpi_rank,'MPI rank') - call write_int(6,mpi_size,'MPI size') - endif ASSERT (mpi_rank >= 0) ASSERT (mpi_rank < mpi_size) @@ -59,6 +55,9 @@ BEGIN_PROVIDER [ logical, mpi_master ] ! If true, rank is zero END_DOC mpi_master = (mpi_rank == 0) + if (mpi_master.and.(mpi_size > 1)) then + print *, 'MPI size: ', mpi_size + endif END_PROVIDER @@ -87,7 +86,7 @@ end SUBST [ double, type, 8, DOUBLE_PRECISION ] double ; double precision ; 8 ; DOUBLE_PRECISION ;; -integer ; integer ; 4 ; INTEGER4 ;; +integer ; integer ; 4 ; INTEGER ;; integer8 ; integer*8 ; 8 ; INTEGER8 ;; END_TEMPLATE diff --git a/src/Nuclei/nuclei.irp.f b/src/Nuclei/nuclei.irp.f index 6b10f572..a382ef8d 100644 --- a/src/Nuclei/nuclei.irp.f +++ b/src/Nuclei/nuclei.irp.f @@ -4,7 +4,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ] BEGIN_DOC ! Nuclear coordinates in the format (:, {x,y,z}) END_DOC - PROVIDE ezfio_filename + PROVIDE ezfio_filename nucl_label nucl_charge if (mpi_master) then double precision, allocatable :: buffer(:,:) @@ -30,6 +30,28 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ] character*(64), parameter :: f = '(A16, 4(1X,F12.6))' character*(64), parameter :: ft= '(A16, 4(1X,A12 ))' double precision, parameter :: a0= 0.529177249d0 + + call write_time(output_Nuclei) + write(output_Nuclei,'(A)') '' + write(output_Nuclei,'(A)') 'Nuclear Coordinates (Angstroms)' + write(output_Nuclei,'(A)') '===============================' + write(output_Nuclei,'(A)') '' + write(output_Nuclei,ft) & + '================','============','============','============','============' + write(output_Nuclei,*) & + ' Atom Charge X Y Z ' + write(output_Nuclei,ft) & + '================','============','============','============','============' + do i=1,nucl_num + write(output_Nuclei,f) nucl_label(i), nucl_charge(i), & + nucl_coord(i,1)*a0, & + nucl_coord(i,2)*a0, & + nucl_coord(i,3)*a0 + enddo + write(output_Nuclei,ft) & + '================','============','============','============','============' + write(output_Nuclei,'(A)') '' + endif IRP_IF MPI @@ -41,28 +63,6 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ] endif IRP_ENDIF - - call write_time(output_Nuclei) - write(output_Nuclei,'(A)') '' - write(output_Nuclei,'(A)') 'Nuclear Coordinates (Angstroms)' - write(output_Nuclei,'(A)') '===============================' - write(output_Nuclei,'(A)') '' - write(output_Nuclei,ft) & - '================','============','============','============','============' - write(output_Nuclei,*) & - ' Atom Charge X Y Z ' - write(output_Nuclei,ft) & - '================','============','============','============','============' - do i=1,nucl_num - write(output_Nuclei,f) nucl_label(i), nucl_charge(i), & - nucl_coord(i,1)*a0, & - nucl_coord(i,2)*a0, & - nucl_coord(i,3)*a0 - enddo - write(output_Nuclei,ft) & - '================','============','============','============','============' - write(output_Nuclei,'(A)') '' - END_PROVIDER @@ -145,8 +145,8 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ] ! Nuclear repulsion energy END_DOC + PROVIDE mpi_master nucl_coord nucl_charge nucl_num IF (disk_access_nuclear_repulsion.EQ.'Read') THEN - print*, 'nuclear_repulsion read from disk' LOGICAL :: has if (mpi_master) then call ezfio_has_nuclei_nuclear_repulsion(has) @@ -156,6 +156,7 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ] print *, 'nuclei/nuclear_repulsion not found in EZFIO file' stop 1 endif + print*, 'Read nuclear_repulsion' endif IRP_IF MPI include 'mpif.h' diff --git a/src/ZMQ/put_get.irp.f b/src/ZMQ/put_get.irp.f index 588abf2c..09970bba 100644 --- a/src/ZMQ/put_get.irp.f +++ b/src/ZMQ/put_get.irp.f @@ -70,6 +70,16 @@ subroutine zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x) print *, irp_here, ': Error getting '//name stop 'error' endif + + IRP_IF MPI + integer :: ierr + include 'mpif.h' + 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 + IRP_ENDIF end