LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-04-25 17:54:44 +02:00
Code Releases Activity

Merge branch 'dev-stable' of https://github.com/QuantumPackage/qp2 into dev-stable

Browse Source
This commit is contained in:
eginer 2025-02-04 11:38:21 +01:00
commit ed92eedc8e
15 changed files with 282 additions and 611 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
external/ezfio vendored

@ -1 +1 @@
Subproject commit dba01c4fe0ff7b84c5ecfb1c7c77ec68781311b3
Subproject commit d02132ea79217c16fd24242e8f8b8a6c3ff68091

1
src/ao_two_e_ints/NEED
View File

@ -2,5 +2,4 @@ hamiltonian
ao_one_e_ints
pseudo
bitmask
zmq
ao_basis

8
src/ao_two_e_ints/cholesky.irp.f
View File

@ -194,14 +194,11 @@ END_PROVIDER
+ (np+1)*memory_of_double(block_size) ! Ltmp_p(np,block_size) + Ltmp_q(nq,block_size)
! call check_mem(mem)
! 5.
do while ( (Dmax > tau).and.(np > 0) )
! a.
i = i+1
block_size = max(N,24)
! Determine nq so that Delta fits in memory
@ -308,6 +305,8 @@ END_PROVIDER
Qmax = max(Qmax, D(Dset(q)))
enddo
if (Qmax <= Dmin) exit
! g.
iblock = 0
@ -466,10 +465,11 @@ END_PROVIDER
endif
! Reverse order of Cholesky vectors to increase precision in dot products
!$OMP PARALLEL DO PRIVATE(k,j)
do k=1,rank
do j=1,ao_num
cholesky_ao(1:ao_num,j,k) = L((j-1_8)*ao_num+1_8:1_8*j*ao_num,k)
cholesky_ao(1:ao_num,j,rank-k+1) = L((j-1_8)*ao_num+1_8:1_8*j*ao_num,rank-k+1)
enddo
enddo
!$OMP END PARALLEL DO

194
src/ao_two_e_ints/integrals_erf_in_map_slave.irp.f
View File

@ -1,194 +0,0 @@
subroutine ao_two_e_integrals_erf_in_map_slave_tcp(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_erf_in_map_slave(0,i)
end
subroutine ao_two_e_integrals_erf_in_map_slave_inproc(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_erf_in_map_slave(1,i)
end
subroutine ao_two_e_integrals_erf_in_map_slave(thread,iproc)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Computes a buffer of integrals
END_DOC
integer, intent(in) :: thread, iproc
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer :: worker_id, task_id
character*(512) :: task
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push
character*(64) :: state
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
integer, external :: connect_to_taskserver
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)
return
endif
zmq_socket_push = new_zmq_push_socket(thread)
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
do
integer, external :: get_task_from_taskserver
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
exit
endif
if (task_id == 0) exit
read(task,*) j, l
integer, external :: task_done_to_taskserver
call compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
stop 'Unable to send task_done'
endif
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
enddo
integer, external :: disconnect_from_taskserver
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
continue
endif
deallocate( buffer_i, buffer_value )
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread)
end
subroutine ao_two_e_integrals_erf_in_map_collector(zmq_socket_pull)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Collects results from the AO integral calculation
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer*8 :: control, accu, sze
integer :: task_id, more
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
sze = ao_num*ao_num
allocate ( buffer_i(sze), buffer_value(sze) )
accu = 0_8
more = 1
do while (more == 1)
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
if (rc == -1) then
n_integrals = 0
return
endif
if (rc /= 4) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
stop 'error'
endif
if (n_integrals >= 0) then
if (n_integrals > sze) then
deallocate (buffer_value, buffer_i)
sze = n_integrals
allocate (buffer_value(sze), buffer_i(sze))
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
if (rc /= key_kind*n_integrals) then
print *, rc, key_kind, n_integrals
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
if (rc /= integral_kind*n_integrals) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
IRP_IF ZMQ_PUSH
IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
if (rc /= 4) then
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
stop 'error'
endif
IRP_ENDIF
call insert_into_ao_integrals_erf_map(n_integrals,buffer_i,buffer_value)
accu += n_integrals
if (task_id /= 0) then
integer, external :: zmq_delete_task
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
stop 'Unable to delete task'
endif
endif
endif
enddo
deallocate( buffer_i, buffer_value )
integer (map_size_kind) :: get_ao_erf_map_size
control = get_ao_erf_map_size(ao_integrals_erf_map)
if (control /= accu) then
print *, ''
print *, irp_here
print *, 'Control : ', control
print *, 'Accu : ', accu
print *, 'Some integrals were lost during the parallel computation.'
print *, 'Try to reduce the number of threads.'
stop
endif
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end

