quantum_package/plugins/Hartree_Fock_SlaterDressed/LinearSystem.irp.f

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