program delta_3bSVD_v1 BEGIN_DOC ! !!! END_DOC implicit none read_wf = .True. touch read_wf call run() end subroutine run() implicit none integer :: ii, ii_i, ii_j, k, l integer :: na, nb, nsvd integer :: n_tmp, n_TSVD double precision, allocatable :: U(:,:), V(:,:), S(:) double precision, allocatable :: delta0_det(:), delta1_det(:) double precision, allocatable :: deltaSVD1_kl(:,:), deltaSVD2_kl(:,:) double precision, allocatable :: delta_tmp(:) na = n_det_alpha_unique nb = n_det_beta_unique call ezfio_get_spindeterminants_n_svd_coefs(nsvd) ! read SVD vectors allocate( u(na,nsvd) , v(nb,nsvd) ) call ezfio_get_spindeterminants_psi_svd_alpha(U) call ezfio_get_spindeterminants_psi_svd_beta (V) ! allocate( s(nsvd) ) ! call ezfio_get_spindeterminants_psi_svd_coefs(S) allocate( delta0_det(N_det) ) call ezfio_get_dmc_dress_dmc_delta_h(delta0_det) ! --------------------------------------------- ! parameters n_TSVD = 50 print *, " --- delta_3bSVD_v1 ---" print *, " n_TSVD =", n_TSVD print *, " tot =", nsvd * n_TSVD + & (nsvd-n_TSVD)*n_TSVD ! ! --------------------------------------------- n_tmp = n_TSVD + 1 allocate( deltaSVD1_kl(1:nsvd,1:n_TSVD) , deltaSVD2_kl(1:n_TSVD,n_tmp:nsvd) ) call obtenir_deltaSVD_3b(nsvd, n_TSVD, U, V, delta0_det, deltaSVD1_kl, deltaSVD2_kl) deallocate( delta0_det ) ! [ delta ]_mn = \sum_{k,l} U_{m,k} delta_SVD_{k,l} V_{n,l} allocate( delta1_det(N_det) ) delta1_det(1:N_det) = 0.d0 !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(nsvd, n_TSVD, n_tmp, N_det, U, V, delta1_det, deltaSVD1_kl & !$OMP , deltaSVD2_kl, psi_bilinear_matrix_rows, psi_bilinear_matrix_columns) & !$OMP PRIVATE(k, l, ii, ii_i, ii_j, delta_tmp) allocate( delta_tmp(N_det) ) delta_tmp(1:N_det) = 0.d0 !$OMP DO do ii = 1, N_det ii_i = psi_bilinear_matrix_rows (ii) ii_j = psi_bilinear_matrix_columns(ii) do l = 1, n_TSVD do k = 1, nsvd delta_tmp(ii) = delta_tmp(ii) + U(ii_i,k) * V(ii_j,l) * deltaSVD1_kl(k,l) enddo enddo do l = n_tmp, nsvd do k = 1, n_TSVD delta_tmp(ii) = delta_tmp(ii) + U(ii_i,k) * V(ii_j,l) * deltaSVD2_kl(k,l) enddo enddo enddo !$OMP END DO !$OMP CRITICAL do ii = 1, N_det delta1_det(ii) = delta1_det(ii) + delta_tmp(ii) enddo !$OMP END CRITICAL deallocate( delta_tmp ) !$OMP END PARALLEL ! deallocate( S ) deallocate( U , V ) deallocate( deltaSVD1_kl, deltaSVD2_kl ) call ezfio_set_dmc_dress_dmc_delta_h(delta1_det) deallocate( delta1_det ) end ! _______________________________________________________________________________________________________ ! ! [ delta_SVD ]_kl = < dup_SVD ddn_SVD | H_tilde - H | psi > ! = \sum_{i,j} U_{i,k} V_{j,l} < dup_i ddn_j | H_tilde - H | psi > ! subroutine obtenir_deltaSVD_3b(nsvd, n_TSVD, U, V, delta0_det, deltaSVD1_kl, deltaSVD2_kl) implicit none integer, intent(in) :: nsvd, n_TSVD double precision, intent(in) :: U(n_det_alpha_unique,nsvd), V(n_det_beta_unique,nsvd) double precision, intent(in) :: delta0_det(N_det) double precision, intent(out) :: deltaSVD1_kl(1:nsvd,1:n_TSVD) double precision, intent(out) :: deltaSVD2_kl(1:n_TSVD,n_TSVD+1:nsvd) integer :: n_tmp integer :: k, l, ii, ii_i, ii_j double precision, allocatable :: delta_tmp(:,:) n_tmp = n_TSVD + 1 deltaSVD1_kl(1:nsvd,1:n_TSVD) = 0.d0 deltaSVD2_kl(1:n_TSVD,n_tmp:nsvd) = 0.d0 !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(nsvd, n_TSVD, N_det, U, V, delta0_det, deltaSVD1_kl & !$OMP , psi_bilinear_matrix_rows, psi_bilinear_matrix_columns) & !$OMP PRIVATE(k, l, ii, ii_i, ii_j, delta_tmp) allocate( delta_tmp(1:nsvd,1:n_TSVD) ) delta_tmp(1:nsvd,1:n_TSVD) = 0.d0 !$OMP DO do l = 1, n_TSVD do k = 1, nsvd do ii = 1, N_det ii_i = psi_bilinear_matrix_rows (ii) ii_j = psi_bilinear_matrix_columns(ii) delta_tmp(k,l) = delta_tmp(k,l) + U(ii_i,k) * V(ii_j,l) * delta0_det(ii) enddo enddo enddo !$OMP END DO !$OMP CRITICAL do l = 1, n_TSVD do k = 1, nsvd deltaSVD1_kl(k,l) = deltaSVD1_kl(k,l) + delta_tmp(k,l) enddo enddo !$OMP END CRITICAL deallocate(delta_tmp) !$OMP END PARALLEL !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(nsvd, n_TSVD, n_tmp, N_det, U, V, delta0_det, deltaSVD2_kl & !$OMP , psi_bilinear_matrix_rows, psi_bilinear_matrix_columns) & !$OMP PRIVATE(k, l, ii, ii_i, ii_j, delta_tmp) allocate( delta_tmp(1:n_TSVD,n_tmp:nsvd) ) delta_tmp(1:n_TSVD,n_tmp:nsvd) = 0.d0 !$OMP DO do l = n_tmp, nsvd do k = 1, n_TSVD do ii = 1, N_det ii_i = psi_bilinear_matrix_rows (ii) ii_j = psi_bilinear_matrix_columns(ii) delta_tmp(k,l) = delta_tmp(k,l) + U(ii_i,k) * V(ii_j,l) * delta0_det(ii) enddo enddo enddo !$OMP END DO !$OMP CRITICAL do l = n_tmp, nsvd do k = 1, n_TSVD deltaSVD2_kl(k,l) = deltaSVD2_kl(k,l) + delta_tmp(k,l) enddo enddo !$OMP END CRITICAL deallocate(delta_tmp) !$OMP END PARALLEL return end subroutine obtenir_deltaSVD_3b ! _______________________________________________________________________________________________________ ! _______________________________________________________________________________________________________