scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-07-25 20:27:35 +02:00
Code Issues Releases Wiki Activity

Merge branch 'master' of gitlab.com:AbdAmmar/qp_plugins_scemama

Browse Source 
Conflicts:
	devel/svdwf/Evar_TruncSVD.irp.f
	devel/svdwf/NEED
This commit is contained in:
Abdallah Ammar 2021-04-08 17:16:12 +02:00
commit 7e1d1bcc9f
6 changed files with 154 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
devel/import_integrals/export_integrals_mo.irp.f
View File

@ -1,4 +1,5 @@
program export_integrals_mo program export_integrals_mo
PROVIDE mo_two_e_integrals_in_map
call run call run
end end
@ -53,7 +54,8 @@ subroutine run
integer :: n_integrals integer :: n_integrals
integer(key_kind) :: idx integer(key_kind) :: idx
double precision, external :: get_two_e_integral double precision, external :: mo_two_e_integral
allocate (A(mo_num,mo_num)) allocate (A(mo_num,mo_num))
call ezfio_set_nuclei_nuclear_repulsion(nuclear_repulsion) call ezfio_set_nuclei_nuclear_repulsion(nuclear_repulsion)
@ -61,13 +63,15 @@ subroutine run
call write_2d('T_mo.qp',mo_kinetic_integrals) call write_2d('T_mo.qp',mo_kinetic_integrals)
call write_2d('P_mo.qp',mo_pseudo_integrals) call write_2d('P_mo.qp',mo_pseudo_integrals)
call write_2d('V_mo.qp',mo_integrals_n_e) call write_2d('V_mo.qp',mo_integrals_n_e)
call write_2d('H_mo.qp',mo_one_e_integrals)
iunit = getunitandopen('W_mo.qp','w') iunit = getunitandopen('W_mo.qp','w')
do l=1,mo_num do l=1,mo_num
do k=1,mo_num do k=1,mo_num
do j=1,mo_num do j=l,mo_num
do i=1,mo_num do i=k,mo_num
integral = get_two_e_integral(i,j,k,l,mo_integrals_map) if (i==j .and. k<l) cycle
integral = mo_two_e_integral(i,j,k,l)
if (integral /= 0.d0) then if (integral /= 0.d0) then
write (iunit,'(4(I5,2X),E22.15)') i,j,k,l, integral write (iunit,'(4(I5,2X),E22.15)') i,j,k,l, integral
endif endif

207
devel/import_integrals/import_integrals_mo.irp.f
View File

