LCPQ
/
qp2
mirror of https://github.com/QuantumPackage/qp2.git
9
1
Fork 0
Code Releases Activity

Add many call provide in TC

This commit is contained in:
Anthony Scemama 2023-09-22 16:26:58 +02:00
parent 088735c69c
commit 4cbe630ec5
7 changed files with 118 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
configure vendored
View File

@ -213,7 +213,7 @@ EOF
wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
cd trexio-${VERSION}
./configure --prefix=\${QP_ROOT} --without-hdf5
./configure --prefix=\${QP_ROOT} --without-hdf5 CFLAGS='-g'
make -j 8 && make -j 8 check && make -j 8 install
tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz
mv ninja "\${QP_ROOT}"/bin/
@ -226,7 +226,7 @@ EOF
wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz
cd trexio-${VERSION}
./configure --prefix=\${QP_ROOT}
./configure --prefix=\${QP_ROOT} CFLAGS="-g"
make -j 8 && make -j 8 check && make -j 8 install
EOF
elif [[ ${PACKAGE} = qmckl ]] ; then
@ -237,7 +237,7 @@ EOF
wget https://github.com/TREX-CoE/qmckl/releases/download/v${VERSION}/qmckl-${VERSION}.tar.gz
tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz
cd qmckl-${VERSION}
./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc
./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc CFLAGS='-g'
make && make -j 4 check && make install
EOF

9
src/bi_ort_ints/three_body_ijm.irp.f
View File

@ -18,12 +18,13 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
double precision :: integral, wall1, wall0
PROVIDE mo_l_coef mo_r_coef
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
three_e_3_idx_direct_bi_ort = 0.d0
print *, ' Providing the three_e_3_idx_direct_bi_ort ...'
call wall_time(wall0)
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
@ -79,6 +80,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_1_bi_ort, (mo_num, mo_num
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,m,integral) &
@ -135,6 +137,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,m,integral) &
@ -191,6 +194,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num,
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,m,integral) &
@ -247,6 +251,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num,
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,m,integral) &
@ -303,6 +308,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num,
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,m,integral) &
@ -349,6 +355,7 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort_new, (mo_num, mo_
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
call give_integrals_3_body_bi_ort(1, 1, 1, 1, 1, 1, integral)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,j,m,integral) &

3
src/bi_ort_ints/three_body_ints_bi_ort.irp.f
View File

