From 3a71cf0dc6aba0e914aafd61445dc64683c50b59 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 16 Jun 2021 09:49:53 +0200 Subject: [PATCH 1/4] CSF-based davidson as an option0 --- src/davidson/EZFIO.cfg | 6 ++++++ src/davidson/diagonalize_ci.irp.f | 4 +--- src/davidson/u0_h_u0.irp.f | 2 +- src/davidson/u0_hs2_u0.irp.f | 4 ++-- 4 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/davidson/EZFIO.cfg b/src/davidson/EZFIO.cfg index 4343cc1e..a3efc2be 100644 --- a/src/davidson/EZFIO.cfg +++ b/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 diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index da5fb950..be4250bf 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/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. (expected_s2 == 0.d0) - do_csf = .False. + do_csf = s2_eig .and. only_expected_s2 .and. csf_based if (diag_algorithm == "Davidson") then diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 3f5113db..7ef154a3 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/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 diff --git a/src/davidson/u0_hs2_u0.irp.f b/src/davidson/u0_hs2_u0.irp.f index 96c266c2..8f7bf06b 100644 --- a/src/davidson/u0_hs2_u0.irp.f +++ b/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) - s_0(i) = u_dot_v(s_vec(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)/norm else e_0(i) = 0.d0 s_0(i) = 0.d0 From 66baf49ca6321ebd0f906973d9b979f673d4322a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 18 Jun 2021 12:45:41 +0200 Subject: [PATCH 2/4] Davidson without diagonal option --- src/davidson/EZFIO.cfg | 5 ++++ .../diagonalization_hcsf_dressed.irp.f | 24 +++++++++++++------ 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/src/davidson/EZFIO.cfg b/src/davidson/EZFIO.cfg index a3efc2be..92c41b4c 100644 --- a/src/davidson/EZFIO.cfg +++ b/src/davidson/EZFIO.cfg @@ -58,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 diff --git a/src/davidson/diagonalization_hcsf_dressed.irp.f b/src/davidson/diagonalization_hcsf_dressed.irp.f index da23b919..b6f438a0 100644 --- a/src/davidson/diagonalization_hcsf_dressed.irp.f +++ b/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) - do k=1,N_st_diag - do i=1,sze - U(i,k) = (lambda(k) * U(i,k) - W(i,k) ) & - /max(H_jj(i) - lambda (k),1.d-2) + if (without_diagonal) then + !$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) ) & + /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) From b1806d517d4bca0b059a9992f02891684bf850a4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 18 Jun 2021 12:47:27 +0200 Subject: [PATCH 3/4] Deactivated banned excitations --- src/mo_one_e_ints/mo_overlap.irp.f | 1 - src/mo_two_e_ints/map_integrals.irp.f | 6 ++++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/mo_one_e_ints/mo_overlap.irp.f b/src/mo_one_e_ints/mo_overlap.irp.f index 4ce83fcd..9b21e032 100644 --- a/src/mo_one_e_ints/mo_overlap.irp.f +++ b/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 diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f index 8756ee47..9fb1e6c9 100644 --- a/src/mo_two_e_ints/map_integrals.irp.f +++ b/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 From abdd4c7dbd64d40686bfe5a8c224129954a8cac7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 18 Jun 2021 12:48:07 +0200 Subject: [PATCH 4/4] Protection of writes in openmp --- src/zmq/utils.irp.f | 52 ++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/zmq/utils.irp.f b/src/zmq/utils.irp.f index 7cb6c896..2cb230c7 100644 --- a/src/zmq/utils.irp.f +++ b/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)