@ -17,31 +17,36 @@ subroutine run
! !
! E.qp : Contains the nuclear repulsion energy ! E.qp : Contains the nuclear repulsion energy
! !
! Tmo.qp : kinetic energy integrals ! T_mo.qp : kinetic energy integrals
! !
! Smo.qp : overlap matrix ! P_mo.qp : pseudopotential integrals
! !
! Pmo.qp : pseudopotential integrals ! V_mo.qp : electron-nucleus potential
! !
! Vmo.qp : electron-nucleus potential ! H_mo.qp : core hamiltonian. If hmo exists, the other 1-e files are not read
! !
! Wmo.qp : electron repulsion integrals ! W_mo.qp : electron repulsion integrals
! !
END_DOC END_DOC
integer :: iunit integer :: iunit
integer :: getunitandopen integer :: getunitandopen
integer ::i,j,k,l integer :: i,j,k,l
double precision :: integral double precision :: integral
double precision, allocatable :: A(:,:) double precision, allocatable :: A(:,:)
integer :: n_integrals integer :: n_integrals
integer(key_kind), allocatable :: buffer_i(:) logical :: exists
integer(key_kind), allocatable :: buffer_i(:)
real(integral_kind), allocatable :: buffer_values(:) real(integral_kind), allocatable :: buffer_values(:)
allocate(buffer_i(mo_num**3), buffer_values(mo_num**3)) allocate(buffer_i(mo_num**3), buffer_values(mo_num**3))
allocate (A(mo_num,mo_num)) allocate (A(mo_num,mo_num))
PROVIDE mo_integrals_map
PROVIDE mo_integrals_threshold
! Nuclear repulsion
A(1,1) = huge(1.d0) A(1,1) = huge(1.d0)
iunit = getunitandopen('E.qp','r') iunit = getunitandopen('E.qp','r')
@ -53,70 +58,109 @@ subroutine run
call ezfio_set_nuclei_io_nuclear_repulsion('Read') call ezfio_set_nuclei_io_nuclear_repulsion('Read')
endif endif
A = 0.d0 ! One-electron integrals
i = 1
j = 1
iunit = getunitandopen('Tmo.qp','r')
do
read (iunit,*,end=10) i,j, integral
if (i<0 .or. i>mo_num) then
print *, i
stop 'i out of bounds in Tmo.qp'
endif
if (j<0 .or. j>mo_num) then
print *, j
stop 'j out of bounds in Tmo.qp'
endif
A(i,j) = integral
enddo
10 continue
close(iunit)
call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(A)
call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('Read')
A = 0.d0 exists = .False.
i = 1 inquire(file='H_mo.qp',exist=exists)
j = 1 if (exists) then
iunit = getunitandopen('Pmo.qp','r')
do
read (iunit,*,end=14) i,j, integral
if (i<0 .or. i>mo_num) then
print *, i
stop 'i out of bounds in Pmo.qp'
endif
if (j<0 .or. j>mo_num) then
print *, j
stop 'j out of bounds in Pmo.qp'
endif
A(i,j) = integral
enddo
14 continue
close(iunit)
call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(A)
call ezfio_set_mo_one_e_ints_io_mo_integrals_pseudo('Read')
A = 0.d0 A = 0.d0
i = 1 i = 1
j = 1 j = 1
iunit = getunitandopen('Vmo.qp','r') iunit = getunitandopen('H_mo.qp','r')
do do
read (iunit,*,end=12) i,j, integral read (iunit,*,end=8) i,j, integral
if (i<0 .or. i>mo_num) then if (i<0 .or. i>mo_num) then
print *, i print *, i
stop 'i out of bounds in Vmo.qp' stop 'i out of bounds in H_mo.qp'
endif endif
if (j<0 .or. j>mo_num) then if (j<0 .or. j>mo_num) then
print *, j print *, j
stop 'j out of bounds in Vmo.qp' stop 'j out of bounds in H_mo.qp'
endif endif
A(i,j) = integral A(i,j) = integral
enddo enddo
12 continue 8 continue
close(iunit) close(iunit)
call ezfio_set_mo_one_e_ints_mo_integrals_n_e(A) call ezfio_set_mo_one_e_ints_mo_one_e_integrals(A)
call ezfio_set_mo_one_e_ints_io_mo_integrals_n_e('Read') call ezfio_set_mo_one_e_ints_io_mo_one_e_integrals('Read')
call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('None')
call ezfio_set_mo_one_e_ints_io_mo_integrals_pseudo('None')
call ezfio_set_mo_one_e_ints_io_mo_integrals_n_e('None')
iunit = getunitandopen('Wmo.qp','r') else
call ezfio_set_mo_one_e_ints_io_mo_one_e_integrals('None')
A = 0.d0
i = 1
j = 1
iunit = getunitandopen('T_mo.qp','r')
do
read (iunit,*,end=10) i,j, integral
if (i<0 .or. i>mo_num) then
print *, i
stop 'i out of bounds in T_mo.qp'
endif
if (j<0 .or. j>mo_num) then
print *, j
stop 'j out of bounds in T_mo.qp'
endif
A(i,j) = integral
enddo
10 continue
close(iunit)
call ezfio_set_mo_one_e_ints_mo_integrals_kinetic(A)
call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('Read')
A = 0.d0
i = 1
j = 1
iunit = getunitandopen('P_mo.qp','r')
do
read (iunit,*,end=14) i,j, integral
if (i<0 .or. i>mo_num) then
print *, i
stop 'i out of bounds in P_mo.qp'
endif
if (j<0 .or. j>mo_num) then
print *, j
stop 'j out of bounds in P_mo.qp'
endif
A(i,j) = integral
enddo
14 continue
close(iunit)
call ezfio_set_mo_one_e_ints_mo_integrals_pseudo(A)
call ezfio_set_mo_one_e_ints_io_mo_integrals_pseudo('Read')
A = 0.d0
i = 1
j = 1
iunit = getunitandopen('V_mo.qp','r')
do
read (iunit,*,end=12) i,j, integral
if (i<0 .or. i>mo_num) then
print *, i
stop 'i out of bounds in V_mo.qp'
endif
if (j<0 .or. j>mo_num) then
print *, j
stop 'j out of bounds in V_mo.qp'
endif
A(i,j) = integral
enddo
12 continue
close(iunit)
call ezfio_set_mo_one_e_ints_mo_integrals_n_e(A)
call ezfio_set_mo_one_e_ints_io_mo_integrals_n_e('Read')
end if
! Two-electron integrals
iunit = getunitandopen('W_mo.qp','r')
n_integrals=0 n_integrals=0
i = 1 i = 1
j = 1 j = 1
@ -127,26 +171,25 @@ subroutine run
read (iunit,*,end=13) i,j,k,l, integral read (iunit,*,end=13) i,j,k,l, integral
if (i<0 .or. i>mo_num) then if (i<0 .or. i>mo_num) then
print *, i print *, i
stop 'i out of bounds in Wmo.qp' stop 'i out of bounds in W_mo.qp'
endif endif
if (j<0 .or. j>mo_num) then if (j<0 .or. j>mo_num) then
print *, j print *, j
stop 'j out of bounds in Wmo.qp' stop 'j out of bounds in W_mo.qp'
endif endif
if (k<0 .or. k>mo_num) then if (k<0 .or. k>mo_num) then
print *, k print *, k
stop 'k out of bounds in Wmo.qp' stop 'k out of bounds in W_mo.qp'
endif endif
if (l<0 .or. l>mo_num) then if (l<0 .or. l>mo_num) then
print *, l print *, l
stop 'l out of bounds in Wmo.qp' stop 'l out of bounds in W_mo.qp'
endif endif
n_integrals += 1 n_integrals += 1
call mo_two_e_integrals_index(i, j, k, l, buffer_i(n_integrals) ) call mo_two_e_integrals_index(i, j, k, l, buffer_i(n_integrals) )
buffer_values(n_integrals) = integral buffer_values(n_integrals) = integral
if (n_integrals == size(buffer_i)) then if (n_integrals == size(buffer_i)) then
call insert_into_mo_integrals_map(n_integrals, buffer_i, buffer_values, & call map_append(mo_integrals_map, buffer_i, buffer_values, n_integrals)
real(mo_integrals_threshold,integral_kind))
n_integrals = 0 n_integrals = 0
endif endif
enddo enddo
@ -154,13 +197,15 @@ subroutine run
close(iunit) close(iunit)
if (n_integrals > 0) then if (n_integrals > 0) then
call insert_into_mo_integrals_map(n_integrals, buffer_i, buffer_values, & call map_append(mo_integrals_map, buffer_i, buffer_values, n_integrals)
real(mo_integrals_threshold,integral_kind))
endif endif
call map_sort(mo_integrals_map)
call map_unique(mo_integrals_map) call map_unique(mo_integrals_map)
call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints',mo_integrals_map) call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints',mo_integrals_map)
call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read') call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read')
end end

