mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-21 11:03:29 +01:00
IO TC normal ordering added
This commit is contained in:
Abdallah Ammar
parent
42c4d6ad56
commit
86b4845412
@ -1,3 +1,6 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth, (mo_num, mo_num, mo_num, mo_num)]
|
BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth, (mo_num, mo_num, mo_num, mo_num)]
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -16,78 +19,96 @@ BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth, (mo_num, mo_num, mo_
|
|||||||
double precision :: hthree_aba,hthree_aaa,hthree_aab
|
double precision :: hthree_aba,hthree_aaa,hthree_aab
|
||||||
double precision :: wall0,wall1
|
double precision :: wall0,wall1
|
||||||
|
|
||||||
PROVIDE N_int
|
print*,' Providing normal_two_body_bi_orth ...'
|
||||||
|
|
||||||
allocate( occ(N_int*bit_kind_size,2) )
|
|
||||||
allocate( key_i_core(N_int,2) )
|
|
||||||
|
|
||||||
if(core_tc_op) then
|
|
||||||
do i = 1, N_int
|
|
||||||
key_i_core(i,1) = xor(ref_bitmask(i,1),core_bitmask(i,1))
|
|
||||||
key_i_core(i,2) = xor(ref_bitmask(i,2),core_bitmask(i,2))
|
|
||||||
enddo
|
|
||||||
call bitstring_to_list_ab(key_i_core,occ,Ne,N_int)
|
|
||||||
else
|
|
||||||
call bitstring_to_list_ab(ref_bitmask,occ,Ne,N_int)
|
|
||||||
endif
|
|
||||||
|
|
||||||
normal_two_body_bi_orth = 0.d0
|
|
||||||
print*,'Providing normal_two_body_bi_orth ...'
|
|
||||||
call wall_time(wall0)
|
call wall_time(wall0)
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
if(read_tc_norm_ord) then
|
||||||
!$OMP DEFAULT (NONE) &
|
|
||||||
!$OMP PRIVATE (hh1, h1, hh2, h2, pp1, p1, pp2, p2, hthree_aba, hthree_aab, hthree_aaa) &
|
open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth', action="read")
|
||||||
!$OMP SHARED (N_int, n_act_orb, list_act, Ne, occ, normal_two_body_bi_orth)
|
read(11) normal_two_body_bi_orth
|
||||||
!$OMP DO SCHEDULE (static)
|
close(11)
|
||||||
do hh1 = 1, n_act_orb
|
|
||||||
h1 = list_act(hh1)
|
else
|
||||||
do pp1 = 1, n_act_orb
|
|
||||||
p1 = list_act(pp1)
|
PROVIDE N_int
|
||||||
do hh2 = 1, n_act_orb
|
|
||||||
h2 = list_act(hh2)
|
allocate( occ(N_int*bit_kind_size,2) )
|
||||||
do pp2 = 1, n_act_orb
|
allocate( key_i_core(N_int,2) )
|
||||||
p2 = list_act(pp2)
|
|
||||||
! all contributions from the 3-e terms to the double excitations
|
if(core_tc_op) then
|
||||||
! s1:(h1-->p1), s2:(h2-->p2) from the HF reference determinant
|
do i = 1, N_int
|
||||||
|
key_i_core(i,1) = xor(ref_bitmask(i,1),core_bitmask(i,1))
|
||||||
|
key_i_core(i,2) = xor(ref_bitmask(i,2),core_bitmask(i,2))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(key_i_core,occ,Ne,N_int)
|
||||||
|
else
|
||||||
|
call bitstring_to_list_ab(ref_bitmask,occ,Ne,N_int)
|
||||||
|
endif
|
||||||
|
|
||||||
|
normal_two_body_bi_orth = 0.d0
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE (hh1, h1, hh2, h2, pp1, p1, pp2, p2, hthree_aba, hthree_aab, hthree_aaa) &
|
||||||
|
!$OMP SHARED (N_int, n_act_orb, list_act, Ne, occ, normal_two_body_bi_orth)
|
||||||
|
!$OMP DO SCHEDULE (static)
|
||||||
|
do hh1 = 1, n_act_orb
|
||||||
|
h1 = list_act(hh1)
|
||||||
|
do pp1 = 1, n_act_orb
|
||||||
|
p1 = list_act(pp1)
|
||||||
|
do hh2 = 1, n_act_orb
|
||||||
|
h2 = list_act(hh2)
|
||||||
|
do pp2 = 1, n_act_orb
|
||||||
|
p2 = list_act(pp2)
|
||||||
|
! all contributions from the 3-e terms to the double excitations
|
||||||
|
! s1:(h1-->p1), s2:(h2-->p2) from the HF reference determinant
|
||||||
|
|
||||||
|
|
||||||
! opposite spin double excitations : s1 /= s2
|
! opposite spin double excitations : s1 /= s2
|
||||||
call give_aba_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aba)
|
call give_aba_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aba)
|
||||||
|
|
||||||
! same spin double excitations : s1 == s2
|
! same spin double excitations : s1 == s2
|
||||||
if(h1<h2.and.p1.gt.p2)then
|
if(h1<h2.and.p1.gt.p2)then
|
||||||
! with opposite spin contributions
|
! with opposite spin contributions
|
||||||
call give_aab_contraction(N_int, h2, h1, p1, p2, Ne, occ, hthree_aab) ! exchange h1<->h2
|
call give_aab_contraction(N_int, h2, h1, p1, p2, Ne, occ, hthree_aab) ! exchange h1<->h2
|
||||||
! same spin double excitations with same spin contributions
|
! same spin double excitations with same spin contributions
|
||||||
if(Ne(2).ge.3)then
|
if(Ne(2).ge.3)then
|
||||||
call give_aaa_contraction(N_int, h2, h1, p1, p2, Ne, occ, hthree_aaa) ! exchange h1<->h2
|
call give_aaa_contraction(N_int, h2, h1, p1, p2, Ne, occ, hthree_aaa) ! exchange h1<->h2
|
||||||
else
|
else
|
||||||
hthree_aaa = 0.d0
|
hthree_aaa = 0.d0
|
||||||
endif
|
endif
|
||||||
else
|
else
|
||||||
! with opposite spin contributions
|
! with opposite spin contributions
|
||||||
call give_aab_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aab)
|
call give_aab_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aab)
|
||||||
if(Ne(2).ge.3)then
|
if(Ne(2).ge.3)then
|
||||||
! same spin double excitations with same spin contributions
|
! same spin double excitations with same spin contributions
|
||||||
call give_aaa_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aaa)
|
call give_aaa_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aaa)
|
||||||
else
|
else
|
||||||
hthree_aaa = 0.d0
|
hthree_aaa = 0.d0
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
normal_two_body_bi_orth(p2,h2,p1,h1) = 0.5d0*(hthree_aba + hthree_aab + hthree_aaa)
|
normal_two_body_bi_orth(p2,h2,p1,h1) = 0.5d0*(hthree_aba + hthree_aab + hthree_aaa)
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
!$OMP END DO
|
||||||
!$OMP END DO
|
!$OMP END PARALLEL
|
||||||
!$OMP END PARALLEL
|
|
||||||
|
deallocate( occ )
|
||||||
|
deallocate( key_i_core )
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(write_tc_norm_ord.and.mpi_master) then
|
||||||
|
open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth', action="write")
|
||||||
|
call ezfio_set_work_empty(.False.)
|
||||||
|
write(11) normal_two_body_bi_orth
|
||||||
|
close(11)
|
||||||
|
call ezfio_set_tc_keywords_io_tc_integ('Read')
|
||||||
|
endif
|
||||||
|
|
||||||
call wall_time(wall1)
|
call wall_time(wall1)
|
||||||
print*,'Wall time for normal_two_body_bi_orth ',wall1-wall0
|
print*,' Wall time for normal_two_body_bi_orth ', wall1-wall0
|
||||||
|
|
||||||
deallocate( occ )
|
|
||||||
deallocate( key_i_core )
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|||||||
@ -202,6 +202,12 @@ doc: Read/Write integrals int2_grad1_u12_ao, tc_grad_square_ao and tc_grad_and_l
|
|||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: None
|
default: None
|
||||||
|
|
||||||
|
[io_tc_norm_ord]
|
||||||
|
type: Disk_access
|
||||||
|
doc: Read/Write normal_two_body_bi_orth from/to disk [ Write | Read | None ]
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: None
|
||||||
|
|
||||||
[debug_tc_pt2]
|
[debug_tc_pt2]
|
||||||
type: integer
|
type: integer
|
||||||
doc: If :: 1 then you compute the TC-PT2 the old way, :: 2 then you check with the new version but without three-body
|
doc: If :: 1 then you compute the TC-PT2 the old way, :: 2 then you check with the new version but without three-body
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user