mirror of
https://github.com/QuantumPackage/qp2.git
synced 2025-04-25 17:54:44 +02:00
Merge branch 'dev-stable' of github.com:QuantumPackage/qp2 into dev-stable
This commit is contained in:
commit
e38ecc0a49
@ -163,14 +163,21 @@ real*8 function gradvec_it(i,t)
|
||||
tt=list_act(t)
|
||||
gradvec_it=2.D0*(Fipq(tt,ii)+Fapq(tt,ii))
|
||||
gradvec_it-=occnum(tt)*Fipq(ii,tt)
|
||||
do y=1,n_act_orb ! active
|
||||
! y3=y+n_core_inact_orb ! list_act(y)
|
||||
do x=1,n_act_orb ! active
|
||||
! x3=x+n_core_inact_orb ! list_act(x)
|
||||
do v=1,n_act_orb ! active
|
||||
vv=list_act(v)
|
||||
do x=1,n_act_orb ! active
|
||||
x3=x+n_core_inact_orb ! list_act(x)
|
||||
do y=1,n_act_orb ! active
|
||||
y3=y+n_core_inact_orb ! list_act(y)
|
||||
! Gamma(2) a a a a 1/r12 i a a a
|
||||
gradvec_it-=2.D0*P0tuvx_no(t,v,x,y)*bielec_PQxx_no(ii,vv,x3,y3)
|
||||
! gradvec_it-=2.D0*P0tuvx_no(t,v,x,y)*bielec_PQxx_no(ii,vv,x3,y3)
|
||||
integer :: ichol
|
||||
double precision :: tmp
|
||||
tmp = 0.d0
|
||||
do ichol=1,cholesky_mo_num
|
||||
tmp = tmp + cholesky_no_total_transp(ichol,vv,ii) * cholesky_no_total_transp(ichol,list_act(x),list_act(y))
|
||||
enddo
|
||||
gradvec_it = gradvec_it - 2.D0*P0tuvx_no(t,v,x,y)*tmp
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
@ -17,7 +17,8 @@ real*8 function hessmat_itju(i,t,j,u)
|
||||
if (i.eq.j) then
|
||||
if (t.eq.u) then
|
||||
! diagonal element
|
||||
term=occnum(tt)*Fipq(ii,ii)+2.D0*(Fipq(tt,tt)+Fapq(tt,tt)) &
|
||||
term = occnum(tt)*Fipq(ii,ii) + &
|
||||
2.D0*(Fipq(tt,tt)+Fapq(tt,tt)) &
|
||||
-2.D0*(Fipq(ii,ii)+Fapq(ii,ii))
|
||||
term+=2.D0*(3.D0*bielec_pxxq_no(tt,i,i,tt)-bielec_pqxx_no(tt,tt,i,i))
|
||||
term-=2.D0*occnum(tt)*(3.D0*bielec_pxxq_no(tt,i,i,tt) &
|
||||
@ -240,73 +241,176 @@ real*8 function hessmat_taub(t,a,u,b)
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: t,a,u,b,tt,aa,uu,bb,v,vv,x,xx,y
|
||||
integer :: v3,x3
|
||||
real*8 :: term,t1,t2,t3
|
||||
integer :: v3,x3, ichol
|
||||
real*8 :: term,t1,t2,t3, tmp
|
||||
double precision :: bielec_pqxx_no,bielec_pxxq_no
|
||||
|
||||
double precision, allocatable :: tmp1(:), tmp2(:,:)
|
||||
allocate(tmp1(n_act_orb))
|
||||
allocate(tmp2(n_act_orb,n_act_orb))
|
||||
|
||||
tt=list_act(t)
|
||||
aa=list_virt(a)
|
||||
|
||||
if (t == u) then
|
||||
if (a == b) then
|
||||
! ta/ta
|
||||
t1=occnum(tt)*Fipq(aa,aa)
|
||||
t1=occnum(tt)*Fipq(aa,aa) - occnum(tt)*Fipq(tt,tt)
|
||||
|
||||
t2=0.D0
|
||||
t3=0.D0
|
||||
t1-=occnum(tt)*Fipq(tt,tt)
|
||||
! do x=1,n_act_orb
|
||||
! x3=x+n_core_inact_orb
|
||||
! do v=1,n_act_orb
|
||||
! v3=v+n_core_inact_orb
|
||||
! tmp = 0.d0
|
||||
! do ichol = 1, cholesky_mo_num
|
||||
! tmp = tmp + cholesky_no_total_transp(ichol,aa,aa) * cholesky_no_total_transp(ichol,v3,x3)
|
||||
! enddo
|
||||
! t2 = t2 + 2.D0*P0tuvx_no(t,t,v,x)*tmp
|
||||
! enddo
|
||||
! enddo
|
||||
|
||||
do x=1,n_act_orb
|
||||
x3=x+n_core_inact_orb
|
||||
call dgemv('T', cholesky_mo_num, n_act_orb, 2.d0, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,x3), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,aa,aa), 1, 0.d0, &
|
||||
tmp1, 1)
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
t2 = t2 + P0tuvx_no(t,t,v,x)*tmp1(v)
|
||||
enddo
|
||||
enddo
|
||||
! do v=1,n_act_orb
|
||||
! v3=v+n_core_inact_orb
|
||||
! do x=1,n_act_orb
|
||||
! x3=x+n_core_inact_orb
|
||||
! tmp = 0.d0
|
||||
! do ichol = 1, cholesky_mo_num
|
||||
! tmp = tmp + cholesky_no_total_transp(ichol,aa,x3) * cholesky_no_total_transp(ichol,v3,aa)
|
||||
! enddo
|
||||
! t2 = t2 + 2.d0*(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v))*tmp
|
||||
! end do
|
||||
! end do
|
||||
call dgemm('T','N', n_act_orb, n_act_orb, cholesky_mo_num, 2.d0, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,aa), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,aa), cholesky_mo_num, 0.d0, &
|
||||
tmp2, n_act_orb)
|
||||
do v=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
t2 = t2 + P0tuvx_no(t,x,v,t)*tmp2(x,v) + P0tuvx_no(t,x,t,v)*tmp2(x,v)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
t3=0.D0
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
t2+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,aa,v3,x3) &
|
||||
+(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v))* &
|
||||
bielec_pxxq_no(aa,x3,v3,aa))
|
||||
do y=1,n_act_orb
|
||||
t3-=2.D0*P0tuvx_no(t,v,x,y)*bielecCI_no(t,v,y,xx)
|
||||
do v=1,n_act_orb
|
||||
t3 = t3 - P0tuvx_no(t,v,x,y)*bielecCI_no(v,t,y,xx)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
term=t1+t2+t3
|
||||
term=t1+t2+t3*2.d0
|
||||
|
||||
else
|
||||
|
||||
bb=list_virt(b)
|
||||
! ta/tb b/=a
|
||||
term=occnum(tt)*Fipq(aa,bb)
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
! do v=1,n_act_orb
|
||||
! vv=list_act(v)
|
||||
! v3=v+n_core_inact_orb
|
||||
! do x=1,n_act_orb
|
||||
! xx=list_act(x)
|
||||
! x3=x+n_core_inact_orb
|
||||
! term+=2.D0*P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,bb,v3,x3)
|
||||
! end do
|
||||
! end do
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
term+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,bb,v3,x3) &
|
||||
+(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v)) &
|
||||
*bielec_pxxq_no(aa,x3,v3,bb))
|
||||
end do
|
||||
end do
|
||||
call dgemv('T', cholesky_mo_num, n_act_orb, 2.d0, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,x3), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,aa,bb), 1, 0.d0, &
|
||||
tmp1, 1)
|
||||
do v=1,n_act_orb
|
||||
term = term + P0tuvx_no(t,t,v,x)*tmp1(v)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! do v=1,n_act_orb
|
||||
! vv=list_act(v)
|
||||
! v3=v+n_core_inact_orb
|
||||
! do x=1,n_act_orb
|
||||
! xx=list_act(x)
|
||||
! x3=x+n_core_inact_orb
|
||||
! term+=2.d0*(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v))*bielec_pxxq_no(aa,x3,v3,bb)
|
||||
! end do
|
||||
! end do
|
||||
call dgemm('T','N', n_act_orb, n_act_orb, cholesky_mo_num, 2.d0, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,aa), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,bb), cholesky_mo_num, 0.d0, &
|
||||
tmp2, n_act_orb)
|
||||
do v=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
term = term + P0tuvx_no(t,x,v,t)*tmp2(x,v) + P0tuvx_no(t,x,t,v)*tmp2(x,v)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end if
|
||||
|
||||
else
|
||||
|
||||
! ta/ub t/=u
|
||||
uu=list_act(u)
|
||||
bb=list_virt(b)
|
||||
|
||||
term=0.D0
|
||||
do v=1,n_act_orb
|
||||
vv=list_act(v)
|
||||
v3=v+n_core_inact_orb
|
||||
! do v=1,n_act_orb
|
||||
! vv=list_act(v)
|
||||
! v3=v+n_core_inact_orb
|
||||
! do x=1,n_act_orb
|
||||
! xx=list_act(x)
|
||||
! x3=x+n_core_inact_orb
|
||||
! term+=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,bb,v3,x3)
|
||||
! end do
|
||||
! end do
|
||||
do x=1,n_act_orb
|
||||
xx=list_act(x)
|
||||
x3=x+n_core_inact_orb
|
||||
term+=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,bb,v3,x3) &
|
||||
+(P0tuvx_no(t,x,v,u)+P0tuvx_no(t,x,u,v)) &
|
||||
*bielec_pxxq_no(aa,x3,v3,bb))
|
||||
end do
|
||||
end do
|
||||
call dgemv('T', cholesky_mo_num, n_act_orb, 2.d0, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,x3), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,aa,bb), 1, 0.d0, &
|
||||
tmp1, 1)
|
||||
do v=1,n_act_orb
|
||||
term = term + P0tuvx_no(t,u,v,x)*tmp1(v)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! do v=1,n_act_orb
|
||||
! vv=list_act(v)
|
||||
! v3=v+n_core_inact_orb
|
||||
! do x=1,n_act_orb
|
||||
! xx=list_act(x)
|
||||
! x3=x+n_core_inact_orb
|
||||
! term+=2.D0*(P0tuvx_no(t,x,v,u)+P0tuvx_no(t,x,u,v))*bielec_pxxq_no(aa,x3,v3,bb)
|
||||
! end do
|
||||
! end do
|
||||
call dgemm('T','N', n_act_orb, n_act_orb, cholesky_mo_num, 2.d0, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,aa), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,n_core_inact_orb+1,bb), cholesky_mo_num, 0.d0, &
|
||||
tmp2, n_act_orb)
|
||||
do v=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
term = term + P0tuvx_no(t,x,v,u)*tmp2(x,v)+P0tuvx_no(t,x,u,v)*tmp2(x,v)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (a.eq.b) then
|
||||
term-=0.5D0*(occnum(tt)*Fipq(uu,tt)+occnum(uu)*Fipq(tt,uu))
|
||||
do v=1,n_act_orb
|
||||
do y=1,n_act_orb
|
||||
do x=1,n_act_orb
|
||||
term-=P0tuvx_no(t,v,x,y)*bielecCI_no(x,y,v,uu)
|
||||
term-=P0tuvx_no(u,v,x,y)*bielecCI_no(x,y,v,tt)
|
||||
term = term - P0tuvx_no(t,v,x,y)*bielecCI_no(x,y,v,uu) &
|
||||
- P0tuvx_no(u,v,x,y)*bielecCI_no(x,y,v,tt)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
@ -3,8 +3,7 @@ BEGIN_PROVIDER [real*8, Fipq, (mo_num,mo_num) ]
|
||||
! the inactive Fock matrix, in molecular orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: p,q,k,kk,t,tt,u,uu
|
||||
double precision :: bielec_pxxq_no, bielec_pqxx_no
|
||||
integer :: i,p,q,k,kk,t,tt,u,uu
|
||||
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
@ -15,15 +14,32 @@ BEGIN_PROVIDER [real*8, Fipq, (mo_num,mo_num) ]
|
||||
! the inactive Fock matrix
|
||||
do k=1,n_core_inact_orb
|
||||
kk=list_core_inact(k)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
Fipq(p,q)+=2.D0*bielec_pqxx_no(p,q,k,k) -bielec_pxxq_no(p,k,k,q)
|
||||
end do
|
||||
end do
|
||||
! do q=1,mo_num
|
||||
! do p=1,mo_num
|
||||
! do i=1,cholesky_mo_num
|
||||
! Fipq(p,q) = Fipq(p,q) + 2.d0* cholesky_no_total_transp(i,p,q) * cholesky_no_total_transp(i,kk,kk)
|
||||
! enddo
|
||||
! end do
|
||||
! end do
|
||||
call dgemv('T', cholesky_mo_num, mo_num*mo_num, 2.d0, &
|
||||
cholesky_no_total_transp, cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,kk,kk), 1, 1.d0, &
|
||||
Fipq, 1)
|
||||
|
||||
! do q=1,mo_num
|
||||
! do p=1,mo_num
|
||||
! do i=1,cholesky_mo_num
|
||||
! Fipq(p,q) = Fipq(p,q) - cholesky_no_total_transp(i,p,kk) * cholesky_no_total_transp(i,kk,q)
|
||||
! enddo
|
||||
! end do
|
||||
! end do
|
||||
call dgemm('T','N', mo_num, mo_num, cholesky_mo_num, -1.d0, &
|
||||
cholesky_no_total_transp(1,1,kk), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,kk,1), cholesky_mo_num*mo_num, 1.d0, &
|
||||
Fipq, mo_num)
|
||||
end do
|
||||
|
||||
if (bavard) then
|
||||
integer :: i
|
||||
write(6,*)
|
||||
write(6,*) ' the diagonal of the inactive effective Fock matrix '
|
||||
write(6,'(5(i3,F12.5))') (i,Fipq(i,i),i=1,mo_num)
|
||||
@ -45,19 +61,34 @@ BEGIN_PROVIDER [real*8, Fapq, (mo_num,mo_num) ]
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: p,q,k,kk,t,tt,u,uu
|
||||
double precision :: bielec_pxxq_no, bielec_pqxx_no
|
||||
|
||||
Fapq = 0.d0
|
||||
|
||||
! the active Fock matrix, D0tu is diagonal
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
Fapq(p,q)+=occnum(tt) &
|
||||
*(bielec_pqxx_no(p,q,tt,tt)-0.5D0*bielec_pxxq_no(p,tt,tt,q))
|
||||
end do
|
||||
end do
|
||||
! do q=1,mo_num
|
||||
! do p=1,mo_num
|
||||
! do i=1,cholesky_mo_num
|
||||
! Fapq(p,q) = Fapq(p,q) + occnum(tt)* cholesky_no_total_transp(i,p,q) * cholesky_no_total_transp(i,tt,tt)
|
||||
! enddo
|
||||
! end do
|
||||
! end do
|
||||
call dgemv('T', cholesky_mo_num, mo_num*mo_num, occnum(tt), &
|
||||
cholesky_no_total_transp, cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,tt,tt), 1, 1.d0, &
|
||||
Fapq, 1)
|
||||
! do q=1,mo_num
|
||||
! do p=1,mo_num
|
||||
! do i=1,cholesky_mo_num
|
||||
! Fapq(p,q) = Fapq(p,q) - 0.5d0*occnum(tt)*cholesky_no_total_transp(i,p,tt) * cholesky_no_total_transp(i,tt,q)
|
||||
! enddo
|
||||
! end do
|
||||
! end do
|
||||
call dgemm('T','N', mo_num, mo_num, cholesky_mo_num, -0.5d0*occnum(tt), &
|
||||
cholesky_no_total_transp(1,1,tt), cholesky_mo_num, &
|
||||
cholesky_no_total_transp(1,tt,1), cholesky_mo_num*mo_num, 1.d0, &
|
||||
Fapq, mo_num)
|
||||
end do
|
||||
|
||||
if (bavard) then
|
||||
|
||||
@ -72,84 +72,27 @@ BEGIN_PROVIDER [real*8, P0tuvx_no, (n_act_orb,n_act_orb,n_act_orb,n_act_orb)]
|
||||
BEGIN_DOC
|
||||
! 4-index transformation of 2part matrices
|
||||
END_DOC
|
||||
integer :: i,j,k,l,p,q
|
||||
real*8 :: d(n_act_orb)
|
||||
|
||||
! index per index
|
||||
! first quarter
|
||||
P0tuvx_no(:,:,:,:) = P0tuvx(:,:,:,:)
|
||||
double precision, allocatable :: tmp(:,:,:,:)
|
||||
allocate(tmp(n_act_orb,n_act_orb,n_act_orb,n_act_orb))
|
||||
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(q,j,k,l)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(p,j,k,l)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! 2nd quarter
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(j,q,k,l)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(j,p,k,l)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! 3rd quarter
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(j,k,q,l)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(j,k,p,l)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! 4th quarter
|
||||
do j=1,n_act_orb
|
||||
do k=1,n_act_orb
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=P0tuvx_no(j,k,l,q)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
P0tuvx_no(j,k,l,p)=d(p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',(n_act_orb*n_act_orb*n_act_orb), n_act_orb, n_act_orb, 1.d0, &
|
||||
P0tuvx, n_act_orb, natorbsCI, n_act_orb, 0.d0, &
|
||||
tmp, (n_act_orb*n_act_orb*n_act_orb))
|
||||
|
||||
call dgemm('T','N',(n_act_orb*n_act_orb*n_act_orb), n_act_orb, n_act_orb, 1.d0, &
|
||||
tmp, n_act_orb, natorbsCI, n_act_orb, 0.d0, &
|
||||
P0tuvx_no, (n_act_orb*n_act_orb*n_act_orb))
|
||||
|
||||
call dgemm('T','N',(n_act_orb*n_act_orb*n_act_orb), n_act_orb, n_act_orb, 1.d0, &
|
||||
P0tuvx_no, n_act_orb, natorbsCI, n_act_orb, 0.d0, &
|
||||
tmp, (n_act_orb*n_act_orb*n_act_orb))
|
||||
|
||||
call dgemm('T','N',(n_act_orb*n_act_orb*n_act_orb), n_act_orb, n_act_orb, 1.d0, &
|
||||
tmp, n_act_orb, natorbsCI, n_act_orb, 0.d0, &
|
||||
P0tuvx_no, (n_act_orb*n_act_orb*n_act_orb))
|
||||
|
||||
deallocate(tmp)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -160,6 +103,7 @@ BEGIN_PROVIDER [real*8, one_ints_no, (mo_num,mo_num)]
|
||||
BEGIN_DOC
|
||||
! Transformed one-e integrals
|
||||
END_DOC
|
||||
|
||||
integer :: i,j, p, q
|
||||
real*8 :: d(n_act_orb)
|
||||
one_ints_no(:,:)=mo_one_e_integrals(:,:)
|
||||
@ -168,10 +112,8 @@ BEGIN_PROVIDER [real*8, one_ints_no, (mo_num,mo_num)]
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=one_ints_no(list_act(q),j)*natorbsCI(q,p)
|
||||
d(p) = d(p) + one_ints_no(list_act(q),j)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
@ -183,8 +125,6 @@ BEGIN_PROVIDER [real*8, one_ints_no, (mo_num,mo_num)]
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
d(p)=0.D0
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
do q=1,n_act_orb
|
||||
d(p)+=one_ints_no(j,list_act(q))*natorbsCI(q,p)
|
||||
end do
|
||||
|
||||
@ -228,20 +228,13 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
shift = N_st_diag*(iter-1)
|
||||
shift2 = N_st_diag*iter
|
||||
|
||||
if ((iter > 1).or.(itertot == 1)) then
|
||||
! Compute |W_k> = \sum_i |i><i|H|u_k>
|
||||
! -----------------------------------
|
||||
|
||||
! Gram-Smitt to orthogonalize all new guess with the previous vectors
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
|
||||
! call H_S2_u_0_nstates_openmp(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
|
||||
call hpsi(W(:,shift+1),U(:,shift+1),N_st_diag,sze,h_mat)
|
||||
else
|
||||
! Already computed in update below
|
||||
continue
|
||||
endif
|
||||
|
||||
! Compute h_kl = <u_k | W_l> = <u_k| H |u_l>
|
||||
! -------------------------------------------
|
||||
@ -311,7 +304,7 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
do i=1,sze
|
||||
U(i,shift2+k) = &
|
||||
(lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) &
|
||||
/max(H_jj(i) - lambda (k),1.d-2)
|
||||
/max(dabs(H_jj(i) - lambda (k)),1.d-2) * dsign(1d0,H_jj(i) - lambda (k))
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
@ -337,7 +330,7 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
|
||||
|
||||
do k=1,N_st
|
||||
if (residual_norm(k) > 1.e8) then
|
||||
if (residual_norm(k) > 1.d8) then
|
||||
print *, 'Davidson failed'
|
||||
stop -1
|
||||
endif
|
||||
@ -365,13 +358,15 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, &
|
||||
U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
|
||||
|
||||
do k=1,N_st_diag
|
||||
do i=1,sze
|
||||
U(i,k) = u_in(i,k)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call ortho_qr(U,size(U,1),sze,N_st_diag)
|
||||
call ortho_qr(U,size(U,1),sze,N_st_diag)
|
||||
|
||||
do j=1,N_st_diag
|
||||
k=1
|
||||
do while ((k<sze).and.(U(k,j) == 0.d0))
|
||||
|
||||
@ -187,7 +187,7 @@ END_PROVIDER
|
||||
BEGIN_PROVIDER[double precision, aos_in_r_array_extra, (ao_num,n_points_extra_final_grid)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! aos_in_r_array_extra(i,j) = value of the ith ao on the jth grid point
|
||||
! aos_in_r_array_extra(i,j) = value of the ith ao on the jth grid point of the EXTRA grid
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
double precision :: aos_array(ao_num), r(3)
|
||||
@ -214,7 +214,7 @@ END_PROVIDER
|
||||
BEGIN_PROVIDER[double precision, aos_in_r_array_extra_transp, (n_points_extra_final_grid,ao_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! aos_in_r_array_extra_transp(i,j) = value of the jth ao on the ith grid point
|
||||
! aos_in_r_array_extra_transp(i,j) = value of the jth ao on the ith grid point of the EXTRA grid
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
||||
@ -181,3 +181,44 @@
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
!!!!!EXTRA GRID
|
||||
|
||||
BEGIN_PROVIDER[double precision, mos_in_r_array_extra_omp, (mo_num,n_points_extra_final_grid)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! mos_in_r_array_extra(i,j) = value of the ith mo on the jth grid point on the EXTRA GRID
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
double precision :: mos_array_extra(mo_num), r(3)
|
||||
print*,'coucou'
|
||||
!$OMP PARALLEL DO &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,r,mos_array_extra,j) &
|
||||
!$OMP SHARED(mos_in_r_array_extra_omp,n_points_extra_final_grid,mo_num,final_grid_points_extra)
|
||||
do i = 1, n_points_extra_final_grid
|
||||
r(1) = final_grid_points_extra(1,i)
|
||||
r(2) = final_grid_points_extra(2,i)
|
||||
r(3) = final_grid_points_extra(3,i)
|
||||
call give_all_mos_at_r(r,mos_array_extra)
|
||||
do j = 1, mo_num
|
||||
mos_in_r_array_extra_omp(j,i) = mos_array_extra(j)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
print*,'coucou fin'
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER[double precision, mos_in_r_array_extra_transp,(n_points_extra_final_grid,mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! mos_in_r_array_extra_transp(i,j) = value of the jth mo on the ith grid point
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
do i = 1, n_points_extra_final_grid
|
||||
do j = 1, mo_num
|
||||
mos_in_r_array_extra_transp(i,j) = mos_in_r_array_extra_omp(j,i)
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
@ -86,7 +86,6 @@ BEGIN_PROVIDER [ double precision, mo_integrals_cache, (0_8:mo_integrals_cache_s
|
||||
|
||||
call set_multiple_levels_omp(.False.)
|
||||
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(k,l,ii) SCHEDULE(dynamic)
|
||||
do l=mo_integrals_cache_min,mo_integrals_cache_max
|
||||
do k=mo_integrals_cache_min,mo_integrals_cache_max
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user