LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-30 15:15:38 +01:00
Code Releases Activity

Fix segfault in cholesky due to array syntax

Browse Source
This commit is contained in:
Anthony Scemama 2023-08-21 09:56:07 +02:00
parent b102cc816a
commit a4d7648bb0
2 changed files with 105 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -198,9 +198,11 @@ END_PROVIDER
stop -1
endif
!$OMP PARALLEL DO PRIVATE(k)
!$OMP PARALLEL DO PRIVATE(k,j)
do k=1,rank
L(:,k) = L_old(:,k)
do j=1,ndim
L(j,k) = L_old(j,k)
enddo
enddo
!$OMP END PARALLEL DO
@ -234,7 +236,9 @@ END_PROVIDER
!$OMP DO
do q=1,nq
Delta(:,q) = 0.d0
do j=1,np
Delta(j,q) = 0.d0
enddo
computed(q) = .False.
enddo
!$OMP ENDDO NOWAIT

47
src/ccsd/ccsd_space_orb_sub_chol.irp.f
View File

@ -252,7 +252,8 @@ subroutine compute_r1_space_chol(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
do a = 1, nV
do j = 1, nO
do i = 1, nO
W_oovo(i,j,a,u) = 2d0 * cc_space_v_vooo(a,u,i,j) - cc_space_v_vooo(a,u,j,i)
! W_oovo(i,j,a,u) = 2d0 * cc_space_v_vooo(a,u,i,j) - cc_space_v_vooo(a,u,j,i)
W_oovo(i,j,a,u) = 2d0 * cc_space_v_oovo(i,j,a,u) - cc_space_v_oovo(j,i,a,u)
enddo
enddo
enddo
@ -514,8 +515,8 @@ subroutine compute_r2_space_chol(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
cc_space_v_vv_chol(1,1,gam), cholesky_mo_num, &
0.d0, tmpB1, nV*block_size)
call dgemm('T','N', nV*min(block_size, nV-iblock+1), nV, cholesky_mo_num, 1.d0, &
cc_space_v_vv_chol(1,1,iblock), cholesky_mo_num, &
call dgemm('T','N', nV*min(block_size, nV-iblock+1), nV, cholesky_mo_num, &
1.d0, cc_space_v_vv_chol(1,1,iblock), cholesky_mo_num, &
tmp_cc2, cholesky_mo_num, &
1.d0, tmpB1, nV*block_size)
@ -1107,37 +1108,27 @@ subroutine compute_g_occ_chol(nO,nV,t1,t2,H_oo,g_occ)
double precision, intent(in) :: t2(nO, nO, nV, nV)
double precision, intent(out) :: g_occ(nO, nO)
integer :: a,tmp_a,b,k,l,c,d,tmp_c,tmp_d,i,j,u,v, beta, gam
g_occ = H_oo
call dgemm('N','N',nO,nO,nV, &
1d0, t1, size(t1,1), &
cc_space_f_vo, size(cc_space_f_vo,1), &
0d0, g_occ, size(g_occ,1))
1d0, g_occ, size(g_occ,1))
!$omp parallel &
!$omp shared(nO,nV,g_occ,H_oo, cc_space_v_ovoo,t1) &
!$omp private(i,j,a,u) &
!$omp default(none)
!$omp do
do i = 1, nO
do u = 1, nO
g_occ(u,i) = g_occ(u,i) + H_oo(u,i)
enddo
enddo
!$omp end do
double precision, allocatable :: X(:)
allocate(X(cholesky_mo_num))
call dgemv('N',cholesky_mo_num,nO*nV,2.d0, &
cc_space_v_ov_chol, cholesky_mo_num, &
t1, 1, 0.d0, X, 1)
!$omp do
do i = 1, nO
do j = 1, nO
do a = 1, nV
do u = 1, nO
g_occ(u,i) = g_occ(u,i) + (2d0 * cc_space_v_ovoo(u,a,i,j) - cc_space_v_ovoo(u,a,j,i)) * t1(j,a)
enddo
enddo
enddo
enddo
!$omp end do
!$omp end parallel
call dgemv('T',cholesky_mo_num,nO*nO,1.d0, &
cc_space_v_oo_chol, cholesky_mo_num, &
X, 1, 1.d0, g_occ, 1)
deallocate(X)
call dgemv('T',nO*nV,nO*nO,-1.d0, &
cc_space_v_ovoo, nO*nV, &
t1, 1, 1.d0, g_occ, 1)
end