9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-09 06:53:38 +01:00

Compare commits

..

2 Commits

Author SHA1 Message Date
05df77ddb8 Fixed previous commit 2019-07-02 23:30:36 +02:00
1db247b27e n_core -> n_core_inactive 2019-07-02 22:52:47 +02:00
10 changed files with 121 additions and 122 deletions

View File

@ -228,6 +228,8 @@ END_PROVIDER
list_core_reverse(i) = n list_core_reverse(i) = n
endif endif
enddo enddo
print *, 'Core MOs:'
print *, list_core(1:n_core_orb)
END_PROVIDER END_PROVIDER
@ -249,6 +251,8 @@ END_PROVIDER
list_inact_reverse(i) = n list_inact_reverse(i) = n
endif endif
enddo enddo
print *, 'Inactive MOs:'
print *, list_inact(1:n_inact_orb)
END_PROVIDER END_PROVIDER
@ -270,6 +274,8 @@ END_PROVIDER
list_virt_reverse(i) = n list_virt_reverse(i) = n
endif endif
enddo enddo
print *, 'Virtual MOs:'
print *, list_virt(1:n_virt_orb)
END_PROVIDER END_PROVIDER
@ -291,6 +297,8 @@ END_PROVIDER
list_del_reverse(i) = n list_del_reverse(i) = n
endif endif
enddo enddo
print *, 'Deleted MOs:'
print *, list_del(1:n_del_orb)
END_PROVIDER END_PROVIDER
@ -312,6 +320,8 @@ END_PROVIDER
list_act_reverse(i) = n list_act_reverse(i) = n
endif endif
enddo enddo
print *, 'Active MOs:'
print *, list_act(1:n_act_orb)
END_PROVIDER END_PROVIDER
@ -330,6 +340,8 @@ END_PROVIDER
do i = 1, n_core_inact_orb do i = 1, n_core_inact_orb
list_core_inact_reverse(list_core_inact(i)) = i list_core_inact_reverse(list_core_inact(i)) = i
enddo enddo
print *, 'Core and Inactive MOs:'
print *, list_core_inact(1:n_core_inact_orb)
END_PROVIDER END_PROVIDER
@ -346,6 +358,8 @@ END_PROVIDER
do i = 1, n_core_inact_act_orb do i = 1, n_core_inact_act_orb
list_core_inact_act_reverse(list_core_inact_act(i)) = i list_core_inact_act_reverse(list_core_inact_act(i)) = i
enddo enddo
print *, 'Core, Inactive and Active MOs:'
print *, list_core_inact_act(1:n_core_inact_act_orb)
END_PROVIDER END_PROVIDER
@ -362,5 +376,7 @@ END_PROVIDER
do i = 1, n_inact_act_orb do i = 1, n_inact_act_orb
list_inact_act_reverse(list_inact_act(i)) = i list_inact_act_reverse(list_inact_act(i)) = i
enddo enddo
print *, 'Inactive and Active MOs:'
print *, list_inact_act(1:n_inact_act_orb)
END_PROVIDER END_PROVIDER

View File

@ -10,9 +10,9 @@ BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_orb+n_act_orb,
bielec_PQxx = 0.d0 bielec_PQxx = 0.d0
do i=1,n_core_inact_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
do j=i,n_core_inact_orb do j=i,n_core_inact_orb
jj=list_core(j) jj=list_core_inact(j)
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j),mo_integrals_map) call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j),mo_integrals_map)
bielec_PQxx(:,:,j,i)=bielec_PQxx(:,:,i,j) bielec_PQxx(:,:,j,i)=bielec_PQxx(:,:,i,j)
end do end do
@ -56,9 +56,9 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_inact_orb+n_act_orb,n_core_i
bielec_PxxQ = 0.d0 bielec_PxxQ = 0.d0
do i=1,n_core_inact_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
do j=i,n_core_inact_orb do j=i,n_core_inact_orb
jj=list_core(j) jj=list_core_inact(j)
call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map) call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map)
do p=1,mo_num do p=1,mo_num
do q=1,mo_num do q=1,mo_num

View File

