quantum_package/plugins/Hartree_Fock_SlaterDressed/LinearSystem.irp.f

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