diff --git a/src/PROPERTIES/properties_buildpsi.irp.f b/src/PROPERTIES/properties_buildpsi.irp.f new file mode 100644 index 0000000..244e1ac --- /dev/null +++ b/src/PROPERTIES/properties_buildpsi.irp.f @@ -0,0 +1,312 @@ + +BEGIN_PROVIDER [ double precision, hij_fm, (size_hij_fm) ] + + implicit none + + BEGIN_DOC + ! !!! + ! hij = < psi_svd J | H | J l l' > / < psi_svd J | psi_svd J > + ! = < H (J l l')/(psi_svd J) > ( first method: fm ) + ! = < E_loc (l l') / psi_svd > ( secnd method: sm ) + ! Dimensions : n_svd_toselect + END_DOC + + integer :: i, l, lp, e + double precision :: f, g, h, T, V + + do i = 1, n_svd_toselect + + l = psi_svd_alpha_numtoselect(i,1) + lp = psi_svd_beta_numtoselect (i,1) + + ! Lapl D + g = 0.d0 + do e = 1, elec_alpha_num + g += det_alpha_grad_lapl_SVD_unique(4,e,l) * det_beta_value_SVD_unique(lp) + enddo + do e = elec_alpha_num+1, elec_num + g += det_alpha_value_SVD_unique(l) * det_beta_grad_lapl_SVD_unique(4,e,lp) + enddo + T = g + + ! D (Lapl J)/J + g = 0.d0 + do e = 1, elec_num + g += jast_lapl_jast_inv(e) + enddo + T += det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * g + + ! 2 (grad D).(Grad J)/J + g = 0.d0 + do e = 1, elec_alpha_num + g += det_alpha_grad_lapl_SVD_unique(1,e,l) * jast_grad_jast_inv_x(e) + & + det_alpha_grad_lapl_SVD_unique(2,e,l) * jast_grad_jast_inv_y(e) + & + det_alpha_grad_lapl_SVD_unique(3,e,l) * jast_grad_jast_inv_z(e) + enddo + h = 0.d0 + do e = elec_alpha_num+1, elec_num + h += det_beta_grad_lapl_SVD_unique(1,e,lp) * jast_grad_jast_inv_x(e) + & + det_beta_grad_lapl_SVD_unique(2,e,lp) * jast_grad_jast_inv_y(e) + & + det_beta_grad_lapl_SVD_unique(3,e,lp) * jast_grad_jast_inv_z(e) + enddo + T += 2.d0 * ( g * det_beta_value_SVD_unique(lp) + h * det_alpha_value_SVD_unique(l) ) + + g = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) + V = E_pot * g + ! TODO + !do e = 1, elec_alpha_num + ! V -= pseudo_non_local_SVD(e) * g + ! V += det_alpha_pseudo_SVD_unique(e,l) * det_beta_value_SVD_unique(lp) + !enddo + !do e = elec_alpha_num+1, elec_num + ! V -= pseudo_non_local_SVD(e) * g + ! V += det_alpha_value_SVD_unique(l) * det_beta_pseudo_SVD_unique(e,lp) + !enddo + f = -0.5d0*T + V + f *= psidet_inv_SVD + + hij_fm(i) = f + + enddo + + hij_fm_min = min( hij_fm_min, minval(hij_fm) ) + hij_fm_max = max( hij_fm_max, maxval(hij_fm) ) + + SOFT_TOUCH hij_fm_min hij_fm_max + +END_PROVIDER + + + +BEGIN_PROVIDER [ double precision, hij_sm, (size_hij_sm) ] + + implicit none + + BEGIN_DOC + ! !!! + ! hij = < psi_svd J | H | J l l' > / < psi_svd J | psi_svd J > + ! = < H (J l l')/(psi_svd J) > ( first method: fm) + ! = < E_loc (l l') / psi_svd > ( secnd method: sm) + ! Dimensions : n_svd_toselect + END_DOC + + integer :: i, l, lp + + do i = 1, n_svd_toselect + + l = psi_svd_alpha_numtoselect(i,1) + lp = psi_svd_beta_numtoselect (i,1) + + hij_sm(i) = E_loc * det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * psidet_inv_SVD + + enddo + + hij_sm_min = min( hij_sm_min, minval(hij_sm) ) + hij_sm_max = max( hij_sm_max, maxval(hij_sm) ) + + SOFT_TOUCH hij_sm_min hij_sm_max + +END_PROVIDER + + + + + +BEGIN_PROVIDER [ double precision, xij_diag, (size_xij_diag) ] + + implicit none + + BEGIN_DOC + ! !!! + ! < l l' | H | l l' > + ! Dimensions : n_svd_toselect + END_DOC + + integer :: i, l, lp, e + double precision :: f, g, h, T, V + + do i = 1, n_svd_toselect + + l = psi_svd_alpha_numtoselect(i,1) + lp = psi_svd_beta_numtoselect (i,1) + + ! Lapl D + g = 0.d0 + do e = 1, elec_alpha_num + g += det_alpha_grad_lapl_SVD_unique(4,e,l) * det_beta_value_SVD_unique(lp) + enddo + do e = elec_alpha_num+1, elec_num + g += det_alpha_value_SVD_unique(l) * det_beta_grad_lapl_SVD_unique(4,e,lp) + enddo + T = g + + ! D (Lapl J)/J + g = 0.d0 + do e = 1, elec_num + g += jast_lapl_jast_inv(e) + enddo + T += det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * g + + ! 2 (grad D).(Grad J)/J + g = 0.d0 + do e = 1, elec_alpha_num + g += det_alpha_grad_lapl_SVD_unique(1,e,l) * jast_grad_jast_inv_x(e) + & + det_alpha_grad_lapl_SVD_unique(2,e,l) * jast_grad_jast_inv_y(e) + & + det_alpha_grad_lapl_SVD_unique(3,e,l) * jast_grad_jast_inv_z(e) + enddo + h = 0.d0 + do e = elec_alpha_num+1, elec_num + h += det_beta_grad_lapl_SVD_unique(1,e,lp) * jast_grad_jast_inv_x(e) + & + det_beta_grad_lapl_SVD_unique(2,e,lp) * jast_grad_jast_inv_y(e) + & + det_beta_grad_lapl_SVD_unique(3,e,lp) * jast_grad_jast_inv_z(e) + enddo + T += 2.d0 * ( g * det_beta_value_SVD_unique(lp) + h * det_alpha_value_SVD_unique(l) ) + + g = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) + V = E_pot * g + ! TODO + !do e = 1, elec_alpha_num + ! V -= pseudo_non_local_SVD(e) * g + ! V += det_alpha_pseudo_SVD_unique(e,l) * det_beta_value_SVD_unique(lp) + !enddo + !do e = elec_alpha_num+1, elec_num + ! V -= pseudo_non_local_SVD(e) * g + ! V += det_alpha_value_SVD_unique(l) * det_beta_pseudo_SVD_unique(e,lp) + !enddo + f = -0.5d0*T + V + f *= psidet_inv_SVD * psidet_inv_SVD + + xij_diag(i) = f * det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) + + enddo + + xij_diag_min = min( xij_diag_min, minval(xij_diag) ) + xij_diag_max = max( xij_diag_max, maxval(xij_diag) ) + + SOFT_TOUCH xij_diag_min xij_diag_max + +END_PROVIDER + + + + +BEGIN_PROVIDER [ double precision, overlop_selected_matrix, (size_overlop_selected_matrix) ] + implicit none + BEGIN_DOC + ! !!! + ! < k_selected k'_selected | l_selected l'_selected > + ! Dimensions : n_svd_selected * n_svd_selected + END_DOC + + integer :: k, kp, l, lp + integer :: i, j, ii0, ii + double precision :: f + + do i = 1, n_svd_selected + ii0 = (i-1)*n_svd_selected + + l = psi_svd_alpha_numselected(i,1) + lp = psi_svd_beta_numselected (i,1) + + f = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * psidet_inv_SVD * psidet_inv_SVD + + do j = 1, n_svd_selected + ii = ii0 + j + + k = psi_svd_alpha_numselected(j,1) + kp = psi_svd_beta_numselected (j,1) + + overlop_selected_matrix(ii) = det_alpha_value_SVD_unique(k) * det_beta_value_SVD_unique(kp) * f + + enddo + enddo + + overlop_selected_matrix_min = min(overlop_selected_matrix_min,minval(overlop_selected_matrix)) + overlop_selected_matrix_max = max(overlop_selected_matrix_max,maxval(overlop_selected_matrix)) + SOFT_TOUCH overlop_selected_matrix_min overlop_selected_matrix_max +END_PROVIDER + + + +BEGIN_PROVIDER [ double precision, h_selected_matrix, (size_h_selected_matrix) ] + implicit none + BEGIN_DOC + ! !!! + ! < k_selected k'_selected | H | l_selected l'_selected > + ! Dimensions : n_svd_selected * n_svd_selected + END_DOC + + integer :: k, kp, l, lp + integer :: i, j, ii0, ii + integer :: e + double precision :: f, g, h, T, V + + do i = 1, n_svd_selected + ii0 = (i-1)*n_svd_selected + + l = psi_svd_alpha_numselected(i,1) + lp = psi_svd_beta_numselected (i,1) + + ! Lapl D + g = 0.d0 + do e = 1, elec_alpha_num + g += det_alpha_grad_lapl_SVD_unique(4,e,l) * det_beta_value_SVD_unique(lp) + enddo + do e = elec_alpha_num+1, elec_num + g += det_alpha_value_SVD_unique(l) * det_beta_grad_lapl_SVD_unique(4,e,lp) + enddo + T = g + + ! D (Lapl J)/J + g = 0.d0 + do e = 1, elec_num + g += jast_lapl_jast_inv(e) + enddo + T += det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * g + + ! 2 (grad D).(Grad J)/J + g = 0.d0 + do e = 1, elec_alpha_num + g += det_alpha_grad_lapl_SVD_unique(1,e,l) * jast_grad_jast_inv_x(e) + & + det_alpha_grad_lapl_SVD_unique(2,e,l) * jast_grad_jast_inv_y(e) + & + det_alpha_grad_lapl_SVD_unique(3,e,l) * jast_grad_jast_inv_z(e) + enddo + h = 0.d0 + do e = elec_alpha_num+1, elec_num + h += det_beta_grad_lapl_SVD_unique(1,e,lp) * jast_grad_jast_inv_x(e) + & + det_beta_grad_lapl_SVD_unique(2,e,lp) * jast_grad_jast_inv_y(e) + & + det_beta_grad_lapl_SVD_unique(3,e,lp) * jast_grad_jast_inv_z(e) + enddo + T += 2.d0 * ( g * det_beta_value_SVD_unique(lp) + h * det_alpha_value_SVD_unique(l) ) + + g = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) + V = E_pot * g + ! TODO + ! ajouter le terme pseudo + !do e = 1, elec_alpha_num + ! V -= pseudo_non_local_SVD(e) * g + ! V += det_alpha_pseudo_SVD_unique(e,l) * det_beta_value_SVD_unique(lp) + !enddo + !do e = elec_alpha_num+1, elec_num + ! V -= pseudo_non_local_SVD(e) * g + ! V += det_alpha_value_SVD_unique(l) * det_beta_pseudo_SVD_unique(e,lp) + !enddo + f = -0.5d0*T + V + f *= psidet_inv_SVD * psidet_inv_SVD + + do j = 1, n_svd_selected + ii = ii0 + j + + k = psi_svd_alpha_numselected(j,1) + kp = psi_svd_beta_numselected (j,1) + + h_selected_matrix(ii) = f * det_alpha_value_SVD_unique(k) * det_beta_value_SVD_unique(kp) + + enddo + enddo + + h_selected_matrix_min = min(h_selected_matrix_min,minval(h_selected_matrix)) + h_selected_matrix_max = max(h_selected_matrix_max,maxval(h_selected_matrix)) + SOFT_TOUCH h_selected_matrix_min h_selected_matrix_max +END_PROVIDER +