10
1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-06-01 02:45:18 +02:00
qmcchem/src/psi.irp.f
2021-04-27 02:38:49 +02:00

142 lines
4.5 KiB
Fortran

BEGIN_PROVIDER [ double precision, psi_value ]
implicit none
BEGIN_DOC
! Value of the wave function
END_DOC
double precision :: norm_Err, psi_value2
if (utilise_svd) then
psi_value = psidet_value_svd*jast_value
else
psi_value = psidet_value*jast_value
endif
if (psi_value == 0.d0) then
call abrt(irp_here,"Value of the wave function is 0.")
endif
!psi_value2 = psidet_value_svd * jast_value
!norm_Err = (psi_value2 - psi_value)**2 / psi_value**2
!if (norm_Err > 1.d-6) then
! print *, 'probleme dans PROVIDER [ psi_value ]: norm_Err = ', norm_Err
!print *, psi_value2
!print *, psi_value
!print *, irp_here
!stop
!endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_value_inv ]
implicit none
BEGIN_DOC
! 1./psi_value
END_DOC
psi_value_inv = 1.d0/psi_value
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_value_inv2 ]
implicit none
BEGIN_DOC
! 1./(psi_value)**2
END_DOC
psi_value_inv2 = psi_value_inv*psi_value_inv
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_lapl, (elec_num_8) ]
implicit none
BEGIN_DOC
! Laplacian of the wave function
END_DOC
double precision :: psi_lapl2(elec_num)
double precision :: norm_Err
integer :: i, j
if (utilise_svd) then
!DIR$ VECTOR ALIGNED
!DIR$ LOOP COUNT (100)
do j=1,elec_num
psi_lapl(j) = jast_value*(psidet_grad_lapl_svd(4,j) + psidet_value_svd*jast_lapl_jast_inv(j) + 2.d0*(&
psidet_grad_lapl_svd(1,j)*jast_grad_jast_inv_x(j) + &
psidet_grad_lapl_svd(2,j)*jast_grad_jast_inv_y(j) + &
psidet_grad_lapl_svd(3,j)*jast_grad_jast_inv_z(j) ))
enddo
else
!DIR$ VECTOR ALIGNED
!DIR$ LOOP COUNT (100)
do j=1,elec_num
psi_lapl(j) = jast_value*(psidet_grad_lapl(4,j) + psidet_value*jast_lapl_jast_inv(j) + 2.d0*(&
psidet_grad_lapl(1,j)*jast_grad_jast_inv_x(j) + &
psidet_grad_lapl(2,j)*jast_grad_jast_inv_y(j) + &
psidet_grad_lapl(3,j)*jast_grad_jast_inv_z(j) ))
enddo
endif
!norm_Err = sum( (psi_lapl2(1:elec_num) - psi_lapl(1:elec_num))**2 ) / sum( psi_lapl(1:elec_num)**2 )
!if (norm_Err > 1.d-6) then
! print *, 'probleme dans PROVIDER [ psi_lapl ]: norm_Err = ', norm_Err
!print *, psi_lapl2(1:elec_num)
!print *, psi_lapl(1:elec_num)
!print *, irp_here
!stop
!endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_grad_psi_inv_x, (elec_num_8) ]
&BEGIN_PROVIDER [ double precision, psi_grad_psi_inv_y, (elec_num_8) ]
&BEGIN_PROVIDER [ double precision, psi_grad_psi_inv_z, (elec_num_8) ]
implicit none
BEGIN_DOC
! grad(psi)/psi
END_DOC
double precision :: psi_grad_psi_inv_x2(elec_num), psi_grad_psi_inv_y2(elec_num), psi_grad_psi_inv_z2(elec_num)
double precision :: norm_Err
integer :: j
if (utilise_svd) then
!DIR$ VECTOR ALIGNED
!DIR$ LOOP COUNT (100)
do j=1,elec_num
psi_grad_psi_inv_x(j) = psidet_grad_lapl_svd(1,j)*psidet_inv_svd + jast_grad_jast_inv_x(j)
psi_grad_psi_inv_y(j) = psidet_grad_lapl_svd(2,j)*psidet_inv_svd + jast_grad_jast_inv_y(j)
psi_grad_psi_inv_z(j) = psidet_grad_lapl_svd(3,j)*psidet_inv_svd + jast_grad_jast_inv_z(j)
enddo
else
!DIR$ VECTOR ALIGNED
!DIR$ LOOP COUNT (100)
do j=1,elec_num
psi_grad_psi_inv_x(j) = psidet_grad_lapl(1,j)*psidet_inv + jast_grad_jast_inv_x(j)
psi_grad_psi_inv_y(j) = psidet_grad_lapl(2,j)*psidet_inv + jast_grad_jast_inv_y(j)
psi_grad_psi_inv_z(j) = psidet_grad_lapl(3,j)*psidet_inv + jast_grad_jast_inv_z(j)
enddo
endif
!norm_Err = sum( (psi_grad_psi_inv_x2(1:elec_num) - psi_grad_psi_inv_x(1:elec_num))**2 ) / sum( psi_grad_psi_inv_x(1:elec_num)**2 )
!norm_Err = norm_Err + sum( (psi_grad_psi_inv_y2(1:elec_num) - psi_grad_psi_inv_y(1:elec_num))**2 ) / sum( psi_grad_psi_inv_y(1:elec_num)**2 )
!norm_Err = norm_Err + sum( (psi_grad_psi_inv_z2(1:elec_num) - psi_grad_psi_inv_z(1:elec_num))**2 ) / sum( psi_grad_psi_inv_z(1:elec_num)**2 )
!if (norm_Err > 1.d-6) then
! print *, 'probleme dans PROVIDER [ psi_grad_psi_inv_xyz ]: norm_Err = ', norm_Err
!print *, irp_here
!stop
!endif
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_lapl_psi_inv, (elec_num_8) ]
implicit none
BEGIN_DOC
! (Laplacian psi) / psi
END_DOC
integer :: i, j
!DIR$ VECTOR ALIGNED
!DIR$ LOOP COUNT (100)
do j=1,elec_num
psi_lapl_psi_inv(j) = psi_lapl(j)*psi_value_inv
enddo
END_PROVIDER