6
devel/svdwf/Evar_TruncSVD.irp.f
View File

@ -44,14 +44,14 @@ subroutine run
print *, 'matrix:', m,'x',n print *, 'matrix:', m,'x',n
print *, 'N det:', N_det print *, 'N det:', N_det
! !!! ! !!!
r_init = 78 !!!42 r_init = 78
delta_r = 1 delta_r = 5
! !!! ! !!!
PowerIt_max = 10 PowerIt_max = 10
nb_oversamp = 10 nb_oversamp = 10
! !!! ! !!!
It_max = 10 It_max = 10
error_thr = 1.d-3 !not stable if less thant 0.001 error_thr = 1.d-3 !! don't touche it but rather increase r_init
! !!! ! !!!
! !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ! ! !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! ~ !!! !
! !!! ~ Rank Revealing Randomized SVD ~ !!! ! ! !!! ~ Rank Revealing Randomized SVD ~ !!! !

14
devel/svdwf/random_svd.irp.f
View File

@ -22,13 +22,17 @@ subroutine run
allocate(Z(m,r)) allocate(Z(m,r))
! Z(m,r) = A(m,n).P(n,r) ! Z(m,r) = A(m,n).P(n,r)
Z(:,:) = 0.d0 do j=1,r
do i=1,m
Z(i,j) = 0.d0
enddo
enddo
allocate(P(n,r)) allocate(P(n,r))
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,r1) !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,r1)
allocate(r1(N_det,2)) allocate(r1(N_det,2))
!$OMP DO !$OMP DO
do l=1,r do l=1,r
call random_number(r1) call random_number(r1)
r1(:,1) = dsqrt(-2.d0*dlog(r1(:,1))) r1(:,1) = dsqrt(-2.d0*dlog(r1(:,1)))
@ -36,7 +40,7 @@ subroutine run
do k=1,N_det do k=1,N_det
i = psi_bilinear_matrix_rows(k) i = psi_bilinear_matrix_rows(k)
j = psi_bilinear_matrix_columns(k) j = psi_bilinear_matrix_columns(k)
Z(i,l) = Z(i,l) + psi_bilinear_matrix_values(k,1) * r1(k,1) Z(i,l) = Z(i,l) + psi_bilinear_matrix_values(k,1) * r1(k,1)
enddo enddo
enddo enddo
!$OMP END DO !$OMP END DO
@ -100,7 +104,7 @@ subroutine run
call svd(Yt,size(Yt,1),V,size(V,1),D,UYt,size(UYt,1),n,r) call svd(Yt,size(Yt,1),V,size(V,1),D,UYt,size(UYt,1),n,r)
deallocate(Yt) deallocate(Yt)
! U(m,r) = Z(m,r).UY(r,r) ! U(m,r) = Z(m,r).UY(r,r)
allocate(U(m,r)) allocate(U(m,r))
call dgemm('N','T',m,r,r,1.d0,Z,size(Z,1),UYt,size(UYt,1),0.d0,U,size(U,1)) call dgemm('N','T',m,r,r,1.d0,Z,size(Z,1),UYt,size(UYt,1),0.d0,U,size(U,1))
deallocate(UYt,Z) deallocate(UYt,Z)

