Merge branch 'dev' of github.com:QuantumPackage/qp2 into dev

src/davidson/EZFIO.cfg

@@ -34,6 +34,12 @@ doc: If |true|, a memory-mapped file may be used to store the W and S2 vectors i
 default: True
 interface: ezfio,provider,ocaml
 
+[csf_based]
+type: logical
+doc: If |true|, use the CSF-based algorithm
+default: False
+interface: ezfio,provider,ocaml
+
 [distributed_davidson]
 type: logical
 doc: If |true|, use the distributed algorithm
@@ -52,3 +58,8 @@ doc: Maximum number of determinants where |H| is fully diagonalized
 interface: ezfio,provider,ocaml
 default: 1000
 
+[without_diagonal]
+type: logical
+doc: If |true|, don't use denominator
+default: False
+interface: ezfio,provider,ocaml

src/davidson/diagonalization_hcsf_dressed.irp.f

@@ -447,14 +447,24 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
       ! Compute residual vector and davidson step
       ! -----------------------------------------
 
-      !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k)
+      if (without_diagonal) then
-      do k=1,N_st_diag
+        !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k)
-        do i=1,sze
+        do k=1,N_st_diag
-           U(i,k) =  (lambda(k) * U(i,k) - W(i,k) )      &
+          do i=1,sze
-              /max(H_jj(i) - lambda (k),1.d-2)
+             U(i,k) =  (lambda(k) * U(i,k) - W(i,k) )      &
+                /max(H_jj(i) - lambda (k),1.d-2)
+          enddo
         enddo
-      enddo
+        !$OMP END PARALLEL DO
-      !$OMP END PARALLEL DO
+      else
+        !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k)
+        do k=1,N_st_diag
+          do i=1,sze
+             U(i,k) =  (lambda(k) * U(i,k) - W(i,k) )  
+          enddo
+        enddo
+        !$OMP END PARALLEL DO
+      endif
 
       do k=1,N_st
         residual_norm(k) = u_dot_u(U(1,k),sze)

src/davidson/diagonalize_ci.irp.f

@@ -56,9 +56,7 @@ END_PROVIDER
      enddo
    enddo
 
-!   Deactivated temporarily: bug in N_csf
+   do_csf = s2_eig .and. only_expected_s2 .and. csf_based
-!   do_csf = s2_eig .and. only_expected_s2 .and. (expected_s2 == 0.d0)
-   do_csf = .False.
 
    if (diag_algorithm == "Davidson") then
 

src/davidson/u0_h_u0.irp.f

@@ -46,7 +46,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
   do i=1,N_st
     norm = u_dot_u(u_0(1,i),n)
     if (norm /= 0.d0) then
-      e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)
+      e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n) / dsqrt(norm)
     else
       e_0(i) = 0.d0
     endif

src/davidson/u0_hs2_u0.irp.f

@@ -75,8 +75,8 @@ subroutine u_0_HS2_u_0(e_0,s_0,u_0,n,keys_tmp,Nint,N_st,sze)
   do i=1,N_st
     norm = u_dot_u(u_0(1,i),n)
     if (norm /= 0.d0) then
-      e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)
+      e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/norm
-      s_0(i) = u_dot_v(s_vec(1,i),u_0(1,i),n)
+      s_0(i) = u_dot_v(s_vec(1,i),u_0(1,i),n)/norm
     else
       e_0(i) = 0.d0
       s_0(i) = 0.d0

src/mo_one_e_ints/mo_overlap.irp.f

@@ -1,4 +1,3 @@
-
 BEGIN_PROVIDER [ double precision, mo_overlap,(mo_num,mo_num) ]
   implicit none
   BEGIN_DOC

src/mo_two_e_ints/map_integrals.irp.f

@@ -296,6 +296,12 @@ end
  ! If true, the excitation is banned in the selection. Useful with local MOs.
  END_DOC
  banned_excitation = .False.
+ use_banned_excitation = .False.
+
+ ! DEACTIVATED
+ return
+ ! DEACTIVATED
+
  integer :: i,j, icount
  integer(key_kind)              :: idx
  double precision :: tmp

src/zmq/utils.irp.f