@ -1,4 +1,4 @@
BEGIN_PROVIDER [real*8, bielec_PQxx_no, (mo_num, mo_num,n_core_orb+n_act_orb,n_core_orb+n_act_orb)] BEGIN_PROVIDER [real*8, bielec_PQxx_no, (mo_num, mo_num,n_core_inact_orb+n_act_orb,n_core_inact_orb+n_act_orb)]
BEGIN_DOC BEGIN_DOC
! integral (pq|xx) in the basis of natural MOs ! integral (pq|xx) in the basis of natural MOs
! indices are unshifted orbital numbers ! indices are unshifted orbital numbers
@ -10,8 +10,8 @@
bielec_PQxx_no(:,:,:,:) = bielec_PQxx(:,:,:,:) bielec_PQxx_no(:,:,:,:) = bielec_PQxx(:,:,:,:)
do j=1,mo_num do j=1,mo_num
do k=1,n_core_orb+n_act_orb do k=1,n_core_inact_orb+n_act_orb
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
@ -29,8 +29,8 @@
end do end do
! 2nd quarter ! 2nd quarter
do j=1,mo_num do j=1,mo_num
do k=1,n_core_orb+n_act_orb do k=1,n_core_inact_orb+n_act_orb
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
@ -49,18 +49,18 @@
! 3rd quarter ! 3rd quarter
do j=1,mo_num do j=1,mo_num
do k=1,mo_num do k=1,mo_num
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
do p=1,n_act_orb do p=1,n_act_orb
pp=n_act_orb-p+1 pp=n_act_orb-p+1
do q=1,n_act_orb do q=1,n_act_orb
d(pp)+=bielec_PQxx_no(j,k,n_core_orb+q,l)*natorbsCI(q,p) d(pp)+=bielec_PQxx_no(j,k,n_core_inact_orb+q,l)*natorbsCI(q,p)
end do end do
end do end do
do p=1,n_act_orb do p=1,n_act_orb
bielec_PQxx_no(j,k,n_core_orb+p,l)=d(p) bielec_PQxx_no(j,k,n_core_inact_orb+p,l)=d(p)
end do end do
end do end do
end do end do
@ -68,18 +68,18 @@
! 4th quarter ! 4th quarter
do j=1,mo_num do j=1,mo_num
do k=1,mo_num do k=1,mo_num
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
do p=1,n_act_orb do p=1,n_act_orb
pp=n_act_orb-p+1 pp=n_act_orb-p+1
do q=1,n_act_orb do q=1,n_act_orb
d(pp)+=bielec_PQxx_no(j,k,l,n_core_orb+q)*natorbsCI(q,p) d(pp)+=bielec_PQxx_no(j,k,l,n_core_inact_orb+q)*natorbsCI(q,p)
end do end do
end do end do
do p=1,n_act_orb do p=1,n_act_orb
bielec_PQxx_no(j,k,l,n_core_orb+p)=d(p) bielec_PQxx_no(j,k,l,n_core_inact_orb+p)=d(p)
end do end do
end do end do
end do end do
@ -89,7 +89,7 @@ END_PROVIDER
BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_orb+n_act_orb,n_core_orb+n_act_orb, mo_num)] BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_inact_orb+n_act_orb,n_core_inact_orb+n_act_orb, mo_num)]
BEGIN_DOC BEGIN_DOC
! integral (px|xq) in the basis of natural MOs ! integral (px|xq) in the basis of natural MOs
! indices are unshifted orbital numbers ! indices are unshifted orbital numbers
@ -101,8 +101,8 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_orb+n_act_orb,n_core_orb+
bielec_PxxQ_no(:,:,:,:) = bielec_PxxQ(:,:,:,:) bielec_PxxQ_no(:,:,:,:) = bielec_PxxQ(:,:,:,:)
do j=1,mo_num do j=1,mo_num
do k=1,n_core_orb+n_act_orb do k=1,n_core_inact_orb+n_act_orb
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
@ -120,8 +120,8 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_orb+n_act_orb,n_core_orb+
end do end do
! 2nd quarter ! 2nd quarter
do j=1,mo_num do j=1,mo_num
do k=1,n_core_orb+n_act_orb do k=1,n_core_inact_orb+n_act_orb
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
@ -140,18 +140,18 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_orb+n_act_orb,n_core_orb+
! 3rd quarter ! 3rd quarter
do j=1,mo_num do j=1,mo_num
do k=1,mo_num do k=1,mo_num
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
do p=1,n_act_orb do p=1,n_act_orb
pp=n_act_orb-p+1 pp=n_act_orb-p+1
do q=1,n_act_orb do q=1,n_act_orb
d(pp)+=bielec_PxxQ_no(j,n_core_orb+q,l,k)*natorbsCI(q,p) d(pp)+=bielec_PxxQ_no(j,n_core_inact_orb+q,l,k)*natorbsCI(q,p)
end do end do
end do end do
do p=1,n_act_orb do p=1,n_act_orb
bielec_PxxQ_no(j,n_core_orb+p,l,k)=d(p) bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)=d(p)
end do end do
end do end do
end do end do
@ -159,18 +159,18 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_orb+n_act_orb,n_core_orb+
! 4th quarter ! 4th quarter
do j=1,mo_num do j=1,mo_num
do k=1,mo_num do k=1,mo_num
do l=1,n_core_orb+n_act_orb do l=1,n_core_inact_orb+n_act_orb
do p=1,n_act_orb do p=1,n_act_orb
d(p)=0.D0 d(p)=0.D0
end do end do
do p=1,n_act_orb do p=1,n_act_orb
pp=n_act_orb-p+1 pp=n_act_orb-p+1
do q=1,n_act_orb do q=1,n_act_orb
d(pp)+=bielec_PxxQ_no(j,l,n_core_orb+q,k)*natorbsCI(q,p) d(pp)+=bielec_PxxQ_no(j,l,n_core_inact_orb+q,k)*natorbsCI(q,p)
end do end do
end do end do
do p=1,n_act_orb do p=1,n_act_orb
bielec_PxxQ_no(j,l,n_core_orb+p,k)=d(p) bielec_PxxQ_no(j,l,n_core_inact_orb+p,k)=d(p)
end do end do
end do end do
end do end do

