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' into trexio-convention

Browse Source
This commit is contained in:
Anthony Scemama 2025-02-14 10:37:35 +01:00
commit 9a840aee7f
8 changed files with 184 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -469,7 +469,7 @@ END_PROVIDER
!$OMP PARALLEL DO PRIVATE(k,j)
do k=1,rank
do j=1,ao_num
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)
cholesky_ao(1:ao_num,j,k) = L((j-1_8)*ao_num+1_8:1_8*j*ao_num,rank-k+1)
enddo
enddo
!$OMP END PARALLEL DO

20
src/cipsi/selection.irp.f
View File

@ -1478,17 +1478,19 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
integer, parameter :: bant=1
double precision, allocatable :: hij_cache1(:), hij_cache2(:)
allocate (hij_cache1(mo_num),hij_cache2(mo_num))
double precision, allocatable :: hij_cache(:,:)
PROVIDE mo_integrals_threshold
allocate(hij_cache(mo_num,mo_num))
if(sp == 3) then ! AB
h1 = p(1,1)
h2 = p(1,2)
call get_mo_two_e_integrals_ij(h2,h1,mo_num,hij_cache,mo_integrals_map)
do p1=1, mo_num
if(bannedOrb(p1, 1)) cycle
call get_mo_two_e_integrals(p1,h2,h1,mo_num,hij_cache1,mo_integrals_map)
do p2=1, mo_num
if(bannedOrb(p2,2)) cycle
if(banned(p1, p2, bant)) cycle ! rentable?
@ -1497,7 +1499,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
call i_h_j(gen, det, N_int, hij)
else
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
hij = hij_cache1(p2) * phase
hij = hij_cache(p2,p1) * phase
end if
if (dabs(hij) < mo_integrals_threshold) cycle
!DIR$ LOOP COUNT AVG(4)
@ -1508,12 +1510,12 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
end do
else ! AA BB
p1 = p(1,sp)
p2 = p(2,sp)
call get_mo_two_e_integrals_ij(p2,p1,mo_num,hij_cache,mo_integrals_map)
do puti=1, mo_num
if (bannedOrb(puti, sp)) cycle
call get_mo_two_e_integrals(puti,p2,p1,mo_num,hij_cache1,mo_integrals_map)
call get_mo_two_e_integrals(puti,p1,p2,mo_num,hij_cache2,mo_integrals_map)
do putj=puti+1, mo_num
if(bannedOrb(putj, sp)) cycle
if(banned(puti, putj, bant)) cycle ! rentable?
@ -1522,7 +1524,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
call i_h_j(gen, det, N_int, hij)
if (dabs(hij) < mo_integrals_threshold) cycle
else
hij = hij_cache1(putj) - hij_cache2(putj)
hij = hij_cache(putj,puti) - hij_cache(puti,putj)
if (dabs(hij) < mo_integrals_threshold) cycle
hij = hij * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
end if
@ -1532,9 +1534,11 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
enddo
end do
end do
end if
deallocate(hij_cache1,hij_cache2)
deallocate(hij_cache)
end

22
src/determinants/spindeterminants.irp.f
View File

@ -197,7 +197,9 @@ integer function get_index_in_psi_det_alpha_unique(key,Nint)
enddo
i += 1
ASSERT (i <= N_det_alpha_unique)
if (i> N_det_alpha_unique) then
call qp_bug(irp_here, i, 'i> N_det_alpha_unique')
endif
!DIR$ FORCEINLINE
do while (spin_det_search_key(psi_det_alpha_unique(1,i),Nint) == det_ref)
@ -219,12 +221,15 @@ integer function get_index_in_psi_det_alpha_unique(key,Nint)
endif
i += 1
if (i > N_det_alpha_unique) then
ASSERT (get_index_in_psi_det_alpha_unique > 0)
return
exit
endif
enddo
if (get_index_in_psi_det_alpha_unique <= 0) then
call qp_bug(irp_here, get_index_in_psi_det_alpha_unique, 'get_index_in_psi_det_alpha_unique <= 0')
endif
end
integer function get_index_in_psi_det_beta_unique(key,Nint)
@ -277,7 +282,9 @@ integer function get_index_in_psi_det_beta_unique(key,Nint)
enddo
i += 1
ASSERT (i <= N_det_beta_unique)
if (i > N_det_beta_unique) then
call qp_bug(irp_here, i, 'i> N_det_beta_unique')
endif
!DIR$ FORCEINLINE
do while (spin_det_search_key(psi_det_beta_unique(1,i),Nint) == det_ref)
@ -299,12 +306,15 @@ integer function get_index_in_psi_det_beta_unique(key,Nint)
endif
i += 1
if (i > N_det_beta_unique) then
ASSERT (get_index_in_psi_det_beta_unique > 0)
return
exit
endif
enddo
if (get_index_in_psi_det_beta_unique <= 0) then
call qp_bug(irp_here, i, 'get_index_in_psi_det_beta_unique <= 0')
endif
end

6
src/mo_two_e_ints/EZFIO.cfg
View File