244
src/ao_two_e_ints/integrals_in_map_slave.irp.f
View File

@ -1,244 +0,0 @@
subroutine ao_two_e_integrals_in_map_slave_tcp(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_in_map_slave(0,i)
end
subroutine ao_two_e_integrals_in_map_slave_inproc(i)
implicit none
integer, intent(in) :: i
BEGIN_DOC
! Computes a buffer of integrals. i is the ID of the current thread.
END_DOC
call ao_two_e_integrals_in_map_slave(1,i)
end
subroutine push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
use f77_zmq
use map_module
implicit none
BEGIN_DOC
! Push integrals in the push socket
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_push
integer, intent(in) :: n_integrals
integer(key_kind), intent(in) :: buffer_i(*)
real(integral_kind), intent(in) :: buffer_value(*)
integer, intent(in) :: task_id
integer :: rc
rc = f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)
if (rc /= 4) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)
if (rc /= key_kind*n_integrals) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, ZMQ_SNDMORE)
if (rc /= integral_kind*n_integrals) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0)
if (rc /= 4) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, task_id, 4, 0)'
stop 'error'
endif
IRP_IF ZMQ_PUSH
IRP_ELSE
integer :: idummy
rc = f77_zmq_recv( zmq_socket_push, idummy, 4, 0)
if (rc /= 4) then
print *, irp_here, ': f77_zmq_send( zmq_socket_push, idummy, 4, 0)'
stop 'error'
endif
IRP_ENDIF
end
subroutine ao_two_e_integrals_in_map_slave(thread,iproc)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Computes a buffer of integrals
END_DOC
integer, intent(in) :: thread, iproc
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer :: worker_id, task_id
character*(512) :: task
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_push_socket
integer(ZMQ_PTR) :: zmq_socket_push
character*(64) :: state
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
integer, external :: connect_to_taskserver
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)
return
endif
zmq_socket_push = new_zmq_push_socket(thread)
allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
do
integer, external :: get_task_from_taskserver
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
exit
endif
if (task_id == 0) exit
call sscanf_dd(task, j, l)
integer, external :: task_done_to_taskserver
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
stop 'Unable to send task_done'
endif
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
enddo
integer, external :: disconnect_from_taskserver
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
continue
endif
deallocate( buffer_i, buffer_value )
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
call end_zmq_push_socket(zmq_socket_push,thread)
end
subroutine ao_two_e_integrals_in_map_collector(zmq_socket_pull)
use map_module
use f77_zmq
implicit none
BEGIN_DOC
! Collects results from the AO integral calculation
END_DOC
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
integer :: j,l,n_integrals
integer :: rc
real(integral_kind), allocatable :: buffer_value(:)
integer(key_kind), allocatable :: buffer_i(:)
integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
integer(ZMQ_PTR), external :: new_zmq_pull_socket
integer*8 :: control, accu, sze
integer :: task_id, more
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
sze = ao_num*ao_num
allocate ( buffer_i(sze), buffer_value(sze) )
accu = 0_8
more = 1
do while (more == 1)
rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
if (rc == -1) then
n_integrals = 0
return
endif
if (rc /= 4) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
stop 'error'
endif
if (n_integrals >= 0) then
if (n_integrals > sze) then
deallocate (buffer_value, buffer_i)
sze = n_integrals
allocate (buffer_value(sze), buffer_i(sze))
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
if (rc /= key_kind*n_integrals) then
print *, rc, key_kind, n_integrals
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
if (rc /= integral_kind*n_integrals) then
print *, irp_here, ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
stop 'error'
endif
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
IRP_IF ZMQ_PUSH
IRP_ELSE
rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
if (rc /= 4) then
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
stop 'error'
endif
IRP_ENDIF
call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value)
accu += n_integrals
if (task_id /= 0) then
integer, external :: zmq_delete_task
if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
stop 'Unable to delete task'
endif
endif
endif
enddo
deallocate( buffer_i, buffer_value )
integer (map_size_kind) :: get_ao_map_size
control = get_ao_map_size(ao_integrals_map)
if (control /= accu) then
print *, ''
print *, irp_here
print *, 'Control : ', control
print *, 'Accu : ', accu
print *, 'Some integrals were lost during the parallel computation.'
print *, 'Try to reduce the number of threads.'
stop
endif
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
end