View File

@ -5,7 +5,7 @@ BEGIN_PROVIDER [ integer, nMonoEx ]
! Number of single excitations ! Number of single excitations
END_DOC END_DOC
implicit none implicit none
nMonoEx=n_core_orb*n_act_orb+n_core_orb*n_virt_orb+n_act_orb*n_virt_orb nMonoEx=n_core_inact_orb*n_act_orb+n_core_inact_orb*n_virt_orb+n_act_orb*n_virt_orb
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer, excit, (2,nMonoEx)] BEGIN_PROVIDER [integer, excit, (2,nMonoEx)]
@ -17,8 +17,8 @@ END_PROVIDER
implicit none implicit none
integer :: i,t,a,ii,tt,aa,indx integer :: i,t,a,ii,tt,aa,indx
indx=0 indx=0
do ii=1,n_core_orb do ii=1,n_core_inact_orb
i=list_core(ii) i=list_core_inact(ii)
do tt=1,n_act_orb do tt=1,n_act_orb
t=list_act(tt) t=list_act(tt)
indx+=1 indx+=1
@ -28,8 +28,8 @@ END_PROVIDER
end do end do
end do end do
do ii=1,n_core_orb do ii=1,n_core_inact_orb
i=list_core(ii) i=list_core_inact(ii)
do aa=1,n_virt_orb do aa=1,n_virt_orb
a=list_virt(aa) a=list_virt(aa)
indx+=1 indx+=1
@ -145,14 +145,14 @@ BEGIN_PROVIDER [real*8, gradvec2, (nMonoEx)]
real*8 :: norm_grad real*8 :: norm_grad
indx=0 indx=0
do i=1,n_core_orb do i=1,n_core_inact_orb
do t=1,n_act_orb do t=1,n_act_orb
indx+=1 indx+=1
gradvec2(indx)=gradvec_it(i,t) gradvec2(indx)=gradvec_it(i,t)
end do end do
end do end do
do i=1,n_core_orb do i=1,n_core_inact_orb
do a=1,n_virt_orb do a=1,n_virt_orb
indx+=1 indx+=1
gradvec2(indx)=gradvec_ia(i,a) gradvec2(indx)=gradvec_ia(i,a)
@ -181,7 +181,7 @@ END_PROVIDER
real*8 function gradvec_it(i,t) real*8 function gradvec_it(i,t)
BEGIN_DOC BEGIN_DOC
! the orbital gradient core -> active ! the orbital gradient core/inactive -> active
! we assume natural orbitals ! we assume natural orbitals
END_DOC END_DOC
implicit none implicit none
@ -190,16 +190,16 @@ real*8 function gradvec_it(i,t)
integer :: ii,tt,v,vv,x,y integer :: ii,tt,v,vv,x,y
integer :: x3,y3 integer :: x3,y3
ii=list_core(i) ii=list_core_inact(i)
tt=list_act(t) tt=list_act(t)
gradvec_it=2.D0*(Fipq(tt,ii)+Fapq(tt,ii)) gradvec_it=2.D0*(Fipq(tt,ii)+Fapq(tt,ii))
gradvec_it-=occnum(tt)*Fipq(ii,tt) gradvec_it-=occnum(tt)*Fipq(ii,tt)
do v=1,n_act_orb do v=1,n_act_orb
vv=list_act(v) vv=list_act(v)
do x=1,n_act_orb do x=1,n_act_orb
x3=x+n_core_orb x3=x+n_core_inact_orb
do y=1,n_act_orb do y=1,n_act_orb
y3=y+n_core_orb y3=y+n_core_inact_orb
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)
end do end do
end do end do
@ -209,12 +209,12 @@ end function gradvec_it
real*8 function gradvec_ia(i,a) real*8 function gradvec_ia(i,a)
BEGIN_DOC BEGIN_DOC
! the orbital gradient core -> virtual ! the orbital gradient core/inactive -> virtual
END_DOC END_DOC
implicit none implicit none
integer :: i,a,ii,aa integer :: i,a,ii,aa
ii=list_core(i) ii=list_core_inact(i)
aa=list_virt(a) aa=list_virt(a)
gradvec_ia=2.D0*(Fipq(aa,ii)+Fapq(aa,ii)) gradvec_ia=2.D0*(Fipq(aa,ii)+Fapq(aa,ii))
gradvec_ia*=2.D0 gradvec_ia*=2.D0

