From ae0815bfac86d5e6f31c8b1cab2a95a218ed9396 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 18 Apr 2017 14:52:23 +0200 Subject: [PATCH] Removed CSC array --- src/Davidson/diagonalization_hs2.irp.f | 8 ++-- src/Davidson/u0Hu0.irp.f | 52 ++++++++++++++------------ 2 files changed, 31 insertions(+), 29 deletions(-) diff --git a/src/Davidson/diagonalization_hs2.irp.f b/src/Davidson/diagonalization_hs2.irp.f index 535eddad..853e5cf7 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/src/Davidson/diagonalization_hs2.irp.f @@ -126,7 +126,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s sze_8 = align_double(sze) itermax = max(3,min(davidson_sze_max, sze/N_st_diag)) - PROVIDE nuclear_repulsion expected_s2 singles_alpha_csc + PROVIDE nuclear_repulsion expected_s2 call write_time(iunit) call wall_time(wall) @@ -138,7 +138,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s call write_int(iunit,N_st,'Number of states') call write_int(iunit,N_st_diag,'Number of states in diagonalization') call write_int(iunit,sze,'Number of determinants') - r1 = 8.d0*(size(singles_alpha_csc)+3.d0*dble(sze_8*N_st_diag*itermax+5.d0*(N_st_diag*itermax)**2 & + r1 = 8.d0*(3.d0*dble(sze_8*N_st_diag*itermax+5.d0*(N_st_diag*itermax)**2 & + 4.d0*(N_st_diag*itermax)+nproc*(4.d0*N_det_alpha_unique+2.d0*N_st_diag*sze_8)))/(1024.d0**3) call write_double(iunit, r1, 'Memory(Gb)') write(iunit,'(A)') '' @@ -452,7 +452,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s y, s_, s_tmp, & lambda & ) - FREE singles_alpha_csc end subroutine davidson_diag_hjj_sjj_mmap(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_st,N_st_diag,Nint,iunit) @@ -520,7 +519,7 @@ subroutine davidson_diag_hjj_sjj_mmap(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz stop -1 endif - PROVIDE nuclear_repulsion expected_s2 singles_alpha_csc + PROVIDE nuclear_repulsion expected_s2 call write_time(iunit) call wall_time(wall) @@ -892,6 +891,5 @@ subroutine davidson_diag_hjj_sjj_mmap(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz y, s_, s_tmp, & lambda & ) - FREE singles_alpha_csc end diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index b963cf32..4ecd0158 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -104,9 +104,10 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif integer :: n_singles, n_doubles integer, allocatable :: singles(:), doubles(:) integer, allocatable :: singles_a(:) + integer, allocatable :: singles_b(:) integer, allocatable :: idx(:), idx0(:) logical, allocatable :: is_single_a(:) - integer :: maxab, n_singles_a, kcol_prev, nmax + integer :: maxab, n_singles_a, n_singles_b, kcol_prev, nmax integer*8 :: k8 double precision, allocatable :: v_t(:,:), s_t(:,:) !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: v_t, s_t @@ -138,7 +139,8 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif !$OMP lcol, lrow, is_single_a,l_a, l_b, nmax, & !$OMP buffer, singles, doubles, n_singles, n_doubles, & !$OMP tmp_det2, hij, sij, idx, l, kcol_prev, v_t, & - !$OMP singles_a, n_singles_a, s_t, k8) + !$OMP singles_a, n_singles_a, singles_b, & + !$OMP n_singles_b, s_t, k8) ! Alpha/Beta double excitations ! ============================= @@ -146,6 +148,7 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif allocate( buffer(N_int,maxab), & singles(maxab), & singles_a(maxab), & + singles_b(maxab), & doubles(maxab), & idx(maxab), & v_t(N_st,N_det), s_t(N_st,N_det), & @@ -166,38 +169,42 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int, krow) tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int, kcol) - do k8=singles_alpha_csc_idx(krow), singles_alpha_csc_idx(krow+1)-1 - is_single_a( singles_alpha_csc(k8) ) = .True. - enddo - if (kcol /= kcol_prev) then call get_all_spin_singles( & - psi_det_beta_unique, idx0, tmp_det(1,2), N_int, N_det_beta_unique,& - singles_a, n_singles_a) + psi_det_beta_unique(1,kcol+1), idx0(kcol+1), tmp_det(1,2), N_int, N_det_beta_unique-kcol+2,& + singles_b, n_singles_b) endif kcol_prev = kcol - ! Loop over singly excited beta columns - ! ------------------------------------- + ! Loop over singly excited beta columns > current column + ! ------------------------------------------------------ - do i=1,n_singles_a - lcol = singles_a(i) - if (lcol <= kcol) cycle + do i=1,n_singles_b + lcol = singles_b(i) tmp_det2(1:N_int,2) = psi_det_beta_unique(1:N_int, lcol) l_a = psi_bilinear_matrix_columns_loc(lcol) + nmax = psi_bilinear_matrix_columns_loc(lcol+1) - l_a + do j=1,nmax + lrow = psi_bilinear_matrix_rows(l_a) + buffer(1:N_int,j) = psi_det_alpha_unique(1:N_int, lrow) + idx(j) = l_a + l_a = l_a+1 + enddo + j = j-1 + + call get_all_spin_singles( & + buffer, idx, tmp_det(1,1), N_int, j, & + singles_a, n_singles_a ) + ! Loop over alpha singles ! ----------------------- - do while ( l_a < psi_bilinear_matrix_columns_loc(lcol+1) ) - do l=l_a,psi_bilinear_matrix_columns_loc(lcol+1)-1 - lrow = psi_bilinear_matrix_rows(l) - if (is_single_a(lrow)) exit - enddo - if (l >= psi_bilinear_matrix_columns_loc(lcol+1)) exit - l_a = l + do k = 1,n_singles_a + l_a = singles_a(k) + lrow = psi_bilinear_matrix_rows(l_a) tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow) call i_H_j_double_alpha_beta(tmp_det,tmp_det2,N_int,hij) call get_s2(tmp_det,tmp_det2,N_int,sij) @@ -207,11 +214,8 @@ subroutine H_S2_u_0_nstates_openmp_work(v_0,s_0,u_t,N_st,sze_8,istart,iend,ishif s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,l_a) s_t(l,l_a) = s_t(l,l_a) + sij * u_t(l,k_a) enddo - l_a = l_a+1 enddo - enddo - do k8=singles_alpha_csc_idx(krow), singles_alpha_csc_idx(krow+1)-1 - is_single_a( singles_alpha_csc(k8) ) = .False. + enddo enddo