53
src/ao_two_e_ints/providers_ao_erf.irp.f
View File

@ -1,7 +1,5 @@
BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
implicit none
use f77_zmq
use map_module
BEGIN_DOC
! Map of Atomic integrals
@ -15,17 +13,16 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
! For integrals file
integer(key_kind),allocatable :: buffer_i(:)
integer,parameter :: size_buffer = 1024*64
integer :: size_buffer
real(integral_kind),allocatable :: buffer_value(:)
integer :: n_integrals, rc
integer :: kk, m, j1, i1, lmax
character*(64) :: fmt
integral = ao_two_e_integral_erf(1,1,1,1)
double precision :: map_mb
PROVIDE read_ao_two_e_integrals_erf io_ao_two_e_integrals_erf
PROVIDE read_ao_two_e_integrals_erf io_ao_two_e_integrals_erf ao_integrals_erf_map
if (read_ao_two_e_integrals_erf) then
print*,'Reading the AO ERF integrals'
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_erf',ao_integrals_erf_map)
@ -39,37 +36,27 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_erf_in_map ]
call wall_time(wall_1)
call cpu_time(cpu_1)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals_erf')
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: task)
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
do l=1,ao_num
write(task,fmt) (i,l, i=1,l)
integer, external :: add_task_to_taskserver
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
stop 'Unable to add task to server'
endif
enddo
deallocate(task)
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral_erf(1,1,1,1)
endif
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call ao_two_e_integrals_erf_in_map_collector(zmq_socket_pull)
else
call ao_two_e_integrals_erf_in_map_slave_inproc(i)
endif
size_buffer = ao_num*ao_num
!$OMP PARALLEL DEFAULT(shared) private(j,l) &
!$OMP PRIVATE(buffer_i, buffer_value, n_integrals)
allocate(buffer_i(size_buffer), buffer_value(size_buffer))
n_integrals = 0
!$OMP DO COLLAPSE(1) SCHEDULE(dynamic)
do l=1,ao_num
do j=1,l
call compute_ao_integrals_erf_jl(j,l,n_integrals,buffer_i,buffer_value)
call insert_into_ao_integrals_erf_map(n_integrals,buffer_i,buffer_value)
enddo
enddo
!$OMP END DO
deallocate(buffer_i, buffer_value)
!$OMP END PARALLEL
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals_erf')
print*, 'Sorting the map'

104
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -397,7 +397,6 @@ end
BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
implicit none
use f77_zmq
use map_module
BEGIN_DOC
! Map of Atomic integrals
@ -411,7 +410,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
! For integrals file
integer(key_kind),allocatable :: buffer_i(:)
integer,parameter :: size_buffer = 1024*64
integer :: size_buffer
real(integral_kind),allocatable :: buffer_value(:)
integer :: n_integrals, rc
@ -419,78 +418,61 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
character*(64) :: fmt
double precision :: map_mb
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals ao_integrals_map
if (read_ao_two_e_integrals) then
print*,'Reading the AO integrals'
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
print*, 'AO integrals provided'
ao_two_e_integrals_in_map = .True.
else
return
endif
print*, 'Providing the AO integrals'
call wall_time(wall_0)
call wall_time(wall_1)
call cpu_time(cpu_1)
print*, 'Providing the AO integrals'
call wall_time(wall_0)
call wall_time(wall_1)
call cpu_time(cpu_1)
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral(1,1,1,1)
endif
if (.True.) then
! Avoid openMP
integral = ao_two_e_integral(1,1,1,1)
endif
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_integrals')
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: task)
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
do l=1,ao_num
write(task,fmt) (i,l, i=1,l)
integer, external :: add_task_to_taskserver
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
stop 'Unable to add task to server'
endif
size_buffer = ao_num*ao_num
!$OMP PARALLEL DEFAULT(shared) private(j,l) &
!$OMP PRIVATE(buffer_i, buffer_value, n_integrals)
allocate(buffer_i(size_buffer), buffer_value(size_buffer))
n_integrals = 0
!$OMP DO COLLAPSE(1) SCHEDULE(dynamic)
do l=1,ao_num
do j=1,l
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value)
enddo
deallocate(task)
enddo
!$OMP END DO
deallocate(buffer_i, buffer_value)
!$OMP END PARALLEL
integer, external :: zmq_set_running
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
print *, irp_here, ': Failed in zmq_set_running'
endif
print*, 'Sorting the map'
call map_sort(ao_integrals_map)
call cpu_time(cpu_2)
call wall_time(wall_2)
integer(map_size_kind) :: get_ao_map_size, ao_map_size
ao_map_size = get_ao_map_size()
PROVIDE nproc
!$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
i = omp_get_thread_num()
if (i==0) then
call ao_two_e_integrals_in_map_collector(zmq_socket_pull)
else
call ao_two_e_integrals_in_map_slave_inproc(i)
endif
!$OMP END PARALLEL
print*, 'AO integrals provided:'
print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB'
print*, ' Number of AO integrals :', ao_map_size
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_integrals')
print*, 'Sorting the map'
call map_sort(ao_integrals_map)
call cpu_time(cpu_2)
call wall_time(wall_2)
integer(map_size_kind) :: get_ao_map_size, ao_map_size
ao_map_size = get_ao_map_size()
print*, 'AO integrals provided:'
print*, ' Size of AO map : ', map_mb(ao_integrals_map) ,'MB'
print*, ' Number of AO integrals :', ao_map_size
print*, ' cpu time :',cpu_2 - cpu_1, 's'
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
ao_two_e_integrals_in_map = .True.
if (write_ao_two_e_integrals.and.mpi_master) then
call ezfio_set_work_empty(.False.)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
endif
ao_two_e_integrals_in_map = .True.
if (write_ao_two_e_integrals.and.mpi_master) then
call ezfio_set_work_empty(.False.)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
endif
END_PROVIDER

