mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-26 14:11:48 +02:00
cholesky in big_array
This commit is contained in:
parent
46cbd80b95
commit
a8948d0916
@ -35,45 +35,82 @@ END_PROVIDER
|
||||
|
||||
double precision :: integral, cpu_1, cpu_2, wall_1, wall_2
|
||||
logical, external :: ao_two_e_integral_zero
|
||||
double precision, external :: get_ao_two_e_integral
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
|
||||
do m=0,9
|
||||
do l=1+m,ao_num,10
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do j=1,l
|
||||
do k=1,ao_num
|
||||
do i=1,min(k,j)
|
||||
if (ao_two_e_integral_zero(i,j,k,l)) cycle
|
||||
integral = ao_two_e_integral(i,k,j,l)
|
||||
ao_integrals(i,k,j,l) = integral
|
||||
ao_integrals(k,i,j,l) = integral
|
||||
ao_integrals(i,k,l,j) = integral
|
||||
ao_integrals(k,i,l,j) = integral
|
||||
ao_integrals(j,l,i,k) = integral
|
||||
ao_integrals(j,l,k,i) = integral
|
||||
ao_integrals(l,j,i,k) = integral
|
||||
ao_integrals(l,j,k,i) = integral
|
||||
if (read_ao_two_e_integrals) then
|
||||
PROVIDE ao_two_e_integrals_in_map
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
|
||||
do m=0,9
|
||||
do l=1+m,ao_num,10
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do j=1,l
|
||||
do k=1,ao_num
|
||||
do i=1,min(k,j)
|
||||
if (ao_two_e_integral_zero(i,j,k,l)) cycle
|
||||
integral = get_ao_two_e_integral(i,j,k,l, ao_integrals_map)
|
||||
ao_integrals(i,k,j,l) = integral
|
||||
ao_integrals(k,i,j,l) = integral
|
||||
ao_integrals(i,k,l,j) = integral
|
||||
ao_integrals(k,i,l,j) = integral
|
||||
ao_integrals(j,l,i,k) = integral
|
||||
ao_integrals(j,l,k,i) = integral
|
||||
ao_integrals(l,j,i,k) = integral
|
||||
ao_integrals(l,j,k,i) = integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
!$OMP MASTER
|
||||
call wall_time(wall_2)
|
||||
print '(I10,'' % in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
|
||||
!$OMP END MASTER
|
||||
enddo
|
||||
!$OMP MASTER
|
||||
call wall_time(wall_2)
|
||||
print '(F10.2,'' % in'', 4X, I10, '' s.'')', (m+1) * 10, wall_2-wall_1
|
||||
!$OMP END MASTER
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall_2)
|
||||
call cpu_time(cpu_2)
|
||||
print*, 'AO integrals provided:'
|
||||
print*, ' cpu time :',cpu_2 - cpu_1, 's'
|
||||
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
|
||||
else
|
||||
|
||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l, integral, wall_2)
|
||||
do m=0,9
|
||||
do l=1+m,ao_num,10
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
do j=1,l
|
||||
do k=1,ao_num
|
||||
do i=1,min(k,j)
|
||||
if (ao_two_e_integral_zero(i,j,k,l)) cycle
|
||||
integral = ao_two_e_integral(i,k,j,l)
|
||||
ao_integrals(i,k,j,l) = integral
|
||||
ao_integrals(k,i,j,l) = integral
|
||||
ao_integrals(i,k,l,j) = integral
|
||||
ao_integrals(k,i,l,j) = integral
|
||||
ao_integrals(j,l,i,k) = integral
|
||||
ao_integrals(j,l,k,i) = integral
|
||||
ao_integrals(l,j,i,k) = integral
|
||||
ao_integrals(l,j,k,i) = integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO NOWAIT
|
||||
enddo
|
||||
!$OMP MASTER
|
||||
call wall_time(wall_2)
|
||||
print '(I10,'' % in'', 4X, F10.2, '' s.'')', (m+1) * 10, wall_2-wall_1
|
||||
!$OMP END MASTER
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall_2)
|
||||
call cpu_time(cpu_2)
|
||||
print*, 'AO integrals provided:'
|
||||
print*, ' cpu time :',cpu_2 - cpu_1, 's'
|
||||
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
|
||||
|
||||
endif
|
||||
|
||||
! Call Lapack
|
||||
cholesky_ao_num = cholesky_ao_num_guess
|
||||
call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_integrals_threshold, ao_num*ao_num, cholesky_ao)
|
||||
call pivoted_cholesky(ao_integrals, cholesky_ao_num, ao_cholesky_threshold, ao_num*ao_num, cholesky_ao)
|
||||
print *, 'Rank: ', cholesky_ao_num, '(', 100.d0*dble(cholesky_ao_num)/dble(ao_num*ao_num), ' %)'
|
||||
|
||||
! Remove mmap
|
||||
|
@ -18,7 +18,7 @@ subroutine run_ccsd_space_orb
|
||||
integer(bit_kind) :: det(N_int,2)
|
||||
integer :: nO, nV, nOa, nVa
|
||||
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
! PROVIDE mo_two_e_integrals_in_map
|
||||
|
||||
det = psi_det(:,:,cc_ref)
|
||||
print*,'Reference determinant:'
|
||||
|
@ -274,7 +274,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ
|
||||
enddo
|
||||
|
||||
call wall_time(t01)
|
||||
if (t01-t00 > 1.0d0) then
|
||||
if ((t01-t00 > 1.0d0).or.(imin >= Nabc)) then
|
||||
t00 = t01
|
||||
|
||||
!$OMP TASKWAIT
|
||||
|
@ -6,11 +6,41 @@ BEGIN_PROVIDER [ double precision, cholesky_mo, (mo_num, mo_num, cholesky_ao_num
|
||||
|
||||
integer :: k
|
||||
|
||||
print *, 'AO->MO Transformation of Cholesky vectors'
|
||||
!$OMP PARALLEL DO PRIVATE(k)
|
||||
do k=1,cholesky_ao_num
|
||||
call ao_to_mo(cholesky_ao(1,1,k),ao_num,cholesky_mo(1,1,k),mo_num)
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
print *, ''
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, cholesky_mo_transp, (cholesky_ao_num, mo_num, mo_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Cholesky vectors in MO basis
|
||||
END_DOC
|
||||
|
||||
integer :: i,j,k
|
||||
double precision, allocatable :: buffer(:,:)
|
||||
|
||||
print *, 'AO->MO Transformation of Cholesky vectors .'
|
||||
!$OMP PARALLEL PRIVATE(i,j,k,buffer)
|
||||
allocate(buffer(mo_num,mo_num))
|
||||
!$OMP DO SCHEDULE(static)
|
||||
do k=1,cholesky_ao_num
|
||||
call ao_to_mo(cholesky_ao(1,1,k),ao_num,buffer,mo_num)
|
||||
do j=1,mo_num
|
||||
do i=1,mo_num
|
||||
cholesky_mo_transp(k,i,j) = buffer(i,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
deallocate(buffer)
|
||||
!$OMP END PARALLEL
|
||||
print *, ''
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -4,24 +4,68 @@
|
||||
BEGIN_DOC
|
||||
! big_array_coulomb_integrals(j,i,k) = <ij|kj> = (ik|jj)
|
||||
!
|
||||
! big_array_exchange_integrals(i,j,k) = <ij|jk> = (ij|kj)
|
||||
! big_array_exchange_integrals(j,i,k) = <ij|jk> = (ij|kj)
|
||||
END_DOC
|
||||
integer :: i,j,k,l
|
||||
integer :: i,j,k,l,a
|
||||
double precision :: get_two_e_integral
|
||||
double precision :: integral
|
||||
|
||||
do k = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
l = j
|
||||
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
big_array_coulomb_integrals(j,i,k) = integral
|
||||
l = j
|
||||
integral = get_two_e_integral(i,j,l,k,mo_integrals_map)
|
||||
big_array_exchange_integrals(j,i,k) = integral
|
||||
if (do_ao_cholesky) then
|
||||
|
||||
double precision, allocatable :: buffer_jj(:,:), buffer(:,:,:)
|
||||
allocate(buffer_jj(cholesky_ao_num,mo_num), buffer(mo_num,mo_num,mo_num))
|
||||
do j=1,mo_num
|
||||
buffer_jj(:,j) = cholesky_mo_transp(:,j,j)
|
||||
enddo
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num,mo_num,cholesky_ao_num, 1.d0, &
|
||||
cholesky_mo_transp, cholesky_ao_num, &
|
||||
buffer_jj, cholesky_ao_num, 0.d0, &
|
||||
buffer, mo_num*mo_num)
|
||||
|
||||
do k = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
big_array_coulomb_integrals(j,i,k) = buffer(i,k,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
deallocate(buffer_jj)
|
||||
|
||||
allocate(buffer_jj(mo_num,mo_num))
|
||||
|
||||
do j = 1, mo_num
|
||||
|
||||
call dgemm('T','N',mo_num,mo_num,cholesky_ao_num, 1.d0, &
|
||||
cholesky_mo_transp(1,1,j), cholesky_ao_num, &
|
||||
cholesky_mo_transp(1,1,j), cholesky_ao_num, 0.d0, &
|
||||
buffer_jj, mo_num)
|
||||
|
||||
do k=1,mo_num
|
||||
do i=1,mo_num
|
||||
big_array_exchange_integrals(j,i,k) = buffer_jj(i,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
deallocate(buffer_jj)
|
||||
|
||||
else
|
||||
|
||||
do k = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
l = j
|
||||
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
big_array_coulomb_integrals(j,i,k) = integral
|
||||
l = j
|
||||
integral = get_two_e_integral(i,j,l,k,mo_integrals_map)
|
||||
big_array_exchange_integrals(j,i,k) = integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1353,15 +1353,30 @@ END_PROVIDER
|
||||
integer :: i,j
|
||||
double precision :: get_two_e_integral
|
||||
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
mo_two_e_integrals_jj = 0.d0
|
||||
mo_two_e_integrals_jj_exchange = 0.d0
|
||||
|
||||
if (do_ao_cholesky) then
|
||||
do j=1,mo_num
|
||||
do i=1,mo_num
|
||||
!TODO: use dgemm
|
||||
mo_two_e_integrals_jj(i,j) = sum(cholesky_mo_transp(:,i,i)*cholesky_mo_transp(:,j,j))
|
||||
mo_two_e_integrals_jj_exchange(i,j) = sum(cholesky_mo_transp(:,i,j)*cholesky_mo_transp(:,j,i))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do j=1,mo_num
|
||||
do i=1,mo_num
|
||||
mo_two_e_integrals_jj(i,j) = get_two_e_integral(i,j,i,j,mo_integrals_map)
|
||||
mo_two_e_integrals_jj_exchange(i,j) = get_two_e_integral(i,j,j,i,mo_integrals_map)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
do j=1,mo_num
|
||||
do i=1,mo_num
|
||||
mo_two_e_integrals_jj(i,j) = get_two_e_integral(i,j,i,j,mo_integrals_map)
|
||||
mo_two_e_integrals_jj_exchange(i,j) = get_two_e_integral(i,j,j,i,mo_integrals_map)
|
||||
mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j)
|
||||
mo_two_e_integrals_jj_anti(i,j) = mo_two_e_integrals_jj(i,j) - mo_two_e_integrals_jj_exchange(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
@ -5,9 +5,8 @@ subroutine det_energy(det,energy)
|
||||
integer(bit_kind), intent(in) :: det
|
||||
|
||||
double precision, intent(out) :: energy
|
||||
double precision, external :: diag_H_mat_elem
|
||||
|
||||
call i_H_j(det,det,N_int,energy)
|
||||
energy = diag_H_mat_elem(det,N_int) + nuclear_repulsion
|
||||
|
||||
energy = energy + nuclear_repulsion
|
||||
|
||||
end
|
||||
|
@ -13,7 +13,7 @@ subroutine gen_f_space(det,n1,n2,list1,list2,f)
|
||||
integer :: i1,i2,idx1,idx2
|
||||
|
||||
allocate(tmp_F(mo_num,mo_num))
|
||||
|
||||
|
||||
call get_fock_matrix_spin(det,1,tmp_F)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
@ -32,7 +32,7 @@ subroutine gen_f_space(det,n1,n2,list1,list2,f)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
deallocate(tmp_F)
|
||||
|
||||
|
||||
end
|
||||
|
||||
! V
|
||||
@ -45,63 +45,66 @@ subroutine gen_v_space(n1,n2,n3,n4,list1,list2,list3,list4,v)
|
||||
integer, intent(in) :: list1(n1),list2(n2),list3(n3),list4(n4)
|
||||
double precision, intent(out) :: v(n1,n2,n3,n4)
|
||||
|
||||
integer :: i1,i2,i3,i4,idx1,idx2,idx3,idx4
|
||||
double precision :: get_two_e_integral
|
||||
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
integer :: i1,i2,i3,i4,idx1,idx2,idx3,idx4,k
|
||||
|
||||
double precision, allocatable :: buffer(:,:,:)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_integrals_map) &
|
||||
!$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4)&
|
||||
!$OMP SHARED(n1,n2,n3,n4,list1,list2,list3,list4,v,mo_num,cholesky_mo_transp,cholesky_ao_num) &
|
||||
!$OMP PRIVATE(i1,i2,i3,i4,idx1,idx2,idx3,idx4,k,buffer)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO collapse(3)
|
||||
allocate(buffer(mo_num,mo_num,mo_num))
|
||||
!$OMP DO
|
||||
do i4 = 1, n4
|
||||
do i3 = 1, n3
|
||||
do i2 = 1, n2
|
||||
idx4 = list4(i4)
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, &
|
||||
cholesky_mo_transp, cholesky_ao_num, &
|
||||
cholesky_mo_transp(1,1,idx4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num)
|
||||
do i2 = 1, n2
|
||||
idx2 = list2(i2)
|
||||
do i3 = 1, n3
|
||||
idx3 = list3(i3)
|
||||
do i1 = 1, n1
|
||||
idx4 = list4(i4)
|
||||
idx3 = list3(i3)
|
||||
idx2 = list2(i2)
|
||||
idx1 = list1(i1)
|
||||
v(i1,i2,i3,i4) = get_two_e_integral(idx1,idx2,idx3,idx4,mo_integrals_map)
|
||||
v(i1,i2,i3,i4) = buffer(idx1,idx3,idx2)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
deallocate(buffer)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
|
||||
end
|
||||
|
||||
! full
|
||||
|
||||
BEGIN_PROVIDER [double precision, cc_space_v, (mo_num,mo_num,mo_num,mo_num)]
|
||||
|
||||
implicit none
|
||||
|
||||
integer :: i,j,k,l
|
||||
double precision :: get_two_e_integral
|
||||
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
|
||||
integer :: i1,i2,i3,i4,k
|
||||
double precision, allocatable :: buffer(:,:,:)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(cc_space_v,mo_num,mo_integrals_map) &
|
||||
!$OMP PRIVATE(i,j,k,l) &
|
||||
!$OMP SHARED(cc_space_v,mo_num,cholesky_mo_transp,cholesky_ao_num) &
|
||||
!$OMP PRIVATE(i1,i2,i3,i4,k,buffer)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
!$OMP DO collapse(3)
|
||||
do l = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do i = 1, mo_num
|
||||
cc_space_v(i,j,k,l) = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
allocate(buffer(mo_num,mo_num,mo_num))
|
||||
!$OMP DO
|
||||
do i4 = 1, mo_num
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num, cholesky_ao_num, 1.d0, &
|
||||
cholesky_mo_transp, cholesky_ao_num, &
|
||||
cholesky_mo_transp(1,1,i4), cholesky_ao_num, 0.d0, buffer, mo_num*mo_num)
|
||||
do i2 = 1, mo_num
|
||||
do i3 = 1, mo_num
|
||||
do i1 = 1, mo_num
|
||||
cc_space_v(i1,i2,i3,i4) = buffer(i1,i3,i2)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
deallocate(buffer)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! oooo
|
||||
@ -280,7 +283,7 @@ BEGIN_PROVIDER [double precision, cc_space_v_ppqq, (cc_n_mo, cc_n_mo)]
|
||||
allocate(tmp_v(cc_n_mo,cc_n_mo,cc_n_mo,cc_n_mo))
|
||||
|
||||
call gen_v_space(cc_n_mo,cc_n_mo,cc_n_mo,cc_n_mo, cc_list_gen,cc_list_gen,cc_list_gen,cc_list_gen, tmp_v)
|
||||
|
||||
|
||||
do q = 1, cc_n_mo
|
||||
do p = 1, cc_n_mo
|
||||
cc_space_v_ppqq(p,q) = tmp_v(p,p,q,q)
|
||||
@ -382,7 +385,7 @@ BEGIN_PROVIDER [double precision, cc_space_v_aabb, (cc_nVa,cc_nVa)]
|
||||
enddo
|
||||
|
||||
FREE cc_space_v_vvvv
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! iaia
|
||||
@ -467,7 +470,7 @@ BEGIN_PROVIDER [double precision, cc_space_w_oovv, (cc_nOa, cc_nOa, cc_nVa, cc_n
|
||||
integer :: i,j,a,b
|
||||
|
||||
allocate(tmp_v(cc_nOa,cc_nOa,cc_nVa,cc_nVa))
|
||||
|
||||
|
||||
call gen_v_space(cc_nOa,cc_nOa,cc_nVa,cc_nVa, cc_list_occ,cc_list_occ,cc_list_vir,cc_list_vir, tmp_v)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
@ -501,7 +504,7 @@ BEGIN_PROVIDER [double precision, cc_space_w_vvoo, (cc_nVa, cc_nVa, cc_nOa, cc_n
|
||||
integer :: i,j,a,b
|
||||
|
||||
allocate(tmp_v(cc_nVa,cc_nVa,cc_nOa,cc_nOa))
|
||||
|
||||
|
||||
call gen_v_space(cc_nVa,cc_nVa,cc_nOa,cc_nOa, cc_list_vir,cc_list_vir,cc_list_occ,cc_list_occ, tmp_v)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
@ -613,7 +616,7 @@ subroutine shift_idx_spin(s,n_S,shift)
|
||||
else
|
||||
shift = n_S(1)
|
||||
endif
|
||||
|
||||
|
||||
end
|
||||
|
||||
! F
|
||||
@ -626,21 +629,22 @@ subroutine gen_f_spin(det, n1,n2, n1_S,n2_S, list1,list2, dim1,dim2, f)
|
||||
! Compute the Fock matrix corresponding to two lists of spin orbitals.
|
||||
! Ex: occ/occ, occ/vir,...
|
||||
END_DOC
|
||||
|
||||
|
||||
integer(bit_kind), intent(in) :: det(N_int,2)
|
||||
integer, intent(in) :: n1,n2, n1_S(2), n2_S(2)
|
||||
integer, intent(in) :: list1(n1,2), list2(n2,2)
|
||||
integer, intent(in) :: dim1, dim2
|
||||
|
||||
|
||||
double precision, intent(out) :: f(dim1, dim2)
|
||||
|
||||
double precision, allocatable :: tmp_F(:,:)
|
||||
integer :: i,j, idx_i,idx_j,i_shift,j_shift
|
||||
integer :: tmp_i,tmp_j
|
||||
integer :: si,sj,s
|
||||
PROVIDE big_array_exchange_integrals big_array_coulomb_integrals
|
||||
|
||||
allocate(tmp_F(mo_num,mo_num))
|
||||
|
||||
|
||||
do sj = 1, 2
|
||||
call shift_idx_spin(sj,n2_S,j_shift)
|
||||
do si = 1, 2
|
||||
@ -669,9 +673,9 @@ subroutine gen_f_spin(det, n1,n2, n1_S,n2_S, list1,list2, dim1,dim2, f)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
deallocate(tmp_F)
|
||||
|
||||
|
||||
end
|
||||
|
||||
! Get F
|
||||
@ -683,12 +687,12 @@ subroutine get_fock_matrix_spin(det,s,f)
|
||||
BEGIN_DOC
|
||||
! Fock matrix alpha or beta of an arbitrary det
|
||||
END_DOC
|
||||
|
||||
|
||||
integer(bit_kind), intent(in) :: det(N_int,2)
|
||||
integer, intent(in) :: s
|
||||
|
||||
|
||||
double precision, intent(out) :: f(mo_num,mo_num)
|
||||
|
||||
|
||||
integer :: p,q,i,s1,s2
|
||||
integer(bit_kind) :: res(N_int,2)
|
||||
logical :: ok
|
||||
@ -701,9 +705,11 @@ subroutine get_fock_matrix_spin(det,s,f)
|
||||
s1 = 2
|
||||
s2 = 1
|
||||
endif
|
||||
|
||||
|
||||
PROVIDE big_array_coulomb_integrals big_array_exchange_integrals
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(f,mo_num,s1,s2,N_int,det,mo_one_e_integrals) &
|
||||
!$OMP SHARED(f,mo_num,s1,s2,N_int,det,mo_one_e_integrals,big_array_coulomb_integrals,big_array_exchange_integrals) &
|
||||
!$OMP PRIVATE(p,q,ok,i,res)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO collapse(1)
|
||||
@ -713,20 +719,21 @@ subroutine get_fock_matrix_spin(det,s,f)
|
||||
do i = 1, mo_num
|
||||
call apply_hole(det, s1, i, res, ok, N_int)
|
||||
if (ok) then
|
||||
f(p,q) = f(p,q) + mo_two_e_integral(p,i,q,i) - mo_two_e_integral(p,i,i,q)
|
||||
! f(p,q) = f(p,q) + mo_two_e_integral(p,i,q,i) - mo_two_e_integral(p,i,i,q)
|
||||
f(p,q) = f(p,q) + big_array_coulomb_integrals(i,p,q) - big_array_exchange_integrals(i,p,q)
|
||||
endif
|
||||
enddo
|
||||
do i = 1, mo_num
|
||||
call apply_hole(det, s2, i, res, ok, N_int)
|
||||
if (ok) then
|
||||
f(p,q) = f(p,q) + mo_two_e_integral(p,i,q,i)
|
||||
f(p,q) = f(p,q) + big_array_coulomb_integrals(i,p,q)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
end
|
||||
|
||||
! V
|
||||
@ -752,14 +759,14 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
integer :: si,sj,sk,sl,s
|
||||
|
||||
PROVIDE cc_space_v
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(cc_space_v,n1_S,n2_S,n3_S,n4_S,list1,list2,list3,list4,v) &
|
||||
!$OMP PRIVATE(s,si,sj,sk,sl,i_shift,j_shift,k_shift,l_shift, &
|
||||
!$OMP i,j,k,l,idx_i,idx_j,idx_k,idx_l,&
|
||||
!$OMP tmp_i,tmp_j,tmp_k,tmp_l)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
|
||||
do sl = 1, 2
|
||||
call shift_idx_spin(sl,n4_S,l_shift)
|
||||
do sk = 1, 2
|
||||
@ -768,7 +775,7 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
call shift_idx_spin(sj,n2_S,j_shift)
|
||||
do si = 1, 2
|
||||
call shift_idx_spin(si,n1_S,i_shift)
|
||||
|
||||
|
||||
s = si+sj+sk+sl
|
||||
! <aa||aa> or <bb||bb>
|
||||
if (s == 4 .or. s == 8) then
|
||||
@ -776,7 +783,7 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -792,14 +799,14 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ab> or <ba||ba>
|
||||
elseif (si == sk .and. sj == sl) then
|
||||
!$OMP DO collapse(3)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -815,14 +822,14 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ba> or <ba||ab>
|
||||
elseif (si == sl .and. sj == sk) then
|
||||
!$OMP DO collapse(3)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -843,7 +850,7 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -859,13 +866,13 @@ subroutine gen_v_spin(n1,n2,n3,n4, n1_S,n2_S,n3_S,n4_S, list1,list2,list3,list4,
|
||||
enddo
|
||||
!$OMP END DO
|
||||
endif
|
||||
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
end
|
||||
|
||||
! V_3idx
|
||||
@ -900,28 +907,28 @@ subroutine gen_v_spin_3idx(n1,n2,n3,n4, idx_l, n1_S,n2_S,n3_S,n4_S, list1,list2,
|
||||
call shift_idx_spin(sl,n4_S,l_shift)
|
||||
tmp_l = idx_l - l_shift
|
||||
l = list4(tmp_l,sl)
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(l,sl,idx_l,cc_space_v,n1_S,n2_S,n3_S,n4_S,list1,list2,list3,list4,v_l) &
|
||||
!$OMP PRIVATE(s,si,sj,sk,i_shift,j_shift,k_shift, &
|
||||
!$OMP i,j,k,idx_i,idx_j,idx_k,&
|
||||
!$OMP tmp_i,tmp_j,tmp_k)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
|
||||
do sk = 1, 2
|
||||
call shift_idx_spin(sk,n3_S,k_shift)
|
||||
do sj = 1, 2
|
||||
call shift_idx_spin(sj,n2_S,j_shift)
|
||||
do si = 1, 2
|
||||
call shift_idx_spin(si,n1_S,i_shift)
|
||||
|
||||
|
||||
s = si+sj+sk+sl
|
||||
! <aa||aa> or <bb||bb>
|
||||
if (s == 4 .or. s == 8) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
k = list3(tmp_k,sk)
|
||||
idx_k = tmp_k + k_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -934,13 +941,13 @@ subroutine gen_v_spin_3idx(n1,n2,n3,n4, idx_l, n1_S,n2_S,n3_S,n4_S, list1,list2,
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ab> or <ba||ba>
|
||||
elseif (si == sk .and. sj == sl) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
k = list3(tmp_k,sk)
|
||||
idx_k = tmp_k + k_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -953,13 +960,13 @@ subroutine gen_v_spin_3idx(n1,n2,n3,n4, idx_l, n1_S,n2_S,n3_S,n4_S, list1,list2,
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ba> or <ba||ab>
|
||||
elseif (si == sl .and. sj == sk) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
k = list3(tmp_k,sk)
|
||||
idx_k = tmp_k + k_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -976,7 +983,7 @@ subroutine gen_v_spin_3idx(n1,n2,n3,n4, idx_l, n1_S,n2_S,n3_S,n4_S, list1,list2,
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
k = list3(tmp_k,sk)
|
||||
idx_k = tmp_k + k_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -989,12 +996,12 @@ subroutine gen_v_spin_3idx(n1,n2,n3,n4, idx_l, n1_S,n2_S,n3_S,n4_S, list1,list2,
|
||||
enddo
|
||||
!$OMP END DO
|
||||
endif
|
||||
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
end
|
||||
|
||||
! V_3idx_ij_l
|
||||
@ -1029,28 +1036,28 @@ subroutine gen_v_spin_3idx_ij_l(n1,n2,n3,n4, idx_k, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
call shift_idx_spin(sk,n3_S,k_shift)
|
||||
tmp_k = idx_k - k_shift
|
||||
k = list3(tmp_k,sk)
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(k,sk,idx_k,cc_space_v,n1_S,n2_S,n3_S,n4_S,list1,list2,list3,list4,v_k) &
|
||||
!$OMP PRIVATE(s,si,sj,sl,i_shift,j_shift,l_shift, &
|
||||
!$OMP i,j,l,idx_i,idx_j,idx_l,&
|
||||
!$OMP tmp_i,tmp_j,tmp_l)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
|
||||
do sl = 1, 2
|
||||
call shift_idx_spin(sl,n4_S,l_shift)
|
||||
do sj = 1, 2
|
||||
call shift_idx_spin(sj,n2_S,j_shift)
|
||||
do si = 1, 2
|
||||
call shift_idx_spin(si,n1_S,i_shift)
|
||||
|
||||
|
||||
s = si+sj+sk+sl
|
||||
! <aa||aa> or <bb||bb>
|
||||
if (s == 4 .or. s == 8) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -1063,13 +1070,13 @@ subroutine gen_v_spin_3idx_ij_l(n1,n2,n3,n4, idx_k, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ab> or <ba||ba>
|
||||
elseif (si == sk .and. sj == sl) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -1082,13 +1089,13 @@ subroutine gen_v_spin_3idx_ij_l(n1,n2,n3,n4, idx_k, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ba> or <ba||ab>
|
||||
elseif (si == sl .and. sj == sk) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -1105,7 +1112,7 @@ subroutine gen_v_spin_3idx_ij_l(n1,n2,n3,n4, idx_k, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_j = 1, n2_S(sj)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
j = list2(tmp_j,sj)
|
||||
@ -1118,12 +1125,12 @@ subroutine gen_v_spin_3idx_ij_l(n1,n2,n3,n4, idx_k, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
enddo
|
||||
!$OMP END DO
|
||||
endif
|
||||
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
end
|
||||
|
||||
! V_3idx_i_kl
|
||||
@ -1158,28 +1165,28 @@ subroutine gen_v_spin_3idx_i_kl(n1,n2,n3,n4, idx_j, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
call shift_idx_spin(sj,n2_S,j_shift)
|
||||
tmp_j = idx_j - j_shift
|
||||
j = list2(tmp_j,sj)
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(j,sj,idx_j,cc_space_v,n1_S,n2_S,n3_S,n4_S,list1,list2,list3,list4,v_j) &
|
||||
!$OMP PRIVATE(s,si,sk,sl,i_shift,l_shift,k_shift, &
|
||||
!$OMP i,k,l,idx_i,idx_k,idx_l,&
|
||||
!$OMP tmp_i,tmp_k,tmp_l)&
|
||||
!$OMP DEFAULT(NONE)
|
||||
|
||||
|
||||
do sl = 1, 2
|
||||
call shift_idx_spin(sl,n4_S,l_shift)
|
||||
do sk = 1, 2
|
||||
call shift_idx_spin(sk,n3_S,k_shift)
|
||||
do si = 1, 2
|
||||
call shift_idx_spin(si,n1_S,i_shift)
|
||||
|
||||
|
||||
s = si+sj+sk+sl
|
||||
! <aa||aa> or <bb||bb>
|
||||
if (s == 4 .or. s == 8) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -1192,13 +1199,13 @@ subroutine gen_v_spin_3idx_i_kl(n1,n2,n3,n4, idx_j, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ab> or <ba||ba>
|
||||
elseif (si == sk .and. sj == sl) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -1211,13 +1218,13 @@ subroutine gen_v_spin_3idx_i_kl(n1,n2,n3,n4, idx_j, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! <ab||ba> or <ba||ab>
|
||||
elseif (si == sl .and. sj == sk) then
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -1234,7 +1241,7 @@ subroutine gen_v_spin_3idx_i_kl(n1,n2,n3,n4, idx_j, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
!$OMP DO collapse(2)
|
||||
do tmp_l = 1, n4_S(sl)
|
||||
do tmp_k = 1, n3_S(sk)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
do tmp_i = 1, n1_S(si)
|
||||
l = list4(tmp_l,sl)
|
||||
idx_l = tmp_l + l_shift
|
||||
k = list3(tmp_k,sk)
|
||||
@ -1247,10 +1254,10 @@ subroutine gen_v_spin_3idx_i_kl(n1,n2,n3,n4, idx_j, n1_S,n2_S,n3_S,n4_S, list1,l
|
||||
enddo
|
||||
!$OMP END DO
|
||||
endif
|
||||
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
end
|
||||
|
Loading…
Reference in New Issue
Block a user