4
devel/svdwf/svdwf.irp.f
View File

@ -53,6 +53,10 @@ subroutine run
print *, 'threshold: ', 2.858 * D(k/2) print *, 'threshold: ', 2.858 * D(k/2)
print *, 'Entropy : ', entropy print *, 'Entropy : ', entropy
call ezfio_set_spindeterminants_psi_svd_alpha(U)
call ezfio_set_spindeterminants_psi_svd_beta (Vt)
call ezfio_set_spindeterminants_psi_svd_coefs(D)
! do i=1,n_det_alpha_unique ! do i=1,n_det_alpha_unique
! print '(I6,4(X,F12.8))', i, U(i,1:4) ! print '(I6,4(X,F12.8))', i, U(i,1:4)
! enddo ! enddo

8
stable/utilities/truncate_wf.irp.f
View File

@ -55,16 +55,16 @@ subroutine routine_s2
integer :: i,j,k integer :: i,j,k
double precision :: accu(N_states) double precision :: accu(N_states)
print *, 'Weights of the SOP' print *, 'Weights of the CFG'
do i=1,N_det do i=1,N_det
print *, i, real(weight_occ_pattern(det_to_occ_pattern(i),:)), real(sum(weight_occ_pattern(det_to_occ_pattern(i),:))) print *, i, real(weight_configuration(det_to_configuration(i),:)), real(sum(weight_configuration(det_to_configuration(i),:)))
enddo enddo
print*, 'Min weight of the occupation pattern ?' print*, 'Min weight of the occupation pattern ?'
read(5,*) wmin read(5,*) wmin
ndet_max = 0 ndet_max = 0
do i=1,N_det do i=1,N_det
if (maxval(weight_occ_pattern( det_to_occ_pattern(i),:)) < wmin) cycle if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle
ndet_max = ndet_max+1 ndet_max = ndet_max+1
enddo enddo
@ -73,7 +73,7 @@ subroutine routine_s2
accu = 0.d0 accu = 0.d0
k=0 k=0
do i = 1, N_det do i = 1, N_det
if (maxval(weight_occ_pattern( det_to_occ_pattern(i),:)) < wmin) cycle if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle
k = k+1 k = k+1
do j = 1, N_int do j = 1, N_int
psi_det_tmp(j,1,k) = psi_det(j,1,i) psi_det_tmp(j,1,k) = psi_det(j,1,i)