2
src/cipsi_utils/run_pt2_slave.irp.f
View File

@ -350,7 +350,6 @@ subroutine push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task
enddo
rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE)
deallocate(pt2_serialized)
if (rc == -1) then
print *, irp_here, ': error sending result'
stop 3
@ -358,6 +357,7 @@ subroutine push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task
else if(rc /= size(pt2_serialized)*8) then
stop 'push'
endif
deallocate(pt2_serialized)
rc = f77_zmq_send( zmq_socket_push, task_id, n_tasks*4, ZMQ_SNDMORE)

2
src/fci/pt2.irp.f
View File

@ -15,11 +15,11 @@ program pt2
! sampling.
!
END_DOC
PROVIDE all_mo_integrals
if (.not. is_zmq_slave) then
read_wf = .True.
threshold_generators = 1.d0
SOFT_TOUCH read_wf threshold_generators
PROVIDE all_mo_integrals
PROVIDE psi_energy
call run
else

59
src/mo_two_e_ints/cholesky.irp.f
View File

@ -7,7 +7,8 @@ BEGIN_PROVIDER [ logical, do_mo_cholesky ]
! do_mo_cholesky = .False.
END_PROVIDER
BEGIN_PROVIDER [ integer, cholesky_mo_num ]
BEGIN_PROVIDER [ integer, cholesky_mo_num ]
&BEGIN_PROVIDER [ integer, cholesky_mo_num_split, (1:5)]
implicit none
BEGIN_DOC
! Number of Cholesky vectors in MO basis
@ -21,6 +22,12 @@ BEGIN_PROVIDER [ integer, cholesky_mo_num ]
else
cholesky_mo_num = cholesky_ao_num
endif
cholesky_mo_num_split(1) = 0
cholesky_mo_num_split(2) = cholesky_mo_num/4
cholesky_mo_num_split(3) = 2*cholesky_mo_num_split(2)
cholesky_mo_num_split(4) = 3*cholesky_mo_num_split(2)
cholesky_mo_num_split(5) = cholesky_mo_num
cholesky_mo_num_split += 1
END_PROVIDER
BEGIN_PROVIDER [ double precision, cholesky_mo, (mo_num, mo_num, cholesky_mo_num) ]
@ -49,7 +56,7 @@ BEGIN_PROVIDER [ double precision, cholesky_mo_transp, (cholesky_mo_num, mo_num,
BEGIN_DOC
! Cholesky vectors in MO basis. Warning: it is transposed wrt cholesky_ao:
!
! - cholesky_ao is (ao_num^2 x cholesky_ao_num)
! - cholesky_ao is (ao_num^2 x cholesky_ao_num)
!
! - cholesky_mo_transp is (cholesky_mo_num x mo_num^2)
END_DOC
@ -132,3 +139,51 @@ BEGIN_PROVIDER [ double precision, cholesky_semi_mo_transp_simple, (cholesky_mo_
END_PROVIDER
BEGIN_PROVIDER [ real, cholesky_mo_sp, (mo_num, mo_num, cholesky_mo_num) ]
implicit none
BEGIN_DOC
! Cholesky vectors in MO basis in stored in single precision
END_DOC
integer :: k, i, j
call set_multiple_levels_omp(.False.)
!$OMP PARALLEL DO PRIVATE(k)
do k=1,cholesky_mo_num
do j=1,mo_num
do i=1,mo_num
cholesky_mo_sp(i,j,k) = cholesky_mo_transp_sp(k,i,j)
enddo
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER [ real, cholesky_mo_transp_sp, (cholesky_mo_num, mo_num, mo_num) ]
implicit none
BEGIN_DOC
! Cholesky vectors in MO basis in s. Warning: it is transposed wrt cholesky_ao:
!
! - cholesky_ao is (ao_num^2 x cholesky_ao_num)
!
! - cholesky_mo_transp is (cholesky_mo_num x mo_num^2)
END_DOC
integer :: i,j,k
!$OMP PARALLEL DO PRIVATE(k)
do k=1,cholesky_mo_num
do j=1,mo_num
do i=1,mo_num
cholesky_mo_transp_sp(k,i,j) = cholesky_mo_transp(k,i,j)
enddo
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER

186
src/mo_two_e_ints/map_integrals.irp.f
View File

@ -9,6 +9,14 @@ BEGIN_PROVIDER [ logical, all_mo_integrals ]
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache mo_two_e_integrals_jj_exchange mo_two_e_integrals_jj_anti mo_two_e_integrals_jj big_array_exchange_integrals big_array_coulomb_integrals mo_one_e_integrals
END_PROVIDER
BEGIN_PROVIDER [ logical, mo_cholesky_double ]
implicit none
BEGIN_DOC
! If true, use double precision to compute integrals from cholesky vectors
END_DOC
mo_cholesky_double = .True.
END_PROVIDER
!! MO Map
!! ======
@ -178,12 +186,19 @@ double precision function get_two_e_integral(i,j,k,l,map)
if (do_mo_cholesky) then
double precision, external :: ddot
get_two_e_integral = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, cholesky_mo_transp(1,j,l), 1)
! get_two_e_integral = 0.d0
! do kk=1,cholesky_mo_num
! get_two_e_integral = get_two_e_integral + cholesky_mo_transp(kk,i,k)*cholesky_mo_transp(kk,i,l)
! enddo
real, external :: sdot
integer :: isplit
if (mo_cholesky_double) then
get_two_e_integral = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, cholesky_mo_transp(1,j,l), 1)
else
get_two_e_integral = 0.d0
do isplit=1,4
get_two_e_integral = get_two_e_integral + &
sdot(cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,k), 1, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),j,l), 1)
enddo
endif
else
@ -214,7 +229,8 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
real(integral_kind) :: tmp
integer(key_kind) :: i1, idx
integer(key_kind) :: p,q,r,s,i2
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache
real, allocatable :: out_val_sp(:)
PROVIDE mo_two_e_integrals_in_map mo_integrals_cache cholesky_mo_transp cholesky_mo_transp_sp
if (banned_excitation(j,l)) then
out_val(1:sze) = 0.d0
@ -225,6 +241,10 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
ii = ior(ii, k-mo_integrals_cache_min)
ii = ior(ii, j-mo_integrals_cache_min)
if (do_mo_cholesky.and. .not.mo_cholesky_double) then
allocate(out_val_sp(sze))
endif
if (iand(ii, -mo_integrals_cache_size) == 0) then
! Some integrals are in the cache
@ -232,11 +252,24 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
if (do_mo_cholesky) then
!TODO: here
call dgemv('T', cholesky_mo_num, mo_integrals_cache_min-1, 1.d0, &
cholesky_mo_transp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp(1,j,l), 1, 0.d0, &
out_val, 1)
!TODO: bottleneck here
if (mo_cholesky_double) then
call dgemv('T', cholesky_mo_num, mo_integrals_cache_min-1, 1.d0, &
cholesky_mo_transp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp(1,j,l), 1, 0.d0, &
out_val, 1)
else
integer :: isplit
out_val = 0.d0
do isplit=1,4
call sgemv('T', cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
mo_integrals_cache_min-1, 1., &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),j,l), 1, 0., &
out_val_sp, 1)
out_val(1:mo_integrals_cache_min-1) += out_val_sp(1:mo_integrals_cache_min-1)
enddo
endif
else
@ -270,11 +303,23 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
if (do_mo_cholesky) then
!TODO: here
call dgemv('T', cholesky_mo_num, mo_num-mo_integrals_cache_max, 1.d0, &
cholesky_mo_transp(1,mo_integrals_cache_max+1,k), cholesky_mo_num, &
cholesky_mo_transp(1,j,l), 1, 0.d0, &
out_val(mo_integrals_cache_max+1), 1)
!TODO: bottleneck here
if (mo_cholesky_double) then
call dgemv('T', cholesky_mo_num, mo_num-mo_integrals_cache_max, 1.d0, &
cholesky_mo_transp(1,mo_integrals_cache_max+1,k), cholesky_mo_num, &
cholesky_mo_transp(1,j,l), 1, 0.d0, &
out_val(mo_integrals_cache_max+1), 1)
else
out_val = 0.d0
do isplit=1,4
call sgemv('T', cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
mo_num-mo_integrals_cache_max, 1., &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),mo_integrals_cache_max+1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),j,l), 1, 0., &
out_val_sp(mo_integrals_cache_max+1), 1)
out_val(mo_integrals_cache_max+1:sze) += out_val_sp(mo_integrals_cache_max+1:sze)
enddo
endif
else
@ -306,11 +351,23 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
if (do_mo_cholesky) then
!TODO: here
call dgemv('T', cholesky_mo_num, mo_num, 1.d0, &
cholesky_mo_transp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp(1,j,l), 1, 0.d0, &
out_val, 1)
!TODO: bottleneck here
if (mo_cholesky_double) then
call dgemv('T', cholesky_mo_num, sze, 1.d0, &
cholesky_mo_transp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp(1,j,l), 1, 0.d0, &
out_val, 1)
else
out_val = 0.d0
do isplit=1,4
call sgemv('T', cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
sze, 1., &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),j,l), 1, 0., &
out_val_sp, 1)
out_val(1:sze) += out_val_sp(1:sze)
enddo
endif
else
@ -513,7 +570,7 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
type(map_type), intent(inout) :: map
integer :: i
double precision, external :: get_two_e_integral
PROVIDE mo_two_e_integrals_in_map
PROVIDE mo_two_e_integrals_in_map mo_cholesky_double
if ( (mo_integrals_cache_min>1).or.(mo_integrals_cache_max<mo_num) ) then
@ -523,40 +580,69 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
(l>=mo_integrals_cache_min).and.(l<=mo_integrals_cache_max) ) then
double precision, external :: ddot
real, external :: sdot
integer :: kk
do i=1,mo_integrals_cache_min-1
out_val(i) = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, &
cholesky_mo_transp(1,i,l), 1)
! out_val(i) = 0.d0
! do kk=1,cholesky_mo_num
! out_val(i) = out_val(i) + cholesky_mo_transp(kk,i,k)*cholesky_mo_transp(kk,i,l)
! enddo
enddo
if (mo_cholesky_double) then
do i=mo_integrals_cache_min,mo_integrals_cache_max
out_val(i) = get_two_e_integral_cache(i,i,k,l)
enddo
do i=1,mo_integrals_cache_min-1
out_val(i) = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, &
cholesky_mo_transp(1,i,l), 1)
enddo
do i=mo_integrals_cache_max, sze
out_val(i) = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, &
cholesky_mo_transp(1,i,l), 1)
! out_val(i) = 0.d0
! do kk=1,cholesky_mo_num
! out_val(i) = out_val(i) + cholesky_mo_transp(kk,i,k)*cholesky_mo_transp(kk,i,l)
! enddo
enddo
do i=mo_integrals_cache_min,mo_integrals_cache_max
out_val(i) = get_two_e_integral_cache(i,i,k,l)
enddo
do i=mo_integrals_cache_max, sze
out_val(i) = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, &
cholesky_mo_transp(1,i,l), 1)
enddo
else
integer :: isplit
do i=1,mo_integrals_cache_min-1
out_val(i) = 0.d0
do isplit=1,4
out_val(i) += sdot(cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,k), 1, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,l), 1)
enddo
enddo
do i=mo_integrals_cache_min,mo_integrals_cache_max
out_val(i) = get_two_e_integral_cache(i,i,k,l)
enddo
do i=mo_integrals_cache_max, sze
out_val(i) = 0.d0
do isplit=1,4
out_val(i) += sdot(cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,k), 1, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,l), 1)
enddo
enddo
endif
else
do i=1,sze
out_val(i) = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, &
cholesky_mo_transp(1,i,l), 1)
! out_val(i) = 0.d0
! do kk=1,cholesky_mo_num
! out_val(i) = out_val(i) + cholesky_mo_transp(kk,i,k)*cholesky_mo_transp(kk,i,l)
! enddo
enddo
if (mo_cholesky_double) then
do i=1,sze
out_val(i) = ddot(cholesky_mo_num, cholesky_mo_transp(1,i,k), 1, &
cholesky_mo_transp(1,i,l), 1)
enddo
else
do i=1,sze
out_val(i) = 0.d0
do isplit=1,4
out_val(i) += sdot(cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,k), 1, &
cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),i,l), 1)
enddo
enddo
endif
endif

