LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-05-07 07:34:55 +02:00
Code Issues Releases Wiki Activity

MPI with I/O

Browse Source
This commit is contained in:
Anthony Scemama 2017-11-28 14:20:17 +01:00
parent 1a5a4d5ff2
commit c476aa1159
14 changed files with 208 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
plugins/Full_CI_ZMQ/broadcast.irp.f
View File

@ -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

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

@ -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)

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

@ -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

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

@ -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 ]

17
scripts/ezfio_interface/ezfio_generate_provider.py
View File

@ -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()

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

@ -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'

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

@ -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

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

@ -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)

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

@ -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

12
src/Ezfio_files/output.irp.f
View File

@ -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

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

@ -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'

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

@ -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

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

@ -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'

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

@ -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