View File

@ -204,10 +204,10 @@ BEGIN_PROVIDER [real*8, hessmat2, (nMonoEx,nMonoEx)]
endif endif
indx=1 indx=1
do i=1,n_core_orb do i=1,n_core_inact_orb
do t=1,n_act_orb do t=1,n_act_orb
jndx=indx jndx=indx
do j=i,n_core_orb do j=i,n_core_inact_orb
if (i.eq.j) then if (i.eq.j) then
ustart=t ustart=t
else else
@ -219,7 +219,7 @@ BEGIN_PROVIDER [real*8, hessmat2, (nMonoEx,nMonoEx)]
jndx+=1 jndx+=1
end do end do
end do end do
do j=1,n_core_orb do j=1,n_core_inact_orb
do a=1,n_virt_orb do a=1,n_virt_orb
hessmat2(indx,jndx)=hessmat_itja(i,t,j,a) hessmat2(indx,jndx)=hessmat_itja(i,t,j,a)
hessmat2(jndx,indx)=hessmat2(indx,jndx) hessmat2(jndx,indx)=hessmat2(indx,jndx)
@ -237,10 +237,10 @@ BEGIN_PROVIDER [real*8, hessmat2, (nMonoEx,nMonoEx)]
end do end do
end do end do
do i=1,n_core_orb do i=1,n_core_inact_orb
do a=1,n_virt_orb do a=1,n_virt_orb
jndx=indx jndx=indx
do j=i,n_core_orb do j=i,n_core_inact_orb
if (i.eq.j) then if (i.eq.j) then
bstart=a bstart=a
else else
@ -286,7 +286,7 @@ END_PROVIDER
real*8 function hessmat_itju(i,t,j,u) real*8 function hessmat_itju(i,t,j,u)
BEGIN_DOC BEGIN_DOC
! the orbital hessian for core->act,core->act ! the orbital hessian for core/inactive -> active, core/inactive -> active
! i, t, j, u are list indices, the corresponding orbitals are ii,tt,jj,uu ! i, t, j, u are list indices, the corresponding orbitals are ii,tt,jj,uu
! !
! we assume natural orbitals ! we assume natural orbitals
@ -295,7 +295,7 @@ real*8 function hessmat_itju(i,t,j,u)
integer :: i,t,j,u,ii,tt,uu,v,vv,x,xx,y,jj integer :: i,t,j,u,ii,tt,uu,v,vv,x,xx,y,jj
real*8 :: term,t2 real*8 :: term,t2
ii=list_core(i) ii=list_core_inact(i)
tt=list_act(t) tt=list_act(t)
if (i.eq.j) then if (i.eq.j) then
if (t.eq.u) then if (t.eq.u) then
@ -343,7 +343,7 @@ real*8 function hessmat_itju(i,t,j,u)
end if end if
else else
! it/ju ! it/ju
jj=list_core(j) jj=list_core_inact(j)
uu=list_act(u) uu=list_act(u)
if (t.eq.u) then if (t.eq.u) then
term=occnum(tt)*Fipq(ii,jj) term=occnum(tt)*Fipq(ii,jj)
@ -374,16 +374,16 @@ end function hessmat_itju
real*8 function hessmat_itja(i,t,j,a) real*8 function hessmat_itja(i,t,j,a)
BEGIN_DOC BEGIN_DOC
! the orbital hessian for core->act,core->virt ! the orbital hessian for core/inactive -> active, core/inactive -> virtual
END_DOC END_DOC
implicit none implicit none
integer :: i,t,j,a,ii,tt,jj,aa,v,vv,x,y integer :: i,t,j,a,ii,tt,jj,aa,v,vv,x,y
real*8 :: term real*8 :: term
! it/ja ! it/ja
ii=list_core(i) ii=list_core_inact(i)
tt=list_act(t) tt=list_act(t)
jj=list_core(j) jj=list_core_inact(j)
aa=list_virt(a) aa=list_virt(a)
term=2.D0*(4.D0*bielec_pxxq_no(aa,j,i,tt) & term=2.D0*(4.D0*bielec_pxxq_no(aa,j,i,tt) &
-bielec_pqxx_no(aa,tt,i,j) -bielec_pxxq_no(aa,i,j,tt)) -bielec_pqxx_no(aa,tt,i,j) -bielec_pxxq_no(aa,i,j,tt))
@ -407,17 +407,17 @@ end function hessmat_itja
real*8 function hessmat_itua(i,t,u,a) real*8 function hessmat_itua(i,t,u,a)
BEGIN_DOC BEGIN_DOC
! the orbital hessian for core->act,act->virt ! the orbital hessian for core/inactive -> active, active -> virtual
END_DOC END_DOC
implicit none implicit none
integer :: i,t,u,a,ii,tt,uu,aa,v,vv,x,xx,u3,t3,v3 integer :: i,t,u,a,ii,tt,uu,aa,v,vv,x,xx,u3,t3,v3
real*8 :: term real*8 :: term
ii=list_core(i) ii=list_core_inact(i)
tt=list_act(t) tt=list_act(t)
t3=t+n_core_orb t3=t+n_core_inact_orb
uu=list_act(u) uu=list_act(u)
u3=u+n_core_orb u3=u+n_core_inact_orb
aa=list_virt(a) aa=list_virt(a)
if (t.eq.u) then if (t.eq.u) then
term=-occnum(tt)*Fipq(aa,ii) term=-occnum(tt)*Fipq(aa,ii)
@ -428,11 +428,11 @@ real*8 function hessmat_itua(i,t,u,a)
+bielec_pxxq_no(aa,t3,u3,ii)) +bielec_pxxq_no(aa,t3,u3,ii))
do v=1,n_act_orb do v=1,n_act_orb
vv=list_act(v) vv=list_act(v)
v3=v+n_core_orb v3=v+n_core_inact_orb
do x=1,n_act_orb do x=1,n_act_orb
integer :: x3 integer :: x3
xx=list_act(x) xx=list_act(x)
x3=x+n_core_orb x3=x+n_core_inact_orb
term-=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,ii,v3,x3) & term-=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,ii,v3,x3) &
+(P0tuvx_no(t,v,u,x)+P0tuvx_no(t,v,x,u)) & +(P0tuvx_no(t,v,u,x)+P0tuvx_no(t,v,x,u)) &
*bielec_pqxx_no(aa,xx,v3,i)) *bielec_pqxx_no(aa,xx,v3,i))
@ -448,13 +448,13 @@ end function hessmat_itua
real*8 function hessmat_iajb(i,a,j,b) real*8 function hessmat_iajb(i,a,j,b)
BEGIN_DOC BEGIN_DOC
! the orbital hessian for core->virt,core->virt ! the orbital hessian for core/inactive -> virtual, core/inactive -> virtual
END_DOC END_DOC
implicit none implicit none
integer :: i,a,j,b,ii,aa,jj,bb integer :: i,a,j,b,ii,aa,jj,bb
real*8 :: term real*8 :: term
ii=list_core(i) ii=list_core_inact(i)
aa=list_virt(a) aa=list_virt(a)
if (i.eq.j) then if (i.eq.j) then
if (a.eq.b) then if (a.eq.b) then
@ -469,7 +469,7 @@ real*8 function hessmat_iajb(i,a,j,b)
end if end if
else else
! ia/jb ! ia/jb
jj=list_core(j) jj=list_core_inact(j)
bb=list_virt(b) bb=list_virt(b)
term=2.D0*(4.D0*bielec_pxxq_no(aa,i,j,bb)-bielec_pqxx_no(aa,bb,i,j) & term=2.D0*(4.D0*bielec_pxxq_no(aa,i,j,bb)-bielec_pqxx_no(aa,bb,i,j) &
-bielec_pxxq_no(aa,j,i,bb)) -bielec_pxxq_no(aa,j,i,bb))
@ -484,17 +484,17 @@ end function hessmat_iajb
real*8 function hessmat_iatb(i,a,t,b) real*8 function hessmat_iatb(i,a,t,b)
BEGIN_DOC BEGIN_DOC
! the orbital hessian for core->virt,act->virt ! the orbital hessian for core/inactive -> virtual, active -> virtual
END_DOC END_DOC
implicit none implicit none
integer :: i,a,t,b,ii,aa,tt,bb,v,vv,x,y,v3,t3 integer :: i,a,t,b,ii,aa,tt,bb,v,vv,x,y,v3,t3
real*8 :: term real*8 :: term
ii=list_core(i) ii=list_core_inact(i)
aa=list_virt(a) aa=list_virt(a)
tt=list_act(t) tt=list_act(t)
bb=list_virt(b) bb=list_virt(b)
t3=t+n_core_orb t3=t+n_core_inact_orb
term=occnum(tt)*(4.D0*bielec_pxxq_no(aa,i,t3,bb)-bielec_pxxq_no(aa,t3,i,bb)& term=occnum(tt)*(4.D0*bielec_pxxq_no(aa,i,t3,bb)-bielec_pxxq_no(aa,t3,i,bb)&
-bielec_pqxx_no(aa,bb,i,t3)) -bielec_pqxx_no(aa,bb,i,t3))
if (a.eq.b) then if (a.eq.b) then
@ -533,10 +533,10 @@ real*8 function hessmat_taub(t,a,u,b)
t1-=occnum(tt)*Fipq(tt,tt) t1-=occnum(tt)*Fipq(tt,tt)
do v=1,n_act_orb do v=1,n_act_orb
vv=list_act(v) vv=list_act(v)
v3=v+n_core_orb v3=v+n_core_inact_orb
do x=1,n_act_orb do x=1,n_act_orb
xx=list_act(x) xx=list_act(x)
x3=x+n_core_orb x3=x+n_core_inact_orb
t2+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,aa,v3,x3) & 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))* & +(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v))* &
bielec_pxxq_no(aa,x3,v3,aa)) bielec_pxxq_no(aa,x3,v3,aa))
@ -552,10 +552,10 @@ real*8 function hessmat_taub(t,a,u,b)
term=occnum(tt)*Fipq(aa,bb) term=occnum(tt)*Fipq(aa,bb)
do v=1,n_act_orb do v=1,n_act_orb
vv=list_act(v) vv=list_act(v)
v3=v+n_core_orb v3=v+n_core_inact_orb
do x=1,n_act_orb do x=1,n_act_orb
xx=list_act(x) xx=list_act(x)
x3=x+n_core_orb x3=x+n_core_inact_orb
term+=2.D0*(P0tuvx_no(t,t,v,x)*bielec_pqxx_no(aa,bb,v3,x3) & 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)) & +(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v)) &
*bielec_pxxq_no(aa,x3,v3,bb)) *bielec_pxxq_no(aa,x3,v3,bb))
@ -569,10 +569,10 @@ real*8 function hessmat_taub(t,a,u,b)
term=0.D0 term=0.D0
do v=1,n_act_orb do v=1,n_act_orb
vv=list_act(v) vv=list_act(v)
v3=v+n_core_orb v3=v+n_core_inact_orb
do x=1,n_act_orb do x=1,n_act_orb
xx=list_act(x) xx=list_act(x)
x3=x+n_core_orb x3=x+n_core_inact_orb
term+=2.D0*(P0tuvx_no(t,u,v,x)*bielec_pqxx_no(aa,bb,v3,x3) & 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)) & +(P0tuvx_no(t,x,v,u)+P0tuvx_no(t,x,u,v)) &
*bielec_pxxq_no(aa,x3,v3,bb)) *bielec_pxxq_no(aa,x3,v3,bb))
@ -606,14 +606,14 @@ BEGIN_PROVIDER [real*8, hessdiag, (nMonoEx)]
real*8 :: hessmat_itju,hessmat_iajb,hessmat_taub real*8 :: hessmat_itju,hessmat_iajb,hessmat_taub
indx=0 indx=0
do i=1,n_core_orb do i=1,n_core_inact_orb
do t=1,n_act_orb do t=1,n_act_orb
indx+=1 indx+=1
hessdiag(indx)=hessmat_itju(i,t,i,t) hessdiag(indx)=hessmat_itju(i,t,i,t)
end do end do
end do end do
do i=1,n_core_orb do i=1,n_core_inact_orb
do a=1,n_virt_orb do a=1,n_virt_orb
indx+=1 indx+=1
hessdiag(indx)=hessmat_iajb(i,a,i,a) hessdiag(indx)=hessmat_iajb(i,a,i,a)