@@ -127,9 +127,9 @@ function zmq_port(ishift)
   END_DOC
   integer, intent(in)            :: ishift
   character*(8)                  :: zmq_port
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(zmq_port,'(I8)') zmq_port_start+ishift
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
   zmq_port = adjustl(trim(zmq_port))
 end
 
@@ -520,9 +520,9 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
   zmq_socket_pull      = new_zmq_pull_socket ()
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(name,'(A,I8.8)') trim(name_in)//'.', icount
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
   sze = len(trim(name))
   zmq_state = trim(name)
   call lowercase(name,sze)
@@ -586,9 +586,9 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,name_in)
   integer, save                  :: icount=0
 
   icount = icount+1
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(name,'(A,I8.8)') trim(name_in)//'.', icount
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
   sze = len(trim(name))
   call lowercase(name,sze)
   if (name /= zmq_state) then
@@ -710,9 +710,9 @@ integer function disconnect_from_taskserver_state(zmq_to_qp_run_socket, worker_i
 
   disconnect_from_taskserver_state = -1
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,*) 'disconnect '//trim(state), worker_id
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
   sze = min(510,len(trim(message)))
   rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
@@ -789,9 +789,9 @@ integer function zmq_abort(zmq_to_qp_run_socket)
   character*(512)                :: message
   zmq_abort = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,*) 'abort '
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
 
   sze = len(trim(message))
@@ -833,9 +833,9 @@ integer function task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_i
 
   task_done_to_taskserver = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,*) 'task_done '//trim(zmq_state), worker_id, task_id
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
   sze = len(trim(message))
   rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
@@ -868,11 +868,11 @@ integer function tasks_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_
 
   tasks_done_to_taskserver = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   allocate(character(LEN=64+n_tasks*12) :: message)
   write(fmt,*) '(A,X,A,I10,X,', n_tasks, '(I11,1X))'
   write(message,*) 'task_done '//trim(zmq_state), worker_id, (task_id(k), k=1,n_tasks)
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
   sze = len(trim(message))
   rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
@@ -914,9 +914,9 @@ integer function get_task_from_taskserver(zmq_to_qp_run_socket,worker_id,task_id
 
   get_task_from_taskserver = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,*) 'get_task '//trim(zmq_state), worker_id
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
   sze = len(trim(message))
   rc = f77_zmq_send(zmq_to_qp_run_socket, message, sze, 0)
@@ -977,9 +977,9 @@ integer function get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id,task_i
 
   get_tasks_from_taskserver = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,'(A,A,X,I10,I10)') 'get_tasks ', trim(zmq_state), worker_id, n_tasks
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
   sze = len(trim(message))
   rc = f77_zmq_send(zmq_to_qp_run_socket, message, sze, 0)
@@ -1079,9 +1079,9 @@ integer function zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,mo
 
   zmq_delete_task = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,*) 'del_task ', zmq_state, task_id
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
   rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0)
   if (rc /= len(trim(message))) then
     zmq_delete_task = -1
@@ -1121,9 +1121,9 @@ integer function zmq_delete_task_async_send(zmq_to_qp_run_socket,task_id,sending
   endif
   zmq_delete_task_async_send = 0
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(message,*) 'del_task ', zmq_state, task_id
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
   rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0)
   if (rc /= len(trim(message))) then
     zmq_delete_task_async_send = -1
@@ -1181,10 +1181,10 @@ integer function zmq_delete_tasks(zmq_to_qp_run_socket,zmq_socket_pull,task_id,n
 
   allocate(character(LEN=64+n_tasks*12) :: message)
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(fmt,*) '(A,1X,A,1X,', n_tasks, '(I11,1X))'
   write(message,*) 'del_task '//trim(zmq_state), (task_id(k), k=1,n_tasks)
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
 
   rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0)
@@ -1230,10 +1230,10 @@ integer function zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_task
 
   allocate(character(LEN=64+n_tasks*12) :: message)
 
-  !$OMP CRITICAL(write)
+  !$OMP CRITICAL
   write(fmt,*) '(A,1X,A,1X,', n_tasks, '(I11,1X))'
   write(message,*) 'del_task '//trim(zmq_state), (task_id(k), k=1,n_tasks)
-  !$OMP END CRITICAL(write)
+  !$OMP END CRITICAL
 
 
   rc = f77_zmq_send(zmq_to_qp_run_socket,trim(message),len(trim(message)),0)