diff --git a/src/tc_bi_ortho/normal_ordered.irp.f b/src/tc_bi_ortho/normal_ordered.irp.f
index 8adc7a63..f9728d05 100644
--- a/src/tc_bi_ortho/normal_ordered.irp.f
+++ b/src/tc_bi_ortho/normal_ordered.irp.f
@@ -1,3 +1,6 @@
+
+! ---
+
BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth, (mo_num, mo_num, mo_num, mo_num)]
BEGIN_DOC
@@ -15,79 +18,97 @@ BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth, (mo_num, mo_num, mo_
integer(bit_kind), allocatable :: key_i_core(:,:)
double precision :: hthree_aba,hthree_aaa,hthree_aab
double precision :: wall0,wall1
-
- PROVIDE N_int
- 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 ...'
+ print*,' Providing normal_two_body_bi_orth ...'
call wall_time(wall0)
- !$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
-
+ if(read_tc_norm_ord) then
- ! opposite spin double excitations : s1 /= s2
- call give_aba_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aba)
+ open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth', action="read")
+ read(11) normal_two_body_bi_orth
+ close(11)
- ! same spin double excitations : s1 == s2
- if(h1
h2
- ! same spin double excitations with same spin contributions
- if(Ne(2).ge.3)then
- call give_aaa_contraction(N_int, h2, h1, p1, p2, Ne, occ, hthree_aaa) ! exchange h1<->h2
- else
- hthree_aaa = 0.d0
- endif
- else
- ! with opposite spin contributions
- call give_aab_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aab)
- if(Ne(2).ge.3)then
- ! same spin double excitations with same spin contributions
- call give_aaa_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aaa)
- else
- hthree_aaa = 0.d0
- endif
- endif
- normal_two_body_bi_orth(p2,h2,p1,h1) = 0.5d0*(hthree_aba + hthree_aab + hthree_aaa)
+ else
+
+ PROVIDE N_int
+
+ 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
+
+ !$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
+ call give_aba_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aba)
+
+ ! same spin double excitations : s1 == s2
+ if(h1h2
+ ! same spin double excitations with same spin contributions
+ if(Ne(2).ge.3)then
+ call give_aaa_contraction(N_int, h2, h1, p1, p2, Ne, occ, hthree_aaa) ! exchange h1<->h2
+ else
+ hthree_aaa = 0.d0
+ endif
+ else
+ ! with opposite spin contributions
+ call give_aab_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aab)
+ if(Ne(2).ge.3)then
+ ! same spin double excitations with same spin contributions
+ call give_aaa_contraction(N_int, h1, h2, p1, p2, Ne, occ, hthree_aaa)
+ else
+ hthree_aaa = 0.d0
+ endif
+ endif
+ normal_two_body_bi_orth(p2,h2,p1,h1) = 0.5d0*(hthree_aba + hthree_aab + hthree_aaa)
+ enddo
enddo
enddo
enddo
- enddo
- !$OMP END DO
- !$OMP END PARALLEL
+ !$OMP END DO
+ !$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)
- print*,'Wall time for normal_two_body_bi_orth ',wall1-wall0
-
- deallocate( occ )
- deallocate( key_i_core )
+ print*,' Wall time for normal_two_body_bi_orth ', wall1-wall0
END_PROVIDER
diff --git a/src/tc_keywords/EZFIO.cfg b/src/tc_keywords/EZFIO.cfg
index 3a26a6eb..de638da9 100644
--- a/src/tc_keywords/EZFIO.cfg
+++ b/src/tc_keywords/EZFIO.cfg
@@ -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
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]
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