2
src/mp2/mp2.irp.f
View File

@ -7,7 +7,7 @@ subroutine run
double precision, allocatable :: pt2(:), norm_pert(:)
double precision :: H_pert_diag, E_old
integer :: N_st, iter
PROVIDE Fock_matrix_diag_mo H_apply_buffer_allocated
PROVIDE all_mo_integrals Fock_matrix_diag_mo H_apply_buffer_allocated
N_st = N_states
allocate (pt2(N_st), norm_pert(N_st))
E_old = HF_energy

3
src/scf_utils/roothaan_hall_scf.irp.f
View File

@ -228,9 +228,10 @@ END_DOC
do while (i<mo_num)
j=i+1
m=1
do while ( (j<=mo_num).and.(fock_matrix_diag_mo(j)-fock_matrix_diag_mo(i) < 1.d-5) )
do while ( (fock_matrix_diag_mo(j)-fock_matrix_diag_mo(i) < 1.d-5) )
j += 1
m += 1
if (j > mo_num) exit
enddo
if (m>1) then
call dgemm('N','T',ao_num,ao_num,m,1.d0,mo_coef(1,i),size(mo_coef,1),mo_coef(1,i),size(mo_coef,1),0.d0,S,size(S,1))

31
src/tools/print_energy.irp.f
View File

