mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-07 14:03:37 +01:00
Merge branch 'dev' of github.com:QuantumPackage/qp2 into dev
This commit is contained in:
commit
d7d3afacb1
1
configure
vendored
1
configure
vendored
@ -238,6 +238,7 @@ EOF
|
|||||||
tar --gunzip --extract --file libcap.tar.gz
|
tar --gunzip --extract --file libcap.tar.gz
|
||||||
rm libcap.tar.gz
|
rm libcap.tar.gz
|
||||||
cd libcap-*/libcap
|
cd libcap-*/libcap
|
||||||
|
prefix=$QP_ROOT make BUILD_GPERF=no
|
||||||
prefix=$QP_ROOT make install
|
prefix=$QP_ROOT make install
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
|
|||||||
@ -8,27 +8,56 @@ subroutine get_mask_phase(det1, pm, Nint)
|
|||||||
integer(bit_kind), intent(out) :: pm(Nint,2)
|
integer(bit_kind), intent(out) :: pm(Nint,2)
|
||||||
integer(bit_kind) :: tmp1, tmp2
|
integer(bit_kind) :: tmp1, tmp2
|
||||||
integer :: i
|
integer :: i
|
||||||
pm(1:Nint,1:2) = det1(1:Nint,1:2)
|
|
||||||
tmp1 = 0_8
|
tmp1 = 0_8
|
||||||
tmp2 = 0_8
|
tmp2 = 0_8
|
||||||
do i=1,Nint
|
select case (Nint)
|
||||||
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 1))
|
|
||||||
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 1))
|
BEGIN_TEMPLATE
|
||||||
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
|
case ($Nint)
|
||||||
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
|
do i=1,$Nint
|
||||||
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
|
pm(i,1) = ieor(det1(i,1), shiftl(det1(i,1), 1))
|
||||||
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
|
pm(i,2) = ieor(det1(i,2), shiftl(det1(i,2), 1))
|
||||||
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
|
||||||
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
|
||||||
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
|
||||||
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
|
||||||
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
|
||||||
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
|
||||||
pm(i,1) = ieor(pm(i,1), tmp1)
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
|
||||||
pm(i,2) = ieor(pm(i,2), tmp2)
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
|
||||||
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
|
||||||
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
|
||||||
end do
|
pm(i,1) = ieor(pm(i,1), tmp1)
|
||||||
|
pm(i,2) = ieor(pm(i,2), tmp2)
|
||||||
|
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
|
||||||
|
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
|
||||||
|
end do
|
||||||
|
SUBST [ Nint ]
|
||||||
|
1;;
|
||||||
|
2;;
|
||||||
|
3;;
|
||||||
|
4;;
|
||||||
|
END_TEMPLATE
|
||||||
|
case default
|
||||||
|
do i=1,Nint
|
||||||
|
pm(i,1) = ieor(det1(i,1), shiftl(det1(i,1), 1))
|
||||||
|
pm(i,2) = ieor(det1(i,2), shiftl(det1(i,2), 1))
|
||||||
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
|
||||||
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
|
||||||
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
|
||||||
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
|
||||||
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
|
||||||
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
|
||||||
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
|
||||||
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
|
||||||
|
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
|
||||||
|
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
|
||||||
|
pm(i,1) = ieor(pm(i,1), tmp1)
|
||||||
|
pm(i,2) = ieor(pm(i,2), tmp2)
|
||||||
|
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
|
||||||
|
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
|
||||||
|
end do
|
||||||
|
end select
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
@ -445,11 +474,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
do i=1,fullinteresting(0)
|
do i=1,fullinteresting(0)
|
||||||
fullminilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,fullinteresting(i))
|
do k=1,N_int
|
||||||
|
fullminilist(k,1,i) = psi_det_sorted(k,1,fullinteresting(i))
|
||||||
|
fullminilist(k,2,i) = psi_det_sorted(k,2,fullinteresting(i))
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i=1,interesting(0)
|
do i=1,interesting(0)
|
||||||
minilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,interesting(i))
|
do k=1,N_int
|
||||||
|
minilist(k,1,i) = psi_det_sorted(k,1,interesting(i))
|
||||||
|
minilist(k,2,i) = psi_det_sorted(k,2,interesting(i))
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do s2=s1,2
|
do s2=s1,2
|
||||||
|
|||||||
@ -438,7 +438,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
ipos=1
|
ipos=1
|
||||||
do imin=1,N_det,tasksize
|
do imin=1,N_det,tasksize
|
||||||
imax = min(N_det,imin-1+tasksize)
|
imax = min(N_det,imin-1+tasksize)
|
||||||
if (imin==1) then
|
if (imin<=N_det/2) then
|
||||||
istep = 2
|
istep = 2
|
||||||
else
|
else
|
||||||
istep = 1
|
istep = 1
|
||||||
@ -505,7 +505,9 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
print *, irp_here, ': Failed in zmq_set_running'
|
print *, irp_here, ': Failed in zmq_set_running'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
call omp_set_max_active_levels(4)
|
|
||||||
|
call omp_set_max_active_levels(5)
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread)
|
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread)
|
||||||
ithread = omp_get_thread_num()
|
ithread = omp_get_thread_num()
|
||||||
if (ithread == 0 ) then
|
if (ithread == 0 ) then
|
||||||
|
|||||||
@ -1075,19 +1075,17 @@ subroutine get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer,
|
|||||||
integer :: i
|
integer :: i
|
||||||
include 'utils/constants.include.F'
|
include 'utils/constants.include.F'
|
||||||
integer :: degree
|
integer :: degree
|
||||||
|
integer :: add_double(0:64) = (/ 0, 0, 0, 0, 1, (0, i=1,60) /)
|
||||||
|
integer :: add_single(0:64) = (/ 0, 0, 1, 0, 0, (0, i=1,60) /)
|
||||||
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
degree = popcnt( xor( spindet, buffer(i) ) )
|
degree = popcnt( xor( spindet, buffer(i) ) )
|
||||||
if ( degree == 4 ) then
|
doubles(n_doubles) = idx(i)
|
||||||
doubles(n_doubles) = idx(i)
|
singles(n_singles) = idx(i)
|
||||||
n_doubles = n_doubles+1
|
n_doubles = n_doubles+add_double(degree)
|
||||||
else if ( degree == 2 ) then
|
n_singles = n_singles+add_single(degree)
|
||||||
singles(n_singles) = idx(i)
|
|
||||||
n_singles = n_singles+1
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
n_singles = n_singles-1
|
n_singles = n_singles-1
|
||||||
n_doubles = n_doubles-1
|
n_doubles = n_doubles-1
|
||||||
@ -1113,15 +1111,14 @@ subroutine get_all_spin_singles_1(buffer, idx, spindet, size_buffer, singles, n_
|
|||||||
integer :: i
|
integer :: i
|
||||||
integer(bit_kind) :: v
|
integer(bit_kind) :: v
|
||||||
integer :: degree
|
integer :: degree
|
||||||
|
integer :: add_single(0:64) = (/ 0, 0, 1, 0, 0, (0, i=1,60) /)
|
||||||
include 'utils/constants.include.F'
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
degree = popcnt(xor( spindet, buffer(i) ))
|
degree = popcnt(xor( spindet, buffer(i) ))
|
||||||
if (degree == 2) then
|
singles(n_singles) = idx(i)
|
||||||
singles(n_singles) = idx(i)
|
n_singles = n_singles+add_single(degree)
|
||||||
n_singles = n_singles+1
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
n_singles = n_singles-1
|
n_singles = n_singles-1
|
||||||
|
|
||||||
@ -1145,14 +1142,13 @@ subroutine get_all_spin_doubles_1(buffer, idx, spindet, size_buffer, doubles, n_
|
|||||||
integer :: i
|
integer :: i
|
||||||
include 'utils/constants.include.F'
|
include 'utils/constants.include.F'
|
||||||
integer :: degree
|
integer :: degree
|
||||||
|
integer :: add_double(0:64) = (/ 0, 0, 0, 0, 1, (0, i=1,60) /)
|
||||||
|
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
degree = popcnt(xor( spindet, buffer(i) ))
|
degree = popcnt(xor( spindet, buffer(i) ))
|
||||||
if ( degree == 4 ) then
|
doubles(n_doubles) = idx(i)
|
||||||
doubles(n_doubles) = idx(i)
|
n_doubles = n_doubles+add_double(degree)
|
||||||
n_doubles = n_doubles+1
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
n_doubles = n_doubles-1
|
n_doubles = n_doubles-1
|
||||||
|
|
||||||
@ -1193,16 +1189,10 @@ subroutine get_all_spin_singles_and_doubles_$N_int(buffer, idx, spindet, size_bu
|
|||||||
xorvec(k) = xor( spindet(k), buffer(k,i) )
|
xorvec(k) = xor( spindet(k), buffer(k,i) )
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if (xorvec(1) /= 0_8) then
|
degree = 0
|
||||||
degree = popcnt(xorvec(1))
|
|
||||||
else
|
|
||||||
degree = 0
|
|
||||||
endif
|
|
||||||
|
|
||||||
do k=2,$N_int
|
do k=1,$N_int
|
||||||
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
|
||||||
degree = degree + popcnt(xorvec(k))
|
degree = degree + popcnt(xorvec(k))
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if ( degree == 4 ) then
|
if ( degree == 4 ) then
|
||||||
@ -1247,23 +1237,19 @@ subroutine get_all_spin_singles_$N_int(buffer, idx, spindet, size_buffer, single
|
|||||||
xorvec(k) = xor( spindet(k), buffer(k,i) )
|
xorvec(k) = xor( spindet(k), buffer(k,i) )
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if (xorvec(1) /= 0_8) then
|
degree = 0
|
||||||
degree = popcnt(xorvec(1))
|
|
||||||
else
|
|
||||||
degree = 0
|
|
||||||
endif
|
|
||||||
|
|
||||||
do k=2,$N_int
|
do k=1,$N_int
|
||||||
if ( (degree <= 2).and.(xorvec(k) /= 0_8) ) then
|
|
||||||
degree = degree + popcnt(xorvec(k))
|
degree = degree + popcnt(xorvec(k))
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if ( degree == 2 ) then
|
if ( degree /= 2 ) then
|
||||||
singles(n_singles) = idx(i)
|
cycle
|
||||||
n_singles = n_singles+1
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
singles(n_singles) = idx(i)
|
||||||
|
n_singles = n_singles+1
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
n_singles = n_singles-1
|
n_singles = n_singles-1
|
||||||
|
|
||||||
@ -1296,23 +1282,19 @@ subroutine get_all_spin_doubles_$N_int(buffer, idx, spindet, size_buffer, double
|
|||||||
xorvec(k) = xor( spindet(k), buffer(k,i) )
|
xorvec(k) = xor( spindet(k), buffer(k,i) )
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if (xorvec(1) /= 0_8) then
|
degree = 0
|
||||||
degree = popcnt(xorvec(1))
|
|
||||||
else
|
|
||||||
degree = 0
|
|
||||||
endif
|
|
||||||
|
|
||||||
do k=2,$N_int
|
do k=1,$N_int
|
||||||
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
|
||||||
degree = degree + popcnt(xorvec(k))
|
degree = degree + popcnt(xorvec(k))
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
if ( degree == 4 ) then
|
if ( degree /= 4 ) then
|
||||||
doubles(n_doubles) = idx(i)
|
cycle
|
||||||
n_doubles = n_doubles+1
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
doubles(n_doubles) = idx(i)
|
||||||
|
n_doubles = n_doubles+1
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
n_doubles = n_doubles-1
|
n_doubles = n_doubles-1
|
||||||
|
|||||||
@ -23,6 +23,10 @@ END_DOC
|
|||||||
error_matrix_DIIS(ao_num,ao_num,max_dim_DIIS) &
|
error_matrix_DIIS(ao_num,ao_num,max_dim_DIIS) &
|
||||||
)
|
)
|
||||||
|
|
||||||
|
Fock_matrix_DIIS = 0.d0
|
||||||
|
error_matrix_DIIS = 0.d0
|
||||||
|
mo_coef_save = 0.d0
|
||||||
|
|
||||||
call write_time(6)
|
call write_time(6)
|
||||||
|
|
||||||
print*,'Energy of the guess = ',SCF_energy
|
print*,'Energy of the guess = ',SCF_energy
|
||||||
@ -198,7 +202,7 @@ END_DOC
|
|||||||
double precision,allocatable :: C_vector_DIIS(:)
|
double precision,allocatable :: C_vector_DIIS(:)
|
||||||
|
|
||||||
double precision,allocatable :: scratch(:,:)
|
double precision,allocatable :: scratch(:,:)
|
||||||
integer :: i,j,k,i_DIIS,j_DIIS
|
integer :: i,j,k,l,i_DIIS,j_DIIS
|
||||||
double precision :: rcond, ferr, berr
|
double precision :: rcond, ferr, berr
|
||||||
integer, allocatable :: iwork(:)
|
integer, allocatable :: iwork(:)
|
||||||
integer :: lwork
|
integer :: lwork
|
||||||
@ -214,28 +218,22 @@ END_DOC
|
|||||||
scratch(ao_num,ao_num) &
|
scratch(ao_num,ao_num) &
|
||||||
)
|
)
|
||||||
|
|
||||||
! Compute the matrices B and X
|
! Compute the matrices B and X
|
||||||
B_matrix_DIIS(:,:) = 0.d0
|
B_matrix_DIIS(:,:) = 0.d0
|
||||||
do j=1,dim_DIIS
|
do j=1,dim_DIIS
|
||||||
j_DIIS = min(dim_DIIS,mod(iteration_SCF-j,max_dim_DIIS)+1)
|
j_DIIS = min(dim_DIIS,mod(iteration_SCF-j,max_dim_DIIS)+1)
|
||||||
do i=1,dim_DIIS
|
|
||||||
|
|
||||||
|
do i=1,dim_DIIS
|
||||||
i_DIIS = min(dim_DIIS,mod(iteration_SCF-i,max_dim_DIIS)+1)
|
i_DIIS = min(dim_DIIS,mod(iteration_SCF-i,max_dim_DIIS)+1)
|
||||||
|
|
||||||
! Compute product of two errors vectors
|
! Compute product of two errors vectors
|
||||||
|
do l=1,ao_num
|
||||||
call dgemm('N','N',ao_num,ao_num,ao_num, &
|
do k=1,ao_num
|
||||||
1.d0, &
|
B_matrix_DIIS(i,j) = B_matrix_DIIS(i,j) + &
|
||||||
error_matrix_DIIS(1,1,i_DIIS),size(error_matrix_DIIS,1), &
|
error_matrix_DIIS(k,l,i_DIIS) * error_matrix_DIIS(k,l,j_DIIS)
|
||||||
error_matrix_DIIS(1,1,j_DIIS),size(error_matrix_DIIS,1), &
|
enddo
|
||||||
0.d0, &
|
|
||||||
scratch,size(scratch,1))
|
|
||||||
|
|
||||||
! Compute Trace
|
|
||||||
|
|
||||||
do k=1,ao_num
|
|
||||||
B_matrix_DIIS(i,j) = B_matrix_DIIS(i,j) + scratch(k,k)
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -308,6 +306,7 @@ END_DOC
|
|||||||
do k=1,dim_DIIS
|
do k=1,dim_DIIS
|
||||||
if (dabs(X_vector_DIIS(k)) < 1.d-10) cycle
|
if (dabs(X_vector_DIIS(k)) < 1.d-10) cycle
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
|
! FPE here
|
||||||
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
|
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
|
||||||
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
|
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
|
||||||
enddo
|
enddo
|
||||||
|
|||||||
@ -14,24 +14,5 @@ end
|
|||||||
|
|
||||||
subroutine run
|
subroutine run
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j
|
print *, psi_energy + nuclear_repulsion
|
||||||
double precision :: i_H_psi_array(N_states)
|
|
||||||
double precision :: E(N_states)
|
|
||||||
double precision :: norm(N_states)
|
|
||||||
|
|
||||||
E(1:N_states) = nuclear_repulsion
|
|
||||||
norm(1:N_states) = 0.d0
|
|
||||||
do i=1,N_det
|
|
||||||
call i_H_psi(psi_det(1,1,i), psi_det, psi_coef, N_int, N_det, &
|
|
||||||
size(psi_coef,1), N_states, i_H_psi_array)
|
|
||||||
do j=1,N_states
|
|
||||||
norm(j) += psi_coef(i,j)*psi_coef(i,j)
|
|
||||||
E(j) += i_H_psi_array(j) * psi_coef(i,j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
print *, 'Energy:'
|
|
||||||
do i=1,N_states
|
|
||||||
print *, E(i)/norm(i)
|
|
||||||
enddo
|
|
||||||
end
|
end
|
||||||
|
|||||||
@ -1,317 +1,4 @@
|
|||||||
BEGIN_PROVIDER [double precision, two_e_dm_ab_mo, (mo_num,mo_num,mo_num,mo_num,N_states)]
|
BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num,1)]
|
||||||
implicit none
|
|
||||||
two_e_dm_ab_mo = 0.d0
|
|
||||||
integer :: i,j,k,l,iorb,jorb,korb,lorb,istate
|
|
||||||
BEGIN_DOC
|
|
||||||
! two_e_dm_ab_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of alpha/beta electrons
|
|
||||||
!
|
|
||||||
! <Psi| a^{\dagger}_{i \alpha} a^{\dagger}_{j \beta} a_{l \beta} a_{k \alpha} |Psi>
|
|
||||||
!
|
|
||||||
! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active
|
|
||||||
!
|
|
||||||
! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\alpha} * N_{\beta}
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! ALL SLATER DETERMINANTS IN PSI_DET MUST BELONG TO AN ACTIVE SPACE DEFINED BY "list_act"
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! For efficiency reasons, electron 1 is ALPHA, electron 2 is BETA
|
|
||||||
!
|
|
||||||
! two_e_dm_ab_mo(i,j,k,l,istate) = i:alpha, j:beta, j:alpha, l:beta
|
|
||||||
!
|
|
||||||
! Therefore you don't necessary have symmetry between electron 1 and 2
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! IF "no_core_density" then all elements involving at least one CORE MO ARE SET TO ZERO
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
two_e_dm_ab_mo = 0.d0
|
|
||||||
do istate = 1, N_states
|
|
||||||
!! PURE ACTIVE PART ALPHA-BETA
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_act_orb
|
|
||||||
korb = list_act(k)
|
|
||||||
do l = 1, n_act_orb
|
|
||||||
lorb = list_act(l)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(lorb,korb,jorb,iorb,istate) = act_2_rdm_ab_mo(l,k,j,i,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! BETA ACTIVE - ALPHA inactive
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(korb,jorb,korb,iorb,istate) = one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! ALPHA ACTIVE - BETA inactive
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(jorb,korb,iorb,korb,istate) = one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! ALPHA INACTIVE - BETA INACTIVE
|
|
||||||
!!
|
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(korb,jorb,korb,jorb,istate) = 1.D0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! BETA ACTIVE - ALPHA CORE
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(korb,jorb,korb,iorb,istate) = one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! ALPHA ACTIVE - BETA CORE
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(jorb,korb,iorb,korb,istate) = one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! ALPHA CORE - BETA CORE
|
|
||||||
!!
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_ab_mo(korb,jorb,korb,jorb,istate) = 1.D0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, two_e_dm_aa_mo, (mo_num,mo_num,mo_num,mo_num,N_states)]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! two_e_dm_aa_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of alpha/alpha electrons
|
|
||||||
!
|
|
||||||
! <Psi| a^{\dagger}_{i \alpha} a^{\dagger}_{j \alpha} a_{l \alpha} a_{k \alpha} |Psi>
|
|
||||||
!
|
|
||||||
! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active
|
|
||||||
!
|
|
||||||
! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\alpha} * (N_{\alpha} - 1)/2
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! ALL SLATER DETERMINANTS IN PSI_DET MUST BELONG TO AN ACTIVE SPACE DEFINED BY "list_act"
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! IF "no_core_density" then all elements involving at least one CORE MO is set to zero
|
|
||||||
END_DOC
|
|
||||||
two_e_dm_aa_mo = 0.d0
|
|
||||||
integer :: i,j,k,l,iorb,jorb,korb,lorb,istate
|
|
||||||
|
|
||||||
do istate = 1, N_states
|
|
||||||
!! PURE ACTIVE PART ALPHA-ALPHA
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_act_orb
|
|
||||||
korb = list_act(k)
|
|
||||||
do l = 1, n_act_orb
|
|
||||||
lorb = list_act(l)
|
|
||||||
two_e_dm_aa_mo(lorb,korb,jorb,iorb,istate) = &
|
|
||||||
act_2_rdm_aa_mo(l,k,j,i,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! ALPHA ACTIVE - ALPHA inactive
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_aa_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_aa_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_aa_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_aa_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! ALPHA INACTIVE - ALPHA INACTIVE
|
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
two_e_dm_aa_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_aa_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
|
||||||
!! ALPHA ACTIVE - ALPHA CORE
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_aa_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_aa_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_aa_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_aa_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! ALPHA CORE - ALPHA CORE
|
|
||||||
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
two_e_dm_aa_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_aa_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, two_e_dm_bb_mo, (mo_num,mo_num,mo_num,mo_num,N_states)]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! two_e_dm_bb_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of beta/beta electrons
|
|
||||||
!
|
|
||||||
! <Psi| a^{\dagger}_{i \beta} a^{\dagger}_{j \beta} a_{l \beta} a_{k \beta} |Psi>
|
|
||||||
!
|
|
||||||
! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active
|
|
||||||
!
|
|
||||||
! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\beta} * (N_{\beta} - 1)/2
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! ALL SLATER DETERMINANTS IN PSI_DET MUST BELONG TO AN ACTIVE SPACE DEFINED BY "list_act"
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!! IF "no_core_density" then all elements involving at least one CORE MO is set to zero
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
integer :: i,j,k,l,iorb,jorb,korb,lorb,istate
|
|
||||||
two_e_dm_bb_mo = 0.d0
|
|
||||||
|
|
||||||
do istate = 1, N_states
|
|
||||||
!! PURE ACTIVE PART beta-beta
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_act_orb
|
|
||||||
korb = list_act(k)
|
|
||||||
do l = 1, n_act_orb
|
|
||||||
lorb = list_act(l)
|
|
||||||
two_e_dm_bb_mo(lorb,korb,jorb,iorb,istate) = &
|
|
||||||
act_2_rdm_bb_mo(l,k,j,i,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! beta ACTIVE - beta inactive
|
|
||||||
!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_bb_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_bb_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_bb_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_bb_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! beta INACTIVE - beta INACTIVE
|
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
two_e_dm_bb_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_bb_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!! beta ACTIVE - beta CORE
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_bb_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_bb_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_bb_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_bb_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! beta CORE - beta CORE
|
|
||||||
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
two_e_dm_bb_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_bb_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num,N_states)]
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! two_e_dm_bb_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of beta/beta electrons
|
! two_e_dm_bb_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of beta/beta electrons
|
||||||
@ -334,197 +21,19 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num,N_st
|
|||||||
two_e_dm_mo = 0.d0
|
two_e_dm_mo = 0.d0
|
||||||
integer :: i,j,k,l,iorb,jorb,korb,lorb,istate
|
integer :: i,j,k,l,iorb,jorb,korb,lorb,istate
|
||||||
|
|
||||||
do istate = 1, N_states
|
do l=1,mo_num
|
||||||
!!!!!!!!!!!!!!!!
|
lorb = list_core_inact_act(l)
|
||||||
!!!!!!!!!!!!!!!!
|
do k=1,mo_num
|
||||||
!! PURE ACTIVE PART SPIN-TRACE
|
korb = list_core_inact_act(k)
|
||||||
do i = 1, n_act_orb
|
do j=1,mo_num
|
||||||
iorb = list_act(i)
|
jorb = list_core_inact_act(j)
|
||||||
do j = 1, n_act_orb
|
do i=1,mo_num
|
||||||
jorb = list_act(j)
|
iorb = list_core_inact_act(i)
|
||||||
do k = 1, n_act_orb
|
two_e_dm_mo(iorb,jorb,korb,lorb,1) = state_av_full_occ_2_rdm_spin_trace_mo(i,j,k,l)
|
||||||
korb = list_act(k)
|
enddo
|
||||||
do l = 1, n_act_orb
|
|
||||||
lorb = list_act(l)
|
|
||||||
two_e_dm_mo(lorb,korb,jorb,iorb,istate) += &
|
|
||||||
act_2_rdm_spin_trace_mo(l,k,j,i,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!
|
|
||||||
!!!!! BETA-BETA !!!!!
|
|
||||||
!! beta ACTIVE - beta inactive
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! beta INACTIVE - beta INACTIVE
|
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
two_e_dm_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
if (.not.no_core_density)then
|
|
||||||
!! beta ACTIVE - beta CORE
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! beta CORE - beta CORE
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
two_e_dm_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
endif
|
|
||||||
|
|
||||||
!!!!!!!!!!!!!!!!
|
|
||||||
!!!!!!!!!!!!!!!!
|
|
||||||
!!!!! ALPHA-ALPHA !!!!!
|
|
||||||
!! ALPHA ACTIVE - ALPHA inactive
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! ALPHA INACTIVE - ALPHA INACTIVE
|
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
two_e_dm_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! 1 2 1 2 : DIRECT TERM
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
! 1 2 1 2 : EXCHANGE TERM
|
|
||||||
two_e_dm_mo(jorb,korb,korb,iorb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
two_e_dm_mo(korb,jorb,iorb,korb,istate) += -0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! ALPHA CORE - ALPHA CORE
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
two_e_dm_mo(korb,jorb,korb,jorb,istate) += 0.5d0
|
|
||||||
two_e_dm_mo(korb,jorb,jorb,korb,istate) -= 0.5d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!!!!! ALPHA-BETA + BETA-ALPHA !!!!!
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! ALPHA INACTIVE - BETA ACTIVE
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! beta alph beta alph
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! BETA INACTIVE - ALPHA ACTIVE
|
|
||||||
! beta alph beta alpha
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5d0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! ALPHA INACTIVE - BETA INACTIVE
|
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
do k = 1, n_inact_orb
|
|
||||||
korb = list_inact(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_mo(korb,jorb,korb,jorb,istate) += 0.5D0
|
|
||||||
two_e_dm_mo(jorb,korb,jorb,korb,istate) += 0.5D0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do i = 1, n_act_orb
|
|
||||||
iorb = list_act(i)
|
|
||||||
do j = 1, n_act_orb
|
|
||||||
jorb = list_act(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
!! BETA ACTIVE - ALPHA CORE
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5D0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
! beta alph beta alph
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5D0 * one_e_dm_mo_beta(jorb,iorb,istate)
|
|
||||||
!! ALPHA ACTIVE - BETA CORE
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_mo(jorb,korb,iorb,korb,istate) += 0.5D0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
! beta alph beta alph
|
|
||||||
two_e_dm_mo(korb,jorb,korb,iorb,istate) += 0.5D0 * one_e_dm_mo_alpha(jorb,iorb,istate)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!! ALPHA CORE - BETA CORE
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
do k = 1, n_core_orb
|
|
||||||
korb = list_core(k)
|
|
||||||
! alph beta alph beta
|
|
||||||
two_e_dm_mo(korb,jorb,korb,jorb,istate) += 0.5D0
|
|
||||||
two_e_dm_mo(jorb,korb,jorb,korb,istate) += 0.5D0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
two_e_dm_mo(:,:,:,:,:) = two_e_dm_mo(:,:,:,:,:) * 2.d0
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|||||||
@ -447,7 +447,7 @@ double precision function rint(n,rho)
|
|||||||
else
|
else
|
||||||
u_inv=1.d0/dsqrt(rho)
|
u_inv=1.d0/dsqrt(rho)
|
||||||
u=rho*u_inv
|
u=rho*u_inv
|
||||||
rint=0.5d0*u_inv*sqpi*erf(u)
|
rint=0.5d0*u_inv*sqpi*derf(u)
|
||||||
endif
|
endif
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
@ -463,7 +463,7 @@ double precision function rint(n,rho)
|
|||||||
endif
|
endif
|
||||||
u=rho*u_inv
|
u=rho*u_inv
|
||||||
two_rho_inv = 0.5d0*u_inv*u_inv
|
two_rho_inv = 0.5d0*u_inv*u_inv
|
||||||
val0=0.5d0*u_inv*sqpi*erf(u)
|
val0=0.5d0*u_inv*sqpi*derf(u)
|
||||||
rint=(val0-v)*two_rho_inv
|
rint=(val0-v)*two_rho_inv
|
||||||
do k=2,n
|
do k=2,n
|
||||||
rint=(rint*dfloat(k+k-1)-v)*two_rho_inv
|
rint=(rint*dfloat(k+k-1)-v)*two_rho_inv
|
||||||
@ -496,7 +496,7 @@ double precision function rint_sum(n_pt_out,rho,d1)
|
|||||||
else
|
else
|
||||||
u_inv=1.d0/dsqrt(rho)
|
u_inv=1.d0/dsqrt(rho)
|
||||||
u=rho*u_inv
|
u=rho*u_inv
|
||||||
rint_sum=0.5d0*u_inv*sqpi*erf(u) *d1(0)
|
rint_sum=0.5d0*u_inv*sqpi*derf(u) *d1(0)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
do i=2,n_pt_out,2
|
do i=2,n_pt_out,2
|
||||||
@ -515,7 +515,7 @@ double precision function rint_sum(n_pt_out,rho,d1)
|
|||||||
u_inv=1.d0/dsqrt(rho)
|
u_inv=1.d0/dsqrt(rho)
|
||||||
u=rho*u_inv
|
u=rho*u_inv
|
||||||
two_rho_inv = 0.5d0*u_inv*u_inv
|
two_rho_inv = 0.5d0*u_inv*u_inv
|
||||||
val0=0.5d0*u_inv*sqpi*erf(u)
|
val0=0.5d0*u_inv*sqpi*derf(u)
|
||||||
rint_sum=val0*d1(0)
|
rint_sum=val0*d1(0)
|
||||||
rint_tmp=(val0-v)*two_rho_inv
|
rint_tmp=(val0-v)*two_rho_inv
|
||||||
di = 3.d0
|
di = 3.d0
|
||||||
|
|||||||
@ -963,7 +963,7 @@ integer function get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id,task_i
|
|||||||
|
|
||||||
get_tasks_from_taskserver = 0
|
get_tasks_from_taskserver = 0
|
||||||
|
|
||||||
write(message,*) 'get_tasks '//trim(zmq_state), worker_id, n_tasks
|
write(message,'(A,A,X,I10,I10)') 'get_tasks ', trim(zmq_state), worker_id, n_tasks
|
||||||
|
|
||||||
sze = len(trim(message))
|
sze = len(trim(message))
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket, message, sze, 0)
|
rc = f77_zmq_send(zmq_to_qp_run_socket, message, sze, 0)
|
||||||
@ -974,8 +974,10 @@ integer function get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id,task_i
|
|||||||
|
|
||||||
message = repeat(' ',1024)
|
message = repeat(' ',1024)
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 1024, 0)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 1024, 0)
|
||||||
rc = min(1024,rc)
|
if (rc <= 0) then
|
||||||
read(message(1:rc),*, end=10, err=10) reply
|
get_tasks_from_taskserver = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
if (trim(message) == 'get_tasks_reply ok') then
|
if (trim(message) == 'get_tasks_reply ok') then
|
||||||
continue
|
continue
|
||||||
else if (trim(message) == 'terminate') then
|
else if (trim(message) == 'terminate') then
|
||||||
@ -993,6 +995,10 @@ integer function get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id,task_i
|
|||||||
do i=1,n_tasks
|
do i=1,n_tasks
|
||||||
message = repeat(' ',512)
|
message = repeat(' ',512)
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 1024, 0)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 1024, 0)
|
||||||
|
if (rc <= 0) then
|
||||||
|
get_tasks_from_taskserver = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
rc = min(1024,rc)
|
rc = min(1024,rc)
|
||||||
read(message(1:rc),*, end=10, err=10) task_id(i)
|
read(message(1:rc),*, end=10, err=10) task_id(i)
|
||||||
if (task_id(i) == 0) then
|
if (task_id(i) == 0) then
|
||||||
@ -1001,10 +1007,10 @@ integer function get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id,task_i
|
|||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
rc = 1
|
rc = 1
|
||||||
do while (message(rc:rc) == ' ')
|
do while (rc < 1024 .and. message(rc:rc) == ' ')
|
||||||
rc += 1
|
rc += 1
|
||||||
enddo
|
enddo
|
||||||
do while (message(rc:rc) /= ' ')
|
do while (rc < 1024 .and. message(rc:rc) /= ' ')
|
||||||
rc += 1
|
rc += 1
|
||||||
enddo
|
enddo
|
||||||
rc += 1
|
rc += 1
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user