@ -29,6 +29,9 @@ BEGIN_PROVIDER [ double precision, three_body_ints_bi_ort, (mo_num, mo_num, mo_n
!provide x_W_ki_bi_ortho_erf_rk
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
provide int2_grad1_u12_ao_transp final_grid_points int2_grad1_u12_bimo_t
provide mo_l_coef mo_r_coef mos_l_in_r_array_transp mos_r_in_r_array_transp n_points_final_grid
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &

122
src/non_h_ints_mu/jast_deriv.irp.f
View File

@ -51,7 +51,7 @@
r1(2) = final_grid_points(2,ipoint)
r1(3) = final_grid_points(3,ipoint)
do jpoint = 1, n_points_extra_final_grid ! r2
do jpoint = 1, n_points_extra_final_grid ! r2
r2(1) = final_grid_points_extra(1,jpoint)
r2(2) = final_grid_points_extra(2,jpoint)
@ -63,9 +63,9 @@
dy = grad1_u2b(2)
dz = grad1_u2b(3)
grad1_u12_num(jpoint,ipoint,1) = dx
grad1_u12_num(jpoint,ipoint,2) = dy
grad1_u12_num(jpoint,ipoint,3) = dz
grad1_u12_num(jpoint,ipoint,1) = dx
grad1_u12_num(jpoint,ipoint,2) = dy
grad1_u12_num(jpoint,ipoint,3) = dz
grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz
enddo
@ -92,7 +92,7 @@
v1b_r1 = j1b_nucl(r1)
call grad1_j1b_nucl(r1, grad1_v1b)
do jpoint = 1, n_points_extra_final_grid ! r2
do jpoint = 1, n_points_extra_final_grid ! r2
r2(1) = final_grid_points_extra(1,jpoint)
r2(2) = final_grid_points_extra(2,jpoint)
@ -106,9 +106,9 @@
dy = (grad1_u2b(2) * v1b_r1 + u2b_r12 * grad1_v1b(2)) * v1b_r2
dz = (grad1_u2b(3) * v1b_r1 + u2b_r12 * grad1_v1b(3)) * v1b_r2
grad1_u12_num(jpoint,ipoint,1) = dx
grad1_u12_num(jpoint,ipoint,2) = dy
grad1_u12_num(jpoint,ipoint,3) = dz
grad1_u12_num(jpoint,ipoint,1) = dx
grad1_u12_num(jpoint,ipoint,2) = dy
grad1_u12_num(jpoint,ipoint,3) = dz
grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz
enddo
@ -121,85 +121,101 @@
double precision :: f
f = 1.d0 / dble(elec_num - 1)
integer*8 :: n_points, k
n_points = n_points_extra_final_grid * n_points_final_grid
double precision, allocatable :: rij(:,:,:)
allocate( rij(3, 2, n_points_extra_final_grid) )
allocate( rij(3, 2, n_points) )
use qmckl
integer(qmckl_exit_code) :: rc
integer*8 :: npoints
npoints = n_points_extra_final_grid
double precision, allocatable :: gl(:,:,:)
allocate( gl(2,4,n_points_extra_final_grid) )
allocate( gl(2,4,n_points) )
k=0
do ipoint = 1, n_points_final_grid ! r1
do jpoint = 1, n_points_extra_final_grid ! r2
rij(1:3, 1, jpoint) = final_grid_points (1:3, ipoint)
rij(1:3, 2, jpoint) = final_grid_points_extra(1:3, jpoint)
do jpoint = 1, n_points_extra_final_grid ! r2
k=k+1
rij(1:3, 1, k) = final_grid_points (1:3, ipoint)
rij(1:3, 2, k) = final_grid_points_extra(1:3, jpoint)
enddo
enddo
rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', npoints, rij, npoints*6_8)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in set_electron_coord'
stop -1
endif
rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', n_points, rij, n_points*6_8)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in set_electron_coord'
rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1
endif
! ---
! e-e term
! ---
! e-e term
rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*npoints)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in fact_ee_gl'
stop -1
endif
rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, ' qmckl error in fact_ee_gl'
rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1
endif
do jpoint = 1, n_points_extra_final_grid ! r2
grad1_u12_num(jpoint,ipoint,1) = gl(1,1,jpoint)
grad1_u12_num(jpoint,ipoint,2) = gl(1,2,jpoint)
grad1_u12_num(jpoint,ipoint,3) = gl(1,3,jpoint)
k=0
do ipoint = 1, n_points_final_grid ! r1
do jpoint = 1, n_points_extra_final_grid ! r2
k=k+1
grad1_u12_num(jpoint,ipoint,1) = gl(1,1,k)
grad1_u12_num(jpoint,ipoint,2) = gl(1,2,k)
grad1_u12_num(jpoint,ipoint,3) = gl(1,3,k)
enddo
enddo
! ---
! e-e-n term
! rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*npoints)
! rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
! if (rc /= QMCKL_SUCCESS) then
! print *, irp_here, 'qmckl error in fact_een_gl'
! rc = qmckl_check(qmckl_ctx_jastrow, rc)
! stop -1
! endif
!
! do jpoint = 1, n_points_extra_final_grid ! r2
! grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,jpoint)
! grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,jpoint)
! grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,jpoint)
! k=0
! do ipoint = 1, n_points_final_grid ! r1
! do jpoint = 1, n_points_extra_final_grid ! r2
! k=k+1
! grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,k)
! grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,k)
! grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,k)
! enddo
! enddo
! ---
! e-n term
rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*npoints)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in fact_en_gl'
stop -1
endif
rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in fact_en_gl'
rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1
endif
do jpoint = 1, n_points_extra_final_grid ! r2
grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,jpoint)
grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,jpoint)
grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,jpoint)
k=0
do ipoint = 1, n_points_final_grid ! r1
do jpoint = 1, n_points_extra_final_grid ! r2
k = k+1
grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,k)
grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,k)
grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,k)
enddo
do jpoint = 1, n_points_extra_final_grid ! r2
dx = grad1_u12_num(jpoint,ipoint,1)
dy = grad1_u12_num(jpoint,ipoint,2)
dz = grad1_u12_num(jpoint,ipoint,3)
do jpoint = 1, n_points_extra_final_grid ! r2
dx = grad1_u12_num(jpoint,ipoint,1)
dy = grad1_u12_num(jpoint,ipoint,2)
dz = grad1_u12_num(jpoint,ipoint,3)
grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz
enddo
enddo
deallocate(gl, rij)
@ -212,7 +228,7 @@
endif
call wall_time(time1)
print*, ' Wall time for grad1_u12_num & grad1_u12_squared_num (min) =', (time1-time0)/60.d0
print*, ' Wall time for grad1_u12_num & grad1_u12_squared_num (min) =', (time1-time0)/60.d0
END_PROVIDER

