mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-19 04:22:32 +01:00
Semi-stochastic (T) OK
This commit is contained in:
parent
02dc4af9e3
commit
de07f73ed9
@ -10,12 +10,6 @@ subroutine ccsd_par_t_space_v3(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
|||||||
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
||||||
double precision, intent(out) :: energy
|
double precision, intent(out) :: energy
|
||||||
|
|
||||||
double precision, allocatable :: W(:,:,:,:,:,:)
|
|
||||||
double precision, allocatable :: V(:,:,:,:,:,:)
|
|
||||||
double precision, allocatable :: W_abc(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
|
|
||||||
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
|
|
||||||
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
|
|
||||||
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
|
|
||||||
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
|
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
|
||||||
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
|
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
|
||||||
integer :: i,j,k,l,a,b,c,d
|
integer :: i,j,k,l,a,b,c,d
|
||||||
@ -105,32 +99,22 @@ subroutine ccsd_par_t_space_v3(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
|||||||
double precision, external :: ccsd_t_task_aba
|
double precision, external :: ccsd_t_task_aba
|
||||||
double precision, external :: ccsd_t_task_abc
|
double precision, external :: ccsd_t_task_abc
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL PRIVATE(a,b,c,e) DEFAULT(SHARED)
|
||||||
!$OMP PRIVATE(a,b,c,e) &
|
|
||||||
!$OMP PRIVATE(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
|
||||||
!$OMP V_abc, V_cab, V_bca, V_bac, V_cba, V_acb ) &
|
|
||||||
!$OMP DEFAULT(SHARED)
|
|
||||||
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
|
||||||
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
|
||||||
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
|
||||||
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
|
||||||
e = 0d0
|
e = 0d0
|
||||||
!$OMP DO SCHEDULE(dynamic)
|
!$OMP DO SCHEDULE(dynamic)
|
||||||
do a = 1, nV
|
do a = 1, nV
|
||||||
do b = a+1, nV
|
do b = a+1, nV
|
||||||
do c = b+1, nV
|
do c = b+1, nV
|
||||||
e = e + ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
e = e + ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov, &
|
||||||
V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
X_ooov,X_oovv,X_vovv,f_o,f_v)
|
||||||
W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
e = e + ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
e = e + ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov, &
|
||||||
V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
X_ooov,X_oovv,X_vovv,f_o,f_v)
|
||||||
W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
|
||||||
|
e = e + ccsd_t_task_aba(b,a,nO,nV,t1,T_oovv,T_voov, &
|
||||||
|
X_ooov,X_oovv,X_vovv,f_o,f_v)
|
||||||
|
|
||||||
e = e + ccsd_t_task_aba(b,a,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
|
||||||
V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
|
||||||
W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END DO NOWAIT
|
!$OMP END DO NOWAIT
|
||||||
@ -139,9 +123,6 @@ subroutine ccsd_par_t_space_v3(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
|||||||
energy = energy + e
|
energy = energy + e
|
||||||
!$OMP END CRITICAL
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
|
||||||
V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
|
|
||||||
|
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
energy = energy / 3.d0
|
energy = energy / 3.d0
|
||||||
@ -151,8 +132,6 @@ end
|
|||||||
|
|
||||||
|
|
||||||
double precision function ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,&
|
double precision function ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,&
|
||||||
V_abc,V_acb,V_bac,V_bca,V_cab,V_cba, &
|
|
||||||
W_abc,W_acb,W_bac,W_bca,W_cab,W_cba, &
|
|
||||||
X_ooov,X_oovv,X_vovv,f_o,f_v) result(e)
|
X_ooov,X_oovv,X_vovv,f_o,f_v) result(e)
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: nO,nV,a,b,c
|
integer, intent(in) :: nO,nV,a,b,c
|
||||||
@ -160,21 +139,27 @@ double precision function ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,&
|
|||||||
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
||||||
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
||||||
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
||||||
double precision, intent(in) :: W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO)
|
|
||||||
double precision, intent(in) :: W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO)
|
|
||||||
double precision, intent(in) :: V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO)
|
|
||||||
double precision, intent(in) :: V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO)
|
|
||||||
|
|
||||||
double precision :: delta, delta_abc
|
double precision :: delta, delta_abc
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
|
|
||||||
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
double precision, allocatable :: W_abc(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
|
||||||
e = 0.d0
|
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
|
||||||
|
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
|
||||||
|
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
|
||||||
|
|
||||||
|
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
||||||
|
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
||||||
|
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
||||||
|
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
||||||
|
|
||||||
call form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
call form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
||||||
|
|
||||||
call form_v_abc(nO,nV,a,b,c,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
call form_v_abc(nO,nV,a,b,c,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
||||||
|
|
||||||
|
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||||
|
e = 0.d0
|
||||||
|
|
||||||
do k = 1, nO
|
do k = 1, nO
|
||||||
do j = 1, nO
|
do j = 1, nO
|
||||||
do i = 1, nO
|
do i = 1, nO
|
||||||
@ -193,11 +178,12 @@ double precision function ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,&
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
||||||
|
V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
double precision function ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,&
|
double precision function ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,&
|
||||||
V_abc,V_acb,V_bac,V_bca,V_cab,V_cba, &
|
|
||||||
W_abc,W_acb,W_bac,W_bca,W_cab,W_cba, &
|
|
||||||
X_ooov,X_oovv,X_vovv,f_o,f_v) result(e)
|
X_ooov,X_oovv,X_vovv,f_o,f_v) result(e)
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: nO,nV,a,b
|
integer, intent(in) :: nO,nV,a,b
|
||||||
@ -205,21 +191,27 @@ double precision function ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,&
|
|||||||
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
|
||||||
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
|
||||||
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
|
||||||
double precision, intent(in) :: W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO)
|
|
||||||
double precision, intent(in) :: W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO)
|
|
||||||
double precision, intent(in) :: V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO)
|
|
||||||
double precision, intent(in) :: V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO)
|
|
||||||
|
|
||||||
double precision :: delta, delta_abc
|
double precision :: delta, delta_abc
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
|
|
||||||
delta_abc = f_v(a) + f_v(b) + f_v(a)
|
double precision, allocatable :: W_abc(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
|
||||||
e = 0.d0
|
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
|
||||||
|
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
|
||||||
|
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
|
||||||
|
|
||||||
|
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
||||||
|
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
||||||
|
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
||||||
|
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
||||||
|
|
||||||
call form_w_abc(nO,nV,a,b,a,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
call form_w_abc(nO,nV,a,b,a,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
||||||
|
|
||||||
call form_v_abc(nO,nV,a,b,a,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
call form_v_abc(nO,nV,a,b,a,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
|
||||||
|
|
||||||
|
delta_abc = f_v(a) + f_v(b) + f_v(a)
|
||||||
|
e = 0.d0
|
||||||
|
|
||||||
do k = 1, nO
|
do k = 1, nO
|
||||||
do j = 1, nO
|
do j = 1, nO
|
||||||
do i = 1, nO
|
do i = 1, nO
|
||||||
@ -233,6 +225,9 @@ double precision function ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,&
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
||||||
|
V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
subroutine form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
|
||||||
|
|||||||
@ -1,5 +1,4 @@
|
|||||||
! Main
|
! Main
|
||||||
|
|
||||||
subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
@ -10,12 +9,6 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
|
|||||||
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
||||||
double precision, intent(out) :: energy
|
double precision, intent(out) :: energy
|
||||||
|
|
||||||
double precision, allocatable :: W(:,:,:,:,:,:)
|
|
||||||
double precision, allocatable :: V(:,:,:,:,:,:)
|
|
||||||
double precision, allocatable :: W_abc(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
|
|
||||||
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
|
|
||||||
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
|
|
||||||
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
|
|
||||||
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
|
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
|
||||||
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
|
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
|
||||||
integer :: i,j,k,l,a,b,c,d
|
integer :: i,j,k,l,a,b,c,d
|
||||||
@ -104,33 +97,32 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
|
|||||||
|
|
||||||
double precision, external :: ccsd_t_task_aba
|
double precision, external :: ccsd_t_task_aba
|
||||||
double precision, external :: ccsd_t_task_abc
|
double precision, external :: ccsd_t_task_abc
|
||||||
|
! logical, external :: omp_test_lock
|
||||||
|
|
||||||
double precision, allocatable :: memo(:), Pabc(:), waccu(:)
|
double precision, allocatable :: memo(:), Pabc(:), waccu(:)
|
||||||
logical , allocatable :: computed(:)
|
integer*8, allocatable :: sampled(:)
|
||||||
|
! integer(omp_lock_kind), allocatable :: lock(:)
|
||||||
integer*2 , allocatable :: abc(:,:)
|
integer*2 , allocatable :: abc(:,:)
|
||||||
integer*8 :: Nabc, i8
|
integer*8 :: Nabc, i8
|
||||||
integer*8, allocatable :: iorder(:)
|
integer*8, allocatable :: iorder(:)
|
||||||
double precision :: eocc
|
double precision :: eocc
|
||||||
double precision :: Pabc_norm, sum_w
|
double precision :: norm
|
||||||
|
integer :: kiter, isample
|
||||||
|
|
||||||
|
|
||||||
! Prepare table of triplets (a,b,c)
|
! Prepare table of triplets (a,b,c)
|
||||||
|
|
||||||
Nabc = (int(nV,8) * int(nV+1,8) * int(nV+2,8))/6_8 - nV
|
Nabc = (int(nV,8) * int(nV+1,8) * int(nV+2,8))/6_8 - nV
|
||||||
allocate (memo(Nabc), computed(Nabc), Pabc(Nabc), waccu(0:Nabc))
|
allocate (memo(Nabc), sampled(Nabc), Pabc(Nabc), waccu(Nabc))
|
||||||
allocate (abc(4,Nabc), iorder(Nabc))
|
allocate (abc(4,Nabc), iorder(Nabc)) !, lock(Nabc))
|
||||||
|
|
||||||
! eocc = 3.d0/dble(nO) * sum(f_o(1:nO))
|
! eocc = 3.d0/dble(nO) * sum(f_o(1:nO))
|
||||||
memo(:) = 0.d0
|
|
||||||
computed(:) = .False.
|
|
||||||
Nabc = 0_8
|
Nabc = 0_8
|
||||||
do a = 1, nV
|
do a = 1, nV
|
||||||
do b = a+1, nV
|
do b = a+1, nV
|
||||||
do c = b+1, nV
|
do c = b+1, nV
|
||||||
Nabc = Nabc + 1_8
|
Nabc = Nabc + 1_8
|
||||||
! Pabc(Nabc) = 1.d0/((f_v(a) + f_v(b) + f_v(c))*(f_v(a)*f_v(b)*f_v(c))**(1.d0/2.d0))
|
Pabc(Nabc) = -1.d0/(f_v(a) + f_v(b) + f_v(c))
|
||||||
! Pabc(Nabc) = 1.d0/((f_v(a) + f_v(b) + f_v(c))**2)
|
|
||||||
Pabc(Nabc) = 1.d0/(f_v(a) + f_v(b) + f_v(c))
|
|
||||||
abc(1,Nabc) = a
|
abc(1,Nabc) = a
|
||||||
abc(2,Nabc) = b
|
abc(2,Nabc) = b
|
||||||
abc(3,Nabc) = c
|
abc(3,Nabc) = c
|
||||||
@ -140,17 +132,13 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
|
|||||||
abc(1,Nabc) = a
|
abc(1,Nabc) = a
|
||||||
abc(2,Nabc) = b
|
abc(2,Nabc) = b
|
||||||
abc(3,Nabc) = a
|
abc(3,Nabc) = a
|
||||||
! Pabc(Nabc) = 1.d0/((f_v(a) + f_v(b) + f_v(a))*(f_v(a)*f_v(b)*f_v(a))**(1.d0/2.d0))
|
Pabc(Nabc) = -1.d0/(2.d0*f_v(a) + f_v(b))
|
||||||
! Pabc(Nabc) = 1.d0/((f_v(a) + f_v(b) + f_v(a))**2)
|
|
||||||
Pabc(Nabc) = 1.d0/(2.d0*f_v(a) + f_v(b))
|
|
||||||
|
|
||||||
Nabc = Nabc + 1_8
|
Nabc = Nabc + 1_8
|
||||||
abc(1,Nabc) = b
|
abc(1,Nabc) = b
|
||||||
abc(2,Nabc) = a
|
abc(2,Nabc) = a
|
||||||
abc(3,Nabc) = b
|
abc(3,Nabc) = b
|
||||||
! Pabc(Nabc) = 1.d0/((f_v(a) + f_v(b) + f_v(b))*(f_v(b)*f_v(a)*f_v(b))**(1.d0/2.d0))
|
Pabc(Nabc) = -1.d0/(f_v(a) + 2.d0*f_v(b))
|
||||||
! Pabc(Nabc) = 1.d0/((f_v(a) + f_v(b) + f_v(b))**2)
|
|
||||||
Pabc(Nabc) = 1.d0/(f_v(a) + 2.d0*f_v(b))
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -162,13 +150,13 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
|
|||||||
call dsort_big(Pabc, iorder, Nabc)
|
call dsort_big(Pabc, iorder, Nabc)
|
||||||
|
|
||||||
! Normalize
|
! Normalize
|
||||||
Pabc_norm = 0.d0
|
norm = 0.d0
|
||||||
do i8=Nabc,1,-1
|
do i8=Nabc,1,-1
|
||||||
Pabc_norm = Pabc_norm + Pabc(i8)
|
norm = norm + Pabc(i8)
|
||||||
enddo
|
enddo
|
||||||
Pabc_norm = 1.d0/Pabc_norm
|
norm = 1.d0/norm
|
||||||
do i8=Nabc,1,-1
|
do i8=1,Nabc
|
||||||
Pabc(i8) = Pabc(i8) * Pabc_norm
|
Pabc(i8) = Pabc(i8) * norm
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call i8set_order_big(abc, iorder, Nabc)
|
call i8set_order_big(abc, iorder, Nabc)
|
||||||
@ -176,145 +164,191 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
|
|||||||
|
|
||||||
! Cumulative distribution for sampling
|
! Cumulative distribution for sampling
|
||||||
waccu(Nabc) = 0.d0
|
waccu(Nabc) = 0.d0
|
||||||
sum_w = 0.d0
|
|
||||||
do i8=Nabc-1,1,-1
|
do i8=Nabc-1,1,-1
|
||||||
waccu(i8) = waccu(i8+1) - Pabc(i8)
|
waccu(i8) = waccu(i8+1) - Pabc(i8+1)
|
||||||
enddo
|
enddo
|
||||||
waccu(:) = waccu(:) + 1.d0
|
waccu(:) = waccu(:) + 1.d0
|
||||||
waccu(0) = 0.d0
|
|
||||||
|
|
||||||
Pabc(:) = 1.d0/Pabc(:) * (1.d0/3.d0)
|
logical :: converged, do_comp
|
||||||
|
double precision :: eta, variance, error, sample
|
||||||
|
double precision :: t00, t01
|
||||||
|
integer*8 :: ieta, Ncomputed
|
||||||
|
integer*8, external :: binary_search
|
||||||
|
|
||||||
logical :: converged
|
integer :: nbuckets
|
||||||
double precision :: ET, ET2, eta, variance, average, error, sample
|
nbuckets = 100
|
||||||
integer*8 :: isample, ieta, Ncomputed
|
|
||||||
integer*8, external :: find_sample
|
|
||||||
|
|
||||||
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
double precision, allocatable :: wsum(:)
|
||||||
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
allocate(wsum(nbuckets))
|
||||||
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
|
||||||
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
|
||||||
|
|
||||||
converged = .False.
|
converged = .False.
|
||||||
ET = 0.d0
|
|
||||||
ET2 = 0.d0
|
|
||||||
Ncomputed = 0_8
|
Ncomputed = 0_8
|
||||||
isample = 0_8
|
|
||||||
|
|
||||||
average = 0.d0
|
energy = 0.d0
|
||||||
variance = 0.d0
|
variance = 0.d0
|
||||||
double precision :: t00, t01
|
memo(:) = 0.d0
|
||||||
call wall_time(t00)
|
sampled(:) = -1_8
|
||||||
! do ieta=1,Nabc
|
|
||||||
do while (.not.converged)
|
|
||||||
call random_number(eta)
|
|
||||||
! eta = eta/dble(1000)
|
|
||||||
! do k=0,1000-1
|
|
||||||
! ieta = find_sample(eta+dble(k)/dble(1000),waccu,Nabc)
|
|
||||||
ieta = find_sample(eta,waccu,Nabc)
|
|
||||||
isample = isample+1_8
|
|
||||||
|
|
||||||
if (.not.computed(ieta)) then
|
integer*8 :: ileft, iright, imin
|
||||||
|
ileft = 1_8
|
||||||
|
iright = Nabc
|
||||||
|
integer*8, allocatable :: bounds(:,:)
|
||||||
|
|
||||||
|
allocate (bounds(2,nbuckets))
|
||||||
|
do isample=1,nbuckets
|
||||||
|
eta = 1.d0/dble(nbuckets) * dble(isample)
|
||||||
|
ieta = binary_search(waccu,eta,Nabc,ileft,iright)
|
||||||
|
bounds(1,isample) = ileft
|
||||||
|
bounds(2,isample) = ieta
|
||||||
|
ileft = ieta+1
|
||||||
|
wsum(isample) = sum( Pabc(bounds(1,isample):bounds(2,isample) ) )
|
||||||
|
enddo
|
||||||
|
|
||||||
|
Pabc(:) = 1.d0/Pabc(:)
|
||||||
|
|
||||||
|
call wall_time(t00)
|
||||||
|
imin = 1_8
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP PRIVATE(ieta,eta,a,b,c,kiter,isample) &
|
||||||
|
!$OMP DEFAULT(SHARED)
|
||||||
|
|
||||||
|
do kiter=1,Nabc
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
do while ((imin <= Nabc).and.(sampled(imin)>-1_8))
|
||||||
|
imin = imin+1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Deterministic part
|
||||||
|
if (imin < Nabc) then
|
||||||
|
ieta=imin
|
||||||
|
sampled(ieta) = 0_8
|
||||||
a = abc(1,ieta)
|
a = abc(1,ieta)
|
||||||
b = abc(2,ieta)
|
b = abc(2,ieta)
|
||||||
c = abc(3,ieta)
|
c = abc(3,ieta)
|
||||||
if (a/=c) then
|
|
||||||
memo(ieta) = ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
|
||||||
V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
|
||||||
W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
|
||||||
else
|
|
||||||
memo(ieta) = ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
|
||||||
V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
|
||||||
W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
|
||||||
endif
|
|
||||||
computed(ieta) = .True.
|
|
||||||
Ncomputed += 1_8
|
Ncomputed += 1_8
|
||||||
call wall_time(t01)
|
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(a,b,c,ieta)
|
||||||
if (t01-t00 > 1.d0) then
|
if (a/=c) then
|
||||||
t00 = t01
|
memo(ieta) = ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov, &
|
||||||
print *, average, dsqrt(variance/dble(isample)), real(Ncomputed)/real(Nabc), real(isample)/real(Nabc)
|
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||||
|
else
|
||||||
|
memo(ieta) = ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov, &
|
||||||
|
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||||
endif
|
endif
|
||||||
! print *, memo(ieta), Pabc(ieta), memo(ieta) * Pabc(ieta)
|
!$OMP END TASK
|
||||||
endif
|
endif
|
||||||
sample = memo(ieta) * Pabc(ieta)
|
|
||||||
ET = ET + sample
|
|
||||||
ET2 = ET2 + sample*sample
|
|
||||||
average = ET/dble(isample)
|
|
||||||
variance = ET2/dble(isample) - average*average
|
|
||||||
converged = (Ncomputed >= (Nabc*90_8)/100_8) .or. (isample>=1000*Nabc)
|
|
||||||
! enddo
|
|
||||||
enddo
|
|
||||||
print *, average, dsqrt(variance/dble(isample)), real(Ncomputed)/real(Nabc), real(isample)/real(Nabc)
|
|
||||||
energy = average
|
|
||||||
|
|
||||||
! !$OMP PARALLEL &
|
! Stochastic part
|
||||||
! !$OMP PRIVATE(a,b,c,e) &
|
call random_number(eta)
|
||||||
! !$OMP PRIVATE(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
do isample=1,nbuckets
|
||||||
! !$OMP V_abc, V_cab, V_bca, V_bac, V_cba, V_acb ) &
|
if (imin >= bounds(2,isample)) then
|
||||||
! !$OMP DEFAULT(SHARED)
|
cycle
|
||||||
! allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
|
endif
|
||||||
! W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
|
ieta = binary_search(waccu,(eta + dble(isample-1))/dble(nbuckets),Nabc)
|
||||||
! V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
|
|
||||||
! V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
|
if (sampled(ieta) == -1_8) then
|
||||||
! e = 0d0
|
sampled(ieta) = 0_8
|
||||||
! !$OMP DO SCHEDULE(dynamic)
|
a = abc(1,ieta)
|
||||||
! do a = 1, nV
|
b = abc(2,ieta)
|
||||||
! do b = a+1, nV
|
c = abc(3,ieta)
|
||||||
! do c = b+1, nV
|
Ncomputed += 1_8
|
||||||
! e = e + ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(a,b,c,ieta)
|
||||||
! V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
if (a/=c) then
|
||||||
! W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
memo(ieta) = ccsd_t_task_abc(a,b,c,nO,nV,t1,T_oovv,T_voov, &
|
||||||
! enddo
|
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||||
! enddo
|
else
|
||||||
!
|
memo(ieta) = ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov, &
|
||||||
! do b = 1, nV
|
X_ooov,X_oovv,X_vovv,f_o,f_v) / 3.d0
|
||||||
! if (b == a) cycle
|
endif
|
||||||
! e = e + ccsd_t_task_aba(a,b,nO,nV,t1,T_oovv,T_voov,V_abc, &
|
!$OMP END TASK
|
||||||
! V_acb,V_bac,V_bca,V_cab,V_cba,W_abc,W_acb,W_bac, &
|
endif
|
||||||
! W_bca,W_cab,W_cba,X_ooov,X_oovv,X_vovv,f_o,f_v)
|
sampled(ieta) = sampled(ieta)+1_8
|
||||||
! enddo
|
|
||||||
! enddo
|
enddo
|
||||||
! !$OMP END DO NOWAIT
|
|
||||||
!
|
call wall_time(t01)
|
||||||
! !$OMP CRITICAL
|
if (t01-t00 > 1.0d0) then
|
||||||
! energy = energy + e
|
t00 = t01
|
||||||
! !$OMP END CRITICAL
|
|
||||||
!
|
!$OMP TASKWAIT
|
||||||
! deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
|
|
||||||
! V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
|
double precision :: ET, ET2
|
||||||
!
|
double precision :: energy_stoch, energy_det
|
||||||
! !$OMP END PARALLEL
|
double precision :: scale
|
||||||
|
double precision :: w
|
||||||
|
double precision :: tmp
|
||||||
|
energy_stoch = 0.d0
|
||||||
|
energy_det = 0.d0
|
||||||
|
norm = 0.d0
|
||||||
|
scale = 1.d0
|
||||||
|
ET = 0.d0
|
||||||
|
ET2 = 0.d0
|
||||||
|
|
||||||
|
|
||||||
|
do isample=1,nbuckets
|
||||||
|
if (imin >= bounds(2,isample)) then
|
||||||
|
energy_det = energy_det + sum(memo(bounds(1,isample):bounds(2,isample)))
|
||||||
|
scale = scale - wsum(isample)
|
||||||
|
else
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do ieta=bounds(1,isample), Nabc
|
||||||
|
w = dble(max(sampled(ieta),0_8))
|
||||||
|
tmp = w * memo(ieta) * Pabc(ieta)
|
||||||
|
ET = ET + tmp
|
||||||
|
ET2 = ET2 + tmp * memo(ieta) * Pabc(ieta)
|
||||||
|
norm = norm + w
|
||||||
|
enddo
|
||||||
|
norm = norm/scale
|
||||||
|
if (norm > 0.d0) then
|
||||||
|
energy_stoch = ET / norm
|
||||||
|
variance = ET2 / norm - energy_stoch*energy_stoch
|
||||||
|
endif
|
||||||
|
|
||||||
|
energy = energy_det + energy_stoch
|
||||||
|
|
||||||
|
print *, real(energy), ' +/- ', real(sqrt(variance/(norm-1.d0))), isample, real(Ncomputed)/real(Nabc)
|
||||||
|
endif
|
||||||
|
!$OMP END MASTER
|
||||||
|
if (imin >= Nabc) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
deallocate(X_vovv,X_ooov,T_voov,T_oovv)
|
deallocate(X_vovv,X_ooov,T_voov,T_oovv)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
integer*8 function find_sample(v, w, n)
|
|
||||||
|
integer*8 function binary_search(arr, key, size)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Finds sample v in weights w
|
! Searches the key in array arr(1:size) between l_in and r_in, and returns its index
|
||||||
END_DOC
|
END_DOC
|
||||||
integer*8, intent(in) :: n
|
integer*8 :: size, i, j, mid, l_in, r_in
|
||||||
double precision, intent(in) :: v, w(0:n)
|
double precision, dimension(size) :: arr(1:size)
|
||||||
integer*8 :: i,l,r
|
double precision :: key
|
||||||
|
|
||||||
l=0
|
i = 1_8
|
||||||
r=n
|
j = size
|
||||||
|
|
||||||
do while(r-l > 1)
|
do while (j >= i)
|
||||||
i = shiftr(r+l,1)
|
mid = i + (j - i) / 2
|
||||||
if(w(i) < v) then
|
if (arr(mid) >= key) then
|
||||||
l = i
|
if (mid > 1 .and. arr(mid - 1) < key) then
|
||||||
|
binary_search = mid
|
||||||
|
return
|
||||||
|
end if
|
||||||
|
j = mid - 1
|
||||||
|
else if (arr(mid) < key) then
|
||||||
|
i = mid + 1
|
||||||
else
|
else
|
||||||
r = i
|
binary_search = mid + 1
|
||||||
|
return
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
i = r
|
binary_search = i
|
||||||
do r=i+1,n
|
end function binary_search
|
||||||
if (w(r) /= w(i)) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
find_sample = r-1
|
|
||||||
end function
|
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user