From 238a5d6dd6877431a05f3b63002a183174f93a8a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 4 Nov 2015 16:21:21 +0100 Subject: [PATCH] removed some unused functions --- plugins/MRCC_Utils/davidson.irp.f | 178 -------------------- src/Determinants/davidson.irp.f | 1 - src/Determinants/s2.irp.f | 124 -------------- src/Determinants/slater_rules.irp.f | 243 ---------------------------- 4 files changed, 546 deletions(-) diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index f1cff31a..db2fe26e 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -371,107 +371,6 @@ end -subroutine H_u_0_mrcc_myold(v_0,u_0,H_jj,n,keys_tmp,shortcut,sort_idx,Nint,istate) - use bitmasks - implicit none - BEGIN_DOC - ! Computes v_0 = H|u_0> - ! - ! n : number of determinants - ! - ! H_jj : array of - END_DOC - integer, intent(in) :: n,Nint,istate - double precision, intent(out) :: v_0(n) - double precision, intent(in) :: u_0(n) - double precision, intent(in) :: H_jj(n) - integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) - integer, allocatable :: idx(:) - double precision :: hij - double precision, allocatable :: vt(:) - integer :: i,j,k,l, jj,ii - integer :: i0, j0 - - integer,intent(in) :: shortcut(0:n+1), sort_idx(n) - integer :: tmp, warp(2,0:n+1), sh, ni -! - - ASSERT (Nint > 0) - ASSERT (Nint == N_int) - ASSERT (n>0) - PROVIDE ref_bitmask_energy delta_ij - integer, parameter :: block_size = 157 - - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(i,hij,j,k,idx,jj,vt,ii,warp,tmp,sh) & - !$OMP SHARED(n_det_ref,n_det_non_ref,idx_ref,idx_non_ref,n,H_jj,u_0,keys_tmp,Nint,v_0,istate,delta_ij,shortcut,sort_idx) - - !$OMP DO SCHEDULE(static) - do i=1,n - v_0(i) = H_jj(i) * u_0(i) - enddo - !$OMP END DO - - allocate(idx(0:n), vt(n)) - Vt = 0.d0 - !$OMP DO SCHEDULE(dynamic) - do sh=1,shortcut(0) - warp(1,0) = 0 - do ii=1,sh!shortcut(0) - tmp = 0 - do ni=1,Nint - tmp = popcnt(xor(keys_tmp(ni,1, shortcut(ii)), keys_tmp(ni,1,shortcut(sh)))) - end do - if(tmp <= 4) then - tmp = warp(1,0) + 1 - warp(1,0) = tmp - warp(1,tmp) = shortcut(ii) - warp(2,tmp) = shortcut(ii+1)-1 - end if - end do - - do ii=shortcut(sh),shortcut(sh+1)-1 - idx(0) = ii - !call filter_connected_davidson_mwen(keys_tmp,shortcut,keys_tmp(1,1,ii),Nint,ii-1,idx) - call filter_connected_davidson_warp(keys_tmp,warp,keys_tmp(1,1,ii),Nint,ii-1,idx) - i = sort_idx(ii) - - do jj=1,idx(0) - j = sort_idx(idx(jj)) - !j = idx(jj) - if ( (dabs(u_0(j)) > 1.d-7).or.((dabs(u_0(i)) > 1.d-7)) ) then - call i_H_j(keys_tmp(1,1,idx(jj)),keys_tmp(1,1,ii),Nint,hij) - vt (i) = vt (i) + hij*u_0(j) - vt (j) = vt (j) + hij*u_0(i) - endif - enddo - enddo - enddo - !$OMP END DO - - - - !$OMP DO SCHEDULE(guided) - do ii=1,n_det_ref - i = idx_ref(ii) - do jj = 1, n_det_non_ref - j = idx_non_ref(jj) - vt (i) = vt (i) + delta_ij(ii,jj,istate)*u_0(j) - vt (j) = vt (j) + delta_ij(ii,jj,istate)*u_0(i) - enddo - enddo - !$OMP END DO - !$OMP CRITICAL - do i=1,n - v_0(i) = v_0(i) + vt(i) - enddo - !$OMP END CRITICAL - deallocate(idx,vt) - !$OMP END PARALLEL -end - - subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate) use bitmasks implicit none @@ -609,80 +508,3 @@ subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate) !$OMP END PARALLEL end - -! -! subroutine H_u_0_mrcc_org(v_0,u_0,H_jj,n,keys_tmp,Nint,istate) -! use bitmasks -! implicit none -! BEGIN_DOC -! ! Computes v_0 = H|u_0> -! ! -! ! n : number of determinants -! ! -! ! H_jj : array of -! END_DOC -! integer, intent(in) :: n,Nint,istate -! double precision, intent(out) :: v_0(n) -! double precision, intent(in) :: u_0(n) -! double precision, intent(in) :: H_jj(n) -! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) -! integer, allocatable :: idx(:) -! double precision :: hij -! double precision, allocatable :: vt(:) -! integer :: i,j,k,l, jj,ii -! integer :: i0, j0 -! -! -! -! -! -! ASSERT (Nint > 0) -! ASSERT (Nint == N_int) -! ASSERT (n>0) -! PROVIDE ref_bitmask_energy delta_ij -! integer, parameter :: block_size = 157 -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE(i,hij,j,k,idx,jj,ii,vt) & -! !$OMP SHARED(n_det_ref,n_det_non_ref,idx_ref,idx_non_ref,n,H_jj,u_0,keys_tmp,Nint,v_0,istate,delta_ij) -! !$OMP DO SCHEDULE(static) -! do i=1,n -! v_0(i) = H_jj(i) * u_0(i) -! enddo -! !$OMP END DO -! allocate(idx(0:n), vt(n)) -! Vt = 0.d0 -! !$OMP DO SCHEDULE(guided) -! do i=1,n -! idx(0) = i -! call filter_connected_davidson(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx) -! do jj=1,idx(0) -! j = idx(jj) -! ! if ( (dabs(u_0(j)) > 1.d-7).or.((dabs(u_0(i)) > 1.d-7)) ) then -! call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij) -! hij = hij -! vt (i) = vt (i) + hij*u_0(j) -! vt (j) = vt (j) + hij*u_0(i) -! ! endif -! enddo -! enddo -! !$OMP END DO -! -! !$OMP DO SCHEDULE(guided) -! do ii=1,n_det_ref -! i = idx_ref(ii) -! do jj = 1, n_det_non_ref -! j = idx_non_ref(jj) -! vt (i) = vt (i) + delta_ij(ii,jj,istate)*u_0(j) -! vt (j) = vt (j) + delta_ij(ii,jj,istate)*u_0(i) -! enddo -! enddo -! !$OMP END DO -! !$OMP CRITICAL -! do i=1,n -! v_0(i) = v_0(i) + vt(i) -! enddo -! !$OMP END CRITICAL -! deallocate(idx,vt) -! !$OMP END PARALLEL -! end - diff --git a/src/Determinants/davidson.irp.f b/src/Determinants/davidson.irp.f index 5e931f14..87605964 100644 --- a/src/Determinants/davidson.irp.f +++ b/src/Determinants/davidson.irp.f @@ -122,7 +122,6 @@ end subroutine subroutine sort_dets_ba_v(key_in, key_out, idx, shortcut, version, N_key, Nint) - use bitmasks implicit none integer(bit_kind),intent(in) :: key_in(Nint,2,N_key) diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f index 252810f3..e836d25d 100644 --- a/src/Determinants/s2.irp.f +++ b/src/Determinants/s2.irp.f @@ -215,127 +215,3 @@ subroutine get_s2_u0(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2) end - - -! subroutine get_s2_u0(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2) -! implicit none -! use bitmasks -! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax) -! integer, intent(in) :: n,nmax -! double precision, intent(in) :: psi_coefs_tmp(nmax) -! double precision, intent(out) :: s2 -! double precision :: s2_tmp -! integer :: i,j,l,jj,ii -! integer, allocatable :: idx(:) -! -! integer(bit_kind) :: psi_keys_srt(N_int,2,n) -! integer :: shortcut(0:n+1), sort_idx(n), warp(2,0:n+1), ni, sh, tmp -! integer :: mon, bie, egz -! -! -! psi_keys_srt(:,:,:) = psi_keys_tmp(:,:,:) -! call sort_dets_ab(psi_keys_srt, sort_idx, shortcut, n, N_int) -! -! s2 = 0.d0 -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE(i,j,s2_tmp,idx,warp,tmp,mon,bie,egz) & -! !$OMP SHARED(n,psi_coefs_tmp,psi_keys_tmp,N_int,davidson_threshold,shortcut,psi_keys_srt,sort_idx)& -! !$OMP REDUCTION(+:s2) -! allocate(idx(0:n)) -! !$OMP DO SCHEDULE(dynamic) -! -! do sh=1,shortcut(0) -! mon = 0 -! bie = 0 -! -! warp(1,0) = 0 -! do ii=1,sh!shortcut(0) -! tmp = 0 -! do ni=1,N_int -! tmp += popcnt(xor(psi_keys_tmp(ni,1, shortcut(ii)), psi_keys_tmp(ni,1,shortcut(sh)))) -! end do -! egz = tmp -! if(tmp <= 4) then -! tmp = warp(1,0) + 1 -! warp(1,0) = tmp -! warp(1,tmp) = shortcut(ii) -! warp(2,tmp) = shortcut(ii+1)-1 -! if(egz == 4) then -! bie = bie + shortcut(ii+1) - shortcut(ii) -! else -! mon = mon + shortcut(ii+1) - shortcut(ii) -! end if -! end if -! end do -! -! if(shortcut(sh+1) - shortcut(sh) /= 1) then -! print *, shortcut(sh+1) - shortcut(sh), shortcut(sh+1), mon, bie -! end if -! -! do ii=shortcut(sh),shortcut(sh+1)-1 -! !do ii=1,n -! idx(0) = ii -! call filter_connected_davidson_warp(psi_keys_srt,warp,psi_keys_srt(1,1,ii),N_int,ii-1,idx) -! i = sort_idx(ii) -! do jj=1,idx(0) -! j = sort_idx(idx(jj)) -! if ( dabs(psi_coefs_tmp(j)) + dabs(psi_coefs_tmp(i)) & -! > davidson_threshold ) then -! call get_s2(psi_keys_srt(1,1,ii),psi_keys_srt(1,1,idx(jj)),s2_tmp,N_int) -! s2 = s2 + psi_coefs_tmp(i)*psi_coefs_tmp(j)*s2_tmp -! endif -! enddo -! end do -! enddo -! !$OMP END DO -! deallocate(idx) -! !$OMP END PARALLEL -! s2 = s2+s2 -! do i=1,n -! call get_s2(psi_keys_srt(1,1,sort_idx(i)),psi_keys_srt(1,1,sort_idx(i)),s2_tmp,N_int) -! s2 = s2 + psi_coefs_tmp(i)*psi_coefs_tmp(i)*s2_tmp -! enddo -! s2 = s2 + S_z2_Sz -! end - -! -! subroutine get_s2_u0_org(psi_keys_tmp,psi_coefs_tmp,n,nmax,s2) -! implicit none -! use bitmasks -! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax) -! integer, intent(in) :: n,nmax -! double precision, intent(in) :: psi_coefs_tmp(nmax) -! double precision, intent(out) :: s2 -! double precision :: s2_tmp -! integer :: i,j,l,jj -! integer, allocatable :: idx(:) -! s2 = 0.d0 -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE(i,j,s2_tmp,idx) & -! !$OMP SHARED(n,psi_coefs_tmp,psi_keys_tmp,N_int,davidson_threshold)& -! !$OMP REDUCTION(+:s2) -! allocate(idx(0:n)) -! !$OMP DO SCHEDULE(dynamic) -! do i=1,n -! idx(0) = i -! call filter_connected_davidson(psi_keys_tmp,psi_keys_tmp(1,1,i),N_int,i-1,idx) -! do jj=1,idx(0) -! j = idx(jj) -! if ( dabs(psi_coefs_tmp(j)) + dabs(psi_coefs_tmp(i)) & -! > davidson_threshold ) then -! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,j),s2_tmp,N_int) -! s2 = s2 + psi_coefs_tmp(i)*psi_coefs_tmp(j)*s2_tmp -! endif -! enddo -! enddo -! !$OMP END DO -! deallocate(idx) -! !$OMP END PARALLEL -! s2 = s2+s2 -! do i=1,n -! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,i),s2_tmp,N_int) -! s2 = s2 + psi_coefs_tmp(i)*psi_coefs_tmp(i)*s2_tmp -! enddo -! s2 = s2 + S_z2_Sz -! end -! diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 1c8573dd..acffeb3d 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -1299,247 +1299,4 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,shortcut,sort_idx,Nint) enddo end -! -! subroutine H_u_0_org(v_0,u_0,H_jj,n,keys_tmp,Nint) -! use bitmasks -! implicit none -! BEGIN_DOC -! ! Computes v_0 = H|u_0> -! ! -! ! n : number of determinants -! ! -! ! H_jj : array of -! END_DOC -! integer, intent(in) :: n,Nint -! double precision, intent(out) :: v_0(n) -! double precision, intent(in) :: u_0(n) -! double precision, intent(in) :: H_jj(n) -! integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n) -! integer, allocatable :: idx(:) -! double precision :: hij -! double precision, allocatable :: vt(:) -! integer :: i,j,k,l, jj,ii,sh -! integer :: i0, j0 -! -! -! -! ASSERT (Nint > 0) -! ASSERT (Nint == N_int) -! ASSERT (n>0) -! PROVIDE ref_bitmask_energy -! !$OMP PARALLEL DEFAULT(NONE) & -! !$OMP PRIVATE(i,hij,j,k,idx,jj,vt,ii) & -! !$OMP SHARED(n,H_jj,u_0,keys_tmp,Nint,v_0,davidson_threshold) -! allocate(idx(0:n), vt(n)) -! Vt = 0.d0 -! v_0 = 0.d0 -! !$OMP DO SCHEDULE(guided) -! -! -! -! -! -! do ii=1,n -! idx(0) = ii -! i = ii -! call filter_connected_davidson(keys_tmp,keys_tmp(1,1,ii),Nint,ii-1,idx) -! -! do jj=1,idx(0) -! j = idx(jj) -! if ( dabs(u_0(j)) + dabs(u_0(i)) > davidson_threshold ) then -! call i_H_j(keys_tmp(1,1,idx(jj)),keys_tmp(1,1,ii),Nint,hij) -! vt (i) = vt (i) + hij*u_0(j) -! vt (j) = vt (j) + hij*u_0(i) -! endif -! enddo -! enddo -! -! !$OMP END DO -! !$OMP CRITICAL -! do i=1,n -! v_0(i) = v_0(i) + vt(i) -! enddo -! !$OMP END CRITICAL -! deallocate(idx,vt) -! !$OMP END PARALLEL -! do i=1,n -! v_0(i) += H_jj(i) * u_0(i) -! enddo -! end -! - - -BEGIN_PROVIDER [ integer, N_con_int ] - implicit none - BEGIN_DOC - ! Number of integers to represent the connections between determinants - END_DOC - N_con_int = 1 + ishft(N_det-1,-11) -END_PROVIDER - -! BEGIN_PROVIDER [ integer*8, det_connectionsqsd, (N_con_int,N_det) ] -! implicit none -! BEGIN_DOC -! ! Build connection proxy between determinants -! END_DOC -! integer :: i,j -! integer :: degree -! integer :: j_int, j_k, j_l -! integer, allocatable :: idx(:) -! integer :: thread_num -! integer :: omp_get_thread_num -! -! PROVIDE progress_bar -! -! print *,"totolabanane" -! -! call start_progress(N_det,'Det connections',0.d0) -! -! select case(N_int) -! -! case(1) -! -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP SHARED(N_det, N_con_int, psi_det,N_int, det_connections, & -! !$OMP progress_bar,progress_value)& -! !$OMP PRIVATE(i,j_int,j_k,j_l,j,degree,idx,thread_num) -! -! !$ thread_num = omp_get_thread_num() -! allocate (idx(0:N_det)) -! !$OMP DO SCHEDULE(guided) -! do i=1,N_det -! if (thread_num == 0) then -! progress_bar(1) = i -! progress_value = dble(i) -! endif -! do j_int=1,N_con_int -! det_connections(j_int,i) = 0_8 -! j_k = ishft(j_int-1,11) -! do j_l = j_k,min(j_k+2047,N_det), 32 -! do j = j_l+1,min(j_l+32,i) -! degree = popcnt(xor( psi_det(1,1,i),psi_det(1,1,j))) + & -! popcnt(xor( psi_det(1,2,i),psi_det(1,2,j))) -! if (degree < 5) then -! det_connections(j_int,i) = ibset( det_connections(j_int,i), iand(63,ishft(j_l,-5)) ) -! exit -! endif -! enddo -! enddo -! enddo -! enddo -! !$OMP ENDDO -! deallocate(idx) -! !$OMP END PARALLEL -! -! case(2) -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP SHARED(N_det, N_con_int, psi_det,N_int, det_connections,& -! !$OMP progress_bar,progress_value)& -! !$OMP PRIVATE(i,j_int,j_k,j_l,j,degree,idx,thread_num) -! !$ thread_num = omp_get_thread_num() -! allocate (idx(0:N_det)) -! !$OMP DO SCHEDULE(guided) -! do i=1,N_det -! if (thread_num == 0) then -! progress_bar(1) = i -! progress_value = dble(i) -! endif -! do j_int=1,N_con_int -! det_connections(j_int,i) = 0_8 -! j_k = ishft(j_int-1,11) -! do j_l = j_k,min(j_k+2047,N_det), 32 -! do j = j_l+1,min(j_l+32,i) -! degree = popcnt(xor( psi_det(1,1,i),psi_det(1,1,j))) + & -! popcnt(xor( psi_det(1,2,i),psi_det(1,2,j))) + & -! popcnt(xor( psi_det(2,1,i),psi_det(2,1,j))) + & -! popcnt(xor( psi_det(2,2,i),psi_det(2,2,j))) -! if (degree < 5) then -! det_connections(j_int,i) = ibset( det_connections(j_int,i), iand(63,ishft(j_l,-5)) ) -! exit -! endif -! enddo -! enddo -! enddo -! enddo -! !$OMP ENDDO -! deallocate(idx) -! !$OMP END PARALLEL -! -! case(3) -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP SHARED(N_det, N_con_int, psi_det,N_int, det_connections,& -! !$OMP progress_bar,progress_value)& -! !$OMP PRIVATE(i,j_int,j_k,j_l,j,degree,idx,thread_num) -! !$ thread_num = omp_get_thread_num() -! allocate (idx(0:N_det)) -! !$OMP DO SCHEDULE(guided) -! do i=1,N_det -! if (thread_num == 0) then -! progress_bar(1) = i -! progress_value = dble(i) -! endif -! do j_int=1,N_con_int -! det_connections(j_int,i) = 0_8 -! j_k = ishft(j_int-1,11) -! do j_l = j_k,min(j_k+2047,N_det), 32 -! do j = j_l+1,min(j_l+32,i) -! degree = popcnt(xor( psi_det(1,1,i),psi_det(1,1,j))) + & -! popcnt(xor( psi_det(1,2,i),psi_det(1,2,j))) + & -! popcnt(xor( psi_det(2,1,i),psi_det(2,1,j))) + & -! popcnt(xor( psi_det(2,2,i),psi_det(2,2,j))) + & -! popcnt(xor( psi_det(3,1,i),psi_det(3,1,j))) + & -! popcnt(xor( psi_det(3,2,i),psi_det(3,2,j))) -! if (degree < 5) then -! det_connections(j_int,i) = ibset( det_connections(j_int,i), iand(63,ishft(j_l,-5)) ) -! exit -! endif -! enddo -! enddo -! enddo -! enddo -! !$OMP ENDDO -! deallocate(idx) -! !$OMP END PARALLEL -! -! case default -! -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP SHARED(N_det, N_con_int, psi_det,N_int, det_connections,& -! !$OMP progress_bar,progress_value)& -! !$OMP PRIVATE(i,j_int,j_k,j_l,j,degree,idx,thread_num) -! !$ thread_num = omp_get_thread_num() -! allocate (idx(0:N_det)) -! !$OMP DO SCHEDULE(guided) -! do i=1,N_det -! if (thread_num == 0) then -! progress_bar(1) = i -! progress_value = dble(i) -! endif -! do j_int=1,N_con_int -! det_connections(j_int,i) = 0_8 -! j_k = ishft(j_int-1,11) -! do j_l = j_k,min(j_k+2047,N_det), 32 -! do j = j_l+1,min(j_l+32,i) -! !DIR$ FORCEINLINE -! call get_excitation_degree(psi_det(1,1,i),psi_det(1,1,j),degree,N_int) -! if (degree < 3) then -! det_connections(j_int,i) = ibset( det_connections(j_int,i), iand(63,ishft(j_l,-5)) ) -! exit -! endif -! enddo -! enddo -! enddo -! enddo -! !$OMP ENDDO -! deallocate(idx) -! !$OMP END PARALLEL -! -! end select -! call stop_progress -! -! END_PROVIDER