4
src/non_h_ints_mu/qmckl.irp.f
View File

@ -59,6 +59,10 @@ BEGIN_PROVIDER [ integer*8, qmckl_ctx_jastrow ]
if (rc /= QMCKL_SUCCESS) stop -1
rc = qmckl_set_jastrow_champ_cord_num(qmckl_ctx_jastrow, jast_qmckl_cord_num*1_8)
rc = qmckl_check(qmckl_ctx_jastrow, rc)
if (rc /= QMCKL_SUCCESS) stop -1
if (jast_qmckl_cord_num > 0) then
rc = qmckl_set_jastrow_champ_c_vector(qmckl_ctx_jastrow, jast_qmckl_c_vector, 1_8*jast_qmckl_c_vector_size)
rc = qmckl_check(qmckl_ctx_jastrow, rc)

11
src/tc_bi_ortho/tc_bi_ortho.irp.f
View File

@ -13,6 +13,17 @@ program tc_bi_ortho
my_n_pt_a_grid = tc_grid1_a
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
if(j1b_type .ge. 100) then
my_extra_grid_becke = .True.
PROVIDE tc_grid2_a tc_grid2_r
my_n_pt_r_extra_grid = tc_grid2_r
my_n_pt_a_extra_grid = tc_grid2_a
touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid
call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over')
call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over')
endif
read_wf = .True.
touch read_wf

26
src/tc_scf/tc_petermann_factor.irp.f
View File

@ -30,9 +30,22 @@ subroutine main()
allocate(Sl(mo_num,mo_num), Sr(mo_num,mo_num), Pf(mo_num,mo_num))
call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
, mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
, 0.d0, Sl, size(Sl, 1) )
call LTxSxR(ao_num, mo_num, mo_l_coef, ao_overlap, mo_r_coef, Sl)
!call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
! , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
! , 0.d0, Sl, size(Sl, 1) )
print *, ''
print *, ' left-right orthog matrix:'
do i = 1, mo_num
write(*,'(100(F8.4,X))') Sl(:,i)
enddo
call LTxSxR(ao_num, mo_num, mo_l_coef, ao_overlap, mo_l_coef, Sl)
!call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
! , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
! , 0.d0, Sl, size(Sl, 1) )
print *, ''
print *, ' left-orthog matrix:'
@ -40,9 +53,10 @@ subroutine main()
write(*,'(100(F8.4,X))') Sl(:,i)
enddo
call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
, mo_r_coef, size(mo_r_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
, 0.d0, Sr, size(Sr, 1) )
call LTxSxR(ao_num, mo_num, mo_r_coef, ao_overlap, mo_r_coef, Sr)
! call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
! , mo_r_coef, size(mo_r_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
! , 0.d0, Sr, size(Sr, 1) )
print *, ''
print *, ' right-orthog matrix:'