mirror of
https://github.com/LCPQ/quantum_package
synced 2024-11-19 12:32:34 +01:00
64 lines
1.6 KiB
Fortran
64 lines
1.6 KiB
Fortran
BEGIN_PROVIDER [ double precision, cusp_A, (nucl_num, nucl_num) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Equations to solve : A.X = B
|
|
END_DOC
|
|
|
|
integer :: mu, A, B
|
|
|
|
cusp_A = 0.d0
|
|
do A=1,nucl_num
|
|
cusp_A(A,A) = slater_expo(A)/nucl_charge(A) * slater_value_at_nucl(A,A)
|
|
do B=1,nucl_num
|
|
cusp_A(A,B) -= slater_value_at_nucl(B,A)
|
|
! Projector
|
|
do mu=1,mo_tot_num
|
|
cusp_A(A,B) += AO_orthoSlaOverlap_matrix(mu,B) * ao_ortho_value_at_nucl(mu,A)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, cusp_B, (nucl_num, mo_tot_num) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Equations to solve : A.C = B
|
|
END_DOC
|
|
|
|
integer :: i, A, info
|
|
|
|
do i=1,mo_tot_num
|
|
do A=1,nucl_num
|
|
cusp_B(A,i) = mo_value_at_nucl(i,A)
|
|
enddo
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, cusp_C, (nucl_num, mo_tot_num) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Equations to solve : A.C = B
|
|
END_DOC
|
|
|
|
integer :: info
|
|
integer :: ipiv(nucl_num)
|
|
double precision, allocatable :: AF(:,:)
|
|
allocate ( AF(nucl_num,nucl_num) )
|
|
|
|
cusp_C(1:nucl_num,1:mo_tot_num) = cusp_B(1:nucl_num,1:mo_tot_num)
|
|
AF(1:nucl_num,1:nucl_num) = cusp_A(1:nucl_num,1:nucl_num)
|
|
call dgetrf(nucl_num,nucl_num,AF,size(AF,1),ipiv,info)
|
|
if (info /= 0) then
|
|
print *, info
|
|
stop 'dgetrf failed'
|
|
endif
|
|
call dgetrs('N',nucl_num,mo_tot_num,AF,size(AF,1),ipiv,cusp_C,size(cusp_C,1),info)
|
|
if (info /= 0) then
|
|
print *, info
|
|
stop 'dgetrs failed'
|
|
endif
|
|
|
|
END_PROVIDER
|
|
|