View File

@ -12,8 +12,8 @@ BEGIN_PROVIDER [real*8, Fipq, (mo_num,mo_num) ]
end do end do
! the inactive Fock matrix ! the inactive Fock matrix
do k=1,n_core_orb do k=1,n_core_inact_orb
kk=list_core(k) kk=list_core_inact(k)
do q=1,mo_num do q=1,mo_num
do p=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) Fipq(p,q)+=2.D0*bielec_pqxx_no(p,q,k,k) -bielec_pxxq_no(p,k,k,q)

View File

@ -6,8 +6,8 @@
integer :: i integer :: i
occnum=0.D0 occnum=0.D0
do i=1,n_core_orb do i=1,n_core_inact_orb
occnum(list_core(i))=2.D0 occnum(list_core_inact(i))=2.D0
end do end do
do i=1,n_act_orb do i=1,n_act_orb

View File

@ -122,8 +122,8 @@ BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
! the orbital rotation matrix T ! the orbital rotation matrix T
Tmat(:,:)=0.D0 Tmat(:,:)=0.D0
indx=1 indx=1
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
do t=1,n_act_orb do t=1,n_act_orb
tt=list_act(t) tt=list_act(t)
indx+=1 indx+=1
@ -131,8 +131,8 @@ BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
Tmat(tt,ii)=-SXvector(indx) Tmat(tt,ii)=-SXvector(indx)
end do end do
end do end do
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
do a=1,n_virt_orb do a=1,n_virt_orb
aa=list_virt(a) aa=list_virt(a)
indx+=1 indx+=1

