10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 21:03:56 +01:00
quantum_package/plugins/Hartree_Fock_SlaterDressed/integrals.irp.f

625 lines
17 KiB
Fortran
Raw Normal View History

2017-06-07 22:19:27 +02:00
!*****************************************************************************
2017-06-08 22:15:42 +02:00
subroutine GauSlaOverlap(expGau,cGau,aGau,expSla,cSla,result)
2017-06-07 22:19:27 +02:00
implicit none
2017-06-08 22:15:42 +02:00
BEGIN_DOC
! Compute the overlap integral between a Gaussian function
! with arbitrary angular momemtum and a s-type Slater function
END_DOC
2017-06-07 22:19:27 +02:00
! Input variables
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
2017-06-08 22:15:42 +02:00
double precision,intent(out) :: result
2017-06-07 22:19:27 +02:00
! Final value of the integrals
double precision :: ss,ps,ds
double precision :: pxs,pys,pzs
double precision :: dxxs,dyys,dzzs,dxys,dxzs,dyzs
double precision :: pi,E,AB,AxBx,AyBy,AzBz,t,u,k
pi = 4d0*atan(1d0)
! calculate the length AB between the two centers and other usful quantities
2017-06-16 15:35:52 +02:00
AB = (cGau(1)-cSla(1))**2 + (cGau(2)-cSla(2))**2 + (cGau(3)-cSla(3))**2
AB = dsqrt(AB)
2017-06-07 22:19:27 +02:00
AxBx = (cGau(1)-cSla(1))/2d0
AyBy = (cGau(2)-cSla(2))/2d0
AzBz = (cGau(3)-cSla(3))/2d0
2017-06-16 15:35:52 +02:00
ds = 0.d0
2017-06-07 22:19:27 +02:00
! intermediate variables
2017-06-16 15:35:52 +02:00
t = expSla*dsqrt(0.25d0/expGau)
u = dsqrt(expGau)*AB
2017-06-07 22:19:27 +02:00
2017-06-16 15:35:52 +02:00
double precision :: d, et2
2017-06-07 22:19:27 +02:00
if(AB > 0d0) then
! (s|s)
2017-06-16 15:35:52 +02:00
ss = 0.d0
d = derfc(t+u)
if (dabs(d) > 1.d-30) then
ss = (t+u)*d*dexp(2d0*t*(t+u))
endif
d = derfc(t-u)
if (dabs(d) > 1.d-30) then
ss -= (t-u)*d*dexp(2d0*t*(t-u))
endif
2017-06-07 22:19:27 +02:00
! (p|s)
2017-06-16 15:35:52 +02:00
ps = 0.d0
if (t*t-u*u > 300.d0) then
et2 = huge(1.0)
else
et2 = dexp(t*t-u*u)
endif
if (et2 /= 0.d0) then
d = derfc(t-u)
if (d /= 0.d0) then
ps += dexp((t-u)**2)*(1d0+2d0*t*(t-u))*d
endif
d = derfc(t+u)
if (d /= 0.d0) then
ps += dexp((t+u)**2)*(1d0+2d0*t*(t+u))*d
endif
ps *= dsqrt(pi)
ps -= 4d0*t
ps *= et2/dsqrt(pi)
endif
2017-06-07 22:19:27 +02:00
! (d|s)
2017-06-16 15:35:52 +02:00
! ds = 4d0*dexp(2d0*t*(t-u))*t*(-((1d0+t**2-t*u)*derfc(t-u))+dexp(4d0*t*u)*(1d0+t*(t+u))*derfc(t+u))
ds = 0.d0
d = derfc(t+u)
if (d /= 0.d0) then
ds = dexp(4d0*t*u)*(1d0+t*(t+u))*d
endif
d = derfc(t-u)
if (d /= 0.d0) then
ds -= (1d0+t*t-t*u)*d
endif
if ( dabs(ds) > 1.d-100) then
ds *= 4d0*dexp(2d0*t*(t-u))*t
endif
2017-06-07 22:19:27 +02:00
! backward scaling
ds = 3d0*ss/u**5d0 - 3d0*ps/u**4d0 + ds/u**3d0
2017-06-16 15:35:52 +02:00
ps = ps/u**2-ss/u**3d0
2017-06-07 22:19:27 +02:00
ss = ss/u
else
! concentric case
2017-06-16 15:35:52 +02:00
d = derfc(t)
if (d /= 0.d0) then
et2 = dexp(t*t)
ss = 2d0*et2*((-2d0*t)/dsqrt(pi)+et2*(1d0+2d0*t*t)*d)
ps = (8d0*et2*t*(-2d0*(1d0+t*t)+et2*dsqrt(pi)*t*(3d0+2d0*t*t)*d))/(3d0*dsqrt(pi))
else
ss = 0.d0
ps = 0.d0
endif
2017-06-07 22:19:27 +02:00
endif
2017-06-16 15:35:52 +02:00
k = t**3d0*dexp(-t*t)*4d0*pi/expSla**(3d0/2d0)
2017-06-07 22:19:27 +02:00
! (s|s)
ss = k*ss
! (p|s)
ps = k*ps
pxs = AxBx*ps
pys = AyBy*ps
pzs = AzBz*ps
! (d|s)
ds = k*ds
2017-06-16 15:35:52 +02:00
dxxs = (2d0*ss+ps)/(4d0*expGau) + AxBx**2*ds
dyys = (2d0*ss+ps)/(4d0*expGau) + AyBy**2*ds
dzzs = (2d0*ss+ps)/(4d0*expGau) + AzBz**2*ds
2017-06-07 22:19:27 +02:00
dxys = AxBx*AyBy*ds
dxzs = AxBx*AzBz*ds
dyzs = AyBy*AzBz*ds
2017-06-08 22:15:42 +02:00
select case (sum(aGau))
case (0)
result = ss
case (1)
if (aGau(1) == 1) then
result = pxs
else if (aGau(2) == 1) then
result = pys
else if (aGau(3) == 1) then
result = pzs
endif
case (2)
if (aGau(1) == 2) then
result = dxxs
else if (aGau(2) == 2) then
result = dyys
else if (aGau(3) == 2) then
result = dzzs
else if (aGau(1)+aGau(2) == 2) then
result = dxys
else if (aGau(1)+aGau(3) == 2) then
result = dxzs
else if (aGau(2)+aGau(3) == 2) then
result = dyzs
endif
case default
stop 'GauSlaOverlap not implemented'
end select
2017-06-07 22:19:27 +02:00
end
!*****************************************************************************
!*****************************************************************************
2017-06-16 15:35:52 +02:00
subroutine GauSlaKinetic(expGau,cGau,aGau,expSla,cSla,result)
2017-06-07 22:19:27 +02:00
implicit none
2017-06-08 22:15:42 +02:00
BEGIN_DOC
! Compute the kinetic energy integral between a Gaussian function
! with arbitrary angular momemtum and a s-type Slater function
END_DOC
2017-06-07 22:19:27 +02:00
! Input variables
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
2017-06-16 15:35:52 +02:00
double precision,intent(out) :: result
2017-06-07 22:19:27 +02:00
! Final value of the integrals
double precision :: ss,ps,ds
double precision :: pxs,pys,pzs
double precision :: dxxs,dyys,dzzs,dxys,dxzs,dyzs
double precision :: pi,E,AB,AxBx,AyBy,AzBz,t,u,k
pi = 4d0*atan(1d0)
! calculate the length AB between the two centers
2017-06-16 15:35:52 +02:00
AB = (cGau(1)-cSla(1))**2 + (cGau(2)-cSla(2))**2 + (cGau(3)-cSla(3))**2
AB = dsqrt(AB)
2017-06-07 22:19:27 +02:00
AxBx = (cGau(1)-cSla(1))/2d0
AyBy = (cGau(2)-cSla(2))/2d0
AzBz = (cGau(3)-cSla(3))/2d0
! intermediate variables
2017-06-16 15:35:52 +02:00
t = expSla*dsqrt(0.25d0/expGau)
u = dsqrt(expGau)*AB
2017-06-07 22:19:27 +02:00
if(AB > 0d0) then
! (s|s)
2017-06-16 15:35:52 +02:00
ss = (1d0+t*(t-u))*derfc(t-u)*dexp(2d0*t*(t-u)) - (1d0+t*(t+u))*derfc(t+u)*dexp(2d0*t*(t+u))
2017-06-07 22:19:27 +02:00
! (p|s)
2017-06-16 15:35:52 +02:00
ps = (dexp(t**2-2d0*t*u-u**2)*(4d0*dexp(2d0*t*u)*(1d0+t**2) &
+ dsqrt(pi)*t*(-(dexp(t**2+u**2)*(3d0+2d0*t*(t-u))*derfc(t-u)) &
- dexp(2d0*t*u+(t+u)**2)*(3d0+2d0*t*(t+u))*derfc(t+u))))/dsqrt(pi)
2017-06-07 22:19:27 +02:00
! (d|s)
2017-06-16 15:35:52 +02:00
ds = (-8d0*dexp(t**2-u**2)*u+4d0*dexp(2d0*t*(t-u))*dsqrt(pi)*t**2*((2d0+t**2-t*u)*derfc(t-u) &
- dexp(4d0*t*u)*(2d0+t*(t+u))*derfc(t+u)))/dsqrt(pi)
2017-06-07 22:19:27 +02:00
! backward scaling
ds = 3d0*ss/u**5d0 - 3d0*ps/u**4d0 + ds/u**3d0
2017-06-16 15:35:52 +02:00
ps = ps/u**2-ss/u**3d0
2017-06-07 22:19:27 +02:00
ss = ss/u
else
! concentric case
2017-06-16 15:35:52 +02:00
ss = (4d0*dexp(t**2)*(1d0+t**2))/dsqrt(pi)-2d0*dexp(2d0*t**2)*t*(3d0+2d0*t**2)*derfc(t)
ps = (8d0*dexp(t**2)*(-1d0+4d0*t**2+2d0*t**4d0-dexp(t**2)*dsqrt(pi)*t**3d0*(5d0+2d0*t**2)*derfc(t)))/(3d0*dsqrt(pi))
2017-06-07 22:19:27 +02:00
endif
2017-06-16 15:35:52 +02:00
k = expSla*dsqrt(expGau)*t**3d0*dexp(-t*t)*4d0*pi/expSla**(3d0/2d0)
2017-06-07 22:19:27 +02:00
! (s|s)
ss = k*ss
! (p|s)
ps = k*ps
pxs = AxBx*ps
pys = AyBy*ps
pzs = AzBz*ps
! (d|s)
ds = k*ds
2017-06-16 15:35:52 +02:00
dxxs = (2d0*ss+ps)/(4d0*expGau) + AxBx**2*ds
dyys = (2d0*ss+ps)/(4d0*expGau) + AyBy**2*ds
dzzs = (2d0*ss+ps)/(4d0*expGau) + AzBz**2*ds
2017-06-07 22:19:27 +02:00
dxys = AxBx*AyBy*ds
dxzs = AxBx*AzBz*ds
dyzs = AyBy*AzBz*ds
2017-06-16 15:35:52 +02:00
select case (sum(aGau))
case (0)
result = ss
case (1)
if (aGau(1) == 1) then
result = pxs
else if (aGau(2) == 1) then
result = pys
else if (aGau(3) == 1) then
result = pzs
endif
case (2)
if (aGau(1) == 2) then
result = dxxs
else if (aGau(2) == 2) then
result = dyys
else if (aGau(3) == 2) then
result = dzzs
else if (aGau(1)+aGau(2) == 2) then
result = dxys
else if (aGau(1)+aGau(3) == 2) then
result = dxzs
else if (aGau(2)+aGau(3) == 2) then
result = dyzs
endif
case default
stop 'GauSlaOverlap not implemented'
end select
2017-06-07 22:19:27 +02:00
end
!*****************************************************************************
2017-06-16 15:35:52 +02:00
2017-06-07 22:19:27 +02:00
!*****************************************************************************
2017-06-16 15:35:52 +02:00
subroutine GauSlaNuclear(expGau,cGau,aGau,expSla,cSla,ZNuc,cNuc,result)
2017-06-07 22:19:27 +02:00
implicit none
2017-06-08 22:15:42 +02:00
BEGIN_DOC
! Compute the nuclear attraction integral between a Gaussian function
! with arbitrary angular momemtum and a s-type Slater function
END_DOC
2017-06-07 22:19:27 +02:00
! Input variables
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
double precision,intent(in) :: cNuc(3)
double precision,intent(in) :: ZNuc
2017-06-16 15:35:52 +02:00
double precision,intent(out) :: result
2017-06-07 22:19:27 +02:00
! Final value of the overlap integral
double precision :: ss,ps,ds,fs
double precision :: pxs,pys,pzs
double precision :: pi,E,AB,x,y,k
pi = 4d0*atan(1d0)
E = exp(1d0)
! calculate the length AB between the two centers
2017-06-16 15:35:52 +02:00
AB = (cGau(1)-cSla(1))**2 + (cGau(2)-cSla(2))**2 + (cGau(3)-cSla(3))**2
AB = dsqrt(AB)
2017-06-07 22:19:27 +02:00
! intermediate variables
2017-06-16 15:35:52 +02:00
x = dsqrt(expSla**2/(4d0*expGau))
y = dsqrt(expGau)*AB
2017-06-07 22:19:27 +02:00
if(AB > 0d0) then
2017-06-16 15:35:52 +02:00
ss = (1d0+x*(x+y))*derfc(x+y)*dexp(2d0*x*(x+y)) - (1d0+x*(x-y))*derfc(x-y)*dexp(2d0*x*(x-y))
2017-06-07 22:19:27 +02:00
ss = ss/y
else
2017-06-16 15:35:52 +02:00
ss = (4d0*E**x**2*(1d0+x**2))/dsqrt(Pi)-2d0*E**(2d0*x**2)*x*(3d0+2d0*x**2)*dErfc(x)
2017-06-07 22:19:27 +02:00
endif
2017-06-16 15:35:52 +02:00
k = expSla*dsqrt(expGau)*x**3d0*dexp(-x*x)*4d0*pi/expSla**(3d0/2d0)
2017-06-07 22:19:27 +02:00
ss = k*ss
! Print result
write(*,*) ss
2017-06-16 15:35:52 +02:00
result = 0.d0
2017-06-07 22:19:27 +02:00
end
!*****************************************************************************
2017-06-16 15:35:52 +02:00
2017-06-07 22:19:27 +02:00
double precision function BoysF0(t)
2017-06-08 22:15:42 +02:00
implicit none
double precision, intent(in) :: t
2017-06-07 22:19:27 +02:00
double precision :: pi
pi = 4d0*atan(1d0)
if(t > 0d0) then
2017-06-16 15:35:52 +02:00
BoysF0 = 0.5d0*dsqrt(pi/t)*derf(dsqrt(t))
2017-06-07 22:19:27 +02:00
else
BoysF0 = 1d0
endif
end
!*****************************************************************************
2017-06-16 15:35:52 +02:00
!TODO
subroutine GauSlaOverlap_write(expGau,cGau,aGau,expSla,cSla,result,iunit)
implicit none
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
integer,intent(in) :: iunit
double precision,intent(out) :: result
write(iunit, *) &
'SDrSla[ {',expGau,',{',cGau(1),',',cGau(2),',',cGau(3),'},{',aGau(1),',',aGau(2),',',aGau(3),'} },{', expSla,', {',cSla(1),',',cSla(2),',',cSla(3),'} } ],'
result = 0.d0
end
subroutine GauSlaOverlap_read(expGau,cGau,aGau,expSla,cSla,result,iunit)
implicit none
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
integer,intent(in) :: iunit
double precision,intent(out) :: result
read(iunit, *) result
end
subroutine GauSlaKinetic_write(expGau,cGau,aGau,expSla,cSla,result,iunit)
implicit none
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
integer,intent(in) :: iunit
double precision,intent(out) :: result
write(iunit, *) &
'TDrSla[ {',expGau,',{',cGau(1),',',cGau(2),',',cGau(3),'},{',aGau(1),',',aGau(2),',',aGau(3),'} },{', expSla,',{',cSla(1),',',cSla(2),',',cSla(3),'} } ],'
result = 0.d0
end
subroutine GauSlaKinetic_read(expGau,cGau,aGau,expSla,cSla,result,iunit)
implicit none
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
integer,intent(in) :: iunit
double precision,intent(out) :: result
read(iunit, *) result
end
subroutine GauSlaNuclear_write(expGau,cGau,aGau,expSla,cSla,ZNuc,cNuc,result,iunit)
implicit none
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
double precision,intent(in) :: cNuc(3)
double precision,intent(in) :: ZNuc
integer,intent(in) :: iunit
double precision,intent(out) :: result
write(iunit, *) &
'VDrSla[ {',expGau,',{',cGau(1),',',cGau(2),',',cGau(3),'},{',aGau(1),',',aGau(2),',',aGau(3),'} },{ ', expSla,',{',cSla(1),',',cSla(2),',',cSla(3),'} }, {', ZNuc, ',{', cNuc(1),',', cNuc(2),',', cNuc(3), '} } ],'
result = 0.d0
end
subroutine GauSlaNuclear_read(expGau,cGau,aGau,expSla,cSla,ZNuc,cNuc,result,iunit)
implicit none
double precision,intent(in) :: expGau,expSla
double precision,intent(in) :: cGau(3),cSla(3)
integer,intent(in) :: aGau(3)
double precision,intent(in) :: cNuc(3)
double precision,intent(in) :: ZNuc
integer,intent(in) :: iunit
double precision,intent(out) :: result
read(iunit, *) result
end
!TODO
BEGIN_TEMPLATE
2017-06-07 22:19:27 +02:00
2017-06-16 15:35:52 +02:00
BEGIN_PROVIDER [ double precision, GauSla$X_matrix, (ao_num, nucl_num) ]
2017-06-08 22:15:42 +02:00
implicit none
BEGIN_DOC
! <Gaussian | Slater> overlap matrix
END_DOC
integer :: i,j,k
double precision :: cGau(3)
double precision :: cSla(3)
double precision :: expSla, res, expGau
integer :: aGau(3)
2017-06-16 15:35:52 +02:00
!TODO
logical :: read
integer :: iunit
integer :: getunitandopen
inquire(FILE=trim(ezfio_filename)//'/work/GauSla$X.dat',EXIST=read)
if (read) then
print *, 'READ $X'
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.dat','r')
else
print *, 'WRITE $X'
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.inp','w')
write(iunit,*) '{'
endif
!TODO
2017-06-08 22:15:42 +02:00
do k=1,nucl_num
cSla(1:3) = nucl_coord_transp(1:3,k)
expSla = slater_expo(k)
do i=1,ao_num
cGau(1:3) = nucl_coord_transp(1:3, ao_nucl(i))
aGau(1:3) = ao_power(i,1:3)
2017-06-16 15:35:52 +02:00
GauSla$X_matrix(i,k) = 0.d0
2017-06-08 22:15:42 +02:00
do j=1,ao_prim_num(i)
expGau = ao_expo_ordered_transp(j,i)
2017-06-16 15:35:52 +02:00
! call GauSla$X(expGau,cGau,aGau,expSla,cSla,res)
if (read) then
call GauSla$X_read(expGau,cGau,aGau,expSla,cSla,res,iunit)
else
call GauSla$X_write(expGau,cGau,aGau,expSla,cSla,res,iunit)
endif
GauSla$X_matrix(i,k) += ao_coef_normalized_ordered_transp(j,i) * res
2017-06-08 22:15:42 +02:00
enddo
enddo
enddo
2017-06-16 15:35:52 +02:00
if (.not.read) then
write(iunit,*) '0.}'
endif
close(iunit)
2017-06-08 22:15:42 +02:00
END_PROVIDER
2017-06-07 22:19:27 +02:00
2017-06-16 15:35:52 +02:00
BEGIN_PROVIDER [ double precision, MOSla$X_matrix, (mo_tot_num, nucl_num) ]
2017-06-12 16:31:34 +02:00
implicit none
BEGIN_DOC
! <MO | Slater>
END_DOC
call dgemm('N','N',mo_tot_num,nucl_num,ao_num,1.d0, &
mo_coef_transp, size(mo_coef_transp,1), &
2017-06-16 15:35:52 +02:00
GauSla$X_matrix, size(GauSla$X_matrix,1), &
0.d0, MOSla$X_matrix, size(MOSla$X_matrix,1))
END_PROVIDER
BEGIN_PROVIDER [ double precision, AO_orthoSla$X_matrix, (ao_num, nucl_num) ]
implicit none
BEGIN_DOC
! <AO_ortho | Slater>
END_DOC
call dgemm('T','N',ao_num,nucl_num,ao_num,1.d0, &
ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1), &
GauSla$X_matrix, size(GauSla$X_matrix,1), &
0.d0, AO_orthoSla$X_matrix, size(AO_orthoSla$X_matrix,1))
END_PROVIDER
SUBST [ X ]
Overlap ;;
Kinetic ;;
END_TEMPLATE
BEGIN_PROVIDER [ double precision, GauSlaNuclear_matrix, (ao_num, nucl_num) ]
implicit none
BEGIN_DOC
! <Gaussian | Slater> overlap matrix
END_DOC
integer :: i,j,k,A
double precision :: cGau(3)
double precision :: cSla(3)
double precision :: expSla, res, expGau, Znuc, cNuc(3)
integer :: aGau(3)
!TODO
logical :: read
integer :: iunit
integer :: getunitandopen
inquire(FILE=trim(ezfio_filename)//'/work/GauSlaNuclear.dat',EXIST=read)
if (read) then
print *, 'READ Nuclear'
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSlaNuclear.dat','r')
else
print *, 'WRITE Nuclear'
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSlaNuclear.inp','w')
write(iunit,*)'{'
endif
!TODO
do k=1,nucl_num
cSla(1:3) = nucl_coord_transp(1:3,k)
expSla = slater_expo(k)
do i=1,ao_num
cGau(1:3) = nucl_coord_transp(1:3, ao_nucl(i))
aGau(1:3) = ao_power(i,1:3)
GauSlaNuclear_matrix(i,k) = 0.d0
do j=1,ao_prim_num(i)
expGau = ao_expo_ordered_transp(j,i)
do A=1,nucl_num
cNuc(1:3) = nucl_coord_transp(1:3,A)
Znuc = nucl_charge(A)
! call GauSlaNuclear(expGau,cGau,aGau,expSla,cSla,Znuc,cNuc,res)
if (read) then
call GauSlaNuclear_read(expGau,cGau,aGau,expSla,cSla,Znuc,cNuc,res,iunit)
else
call GauSlaNuclear_write(expGau,cGau,aGau,expSla,cSla,Znuc,cNuc,res,iunit)
endif
GauSlaNuclear_matrix(i,k) += ao_coef_normalized_ordered_transp(j,i) * res
enddo
enddo
enddo
enddo
if (.not.read) then
write(iunit,*) '0.}'
endif
close(iunit)
END_PROVIDER
BEGIN_PROVIDER [ double precision, GauSlaH_matrix, (ao_num, nucl_num) ]
implicit none
BEGIN_DOC
! Core hamiltonian in AO basis
END_DOC
GauSlaH_matrix(1:ao_num,1:nucl_num) = &
GauSlaKinetic_matrix(1:ao_num,1:nucl_num) + &
GauSlaNuclear_matrix(1:ao_num,1:nucl_num)
END_PROVIDER
BEGIN_PROVIDER [ double precision, MOSlaNuclear_matrix, (mo_tot_num, nucl_num) ]
implicit none
BEGIN_DOC
! <MO | Slater>
END_DOC
call dgemm('N','N',mo_tot_num,nucl_num,ao_num,1.d0, &
mo_coef_transp, size(mo_coef_transp,1), &
GauSlaNuclear_matrix, size(GauSlaNuclear_matrix,1), &
0.d0, MOSlaNuclear_matrix, size(MOSlaNuclear_matrix,1))
END_PROVIDER
BEGIN_PROVIDER [ double precision, AO_orthoSlaH_matrix, (ao_num, nucl_num) ]
implicit none
BEGIN_DOC
! <AO ortho | Slater>
END_DOC
call dgemm('T','N',ao_num,nucl_num,ao_num,1.d0, &
ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1), &
GauSlaH_matrix, size(GauSlaH_matrix,1), &
0.d0, AO_orthoSlaH_matrix, size(AO_orthoSlaH_matrix,1))
2017-06-12 16:31:34 +02:00
END_PROVIDER