LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-08-29 12:13:40 +02: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 stop -1
endif endif
!$OMP PARALLEL DO PRIVATE(k) !$OMP PARALLEL DO PRIVATE(k,j)
do k=1,rank do k=1,rank
L(:,k) = L_old(:,k) do j=1,ndim
L(j,k) = L_old(j,k)
enddo
enddo enddo
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
@ -234,7 +236,9 @@ END_PROVIDER
!$OMP DO !$OMP DO
do q=1,nq do q=1,nq
Delta(:,q) = 0.d0 do j=1,np
Delta(j,q) = 0.d0
enddo
computed(q) = .False. computed(q) = .False.
enddo enddo
!$OMP ENDDO NOWAIT !$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 a = 1, nV
do j = 1, nO do j = 1, nO
do i = 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 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, & cc_space_v_vv_chol(1,1,gam), cholesky_mo_num, &
0.d0, tmpB1, nV*block_size) 0.d0, tmpB1, nV*block_size)
call dgemm('T','N', nV*min(block_size, nV-iblock+1), nV, cholesky_mo_num, 1.d0, & call dgemm('T','N', nV*min(block_size, nV-iblock+1), nV, cholesky_mo_num, &
cc_space_v_vv_chol(1,1,iblock), cholesky_mo_num, & 1.d0, cc_space_v_vv_chol(1,1,iblock), cholesky_mo_num, &
tmp_cc2, cholesky_mo_num, & tmp_cc2, cholesky_mo_num, &
1.d0, tmpB1, nV*block_size) 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(in) :: t2(nO, nO, nV, nV)
double precision, intent(out) :: g_occ(nO, nO) 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, & call dgemm('N','N',nO,nO,nV, &
1d0, t1, size(t1,1), & 1d0, t1, size(t1,1), &
cc_space_f_vo, size(cc_space_f_vo,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 & double precision, allocatable :: X(:)
!$omp shared(nO,nV,g_occ,H_oo, cc_space_v_ovoo,t1) & allocate(X(cholesky_mo_num))
!$omp private(i,j,a,u) & call dgemv('N',cholesky_mo_num,nO*nV,2.d0, &
!$omp default(none) cc_space_v_ov_chol, cholesky_mo_num, &
!$omp do t1, 1, 0.d0, X, 1)
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
!$omp do call dgemv('T',cholesky_mo_num,nO*nO,1.d0, &
do i = 1, nO cc_space_v_oo_chol, cholesky_mo_num, &
do j = 1, nO X, 1, 1.d0, g_occ, 1)
do a = 1, nV deallocate(X)
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) call dgemv('T',nO*nV,nO*nO,-1.d0, &
enddo cc_space_v_ovoo, nO*nV, &
enddo t1, 1, 1.d0, g_occ, 1)
enddo
enddo
!$omp end do
!$omp end parallel
end end