Merge pull request #11 from QuantumPackage/dev-stable-tc-scf

Dev stable tc scf

scripts/qp_extract_cipsi_data.py

@@ -23,6 +23,9 @@ def extract_data(output):
 
     reading = False
     for iline, line in enumerate(lines):
+        if line.startswith("Summary at N_det"):
+            reading = False
+
         if not reading and line.startswith(" N_det "):
             n_det = int(re.search(r"N_det\s+=\s+(\d+)", line).group(1))
             reading = True
@@ -52,4 +55,3 @@ data = extract_data(output)
 for item in data:
     print(item)
 
-

src/tc_bi_ortho/h_tc_s2_u0.irp.f

@@ -1,7 +1,6 @@
 
-subroutine get_H_tc_s2_l0_r0(l_0,r_0,N_st,sze,energies, s2)
+subroutine get_H_tc_s2_l0_r0(l_0, r_0, N_st, sze, energies, s2)
-  use bitmasks
+
-  implicit none
   BEGIN_DOC
   ! Computes $e_0 = \langle l_0 | H | r_0\rangle$.
   !
@@ -11,26 +10,34 @@ subroutine get_H_tc_s2_l0_r0(l_0,r_0,N_st,sze,energies, s2)
   !
   ! istart, iend, ishift, istep are used in ZMQ parallelization.
   END_DOC
-  integer, intent(in)              :: N_st,sze
+
-  double precision, intent(in)     :: l_0(sze,N_st), r_0(sze,N_st)
+  use bitmasks
-  double precision, intent(out)    :: energies(N_st), s2(N_st)
+  implicit none
-  logical           :: do_right 
+
-  integer :: istate
+  integer,          intent(in)  :: N_st,sze
+  double precision, intent(in)  :: l_0(sze,N_st), r_0(sze,N_st)
+  double precision, intent(out) :: energies(N_st), s2(N_st)
+  logical                       :: do_right 
+  integer                       :: istate
   double precision, allocatable :: s_0(:,:), v_0(:,:)
-  double precision :: u_dot_v, norm
+  double precision              :: u_dot_v, norm
+
   allocate(s_0(sze,N_st), v_0(sze,N_st))
   do_right = .True.
-  call H_tc_s2_u_0_opt(v_0,s_0,r_0,N_st,sze)
+  call H_tc_s2_u_0_opt(v_0, s_0, r_0, N_st, sze)
+
   do istate = 1, N_st
-   norm = u_dot_v(l_0(1,istate),r_0(1,istate),sze)
+    norm = u_dot_v(l_0(1,istate),r_0(1,istate),sze)
-   energies(istate) = u_dot_v(l_0(1,istate),v_0(1,istate),sze)/norm
+    energies(istate) = u_dot_v(l_0(1,istate),v_0(1,istate),sze)/norm
-   s2(istate) = u_dot_v(l_0(1,istate),s_0(1,istate),sze)/norm
+    s2(istate) = u_dot_v(l_0(1,istate),s_0(1,istate),sze)/norm
   enddo
+
 end
 
-subroutine H_tc_s2_u_0_opt(v_0,s_0,u_0,N_st,sze)
+! ---
-  use bitmasks
+
-  implicit none
+subroutine H_tc_s2_u_0_opt(v_0, s_0, u_0, N_st, sze)
+
   BEGIN_DOC
   ! Computes $v_0 = H | u_0\rangle$.
   !
@@ -38,16 +45,24 @@ subroutine H_tc_s2_u_0_opt(v_0,s_0,u_0,N_st,sze)
   !
   ! istart, iend, ishift, istep are used in ZMQ parallelization.
   END_DOC
-  integer, intent(in)              :: N_st,sze
+
-  double precision, intent(inout)  :: v_0(sze,N_st), u_0(sze,N_st), s_0(sze,N_st)
+  use bitmasks
-  logical           :: do_right 
+  implicit none
+
+  integer,          intent(in)  :: N_st,sze
+  double precision, intent(in)  :: u_0(sze,N_st)
+  double precision, intent(out) :: v_0(sze,N_st), s_0(sze,N_st)
+  logical                       :: do_right 
+
   do_right = .True.
-  call H_tc_s2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze, do_right)
+  call H_tc_s2_u_0_nstates_openmp(v_0, s_0, u_0, N_st, sze, do_right)
+
 end
 
-subroutine H_tc_s2_dagger_u_0_opt(v_0,s_0,u_0,N_st,sze)
+! ---
-  use bitmasks
+
-  implicit none
+subroutine H_tc_s2_dagger_u_0_opt(v_0, s_0, u_0, N_st, sze)
+
   BEGIN_DOC
   ! Computes $v_0 = H | u_0\rangle$.
   !
@@ -55,17 +70,23 @@ subroutine H_tc_s2_dagger_u_0_opt(v_0,s_0,u_0,N_st,sze)
   !
   ! istart, iend, ishift, istep are used in ZMQ parallelization.
   END_DOC
-  integer, intent(in)            :: N_st,sze
-  double precision, intent(inout)  :: v_0(sze,N_st), u_0(sze,N_st), s_0(sze,N_st)
-  logical           :: do_right 
-  do_right = .False.
-  call H_tc_s2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze, do_right)
-end
 
-
-subroutine H_tc_s2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze, do_right)
   use bitmasks
   implicit none
+  integer,          intent(in)  :: N_st,sze
+  double precision, intent(in)  :: u_0(sze,N_st)
+  double precision, intent(out) :: v_0(sze,N_st), s_0(sze,N_st)
+  logical                       :: do_right 
+
+  do_right = .False.
+  call H_tc_s2_u_0_nstates_openmp(v_0, s_0, u_0, N_st, sze, do_right)
+
+end
+
+! ---
+
+subroutine H_tc_s2_u_0_nstates_openmp(v_0, s_0, u_0, N_st, sze, do_right)
+
   BEGIN_DOC
   ! Computes $v_0 = H | u_0\rangle$.
   !
@@ -75,12 +96,18 @@ subroutine H_tc_s2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze, do_right)
   !
   ! if do_right == True then you compute H_TC |Psi>, else H_TC^T |Psi>
   END_DOC
-  integer, intent(in)            :: N_st,sze
+
-  double precision, intent(inout)  :: v_0(sze,N_st), u_0(sze,N_st), s_0(sze,N_st)
+  use bitmasks
-  logical, intent(in)             :: do_right 
+  implicit none
-  integer :: k
+
-  double precision, allocatable  :: u_t(:,:), v_t(:,:), s_t(:,:)
+  integer,          intent(in)  :: N_st,sze
+  logical,          intent(in)  :: do_right 
+  double precision, intent(in)  :: u_0(sze,N_st)
+  double precision, intent(out) :: v_0(sze,N_st), s_0(sze,N_st)
+  integer                       :: k
+  double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:)
   !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
+
   allocate(u_t(N_st,N_det),v_t(N_st,N_det),s_t(N_st,N_det))
   do k=1,N_st
     call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
@@ -119,6 +146,7 @@ subroutine H_tc_s2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze, do_right)
 
 end
 
+! ---
 
 subroutine H_tc_s2_u_0_nstates_openmp_work(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep, do_right)
   use bitmasks