quantum_package/src/QmcChem/pseudo.irp.f

subroutine write_pseudopotential
  implicit none
  BEGIN_DOC
!  Write the pseudo_potential into the EZFIO file
  END_DOC
!  call ezfio_set_pseudo_pseudo_matrix(pseudo_matrix)
  call ezfio_set_pseudo_ao_pseudo_grid(ao_pseudo_grid)
end


BEGIN_PROVIDER [ double precision, pseudo_matrix, (aux_basis_num_sqrt,aux_basis_num_sqrt) ]
 implicit none
 BEGIN_DOC
 ! Pseudo-potential expressed in the basis of ao products
 END_DOC

 integer :: i,j,k,l
 integer :: info, m,n, lwork, lda, ldu, ldvt
 integer, allocatable :: iwork(:)
 character :: jobz
 double precision, allocatable :: a(:,:),work(:)

 double precision,allocatable :: U(:,:)
 double precision,allocatable :: Vt(:,:)
 double precision,allocatable :: S(:), B(:)



 jobz = 'A'
 m = aux_basis_num
 n = aux_basis_num
 lda = size(aux_basis_overlap_matrix,1)
 ldu = lda
 ldvt = lda
 lwork = -1

! allocate (A(lda,n), U(ldu,n), Vt(ldvt,n), S(n), work(1), b(n), iwork(8*n))
 allocate (A(lda,n), U(ldu,n), Vt(ldvt,n), S(n), work(1), b(n),iwork(1))

 work(1) = 1
 do i=1,n
   do j=1,n
     A(i,j) = aux_basis_overlap_matrix(i,j)
   enddo
 enddo

! call dgesdd(jobz, m, n, A, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
 call dgesvd(jobz, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info)
 lwork = int(work(1))
 deallocate(work)

 print *,  'Fitting pseudo-potentials'

 allocate(work(lwork))
! call dgesdd(jobz, m, n, A, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
 call dgesvd(jobz, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info)
 deallocate(work)

 do i=1,n
 print *,  i, s(i)
 enddo

 do k=1,n
   if (s(k) < 1.d-1) then
     s(k) = 0.d0
   else
     s(k) = 1.d0/s(k)
   endif
   do m=1,n
     Vt(m,k) = S(m) * Vt(m,k) 
   enddo
 enddo
 call dgemm('N','N',n,n,n,1.d0,U,lda,Vt,ldvt,0.d0,A,lda)
! do k=1,n
!  do l=1,n
!   A(k,l) = 0.d0
!   do m=1,n
!    A(k,l) = A(k,l) + U(k,m) * Vt(m,l)
!   enddo
! enddo

 do k=1,n
   i = aux_basis_idx(1,k)
   j = aux_basis_idx(2,k)
   b(k) = aux_pseudo_integral(i,j)
 enddo

 do k=1,n
   S(k) = 0.d0
 enddo
 do l=1,n
   do k=1,n
     S(k) = S(k) + A(k,l) * b(l)
   enddo
 enddo

 do k=1,aux_basis_num
   i = aux_basis_idx(1,k)
   j = aux_basis_idx(2,k)
   pseudo_matrix(i,j) = S(k)
   pseudo_matrix(j,i) = S(k)
 enddo
 deallocate(a,b,s,iwork,u,vt)

print *,  'Done'
 if (info /= 0) then
   print *,  info
   stop 'pseudo fit failed'
 endif
END_PROVIDER





!BEGIN_PROVIDER [ double precision, pseudo_matrix, (ao_num,ao_num) ]
! implicit none
! BEGIN_DOC
! ! Pseudo-potential expressed in the basis of ao products
! END_DOC
!
! integer :: i,j,k
! integer :: info, n, lwork, lda, ldb, nrhs
! character :: uplo
! integer, allocatable :: ipiv(:)
! double precision, allocatable :: a(:,:),work(:), b(:)
!
! uplo = 'L'
! n = aux_basis_num
! nrhs = 1
! lda = size(aux_basis_overlap_matrix,1)
! ldb = n
! lwork = -1
!
! print *,  'Fitting pseudo-potentials'
! allocate(work(1),a(lda,n),ipiv(n),b(n))
! work(1) = 1
! do i=1,n
!   do j=1,n
!     a(i,j) = aux_basis_overlap_matrix(i,j)
!   enddo
! enddo
!
! do k=1,n
!   i = aux_basis_idx(1,k)
!   j = aux_basis_idx(2,k)
!   b(k) = ao_pseudo_integral(i,j)
! enddo
! call dsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info )
! lwork = int(work(1))
! deallocate(work)
!
! allocate(work(lwork))
! call dsysv( uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info )
! deallocate(work,ipiv)
! do k=1,aux_basis_num
!   i = aux_basis_idx(1,k)
!   j = aux_basis_idx(2,k)
!   pseudo_matrix(i,j) = b(k)
!   pseudo_matrix(j,i) = b(k)
! enddo
! deallocate(a,b)
!
!print *,  'Done'
! if (info /= 0) then
!   print *,  info
!   stop 'pseudo fit failed'
! endif
!END_PROVIDER