LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-04-25 17:54:44 +02:00
Code Releases Activity

Merge branch 'dev-stable' of github.com:QuantumPackage/qp2 into dev-stable

Browse Source
This commit is contained in:
Anthony Scemama 2025-02-12 12:00:28 +01:00
commit e38ecc0a49
8 changed files with 366 additions and 249 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/casscf_cipsi/gradient.irp.f
View File

@ -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 v=1,n_act_orb ! active
vv=list_act(v)
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 y=1,n_act_orb ! active
y3=y+n_core_inact_orb ! list_act(y)
! x3=x+n_core_inact_orb ! list_act(x)
do v=1,n_act_orb ! active
vv=list_act(v)
! 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

176
src/casscf_cipsi/hessian.irp.f
View File

@ -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
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
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
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)
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)
do y=1,n_act_orb
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 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
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,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
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) &
+(P0tuvx_no(t,x,v,t)+P0tuvx_no(t,x,t,v)) &
*bielec_pxxq_no(aa,x3,v3,bb))
end do
end do
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 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
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,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
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) &
+(P0tuvx_no(t,x,v,u)+P0tuvx_no(t,x,u,v)) &
*bielec_pxxq_no(aa,x3,v3,bb))
end do
end do
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

61
src/casscf_cipsi/mcscf_fock.irp.f
View File

@ -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

102
src/casscf_cipsi/natorb.irp.f
View File

@ -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

27
src/dav_general_mat/dav_general.irp.f
View File

@ -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>
! -----------------------------------
! 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)
! Gram-Smitt to orthogonalize all new guess with the previous vectors
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
call hpsi(W(:,shift+1),U(:,shift+1),N_st_diag,sze,h_mat)
! 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)
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))

4
src/dft_utils_in_r/ao_in_r.irp.f
View File

@ -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

41
src/dft_utils_in_r/mo_in_r.irp.f
View File

@ -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

1
src/mo_two_e_ints/map_integrals.irp.f
View File

@ -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