@ -14,22 +14,21 @@ end
subroutine run
implicit none
call print_mol_properties
print *, psi_energy + nuclear_repulsion
call print_energy_components
print *, 'E(HF) = ', HF_energy
call print_mol_properties
call print_energy_components
! print *, 'E(HF) = ', HF_energy
print *, 'E(CI) = ', psi_energy + nuclear_repulsion
print *, ''
print *, 'E_kin(CI) = ', ref_bitmask_kinetic_energy
print *, 'E_kin(HF) = ', HF_kinetic_energy
print *, ''
print *, 'E_ne (CI) = ', ref_bitmask_n_e_energy
print *, 'E_ne (HF) = ', HF_n_e_energy
print *, ''
print *, 'E_1e (CI) = ', ref_bitmask_one_e_energy
print *, 'E_1e (HF) = ', HF_one_electron_energy
print *, ''
print *, 'E_2e (CI) = ', ref_bitmask_two_e_energy
print *, 'E_2e (HF) = ', HF_two_electron_energy
! print *, ''
! print *, 'E_kin(CI) = ', ref_bitmask_kinetic_energy
! print *, 'E_kin(HF) = ', HF_kinetic_energy
! print *, ''
! print *, 'E_ne (CI) = ', ref_bitmask_n_e_energy
! print *, 'E_ne (HF) = ', HF_n_e_energy
! print *, ''
! print *, 'E_1e (CI) = ', ref_bitmask_one_e_energy
! print *, 'E_1e (HF) = ', HF_one_electron_energy
! print *, ''
! print *, 'E_2e (CI) = ', ref_bitmask_two_e_energy
! print *, 'E_2e (HF) = ', HF_two_electron_energy
end

2
src/utils/map_module.f90
View File

@ -157,7 +157,7 @@ subroutine cache_map_reallocate(map,sze)
stop 2
endif
if (associated(map%value)) then
do i=1_8,min(size(map%key),map%n_elements)
do i=1_8,min(size(map%value),map%n_elements)
value_new(i) = map%value(i)
enddo
deallocate(map%value)