@ -29,4 +29,10 @@ doc: Read/Write MO integrals with the long range interaction from/to disk [ W
interface: ezfio,provider,ocaml
default: None
[mo_cholesky_double]
type: logical
doc: Use double precision to build integrals from Cholesky vectors
interface: ezfio,provider,ocaml
default: True

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

@ -175,9 +175,9 @@ BEGIN_PROVIDER [ real, cholesky_mo_transp_sp, (cholesky_mo_num, mo_num, mo_num)
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
do k=1,cholesky_mo_num
cholesky_mo_transp_sp(k,i,j) = cholesky_mo_transp(k,i,j)
enddo
enddo

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

@ -9,15 +9,6 @@ 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
!! ======
@ -193,13 +184,14 @@ double precision function get_two_e_integral(i,j,k,l,map)
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
get_two_e_integral = sdot(cholesky_mo_num, cholesky_mo_transp_sp(1,i,k), 1, cholesky_mo_transp_sp(1,j,l), 1)
! 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
@ -244,7 +236,7 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
ii = ior(ii, j-mo_integrals_cache_min)
if (do_mo_cholesky.and. .not.mo_cholesky_double) then
allocate(out_val_sp(sze))
allocate(out_val_sp(mo_num))
endif
if (iand(ii, -mo_integrals_cache_size) == 0) then
@ -261,16 +253,27 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
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., &
call sgemv('T', cholesky_mo_num, mo_integrals_cache_min-1, 1., &
cholesky_mo_transp_sp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(1,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
out_val(1:mo_integrals_cache_min-1) = out_val_sp(1:mo_integrals_cache_min-1)
! integer :: isplit
! isplit=1
! 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)
! do isplit=2,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
@ -312,15 +315,26 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
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., &
call sgemv('T', cholesky_mo_num, mo_num-mo_integrals_cache_max, 1., &
cholesky_mo_transp_sp(1,mo_integrals_cache_max+1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(1,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
out_val(mo_integrals_cache_max+1:sze) = out_val_sp(mo_integrals_cache_max+1:sze)
! isplit=1
! 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)
! do isplit=2,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
@ -360,15 +374,26 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
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., &
call sgemv('T', cholesky_mo_num, sze, 1., &
cholesky_mo_transp_sp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(1,j,l), 1, 0., &
out_val_sp, 1)
out_val(1:sze) += out_val_sp(1:sze)
enddo
out_val(1:sze) = out_val_sp(1:sze)
! isplit=1
! 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)
! do isplit=2,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
@ -442,16 +467,43 @@ subroutine get_mo_two_e_integrals_ij(k,l,sze,out_array,map)
double precision, intent(out) :: out_array(sze,sze)
type(map_type), intent(inout) :: map
integer :: j
real(integral_kind), allocatable :: tmp_val(:)
if ( (mo_integrals_cache_min>1).or.(mo_integrals_cache_max<mo_num) ) then
if (do_mo_cholesky) then
if (mo_cholesky_double) then
call dgemm('T', 'N', mo_num, mo_num, cholesky_mo_num, 1.d0, &
cholesky_mo_transp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp(1,1,l), cholesky_mo_num, 0.d0, &
out_array, sze)
else
real, allocatable :: out_array_sp(:,:)
allocate(out_array_sp(sze,sze))
call sgemm('T', 'N', mo_num, mo_num, cholesky_mo_num, 1.0, &
cholesky_mo_transp_sp(1,1,k), cholesky_mo_num, &
cholesky_mo_transp_sp(1,1,l), cholesky_mo_num, 0.0, &
out_array_sp, sze)
out_array(1:sze,1:sze) = out_array_sp(1:sze,1:sze)
!
! isplit=1
! call sgemm('T', 'N', mo_num, mo_num, &
! cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), 1., &
! cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),1,k), cholesky_mo_num, &
! cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),1,l), cholesky_mo_num, 0., &
! out_array_sp, sze)
! out_array(1:sze,1:sze) = out_array_sp(1:sze,1:sze)
! integer :: isplit
! do isplit=2,4
! call sgemm('T', 'N', mo_num, mo_num, &
! cholesky_mo_num_split(isplit+1) - cholesky_mo_num_split(isplit), 1., &
! cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),1,k), cholesky_mo_num, &
! cholesky_mo_transp_sp(cholesky_mo_num_split(isplit),1,l), cholesky_mo_num, 0., &
! out_array_sp, sze)
! out_array(1:sze,1:sze) = out_array(1:sze,1:sze) + out_array_sp(1:sze,1:sze)
! enddo
deallocate(out_array_sp)
endif
else
@ -605,12 +657,13 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
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
out_val(i) = sdot(cholesky_mo_num, cholesky_mo_transp_sp(1,i,k), 1, cholesky_mo_transp_sp(1,i,l), 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
@ -618,12 +671,13 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
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
out_val(i) = sdot(cholesky_mo_num, cholesky_mo_transp_sp(1,i,k), 1, cholesky_mo_transp_sp(1,i,l), 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
endif
@ -637,12 +691,13 @@ subroutine get_mo_two_e_integrals_exch_ii(k,l,sze,out_val,map)
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
out_val(i) = sdot(cholesky_mo_num, cholesky_mo_transp_sp(1,i,k), 1, cholesky_mo_transp_sp(1,i,l), 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
endif

1
src/trexio/export_trexio_routines.irp.f
View File

@ -316,7 +316,6 @@ subroutine export_trexio(update,full_path)
if (ezfio_convention >= 20250211) then
rc = trexio_write_ao_normalization(f(1), ao_coef_normalization_factor)
print *, ao_coef_normalization_factor(:)
else
integer :: pow0(3), powA(3), nz
double precision :: normA, norm0, C_A(3), overlap_x, overlap_z, overlap_y, c

23
src/utils/bug.irp.f Normal file
View File

@ -0,0 +1,23 @@
subroutine qp_bug(from, code, message)
implicit none
BEGIN_DOC
! This routine prints a bug report
END_DOC
character*(*) :: from
integer :: code
character*(*) :: message
print *, ''
print *, '======================='
print *, 'Bug in Quantum Package!'
print *, '======================='
print *, ''
print *, ' from: ', trim(from)
print *, ' code: ', code
print *, ' info: ', trim(message)
print *, ''
print *, 'Please report this bug at https://github.com/QuantumPackage/qp2/issues'
print *, 'with your output file attached.'
print *, ''
stop -1
end subroutine qp_bug