View File

@ -10,19 +10,19 @@
real*8 :: e_one_all,e_two_all real*8 :: e_one_all,e_two_all
e_one_all=0.D0 e_one_all=0.D0
e_two_all=0.D0 e_two_all=0.D0
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
e_one_all+=2.D0*mo_one_e_integrals(ii,ii) e_one_all+=2.D0*mo_one_e_integrals(ii,ii)
do j=1,n_core_orb do j=1,n_core_inact_orb
jj=list_core(j) jj=list_core_inact(j)
e_two_all+=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i) e_two_all+=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i)
end do end do
do t=1,n_act_orb do t=1,n_act_orb
tt=list_act(t) tt=list_act(t)
t3=t+n_core_orb t3=t+n_core_inact_orb
do u=1,n_act_orb do u=1,n_act_orb
uu=list_act(u) uu=list_act(u)
u3=u+n_core_orb u3=u+n_core_inact_orb
e_two_all+=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i) & e_two_all+=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i) &
-bielec_PQxx(tt,ii,i,u3)) -bielec_PQxx(tt,ii,i,u3))
end do end do
@ -34,9 +34,9 @@
uu=list_act(u) uu=list_act(u)
e_one_all+=D0tu(t,u)*mo_one_e_integrals(tt,uu) e_one_all+=D0tu(t,u)*mo_one_e_integrals(tt,uu)
do v=1,n_act_orb do v=1,n_act_orb
v3=v+n_core_orb v3=v+n_core_inact_orb
do x=1,n_act_orb do x=1,n_act_orb
x3=x+n_core_orb x3=x+n_core_inact_orb
e_two_all +=P0tuvx(t,u,v,x)*bielec_PQxx(tt,uu,v3,x3) e_two_all +=P0tuvx(t,u,v,x)*bielec_PQxx(tt,uu,v3,x3)
end do end do
end do end do
@ -44,12 +44,12 @@
end do end do
ecore =nuclear_repulsion ecore =nuclear_repulsion
ecore_bis=nuclear_repulsion ecore_bis=nuclear_repulsion
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
ecore +=2.D0*mo_one_e_integrals(ii,ii) ecore +=2.D0*mo_one_e_integrals(ii,ii)
ecore_bis+=2.D0*mo_one_e_integrals(ii,ii) ecore_bis+=2.D0*mo_one_e_integrals(ii,ii)
do j=1,n_core_orb do j=1,n_core_inact_orb
jj=list_core(j) jj=list_core_inact(j)
ecore +=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i) ecore +=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i)
ecore_bis+=2.D0*bielec_PxxQ(ii,i,j,jj)-bielec_PxxQ(ii,j,j,ii) ecore_bis+=2.D0*bielec_PxxQ(ii,i,j,jj)-bielec_PxxQ(ii,j,j,ii)
end do end do
@ -61,14 +61,14 @@
etwo_ter=0.D0 etwo_ter=0.D0
do t=1,n_act_orb do t=1,n_act_orb
tt=list_act(t) tt=list_act(t)
t3=t+n_core_orb t3=t+n_core_inact_orb
do u=1,n_act_orb do u=1,n_act_orb
uu=list_act(u) uu=list_act(u)
u3=u+n_core_orb u3=u+n_core_inact_orb
eone +=D0tu(t,u)*mo_one_e_integrals(tt,uu) eone +=D0tu(t,u)*mo_one_e_integrals(tt,uu)
eone_bis+=D0tu(t,u)*mo_one_e_integrals(tt,uu) eone_bis+=D0tu(t,u)*mo_one_e_integrals(tt,uu)
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core_inact(i)
eone +=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i) & eone +=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i) &
-bielec_PQxx(tt,ii,i,u3)) -bielec_PQxx(tt,ii,i,u3))
eone_bis+=D0tu(t,u)*(2.D0*bielec_PxxQ(tt,u3,i,ii) & eone_bis+=D0tu(t,u)*(2.D0*bielec_PxxQ(tt,u3,i,ii) &
@ -76,10 +76,10 @@
end do end do
do v=1,n_act_orb do v=1,n_act_orb
vv=list_act(v) vv=list_act(v)
v3=v+n_core_orb v3=v+n_core_inact_orb
do x=1,n_act_orb do x=1,n_act_orb
xx=list_act(x) xx=list_act(x)
x3=x+n_core_orb x3=x+n_core_inact_orb
real*8 :: h1,h2,h3 real*8 :: h1,h2,h3
h1=bielec_PQxx(tt,uu,v3,x3) h1=bielec_PQxx(tt,uu,v3,x3)
h2=bielec_PxxQ(tt,u3,v3,xx) h2=bielec_PxxQ(tt,u3,v3,xx)

View File

@ -38,22 +38,6 @@ END_PROVIDER
END_DOC END_DOC
integer :: i,k integer :: i,k
! if (threshold_selectors == 1.d0) then
!
! do i=1,N_det_selectors
! do k=1,N_int
! psi_selectors(k,1,i) = psi_det(k,1,i)
! psi_selectors(k,2,i) = psi_det(k,2,i)
! enddo
! enddo
! do k=1,N_states
! do i=1,N_det_selectors
! psi_selectors_coef(i,k) = psi_coef(i,k)
! enddo
! enddo
!
! else
do i=1,N_det_selectors do i=1,N_det_selectors
do k=1,N_int do k=1,N_int
psi_selectors(k,1,i) = psi_det_sorted(k,1,i) psi_selectors(k,1,i) = psi_det_sorted(k,1,i)
@ -66,7 +50,6 @@ END_PROVIDER
enddo enddo
enddo enddo
! endif
END_PROVIDER END_PROVIDER