mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-08 22:43:38 +01:00
Compare commits
5 Commits
05df77ddb8
...
62ef1526a2
| Author | SHA1 | Date | |
|---|---|---|---|
| 62ef1526a2 | |||
| 721f5a662b | |||
| 1018c686a9 | |||
| 21dc0f5380 | |||
| 0c2bf90cc5 |
@ -1,4 +1,4 @@
|
|||||||
BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_orb+n_act_orb,n_core_inact_orb+n_act_orb)]
|
BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_act_orb,n_core_inact_act_orb)]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! bielec_PQxx : integral (pq|xx) with p,q arbitrary, x core or active
|
! bielec_PQxx : integral (pq|xx) with p,q arbitrary, x core or active
|
||||||
! indices are unshifted orbital numbers
|
! indices are unshifted orbital numbers
|
||||||
@ -7,8 +7,15 @@ BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_orb+n_act_orb,
|
|||||||
integer :: i,j,ii,jj,p,q,i3,j3,t3,v3
|
integer :: i,j,ii,jj,p,q,i3,j3,t3,v3
|
||||||
real*8 :: mo_two_e_integral
|
real*8 :: mo_two_e_integral
|
||||||
|
|
||||||
bielec_PQxx = 0.d0
|
bielec_PQxx(:,:,:,:) = 0.d0
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i,ii,j,jj,i3,j3) &
|
||||||
|
!$OMP SHARED(n_core_inact_orb,list_core_inact,mo_num,bielec_PQxx, &
|
||||||
|
!$OMP n_act_orb,mo_integrals_map,list_act)
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
do i=1,n_core_inact_orb
|
do i=1,n_core_inact_orb
|
||||||
ii=list_core_inact(i)
|
ii=list_core_inact(i)
|
||||||
do j=i,n_core_inact_orb
|
do j=i,n_core_inact_orb
|
||||||
@ -23,9 +30,10 @@ BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_orb+n_act_orb,
|
|||||||
bielec_PQxx(:,:,j3,i)=bielec_PQxx(:,:,i,j3)
|
bielec_PQxx(:,:,j3,i)=bielec_PQxx(:,:,i,j3)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
|
||||||
! (ij|pq)
|
!$OMP DO
|
||||||
do i=1,n_act_orb
|
do i=1,n_act_orb
|
||||||
ii=list_act(i)
|
ii=list_act(i)
|
||||||
i3=i+n_core_inact_orb
|
i3=i+n_core_inact_orb
|
||||||
@ -36,6 +44,9 @@ BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_orb+n_act_orb,
|
|||||||
bielec_PQxx(:,:,j3,i3)=bielec_PQxx(:,:,i3,j3)
|
bielec_PQxx(:,:,j3,i3)=bielec_PQxx(:,:,i3,j3)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -51,17 +62,24 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_inact_orb+n_act_orb,n_core_i
|
|||||||
double precision, allocatable :: integrals_array(:,:)
|
double precision, allocatable :: integrals_array(:,:)
|
||||||
real*8 :: mo_two_e_integral
|
real*8 :: mo_two_e_integral
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
bielec_PxxQ = 0.d0
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i,ii,j,jj,i3,j3,integrals_array) &
|
||||||
|
!$OMP SHARED(n_core_inact_orb,list_core_inact,mo_num,bielec_PxxQ, &
|
||||||
|
!$OMP n_act_orb,mo_integrals_map,list_act)
|
||||||
|
|
||||||
allocate(integrals_array(mo_num,mo_num))
|
allocate(integrals_array(mo_num,mo_num))
|
||||||
|
|
||||||
bielec_PxxQ = 0.d0
|
!$OMP DO
|
||||||
|
|
||||||
do i=1,n_core_inact_orb
|
do i=1,n_core_inact_orb
|
||||||
ii=list_core_inact(i)
|
ii=list_core_inact(i)
|
||||||
do j=i,n_core_inact_orb
|
do j=i,n_core_inact_orb
|
||||||
jj=list_core_inact(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 q=1,mo_num
|
||||||
do q=1,mo_num
|
do p=1,mo_num
|
||||||
bielec_PxxQ(p,i,j,q)=integrals_array(p,q)
|
bielec_PxxQ(p,i,j,q)=integrals_array(p,q)
|
||||||
bielec_PxxQ(p,j,i,q)=integrals_array(q,p)
|
bielec_PxxQ(p,j,i,q)=integrals_array(q,p)
|
||||||
end do
|
end do
|
||||||
@ -70,33 +88,40 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_inact_orb+n_act_orb,n_core_i
|
|||||||
do j=1,n_act_orb
|
do j=1,n_act_orb
|
||||||
jj=list_act(j)
|
jj=list_act(j)
|
||||||
j3=j+n_core_inact_orb
|
j3=j+n_core_inact_orb
|
||||||
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 q=1,mo_num
|
||||||
do q=1,mo_num
|
do p=1,mo_num
|
||||||
bielec_PxxQ(p,i,j3,q)=integrals_array(p,q)
|
bielec_PxxQ(p,i,j3,q)=integrals_array(p,q)
|
||||||
bielec_PxxQ(p,j3,i,q)=integrals_array(q,p)
|
bielec_PxxQ(p,j3,i,q)=integrals_array(q,p)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
|
||||||
! (ip|qj)
|
! (ip|qj)
|
||||||
|
!$OMP DO
|
||||||
do i=1,n_act_orb
|
do i=1,n_act_orb
|
||||||
ii=list_act(i)
|
ii=list_act(i)
|
||||||
i3=i+n_core_inact_orb
|
i3=i+n_core_inact_orb
|
||||||
do j=i,n_act_orb
|
do j=i,n_act_orb
|
||||||
jj=list_act(j)
|
jj=list_act(j)
|
||||||
j3=j+n_core_inact_orb
|
j3=j+n_core_inact_orb
|
||||||
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 q=1,mo_num
|
||||||
do q=1,mo_num
|
do p=1,mo_num
|
||||||
bielec_PxxQ(p,i3,j3,q)=integrals_array(p,q)
|
bielec_PxxQ(p,i3,j3,q)=integrals_array(p,q)
|
||||||
bielec_PxxQ(p,j3,i3,q)=integrals_array(q,p)
|
bielec_PxxQ(p,j3,i3,q)=integrals_array(q,p)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
deallocate(integrals_array)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
@ -107,24 +132,25 @@ BEGIN_PROVIDER [real*8, bielecCI, (n_act_orb,n_act_orb,n_act_orb, mo_num)]
|
|||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,k,p,t,u,v
|
integer :: i,j,k,p,t,u,v
|
||||||
double precision, allocatable :: integrals_array(:)
|
double precision, external :: mo_two_e_integral
|
||||||
real*8 :: mo_two_e_integral
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
allocate(integrals_array(mo_num))
|
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i,j,k,p,t,u,v) &
|
||||||
do i=1,n_act_orb
|
!$OMP SHARED(mo_num,n_act_orb,list_act,bielecCI)
|
||||||
t=list_act(i)
|
do p=1,mo_num
|
||||||
do j=1,n_act_orb
|
do j=1,n_act_orb
|
||||||
u=list_act(j)
|
u=list_act(j)
|
||||||
do k=1,n_act_orb
|
do k=1,n_act_orb
|
||||||
v=list_act(k)
|
v=list_act(k)
|
||||||
! (tu|vp)
|
do i=1,n_act_orb
|
||||||
call get_mo_two_e_integrals(t,u,v,mo_num,integrals_array,mo_integrals_map)
|
t=list_act(i)
|
||||||
do p=1,mo_num
|
bielecCI(i,k,j,p) = mo_two_e_integral(t,u,v,p)
|
||||||
bielecCI(i,k,j,p)=integrals_array(p)
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
END_PROVIDER
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|||||||
@ -1,180 +1,264 @@
|
|||||||
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_PROVIDER [real*8, bielec_PQxx_no, (mo_num, mo_num,n_core_inact_act_orb,n_core_inact_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
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,k,l,t,u,p,q,pp
|
integer :: i,j,k,l,t,u,p,q,pp
|
||||||
real*8 :: d(n_act_orb)
|
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||||
|
|
||||||
bielec_PQxx_no(:,:,:,:) = bielec_PQxx(:,:,:,:)
|
|
||||||
|
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,n_core_inact_orb+n_act_orb
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
!$OMP PRIVATE(j,k,l,p,pp,d,f) &
|
||||||
|
!$OMP SHARED(n_core_inact_act_orb,mo_num,n_act_orb,n_core_inact_orb, &
|
||||||
|
!$OMP bielec_PQxx_no,bielec_PQxx,list_act,natorbsCI)
|
||||||
|
|
||||||
|
allocate (f(n_act_orb,mo_num,n_core_inact_act_orb), &
|
||||||
|
d(n_act_orb,mo_num,n_core_inact_act_orb))
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
bielec_PQxx_no(:,:,:,l) = bielec_PQxx(:,:,:,l)
|
||||||
|
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
d(p)=0.D0
|
f(p,j,k)=bielec_PQxx_no(list_act(p),j,k,l)
|
||||||
end do
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
call dgemm('T','N',n_act_orb,mo_num*n_core_inact_act_orb,n_act_orb,1.d0, &
|
||||||
|
natorbsCI, size(natorbsCI,1), &
|
||||||
|
f, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb)
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
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
|
bielec_PQxx_no(list_act(p),j,k,l)=d(pp,j,k)
|
||||||
d(pp)+=bielec_PQxx_no(list_act(q),j,k,l)*natorbsCI(q,p)
|
|
||||||
end do
|
|
||||||
end do
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
do j=1,mo_num
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
bielec_PQxx_no(list_act(p),j,k,l)=d(p)
|
f(p,j,k)=bielec_PQxx_no(j,list_act(p),k,l)
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
call dgemm('T','N',n_act_orb,mo_num*n_core_inact_act_orb,n_act_orb,1.d0, &
|
||||||
|
natorbsCI, n_act_orb, &
|
||||||
|
f, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb)
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
|
do p=1,n_act_orb
|
||||||
|
pp=n_act_orb-p+1
|
||||||
|
do j=1,mo_num
|
||||||
|
bielec_PQxx_no(j,list_act(p),k,l)=d(pp,j,k)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
! 2nd quarter
|
!$OMP END DO NOWAIT
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,n_core_inact_orb+n_act_orb
|
deallocate (f,d)
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
|
||||||
do p=1,n_act_orb
|
allocate (f(mo_num,mo_num,n_act_orb),d(mo_num,mo_num,n_act_orb))
|
||||||
d(p)=0.D0
|
|
||||||
|
!$OMP DO
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
|
||||||
|
do p=1,n_act_orb
|
||||||
|
do k=1,mo_num
|
||||||
|
do j=1,mo_num
|
||||||
|
f(j,k,p) = bielec_PQxx_no(j,k,n_core_inact_orb+p,l)
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
pp=n_act_orb-p+1
|
end do
|
||||||
do q=1,n_act_orb
|
call dgemm('N','N',mo_num*mo_num,n_act_orb,n_act_orb,1.d0, &
|
||||||
d(pp)+=bielec_PQxx_no(j,list_act(q),k,l)*natorbsCI(q,p)
|
f, mo_num*mo_num, &
|
||||||
end do
|
natorbsCI, n_act_orb, &
|
||||||
end do
|
0.d0, &
|
||||||
do p=1,n_act_orb
|
d, mo_num*mo_num)
|
||||||
bielec_PQxx_no(j,list_act(p),k,l)=d(p)
|
do p=1,n_act_orb
|
||||||
|
pp=n_act_orb-p+1
|
||||||
|
do k=1,mo_num
|
||||||
|
do j=1,mo_num
|
||||||
|
bielec_PQxx_no(j,k,n_core_inact_orb+p,l)=d(j,k,pp)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
! 3rd quarter
|
!$OMP END DO NOWAIT
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,mo_num
|
!$OMP BARRIER
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
|
||||||
do p=1,n_act_orb
|
!$OMP DO
|
||||||
d(p)=0.D0
|
do l=1,n_core_inact_act_orb
|
||||||
|
do p=1,n_act_orb
|
||||||
|
do k=1,mo_num
|
||||||
|
do j=1,mo_num
|
||||||
|
f(j,k,p) = bielec_PQxx_no(j,k,l,n_core_inact_orb+p)
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
pp=n_act_orb-p+1
|
end do
|
||||||
do q=1,n_act_orb
|
call dgemm('N','N',mo_num*mo_num,n_act_orb,n_act_orb,1.d0, &
|
||||||
d(pp)+=bielec_PQxx_no(j,k,n_core_inact_orb+q,l)*natorbsCI(q,p)
|
f, mo_num*mo_num, &
|
||||||
end do
|
natorbsCI, n_act_orb, &
|
||||||
end do
|
0.d0, &
|
||||||
do p=1,n_act_orb
|
d, mo_num*mo_num)
|
||||||
bielec_PQxx_no(j,k,n_core_inact_orb+p,l)=d(p)
|
do p=1,n_act_orb
|
||||||
end do
|
pp=n_act_orb-p+1
|
||||||
end do
|
do k=1,mo_num
|
||||||
end do
|
do j=1,mo_num
|
||||||
end do
|
bielec_PQxx_no(j,k,l,n_core_inact_orb+p)=d(j,k,pp)
|
||||||
! 4th quarter
|
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,mo_num
|
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
|
||||||
do p=1,n_act_orb
|
|
||||||
d(p)=0.D0
|
|
||||||
end do
|
|
||||||
do p=1,n_act_orb
|
|
||||||
pp=n_act_orb-p+1
|
|
||||||
do q=1,n_act_orb
|
|
||||||
d(pp)+=bielec_PQxx_no(j,k,l,n_core_inact_orb+q)*natorbsCI(q,p)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
do p=1,n_act_orb
|
|
||||||
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
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
deallocate (f,d)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
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_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_inact_act_orb,n_core_inact_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
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,k,l,t,u,p,q,pp
|
integer :: i,j,k,l,t,u,p,q,pp
|
||||||
real*8 :: d(n_act_orb)
|
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||||
|
|
||||||
bielec_PxxQ_no(:,:,:,:) = bielec_PxxQ(:,:,:,:)
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(j,k,l,p,pp,d,f) &
|
||||||
|
!$OMP SHARED(n_core_inact_act_orb,mo_num,n_act_orb,n_core_inact_orb, &
|
||||||
|
!$OMP bielec_PxxQ_no,bielec_PxxQ,list_act,natorbsCI)
|
||||||
|
|
||||||
|
|
||||||
|
allocate (f(n_act_orb,n_core_inact_act_orb,n_core_inact_act_orb), &
|
||||||
|
d(n_act_orb,n_core_inact_act_orb,n_core_inact_act_orb))
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
do j=1,mo_num
|
do j=1,mo_num
|
||||||
do k=1,n_core_inact_orb+n_act_orb
|
bielec_PxxQ_no(:,:,:,j) = bielec_PxxQ(:,:,:,j)
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
do l=1,n_core_inact_act_orb
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
d(p)=0.D0
|
f(p,k,l) = bielec_PxxQ_no(list_act(p),k,l,j)
|
||||||
end do
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
call dgemm('T','N',n_act_orb,n_core_inact_act_orb**2,n_act_orb,1.d0, &
|
||||||
|
natorbsCI, size(natorbsCI,1), &
|
||||||
|
f, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb)
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
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
|
bielec_PxxQ_no(list_act(p),k,l,j)=d(pp,k,l)
|
||||||
d(pp)+=bielec_PxxQ_no(list_act(q),k,l,j)*natorbsCI(q,p)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
do p=1,n_act_orb
|
|
||||||
bielec_PxxQ_no(list_act(p),k,l,j)=d(p)
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
! 2nd quarter
|
!$OMP END DO NOWAIT
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,n_core_inact_orb+n_act_orb
|
deallocate (f,d)
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
|
||||||
|
allocate (f(n_act_orb,mo_num,n_core_inact_act_orb), &
|
||||||
|
d(n_act_orb,mo_num,n_core_inact_act_orb))
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do k=1,mo_num
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
d(p)=0.D0
|
f(p,j,l) = bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)
|
||||||
end do
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
call dgemm('T','N',n_act_orb,mo_num*n_core_inact_act_orb,n_act_orb,1.d0, &
|
||||||
|
natorbsCI, size(natorbsCI,1), &
|
||||||
|
f, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb)
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
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
|
bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)=d(pp,j,l)
|
||||||
d(pp)+=bielec_PxxQ_no(j,k,l,list_act(q))*natorbsCI(q,p)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
do p=1,n_act_orb
|
|
||||||
bielec_PxxQ_no(j,k,l,list_act(p))=d(p)
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
! 3rd quarter
|
!$OMP END DO NOWAIT
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,mo_num
|
deallocate(f,d)
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
|
||||||
do p=1,n_act_orb
|
allocate(f(mo_num,n_core_inact_act_orb,n_act_orb), &
|
||||||
d(p)=0.D0
|
d(mo_num,n_core_inact_act_orb,n_act_orb) )
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do k=1,mo_num
|
||||||
|
do p=1,n_act_orb
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
|
f(j,l,p) = bielec_PxxQ_no(j,l,n_core_inact_orb+p,k)
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
pp=n_act_orb-p+1
|
end do
|
||||||
do q=1,n_act_orb
|
call dgemm('N','N',mo_num*n_core_inact_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||||
d(pp)+=bielec_PxxQ_no(j,n_core_inact_orb+q,l,k)*natorbsCI(q,p)
|
f, mo_num*n_core_inact_act_orb, &
|
||||||
end do
|
natorbsCI, size(natorbsCI,1), &
|
||||||
end do
|
0.d0, &
|
||||||
do p=1,n_act_orb
|
d, mo_num*n_core_inact_act_orb)
|
||||||
bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)=d(p)
|
do p=1,n_act_orb
|
||||||
|
pp=n_act_orb-p+1
|
||||||
|
do l=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
|
bielec_PxxQ_no(j,l,n_core_inact_orb+p,k)=d(j,l,pp)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
! 4th quarter
|
!$OMP END DO NOWAIT
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,mo_num
|
!$OMP BARRIER
|
||||||
do l=1,n_core_inact_orb+n_act_orb
|
|
||||||
do p=1,n_act_orb
|
!$OMP DO
|
||||||
d(p)=0.D0
|
do l=1,n_core_inact_act_orb
|
||||||
|
do p=1,n_act_orb
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
|
f(j,k,p) = bielec_PxxQ_no(j,k,l,n_core_inact_orb+p)
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
pp=n_act_orb-p+1
|
end do
|
||||||
do q=1,n_act_orb
|
call dgemm('N','N',mo_num*n_core_inact_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||||
d(pp)+=bielec_PxxQ_no(j,l,n_core_inact_orb+q,k)*natorbsCI(q,p)
|
f, mo_num*n_core_inact_act_orb, &
|
||||||
end do
|
natorbsCI, size(natorbsCI,1), &
|
||||||
end do
|
0.d0, &
|
||||||
do p=1,n_act_orb
|
d, mo_num*n_core_inact_act_orb)
|
||||||
bielec_PxxQ_no(j,l,n_core_inact_orb+p,k)=d(p)
|
do p=1,n_act_orb
|
||||||
|
pp=n_act_orb-p+1
|
||||||
|
do k=1,n_core_inact_act_orb
|
||||||
|
do j=1,mo_num
|
||||||
|
bielec_PxxQ_no(j,k,l,n_core_inact_orb+p)=d(j,k,pp)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
deallocate(f,d)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -186,85 +270,112 @@ BEGIN_PROVIDER [real*8, bielecCI_no, (n_act_orb,n_act_orb,n_act_orb, mo_num)]
|
|||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,k,l,t,u,p,q,pp
|
integer :: i,j,k,l,t,u,p,q,pp
|
||||||
real*8 :: d(n_act_orb)
|
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||||
|
|
||||||
bielecCI_no(:,:,:,:) = bielecCI(:,:,:,:)
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(j,k,l,p,pp,d,f) &
|
||||||
|
!$OMP SHARED(n_core_inact_act_orb,mo_num,n_act_orb,n_core_inact_orb, &
|
||||||
|
!$OMP bielecCI_no,bielecCI,list_act,natorbsCI)
|
||||||
|
|
||||||
do j=1,n_act_orb
|
allocate (f(n_act_orb,n_act_orb,mo_num), &
|
||||||
|
d(n_act_orb,n_act_orb,mo_num))
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do l=1,mo_num
|
||||||
|
bielecCI_no(:,:,:,l) = bielecCI(:,:,:,l)
|
||||||
do k=1,n_act_orb
|
do k=1,n_act_orb
|
||||||
do l=1,mo_num
|
do j=1,n_act_orb
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
d(p)=0.D0
|
f(p,j,k)=bielecCI_no(p,j,k,l)
|
||||||
end do
|
|
||||||
do p=1,n_act_orb
|
|
||||||
pp=n_act_orb-p+1
|
|
||||||
do q=1,n_act_orb
|
|
||||||
d(pp)+=bielecCI_no(q,j,k,l)*natorbsCI(q,p)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
do p=1,n_act_orb
|
|
||||||
bielecCI_no(p,j,k,l)=d(p)
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
call dgemm('T','N',n_act_orb,n_act_orb*n_act_orb,n_act_orb,1.d0, &
|
||||||
! 2nd quarter
|
natorbsCI, size(natorbsCI,1), &
|
||||||
do j=1,n_act_orb
|
f, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb)
|
||||||
do k=1,n_act_orb
|
do k=1,n_act_orb
|
||||||
do l=1,mo_num
|
do j=1,n_act_orb
|
||||||
do p=1,n_act_orb
|
|
||||||
d(p)=0.D0
|
|
||||||
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
|
bielecCI_no(p,j,k,l)=d(pp,j,k)
|
||||||
d(pp)+=bielecCI_no(j,q,k,l)*natorbsCI(q,p)
|
|
||||||
end do
|
|
||||||
end do
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
do j=1,n_act_orb
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
bielecCI_no(j,p,k,l)=d(p)
|
f(p,j,k)=bielecCI_no(j,p,k,l)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
call dgemm('T','N',n_act_orb,n_act_orb*n_act_orb,n_act_orb,1.d0, &
|
||||||
! 3rd quarter
|
natorbsCI, n_act_orb, &
|
||||||
do j=1,n_act_orb
|
f, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb)
|
||||||
do k=1,n_act_orb
|
do k=1,n_act_orb
|
||||||
do l=1,mo_num
|
do p=1,n_act_orb
|
||||||
do p=1,n_act_orb
|
pp=n_act_orb-p+1
|
||||||
d(p)=0.D0
|
do j=1,n_act_orb
|
||||||
|
bielecCI_no(j,p,k,l)=d(pp,j,k)
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
pp=n_act_orb-p+1
|
end do
|
||||||
do q=1,n_act_orb
|
|
||||||
d(pp)+=bielecCI_no(j,k,q,l)*natorbsCI(q,p)
|
do p=1,n_act_orb
|
||||||
end do
|
do k=1,n_act_orb
|
||||||
|
do j=1,n_act_orb
|
||||||
|
f(j,k,p)=bielecCI_no(j,k,p,l)
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
bielecCI_no(j,k,p,l)=d(p)
|
end do
|
||||||
|
call dgemm('N','N',n_act_orb*n_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||||
|
f, n_act_orb*n_act_orb, &
|
||||||
|
natorbsCI, n_act_orb, &
|
||||||
|
0.d0, &
|
||||||
|
d, n_act_orb*n_act_orb)
|
||||||
|
|
||||||
|
do p=1,n_act_orb
|
||||||
|
pp=n_act_orb-p+1
|
||||||
|
do k=1,n_act_orb
|
||||||
|
do j=1,n_act_orb
|
||||||
|
bielecCI_no(j,k,p,l)=d(j,k,pp)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
! 4th quarter
|
!$OMP END DO
|
||||||
do j=1,n_act_orb
|
|
||||||
do k=1,n_act_orb
|
!$OMP DO
|
||||||
do l=1,n_act_orb
|
do l=1,n_act_orb
|
||||||
do p=1,n_act_orb
|
do p=1,n_act_orb
|
||||||
d(p)=0.D0
|
do k=1,n_act_orb
|
||||||
|
do j=1,n_act_orb
|
||||||
|
f(j,k,p)=bielecCI_no(j,k,l,list_act(p))
|
||||||
end do
|
end do
|
||||||
do p=1,n_act_orb
|
end do
|
||||||
pp=n_act_orb-p+1
|
end do
|
||||||
do q=1,n_act_orb
|
call dgemm('N','N',n_act_orb*n_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||||
d(pp)+=bielecCI_no(j,k,l,list_act(q))*natorbsCI(q,p)
|
f, n_act_orb*n_act_orb, &
|
||||||
end do
|
natorbsCI, n_act_orb, &
|
||||||
end do
|
0.d0, &
|
||||||
do p=1,n_act_orb
|
d, n_act_orb*n_act_orb)
|
||||||
bielecCI_no(j,k,l,list_act(p))=d(p)
|
|
||||||
|
do p=1,n_act_orb
|
||||||
|
pp=n_act_orb-p+1
|
||||||
|
do k=1,n_act_orb
|
||||||
|
do j=1,n_act_orb
|
||||||
|
bielecCI_no(j,k,l,list_act(p))=d(j,k,pp)
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
deallocate(d,f)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user