mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-14 03:31:32 +02:00
Merge branch 'dev-stable' of https://github.com/QuantumPackage/qp2 into dev-stable
This commit is contained in:
commit
2201733dbe
2
.github/workflows/configuration.yml
vendored
2
.github/workflows/configuration.yml
vendored
@ -22,7 +22,7 @@ jobs:
|
||||
- uses: actions/checkout@v3
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config hdf5
|
||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config libhdf5-dev
|
||||
- name: zlib
|
||||
run: |
|
||||
./configure -i zlib || echo OK
|
||||
|
||||
49
src/casscf_cipsi/50.casscf.bats
Normal file
49
src/casscf_cipsi/50.casscf.bats
Normal file
@ -0,0 +1,49 @@
|
||||
#!/usr/bin/env bats
|
||||
|
||||
source $QP_ROOT/tests/bats/common.bats.sh
|
||||
source $QP_ROOT/quantum_package.rc
|
||||
|
||||
|
||||
function run_stoch() {
|
||||
thresh=$2
|
||||
test_exe casscf || skip
|
||||
qp set perturbation do_pt2 True
|
||||
qp set determinants n_det_max $3
|
||||
qp set davidson threshold_davidson 1.e-10
|
||||
qp set davidson n_states_diag 4
|
||||
qp run casscf | tee casscf.out
|
||||
energy1="$(ezfio get casscf energy_pt2 | tr '[]' ' ' | cut -d ',' -f 1)"
|
||||
eq $energy1 $1 $thresh
|
||||
}
|
||||
|
||||
@test "F2" { # 18.0198s
|
||||
rm -rf f2_casscf
|
||||
qp_create_ezfio -b aug-cc-pvdz ../input/f2.zmt -o f2_casscf
|
||||
qp set_file f2_casscf
|
||||
qp run scf
|
||||
qp set_mo_class --core="[1-6,8-9]" --act="[7,10]" --virt="[11-46]"
|
||||
run_stoch -198.773366970 1.e-4 100000
|
||||
}
|
||||
|
||||
@test "N2" { # 18.0198s
|
||||
rm -rf n2_casscf
|
||||
qp_create_ezfio -b aug-cc-pvdz ../input/n2.xyz -o n2_casscf
|
||||
qp set_file n2_casscf
|
||||
qp run scf
|
||||
qp set_mo_class --core="[1-4]" --act="[5-10]" --virt="[11-46]"
|
||||
run_stoch -109.0961643162 1.e-4 100000
|
||||
}
|
||||
|
||||
@test "N2_stretched" {
|
||||
rm -rf n2_stretched_casscf
|
||||
qp_create_ezfio -b aug-cc-pvdz -m 7 ../input/n2_stretched.xyz -o n2_stretched_casscf
|
||||
qp set_file n2_stretched_casscf
|
||||
qp run scf | tee scf.out
|
||||
qp set_mo_class --core="[1-4]" --act="[5-10]" --virt="[11-46]"
|
||||
qp set electrons elec_alpha_num 7
|
||||
qp set electrons elec_beta_num 7
|
||||
run_stoch -108.7860471300 1.e-4 100000
|
||||
#
|
||||
|
||||
}
|
||||
|
||||
75
src/casscf_cipsi/EZFIO.cfg
Normal file
75
src/casscf_cipsi/EZFIO.cfg
Normal file
@ -0,0 +1,75 @@
|
||||
[energy]
|
||||
type: double precision
|
||||
doc: Calculated Selected |FCI| energy
|
||||
interface: ezfio
|
||||
size: (determinants.n_states)
|
||||
|
||||
[energy_pt2]
|
||||
type: double precision
|
||||
doc: Calculated |FCI| energy + |PT2|
|
||||
interface: ezfio
|
||||
size: (determinants.n_states)
|
||||
|
||||
[state_following_casscf]
|
||||
type: logical
|
||||
doc: If |true|, the CASSCF will try to follow the guess CI vector and orbitals
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
|
||||
|
||||
[diag_hess_cas]
|
||||
type: logical
|
||||
doc: If |true|, only the DIAGONAL part of the hessian is retained for the CASSCF
|
||||
interface: ezfio,provider,ocaml
|
||||
default: False
|
||||
|
||||
[hess_cv_cv]
|
||||
type: logical
|
||||
doc: If |true|, the core-virtual - core-virtual part of the hessian is computed
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
|
||||
|
||||
[level_shift_casscf]
|
||||
type: Positive_float
|
||||
doc: Energy shift on the virtual MOs to improve SCF convergence
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 0.005
|
||||
|
||||
|
||||
[fast_2rdm]
|
||||
type: logical
|
||||
doc: If true, the two-rdm are computed with a fast algo
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
|
||||
[criterion_casscf]
|
||||
type: character*(32)
|
||||
doc: choice of the criterion for the convergence of the casscf: can be energy or gradients or e_pt2
|
||||
interface: ezfio, provider, ocaml
|
||||
default: e_pt2
|
||||
|
||||
[thresh_casscf]
|
||||
type: Threshold
|
||||
doc: Threshold on the convergence of the CASCF energy.
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1.e-06
|
||||
|
||||
|
||||
[pt2_min_casscf]
|
||||
type: Threshold
|
||||
doc: Minimum value of the pt2_max parameter for the CIPSI in the CASSCF iterations.
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1.e-04
|
||||
|
||||
[n_big_act_orb]
|
||||
type: integer
|
||||
doc: Number of active orbitals from which the active space is considered as large, and therefore pt2_min_casscf is activated.
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 16
|
||||
|
||||
[adaptive_pt2_max]
|
||||
type: logical
|
||||
doc: If |true|, the pt2_max value in the CIPSI iterations will automatically adapt, otherwise it is fixed at the value given in the EZFIO folder
|
||||
interface: ezfio,provider,ocaml
|
||||
default: True
|
||||
5
src/casscf_cipsi/NEED
Normal file
5
src/casscf_cipsi/NEED
Normal file
@ -0,0 +1,5 @@
|
||||
cipsi
|
||||
selectors_full
|
||||
generators_cas
|
||||
two_body_rdm
|
||||
dav_general_mat
|
||||
5
src/casscf_cipsi/README.rst
Normal file
5
src/casscf_cipsi/README.rst
Normal file
@ -0,0 +1,5 @@
|
||||
======
|
||||
casscf
|
||||
======
|
||||
|
||||
|CASSCF| program with the CIPSI algorithm.
|
||||
6
src/casscf_cipsi/bavard.irp.f
Normal file
6
src/casscf_cipsi/bavard.irp.f
Normal file
@ -0,0 +1,6 @@
|
||||
! -*- F90 -*-
|
||||
BEGIN_PROVIDER [logical, bavard]
|
||||
! bavard=.true.
|
||||
bavard=.false.
|
||||
END_PROVIDER
|
||||
|
||||
155
src/casscf_cipsi/bielec.irp.f
Normal file
155
src/casscf_cipsi/bielec.irp.f
Normal file
@ -0,0 +1,155 @@
|
||||
BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_act_orb,n_core_inact_act_orb)]
|
||||
BEGIN_DOC
|
||||
! bielec_PQxx : integral (pq|xx) with p,q arbitrary, x core or active
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,ii,jj,p,q,i3,j3,t3,v3
|
||||
real*8 :: mo_two_e_integral
|
||||
|
||||
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
|
||||
ii=list_core_inact(i)
|
||||
do j=i,n_core_inact_orb
|
||||
jj=list_core_inact(j)
|
||||
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j),mo_integrals_map)
|
||||
bielec_PQxx(:,:,j,i)=bielec_PQxx(:,:,i,j)
|
||||
end do
|
||||
do j=1,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j3),mo_integrals_map)
|
||||
bielec_PQxx(:,:,j3,i)=bielec_PQxx(:,:,i,j3)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_act_orb
|
||||
ii=list_act(i)
|
||||
i3=i+n_core_inact_orb
|
||||
do j=i,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i3,j3),mo_integrals_map)
|
||||
bielec_PQxx(:,:,j3,i3)=bielec_PQxx(:,:,i3,j3)
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_inact_act_orb,n_core_inact_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! bielec_PxxQ : integral (px|xq) with p,q arbitrary, x core or active
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,ii,jj,p,q,i3,j3,t3,v3
|
||||
double precision, allocatable :: integrals_array(:,:)
|
||||
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))
|
||||
|
||||
!$OMP DO
|
||||
do i=1,n_core_inact_orb
|
||||
ii=list_core_inact(i)
|
||||
do j=i,n_core_inact_orb
|
||||
jj=list_core_inact(j)
|
||||
call get_mo_two_e_integrals_ij(ii,jj,mo_num,integrals_array,mo_integrals_map)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
bielec_PxxQ(p,i,j,q)=integrals_array(p,q)
|
||||
bielec_PxxQ(p,j,i,q)=integrals_array(q,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
do j=1,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_ij(ii,jj,mo_num,integrals_array,mo_integrals_map)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
bielec_PxxQ(p,i,j3,q)=integrals_array(p,q)
|
||||
bielec_PxxQ(p,j3,i,q)=integrals_array(q,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
|
||||
! (ip|qj)
|
||||
!$OMP DO
|
||||
do i=1,n_act_orb
|
||||
ii=list_act(i)
|
||||
i3=i+n_core_inact_orb
|
||||
do j=i,n_act_orb
|
||||
jj=list_act(j)
|
||||
j3=j+n_core_inact_orb
|
||||
call get_mo_two_e_integrals_ij(ii,jj,mo_num,integrals_array,mo_integrals_map)
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
bielec_PxxQ(p,i3,j3,q)=integrals_array(p,q)
|
||||
bielec_PxxQ(p,j3,i3,q)=integrals_array(q,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
deallocate(integrals_array)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielecCI, (n_act_orb,n_act_orb,n_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! bielecCI : integrals (tu|vp) with p arbitrary, tuv active
|
||||
! index p runs over the whole basis, t,u,v only over the active orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,p,t,u,v
|
||||
double precision, external :: mo_two_e_integral
|
||||
PROVIDE mo_two_e_integrals_in_map
|
||||
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(i,j,k,p,t,u,v) &
|
||||
!$OMP SHARED(mo_num,n_act_orb,list_act,bielecCI)
|
||||
do p=1,mo_num
|
||||
do j=1,n_act_orb
|
||||
u=list_act(j)
|
||||
do k=1,n_act_orb
|
||||
v=list_act(k)
|
||||
do i=1,n_act_orb
|
||||
t=list_act(i)
|
||||
bielecCI(i,k,j,p) = mo_two_e_integral(t,u,v,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
END_PROVIDER
|
||||
369
src/casscf_cipsi/bielec_natorb.irp.f
Normal file
369
src/casscf_cipsi/bielec_natorb.irp.f
Normal file
@ -0,0 +1,369 @@
|
||||
BEGIN_PROVIDER [real*8, bielec_PQxx_no, (mo_num, mo_num,n_core_inact_act_orb,n_core_inact_act_orb)]
|
||||
BEGIN_DOC
|
||||
! integral (pq|xx) in the basis of natural MOs
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,t,u,p,q
|
||||
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||
|
||||
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,p,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
|
||||
f(p,j,k)=bielec_PQxx_no(list_act(p),j,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, 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
|
||||
bielec_PQxx_no(list_act(p),j,k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
|
||||
do j=1,mo_num
|
||||
do p=1,n_act_orb
|
||||
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
|
||||
do j=1,mo_num
|
||||
bielec_PQxx_no(j,list_act(p),k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
deallocate (f,d)
|
||||
|
||||
allocate (f(mo_num,mo_num,n_act_orb),d(mo_num,mo_num,n_act_orb))
|
||||
|
||||
!$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
|
||||
end do
|
||||
call dgemm('N','N',mo_num*mo_num,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*mo_num, &
|
||||
natorbsCI, n_act_orb, &
|
||||
0.d0, &
|
||||
d, mo_num*mo_num)
|
||||
do p=1,n_act_orb
|
||||
do k=1,mo_num
|
||||
do j=1,mo_num
|
||||
bielec_PQxx_no(j,k,n_core_inact_orb+p,l)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP BARRIER
|
||||
|
||||
!$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,l,n_core_inact_orb+p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('N','N',mo_num*mo_num,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*mo_num, &
|
||||
natorbsCI, n_act_orb, &
|
||||
0.d0, &
|
||||
d, mo_num*mo_num)
|
||||
do p=1,n_act_orb
|
||||
do k=1,mo_num
|
||||
do j=1,mo_num
|
||||
bielec_PQxx_no(j,k,l,n_core_inact_orb+p)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
deallocate (f,d)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielec_PxxQ_no, (mo_num,n_core_inact_act_orb,n_core_inact_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! integral (px|xq) in the basis of natural MOs
|
||||
! indices are unshifted orbital numbers
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,t,u,p,q
|
||||
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,p,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
|
||||
bielec_PxxQ_no(:,:,:,j) = bielec_PxxQ(:,:,:,j)
|
||||
do l=1,n_core_inact_act_orb
|
||||
do k=1,n_core_inact_act_orb
|
||||
do p=1,n_act_orb
|
||||
f(p,k,l) = bielec_PxxQ_no(list_act(p),k,l,j)
|
||||
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
|
||||
bielec_PxxQ_no(list_act(p),k,l,j)=d(p,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
deallocate (f,d)
|
||||
|
||||
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
|
||||
f(p,j,l) = bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)
|
||||
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
|
||||
bielec_PxxQ_no(j,n_core_inact_orb+p,l,k)=d(p,j,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
deallocate(f,d)
|
||||
|
||||
allocate(f(mo_num,n_core_inact_act_orb,n_act_orb), &
|
||||
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
|
||||
end do
|
||||
call dgemm('N','N',mo_num*n_core_inact_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*n_core_inact_act_orb, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
0.d0, &
|
||||
d, mo_num*n_core_inact_act_orb)
|
||||
do p=1,n_act_orb
|
||||
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,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
|
||||
!$OMP BARRIER
|
||||
|
||||
!$OMP DO
|
||||
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
|
||||
end do
|
||||
call dgemm('N','N',mo_num*n_core_inact_act_orb,n_act_orb,n_act_orb,1.d0, &
|
||||
f, mo_num*n_core_inact_act_orb, &
|
||||
natorbsCI, size(natorbsCI,1), &
|
||||
0.d0, &
|
||||
d, mo_num*n_core_inact_act_orb)
|
||||
do p=1,n_act_orb
|
||||
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,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO NOWAIT
|
||||
deallocate(f,d)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, bielecCI_no, (n_act_orb,n_act_orb,n_act_orb, mo_num)]
|
||||
BEGIN_DOC
|
||||
! integrals (tu|vp) in the basis of natural MOs
|
||||
! index p runs over the whole basis, t,u,v only over the active orbitals
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i,j,k,l,t,u,p,q
|
||||
double precision, allocatable :: f(:,:,:), d(:,:,:)
|
||||
|
||||
!$OMP PARALLEL DEFAULT(NONE) &
|
||||
!$OMP PRIVATE(j,k,l,p,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)
|
||||
|
||||
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 j=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
f(p,j,k)=bielecCI_no(p,j,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,n_act_orb*n_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_act_orb
|
||||
do j=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
bielecCI_no(p,j,k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
|
||||
do j=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
f(p,j,k)=bielecCI_no(j,p,k,l)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
call dgemm('T','N',n_act_orb,n_act_orb*n_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_act_orb
|
||||
do p=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
bielecCI_no(j,p,k,l)=d(p,j,k)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do p=1,n_act_orb
|
||||
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
|
||||
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
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
bielecCI_no(j,k,p,l)=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
!$OMP DO
|
||||
do l=1,n_act_orb
|
||||
do p=1,n_act_orb
|
||||
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
|
||||
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
|
||||
do k=1,n_act_orb
|
||||
do j=1,n_act_orb
|
||||
bielecCI_no(j,k,l,list_act(p))=d(j,k,p)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
|
||||
deallocate(d,f)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
110
src/casscf_cipsi/casscf.irp.f
Normal file
110
src/casscf_cipsi/casscf.irp.f
Normal file
@ -0,0 +1,110 @@
|
||||
program casscf
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
END_DOC
|
||||
call reorder_orbitals_for_casscf
|
||||
! no_vvvv_integrals = .True.
|
||||
! touch no_vvvv_integrals
|
||||
n_det_max_full = 500
|
||||
touch n_det_max_full
|
||||
pt2_relative_error = 0.04
|
||||
touch pt2_relative_error
|
||||
! call run_stochastic_cipsi
|
||||
call run
|
||||
end
|
||||
|
||||
subroutine run
|
||||
implicit none
|
||||
double precision :: energy_old, energy, pt2_max_before, ept2_before,delta_E
|
||||
logical :: converged,state_following_casscf_cipsi_save
|
||||
integer :: iteration
|
||||
converged = .False.
|
||||
|
||||
energy = 0.d0
|
||||
mo_label = "MCSCF"
|
||||
iteration = 1
|
||||
state_following_casscf_cipsi_save = state_following_casscf
|
||||
state_following_casscf = .True.
|
||||
touch state_following_casscf
|
||||
ept2_before = 0.d0
|
||||
if(adaptive_pt2_max)then
|
||||
pt2_max = 0.005
|
||||
SOFT_TOUCH pt2_max
|
||||
endif
|
||||
do while (.not.converged)
|
||||
print*,'pt2_max = ',pt2_max
|
||||
call run_stochastic_cipsi
|
||||
energy_old = energy
|
||||
energy = eone+etwo+ecore
|
||||
pt2_max_before = pt2_max
|
||||
|
||||
call write_time(6)
|
||||
call write_int(6,iteration,'CAS-SCF iteration = ')
|
||||
call write_double(6,energy,'CAS-SCF energy = ')
|
||||
if(n_states == 1)then
|
||||
double precision :: E_PT2, PT2
|
||||
call ezfio_get_casscf_cipsi_energy_pt2(E_PT2)
|
||||
call ezfio_get_casscf_cipsi_energy(PT2)
|
||||
PT2 -= E_PT2
|
||||
call write_double(6,E_PT2,'E + PT2 energy = ')
|
||||
call write_double(6,PT2,' PT2 = ')
|
||||
call write_double(6,pt2_max,' PT2_MAX = ')
|
||||
endif
|
||||
|
||||
print*,''
|
||||
call write_double(6,norm_grad_vec2,'Norm of gradients = ')
|
||||
call write_double(6,norm_grad_vec2_tab(1), ' Core-active gradients = ')
|
||||
call write_double(6,norm_grad_vec2_tab(2), ' Core-virtual gradients = ')
|
||||
call write_double(6,norm_grad_vec2_tab(3), ' Active-virtual gradients = ')
|
||||
print*,''
|
||||
call write_double(6,energy_improvement, 'Predicted energy improvement = ')
|
||||
|
||||
if(criterion_casscf == "energy")then
|
||||
converged = dabs(energy_improvement) < thresh_scf
|
||||
else if (criterion_casscf == "gradients")then
|
||||
converged = norm_grad_vec2 < thresh_scf
|
||||
else if (criterion_casscf == "e_pt2")then
|
||||
delta_E = dabs(E_PT2 - ept2_before)
|
||||
converged = dabs(delta_E) < thresh_casscf
|
||||
endif
|
||||
ept2_before = E_PT2
|
||||
if(adaptive_pt2_max)then
|
||||
pt2_max = dabs(energy_improvement / (pt2_relative_error))
|
||||
pt2_max = min(pt2_max, pt2_max_before)
|
||||
if(n_act_orb.ge.n_big_act_orb)then
|
||||
pt2_max = max(pt2_max,pt2_min_casscf)
|
||||
endif
|
||||
endif
|
||||
print*,''
|
||||
call write_double(6,pt2_max, 'PT2_MAX for next iteration = ')
|
||||
|
||||
mo_coef = NewOrbs
|
||||
mo_occ = occnum
|
||||
call save_mos
|
||||
if(.not.converged)then
|
||||
iteration += 1
|
||||
if(norm_grad_vec2.gt.0.01d0)then
|
||||
N_det = N_states
|
||||
else
|
||||
N_det = max(N_det/8 ,N_states)
|
||||
endif
|
||||
psi_det = psi_det_sorted
|
||||
psi_coef = psi_coef_sorted
|
||||
read_wf = .True.
|
||||
call clear_mo_map
|
||||
SOFT_TOUCH mo_coef N_det psi_det psi_coef
|
||||
if(adaptive_pt2_max)then
|
||||
SOFT_TOUCH pt2_max
|
||||
endif
|
||||
if(iteration .gt. 3)then
|
||||
state_following_casscf = state_following_casscf_cipsi_save
|
||||
soft_touch state_following_casscf
|
||||
endif
|
||||
endif
|
||||
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
|
||||
12
src/casscf_cipsi/class.irp.f
Normal file
12
src/casscf_cipsi/class.irp.f
Normal file
@ -0,0 +1,12 @@
|
||||
BEGIN_PROVIDER [ logical, do_only_1h1p ]
|
||||
&BEGIN_PROVIDER [ logical, do_only_cas ]
|
||||
&BEGIN_PROVIDER [ logical, do_ddci ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! In the CAS case, all those are always false except do_only_cas
|
||||
END_DOC
|
||||
do_only_cas = .True.
|
||||
do_only_1h1p = .False.
|
||||
do_ddci = .False.
|
||||
END_PROVIDER
|
||||
|
||||
45
src/casscf_cipsi/dav_sx_mat.irp.f
Normal file
45
src/casscf_cipsi/dav_sx_mat.irp.f
Normal file
@ -0,0 +1,45 @@
|
||||
|
||||
|
||||
subroutine davidson_diag_sx_mat(N_st, u_in, energies)
|
||||
implicit none
|
||||
integer, intent(in) :: N_st
|
||||
double precision, intent(out) :: u_in(nMonoEx+1,n_states_diag), energies(N_st)
|
||||
integer :: i,j,N_st_tmp, dim_in, sze, N_st_diag_in
|
||||
integer, allocatable :: list_guess(:)
|
||||
double precision, allocatable :: H_jj(:)
|
||||
logical :: converged
|
||||
N_st_diag_in = n_states_diag
|
||||
provide SXmatrix
|
||||
sze = nMonoEx+1
|
||||
dim_in = sze
|
||||
allocate(H_jj(sze), list_guess(sze))
|
||||
H_jj(1) = 0.d0
|
||||
N_st_tmp = 1
|
||||
list_guess(1) = 1
|
||||
do j = 2, nMonoEx+1
|
||||
H_jj(j) = SXmatrix(j,j)
|
||||
if(H_jj(j).lt.0.d0)then
|
||||
list_guess(N_st_tmp) = j
|
||||
N_st_tmp += 1
|
||||
endif
|
||||
enddo
|
||||
if(N_st_tmp .ne. N_st)then
|
||||
print*,'Pb in davidson_diag_sx_mat'
|
||||
print*,'N_st_tmp .ne. N_st'
|
||||
print*,N_st_tmp, N_st
|
||||
stop
|
||||
endif
|
||||
print*,'Number of possibly interesting states = ',N_st
|
||||
print*,'Corresponding diagonal elements of the SX matrix '
|
||||
u_in = 0.d0
|
||||
do i = 1, min(N_st, N_st_diag_in)
|
||||
! do i = 1, N_st
|
||||
j = list_guess(i)
|
||||
print*,'i,j',i,j
|
||||
print*,'SX(i,i) = ',H_jj(j)
|
||||
u_in(j,i) = 1.d0
|
||||
enddo
|
||||
call davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,converged,SXmatrix)
|
||||
print*,'energies = ',energies
|
||||
|
||||
end
|
||||
67
src/casscf_cipsi/densities.irp.f
Normal file
67
src/casscf_cipsi/densities.irp.f
Normal file
@ -0,0 +1,67 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [real*8, D0tu, (n_act_orb,n_act_orb) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! the first-order density matrix in the basis of the starting MOs.
|
||||
! matrix is state averaged.
|
||||
END_DOC
|
||||
integer :: t,u
|
||||
|
||||
do u=1,n_act_orb
|
||||
do t=1,n_act_orb
|
||||
D0tu(t,u) = one_e_dm_mo_alpha_average( list_act(t), list_act(u) ) + &
|
||||
one_e_dm_mo_beta_average ( list_act(t), list_act(u) )
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [real*8, P0tuvx, (n_act_orb,n_act_orb,n_act_orb,n_act_orb) ]
|
||||
BEGIN_DOC
|
||||
! The second-order density matrix in the basis of the starting MOs ONLY IN THE RANGE OF ACTIVE MOS
|
||||
! The values are state averaged
|
||||
!
|
||||
! We use the spin-free generators of mono-excitations
|
||||
! E_pq destroys q and creates p
|
||||
! D_pq = <0|E_pq|0> = D_qp
|
||||
! P_pqrs = 1/2 <0|E_pq E_rs - delta_qr E_ps|0>
|
||||
!
|
||||
! P0tuvx(p,q,r,s) = chemist notation : 1/2 <0|E_pq E_rs - delta_qr E_ps|0>
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: t,u,v,x
|
||||
integer :: tt,uu,vv,xx
|
||||
integer :: mu,nu,istate,ispin,jspin,ihole,ipart,jhole,jpart
|
||||
integer :: ierr
|
||||
real*8 :: phase1,phase11,phase12,phase2,phase21,phase22
|
||||
integer :: nu1,nu2,nu11,nu12,nu21,nu22
|
||||
integer :: ierr1,ierr2,ierr11,ierr12,ierr21,ierr22
|
||||
real*8 :: cI_mu(N_states),term
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu, det_mu_ex
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu_ex1, det_mu_ex11, det_mu_ex12
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu_ex2, det_mu_ex21, det_mu_ex22
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' providing the 2 body RDM on the active part'
|
||||
endif
|
||||
|
||||
P0tuvx= 0.d0
|
||||
if(fast_2rdm)then
|
||||
do istate=1,N_states
|
||||
do x = 1, n_act_orb
|
||||
do v = 1, n_act_orb
|
||||
do u = 1, n_act_orb
|
||||
do t = 1, n_act_orb
|
||||
! 1 1 2 2 1 2 1 2
|
||||
P0tuvx(t,u,v,x) = 0.5d0 * state_av_act_2_rdm_spin_trace_mo(t,v,u,x)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
P0tuvx = P0tuvx_peter
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
150
src/casscf_cipsi/densities_peter.irp.f
Normal file
150
src/casscf_cipsi/densities_peter.irp.f
Normal file
@ -0,0 +1,150 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [real*8, P0tuvx_peter, (n_act_orb,n_act_orb,n_act_orb,n_act_orb) ]
|
||||
BEGIN_DOC
|
||||
! the second-order density matrix in the basis of the starting MOs
|
||||
! matrices are state averaged
|
||||
!
|
||||
! we use the spin-free generators of mono-excitations
|
||||
! E_pq destroys q and creates p
|
||||
! D_pq = <0|E_pq|0> = D_qp
|
||||
! P_pqrs = 1/2 <0|E_pq E_rs - delta_qr E_ps|0>
|
||||
!
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: t,u,v,x,mu,nu,istate,ispin,jspin,ihole,ipart,jhole,jpart
|
||||
integer :: ierr
|
||||
real*8 :: phase1,phase11,phase12,phase2,phase21,phase22
|
||||
integer :: nu1,nu2,nu11,nu12,nu21,nu22
|
||||
integer :: ierr1,ierr2,ierr11,ierr12,ierr21,ierr22
|
||||
real*8 :: cI_mu(N_states),term
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu, det_mu_ex
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu_ex1, det_mu_ex11, det_mu_ex12
|
||||
integer(bit_kind), dimension(N_int,2) :: det_mu_ex2, det_mu_ex21, det_mu_ex22
|
||||
|
||||
if (bavard) then
|
||||
write(6,*) ' providing density matrix P0'
|
||||
endif
|
||||
|
||||
P0tuvx_peter = 0.d0
|
||||
|
||||
! first loop: we apply E_tu, once for D_tu, once for -P_tvvu
|
||||
do mu=1,n_det
|
||||
call det_extract(det_mu,mu,N_int)
|
||||
do istate=1,n_states
|
||||
cI_mu(istate)=psi_coef(mu,istate)
|
||||
end do
|
||||
do t=1,n_act_orb
|
||||
ipart=list_act(t)
|
||||
do u=1,n_act_orb
|
||||
ihole=list_act(u)
|
||||
! apply E_tu
|
||||
call det_copy(det_mu,det_mu_ex1,N_int)
|
||||
call det_copy(det_mu,det_mu_ex2,N_int)
|
||||
call do_spinfree_mono_excitation(det_mu,det_mu_ex1 &
|
||||
,det_mu_ex2,nu1,nu2,ihole,ipart,phase1,phase2,ierr1,ierr2)
|
||||
! det_mu_ex1 is in the list
|
||||
if (nu1.ne.-1) then
|
||||
do istate=1,n_states
|
||||
term=cI_mu(istate)*psi_coef(nu1,istate)*phase1
|
||||
! and we fill P0_tvvu
|
||||
do v=1,n_act_orb
|
||||
P0tuvx_peter(t,v,v,u)-=term
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
! det_mu_ex2 is in the list
|
||||
if (nu2.ne.-1) then
|
||||
do istate=1,n_states
|
||||
term=cI_mu(istate)*psi_coef(nu2,istate)*phase2
|
||||
do v=1,n_act_orb
|
||||
P0tuvx_peter(t,v,v,u)-=term
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
! now we do the double excitation E_tu E_vx |0>
|
||||
do mu=1,n_det
|
||||
call det_extract(det_mu,mu,N_int)
|
||||
do istate=1,n_states
|
||||
cI_mu(istate)=psi_coef(mu,istate)
|
||||
end do
|
||||
do v=1,n_act_orb
|
||||
ipart=list_act(v)
|
||||
do x=1,n_act_orb
|
||||
ihole=list_act(x)
|
||||
! apply E_vx
|
||||
call det_copy(det_mu,det_mu_ex1,N_int)
|
||||
call det_copy(det_mu,det_mu_ex2,N_int)
|
||||
call do_spinfree_mono_excitation(det_mu,det_mu_ex1 &
|
||||
,det_mu_ex2,nu1,nu2,ihole,ipart,phase1,phase2,ierr1,ierr2)
|
||||
! we apply E_tu to the first resultant determinant, thus E_tu E_vx |0>
|
||||
if (ierr1.eq.1) then
|
||||
do t=1,n_act_orb
|
||||
jpart=list_act(t)
|
||||
do u=1,n_act_orb
|
||||
jhole=list_act(u)
|
||||
call det_copy(det_mu_ex1,det_mu_ex11,N_int)
|
||||
call det_copy(det_mu_ex1,det_mu_ex12,N_int)
|
||||
call do_spinfree_mono_excitation(det_mu_ex1,det_mu_ex11&
|
||||
,det_mu_ex12,nu11,nu12,jhole,jpart,phase11,phase12,ierr11,ierr12)
|
||||
if (nu11.ne.-1) then
|
||||
do istate=1,n_states
|
||||
P0tuvx_peter(t,u,v,x)+=cI_mu(istate)*psi_coef(nu11,istate)&
|
||||
*phase11*phase1
|
||||
end do
|
||||
end if
|
||||
if (nu12.ne.-1) then
|
||||
do istate=1,n_states
|
||||
P0tuvx_peter(t,u,v,x)+=cI_mu(istate)*psi_coef(nu12,istate)&
|
||||
*phase12*phase1
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
! we apply E_tu to the second resultant determinant
|
||||
if (ierr2.eq.1) then
|
||||
do t=1,n_act_orb
|
||||
jpart=list_act(t)
|
||||
do u=1,n_act_orb
|
||||
jhole=list_act(u)
|
||||
call det_copy(det_mu_ex2,det_mu_ex21,N_int)
|
||||
call det_copy(det_mu_ex2,det_mu_ex22,N_int)
|
||||
call do_spinfree_mono_excitation(det_mu_ex2,det_mu_ex21&
|
||||
,det_mu_ex22,nu21,nu22,jhole,jpart,phase21,phase22,ierr21,ierr22)
|
||||
if (nu21.ne.-1) then
|
||||
do istate=1,n_states
|
||||
P0tuvx_peter(t,u,v,x)+=cI_mu(istate)*psi_coef(nu21,istate)&
|
||||
*phase21*phase2
|
||||
end do
|
||||
end if
|
||||
if (nu22.ne.-1) then
|
||||
do istate=1,n_states
|
||||
P0tuvx_peter(t,u,v,x)+=cI_mu(istate)*psi_coef(nu22,istate)&
|
||||
*phase22*phase2
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! we average by just dividing by the number of states
|
||||
do x=1,n_act_orb
|
||||
do v=1,n_act_orb
|
||||
do u=1,n_act_orb
|
||||
do t=1,n_act_orb
|
||||
P0tuvx_peter(t,u,v,x)*=0.5D0/dble(N_states)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
END_PROVIDER
|
||||
125
src/casscf_cipsi/det_manip.irp.f
Normal file
125
src/casscf_cipsi/det_manip.irp.f
Normal file
@ -0,0 +1,125 @@
|
||||
use bitmasks
|
||||
|
||||
subroutine do_signed_mono_excitation(key1,key2,nu,ihole,ipart, &
|
||||
ispin,phase,ierr)
|
||||
BEGIN_DOC
|
||||
! we create the mono-excitation, and determine, if possible,
|
||||
! the phase and the number in the list of determinants
|
||||
END_DOC
|
||||
implicit none
|
||||
integer(bit_kind) :: key1(N_int,2),key2(N_int,2)
|
||||
integer(bit_kind), allocatable :: keytmp(:,:)
|
||||
integer :: exc(0:2,2,2),ihole,ipart,ierr,nu,ispin
|
||||
real*8 :: phase
|
||||
logical :: found
|
||||
allocate(keytmp(N_int,2))
|
||||
|
||||
nu=-1
|
||||
phase=1.D0
|
||||
ierr=0
|
||||
call det_copy(key1,key2,N_int)
|
||||
! write(6,*) ' key2 before excitation ',ihole,' -> ',ipart,' spin = ',ispin
|
||||
! call print_det(key2,N_int)
|
||||
call do_single_excitation(key2,ihole,ipart,ispin,ierr)
|
||||
! write(6,*) ' key2 after ',ihole,' -> ',ipart,' spin = ',ispin
|
||||
! call print_det(key2,N_int)
|
||||
! write(6,*) ' excitation ',ihole,' -> ',ipart,' gives ierr = ',ierr
|
||||
if (ierr.eq.1) then
|
||||
! excitation is possible
|
||||
! get the phase
|
||||
call get_single_excitation(key1,key2,exc,phase,N_int)
|
||||
! get the number in the list
|
||||
found=.false.
|
||||
nu=0
|
||||
|
||||
!TODO BOTTLENECK
|
||||
do while (.not.found)
|
||||
nu+=1
|
||||
if (nu.gt.N_det) then
|
||||
! the determinant is possible, but not in the list
|
||||
found=.true.
|
||||
nu=-1
|
||||
else
|
||||
call det_extract(keytmp,nu,N_int)
|
||||
integer :: i,ii
|
||||
found=.true.
|
||||
do ii=1,2
|
||||
do i=1,N_int
|
||||
if (keytmp(i,ii).ne.key2(i,ii)) then
|
||||
found=.false.
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
!
|
||||
! we found the new string, the phase, and possibly the number in the list
|
||||
!
|
||||
end subroutine do_signed_mono_excitation
|
||||
|
||||
subroutine det_extract(key,nu,Nint)
|
||||
BEGIN_DOC
|
||||
! extract a determinant from the list of determinants
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ispin,i,nu,Nint
|
||||
integer(bit_kind) :: key(Nint,2)
|
||||
do ispin=1,2
|
||||
do i=1,Nint
|
||||
key(i,ispin)=psi_det(i,ispin,nu)
|
||||
end do
|
||||
end do
|
||||
end subroutine det_extract
|
||||
|
||||
subroutine det_copy(key1,key2,Nint)
|
||||
use bitmasks ! you need to include the bitmasks_module.f90 features
|
||||
BEGIN_DOC
|
||||
! copy a determinant from key1 to key2
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ispin,i,Nint
|
||||
integer(bit_kind) :: key1(Nint,2),key2(Nint,2)
|
||||
do ispin=1,2
|
||||
do i=1,Nint
|
||||
key2(i,ispin)=key1(i,ispin)
|
||||
end do
|
||||
end do
|
||||
end subroutine det_copy
|
||||
|
||||
subroutine do_spinfree_mono_excitation(key_in,key_out1,key_out2 &
|
||||
,nu1,nu2,ihole,ipart,phase1,phase2,ierr,jerr)
|
||||
BEGIN_DOC
|
||||
! we create the spin-free mono-excitation E_pq=(a^+_p a_q + a^+_P a_Q)
|
||||
! we may create two determinants as result
|
||||
!
|
||||
END_DOC
|
||||
implicit none
|
||||
integer(bit_kind) :: key_in(N_int,2),key_out1(N_int,2)
|
||||
integer(bit_kind) :: key_out2(N_int,2)
|
||||
integer :: ihole,ipart,ierr,jerr,nu1,nu2
|
||||
integer :: ispin
|
||||
real*8 :: phase1,phase2
|
||||
|
||||
! write(6,*) ' applying E_',ipart,ihole,' on determinant '
|
||||
! call print_det(key_in,N_int)
|
||||
|
||||
! spin alpha
|
||||
ispin=1
|
||||
call do_signed_mono_excitation(key_in,key_out1,nu1,ihole &
|
||||
,ipart,ispin,phase1,ierr)
|
||||
! if (ierr.eq.1) then
|
||||
! write(6,*) ' 1 result is ',nu1,phase1
|
||||
! call print_det(key_out1,N_int)
|
||||
! end if
|
||||
! spin beta
|
||||
ispin=2
|
||||
call do_signed_mono_excitation(key_in,key_out2,nu2,ihole &
|
||||
,ipart,ispin,phase2,jerr)
|
||||
! if (jerr.eq.1) then
|
||||
! write(6,*) ' 2 result is ',nu2,phase2
|
||||
! call print_det(key_out2,N_int)
|
||||
! end if
|
||||
|
||||
end subroutine do_spinfree_mono_excitation
|
||||
|
||||
3
src/casscf_cipsi/driver_optorb.irp.f
Normal file
3
src/casscf_cipsi/driver_optorb.irp.f
Normal file
@ -0,0 +1,3 @@
|
||||
subroutine driver_optorb
|
||||
implicit none
|
||||
end
|
||||
51
src/casscf_cipsi/get_energy.irp.f
Normal file
51
src/casscf_cipsi/get_energy.irp.f
Normal file
@ -0,0 +1,51 @@
|
||||
program print_2rdm
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! get the active part of the bielectronic energy on a given wave function.
|
||||
!
|
||||
! useful to test the active part of the spin trace 2 rdms
|
||||
END_DOC
|
||||
!no_vvvv_integrals = .True.
|
||||
read_wf = .True.
|
||||
!touch read_wf no_vvvv_integrals
|
||||
!call routine
|
||||
!call routine_bis
|
||||
call print_grad
|
||||
end
|
||||
|
||||
subroutine print_grad
|
||||
implicit none
|
||||
integer :: i
|
||||
do i = 1, nMonoEx
|
||||
if(dabs(gradvec2(i)).gt.1.d-5)then
|
||||
print*,''
|
||||
print*,i,gradvec2(i),excit(:,i)
|
||||
endif
|
||||
enddo
|
||||
end
|
||||
|
||||
subroutine routine
|
||||
integer :: i,j,k,l
|
||||
integer :: ii,jj,kk,ll
|
||||
double precision :: accu(4),twodm,thr,act_twodm2,integral,get_two_e_integral
|
||||
thr = 1.d-10
|
||||
|
||||
|
||||
accu = 0.d0
|
||||
do ll = 1, n_act_orb
|
||||
l = list_act(ll)
|
||||
do kk = 1, n_act_orb
|
||||
k = list_act(kk)
|
||||
do jj = 1, n_act_orb
|
||||
j = list_act(jj)
|
||||
do ii = 1, n_act_orb
|
||||
i = list_act(ii)
|
||||
integral = get_two_e_integral(i,j,k,l,mo_integrals_map)
|
||||
accu(1) += state_av_act_2_rdm_spin_trace_mo(ii,jj,kk,ll) * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'accu = ',accu(1)
|
||||
|
||||
end
|
||||
74
src/casscf_cipsi/grad_old.irp.f
Normal file
74
src/casscf_cipsi/grad_old.irp.f
Normal file
@ -0,0 +1,74 @@
|
||||
|
||||
BEGIN_PROVIDER [real*8, gradvec_old, (nMonoEx)]
|
||||
BEGIN_DOC
|
||||
! calculate the orbital gradient <Psi| H E_pq |Psi> by hand, i.e. for
|
||||
! each determinant I we determine the string E_pq |I> (alpha and beta
|
||||
! separately) and generate <Psi|H E_pq |I>
|
||||
! sum_I c_I <Psi|H E_pq |I> is then the pq component of the orbital
|
||||
! gradient
|
||||
! E_pq = a^+_pa_q + a^+_Pa_Q
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ii,tt,aa,indx,ihole,ipart,istate
|
||||
real*8 :: res
|
||||
|
||||
do indx=1,nMonoEx
|
||||
ihole=excit(1,indx)
|
||||
ipart=excit(2,indx)
|
||||
call calc_grad_elem(ihole,ipart,res)
|
||||
gradvec_old(indx)=res
|
||||
end do
|
||||
|
||||
real*8 :: norm_grad
|
||||
norm_grad=0.d0
|
||||
do indx=1,nMonoEx
|
||||
norm_grad+=gradvec_old(indx)*gradvec_old(indx)
|
||||
end do
|
||||
norm_grad=sqrt(norm_grad)
|
||||
if (bavard) then
|
||||
write(6,*)
|
||||
write(6,*) ' Norm of the orbital gradient (via <0|EH|0>) : ', norm_grad
|
||||
write(6,*)
|
||||
endif
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine calc_grad_elem(ihole,ipart,res)
|
||||
BEGIN_DOC
|
||||
! eq 18 of Siegbahn et al, Physica Scripta 1980
|
||||
! we calculate 2 <Psi| H E_pq | Psi>, q=hole, p=particle
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: ihole,ipart,mu,iii,ispin,ierr,nu,istate
|
||||
real*8 :: res
|
||||
integer(bit_kind), allocatable :: det_mu(:,:),det_mu_ex(:,:)
|
||||
real*8 :: i_H_psi_array(N_states),phase
|
||||
allocate(det_mu(N_int,2))
|
||||
allocate(det_mu_ex(N_int,2))
|
||||
|
||||
res=0.D0
|
||||
|
||||
do mu=1,n_det
|
||||
! get the string of the determinant
|
||||
call det_extract(det_mu,mu,N_int)
|
||||
do ispin=1,2
|
||||
! do the monoexcitation on it
|
||||
call det_copy(det_mu,det_mu_ex,N_int)
|
||||
call do_signed_mono_excitation(det_mu,det_mu_ex,nu &
|
||||
,ihole,ipart,ispin,phase,ierr)
|
||||
if (ierr.eq.1) then
|
||||
call i_H_psi(det_mu_ex,psi_det,psi_coef,N_int &
|
||||
,N_det,N_det,N_states,i_H_psi_array)
|
||||
do istate=1,N_states
|
||||
res+=i_H_psi_array(istate)*psi_coef(mu,istate)*phase
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
! state-averaged gradient
|
||||
res*=2.D0/dble(N_states)
|
||||
|
||||
end subroutine calc_grad_elem
|
||||
|
||||
215
src/casscf_cipsi/gradient.irp.f
Normal file
215
src/casscf_cipsi/gradient.irp.f
Normal file
@ -0,0 +1,215 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ integer, nMonoEx ]
|
||||
BEGIN_DOC
|
||||
! Number of single excitations
|
||||
END_DOC
|
||||
implicit none
|
||||
nMonoEx=n_core_inact_orb*n_act_orb+n_core_inact_orb*n_virt_orb+n_act_orb*n_virt_orb
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [integer, n_c_a_prov]
|
||||
&BEGIN_PROVIDER [integer, n_c_v_prov]
|
||||
& | ||||