9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-07 05:53:37 +01:00

Merge branch 'dev-stable' of https://github.com/QuantumPackage/qp2 into dev-stable
Some checks failed
continuous-integration/drone/push Build is failing

This commit is contained in:
eginer 2023-08-21 17:29:17 +02:00
commit 99d856570a
2 changed files with 106 additions and 111 deletions

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

View File

@ -244,7 +244,7 @@ subroutine compute_r1_space_chol(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
allocate(W_oovo(nO,nO,nV,nO)) allocate(W_oovo(nO,nO,nV,nO))
!$omp parallel & !$omp parallel &
!$omp shared(nO,nV,cc_space_v_vooo,W_oovo) & !$omp shared(nO,nV,cc_space_v_oovo,W_oovo) &
!$omp private(u,a,i,j) & !$omp private(u,a,i,j) &
!$omp default(none) !$omp default(none)
do u = 1, nO do u = 1, nO
@ -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,10 +515,10 @@ 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)
do beta = iblock, min(nV, iblock+block_size-1) do beta = iblock, min(nV, iblock+block_size-1)
do b = 1, nV do b = 1, nV
@ -1071,37 +1072,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