Merge branch 'master' of github.com:scemama/quantum_package

src/Davidson/davidson_parallel.irp.f

@@ -54,6 +54,8 @@ subroutine davidson_process(blockb, blockb2, N, idx, vt, st, bs, istep)
           org_j = sort_idx_(j,1)
           call i_h_j (dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,hij)
           call get_s2(dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,s2) 
+!          call i_h_j (sorted_(1,j,1),sorted_(1,i,1),n_int,hij)
+!          call get_s2(sorted_(1,j,1),sorted_(1,i,1),n_int,s2) 
           if(.not. wrotten(ii)) then
             wrotten(ii) = .true.
             idx(ii) = org_i
@@ -70,11 +72,15 @@ subroutine davidson_process(blockb, blockb2, N, idx, vt, st, bs, istep)
   enddo
   
 
-  if (blockb <= shortcut_(0,2)) then
+  if ( blockb <= shortcut_(0,2) ) then
     sh=blockb
     do sh2=sh, shortcut_(0,2), shortcut_(0,1)
       do i=blockb2+shortcut_(sh2,2),shortcut_(sh2+1,2)-1, istep
         ii += 1
+        if (ii>bs) then
+          print *,  irp_here
+          stop 'ii>bs'
+        endif
         org_i = sort_idx_(i,2)
         do j=shortcut_(sh2,2),shortcut_(sh2+1,2)-1
           if(i == j) cycle
@@ -88,6 +94,8 @@ subroutine davidson_process(blockb, blockb2, N, idx, vt, st, bs, istep)
           if(ext == 4) then
             call i_h_j (dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,hij)
             call get_s2(dav_det(1,1,org_j),dav_det(1,1,org_i),n_int,s2)
+!            call i_h_j (sorted_(1,j,2),sorted_(1,i,2),n_int,hij)
+!            call get_s2(sorted_(1,j,2),sorted_(1,i,2),n_int,s2) 
             if(.not. wrotten(ii)) then
               wrotten(ii) = .true.
               idx(ii) = org_i
@@ -133,10 +141,8 @@ subroutine davidson_collect(N, idx, vt, st , v0t, s0t)
 
   integer :: i, j, k
 
-  !DIR$ IVDEP
   do i=1,N
     k = idx(i)
-    !DIR$ IVDEP
     do j=1,N_states_diag
       v0t(j,k) = v0t(j,k) + vt(j,i)
       s0t(j,k) = s0t(j,k) + st(j,i)
@@ -416,9 +422,7 @@ subroutine davidson_collector(zmq_to_qp_run_socket, zmq_socket_pull , v0, s0, LD
   deallocate(idx,vt,st)
 
   integer :: i,j
-  !DIR$ IVDEP
   do j=1,N_states_diag
-   !DIR$ IVDEP
    do i=1,dav_size
      v0(i,j) = v0t(j,i)
      s0(i,j) = s0t(j,i)

src/Davidson/diagonalization_hs2.irp.f

@@ -191,8 +191,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
   ASSERT (Nint > 0)
   ASSERT (Nint == N_int)
   
-  update_dets = 1
-
   ! Davidson iterations
   ! ===================
   
@@ -213,6 +211,8 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
   enddo
   
   
+  update_dets = 1
+
   do while (.not.converged)
     
     do k=1,N_st_diag

src/Davidson/u0Hu0.irp.f

@@ -339,7 +339,8 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_
         workload += (shortcut_(j+1,2) - shortcut_(j, 2))**2
       end do
     end do
-    istep = 1+ int(workload*target_workload_inv)
+!    istep = 1+ int(workload*target_workload_inv)
+    istep = 1
     do blockb2=0, istep-1
       write(tmp_task,'(3(I9,X),''|'',X)') sh, blockb2, istep
       task = task//tmp_task

src/Utils/LinearAlgebra.irp.f

@@ -152,8 +152,8 @@ subroutine ortho_qr(A,LDA,m,n)
   LWORK=2*WORK(1)
   deallocate(WORK)
   allocate(WORK(LWORK))
-  call  dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO )
+  call  dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO )
-  call dorgqr(m, n, n, A, LDA, tau, WORK, LWORK, INFO)
+  call  dorgqr(m, n, n, A, LDA, tau, WORK, LWORK, INFO)
   deallocate(WORK,jpvt,tau)
 end