PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-08 07:03:52 +01:00
Code Releases Activity

the casscf adapts

Browse Source
This commit is contained in:
Emmanuel Giner 2019-10-23 02:42:17 +02:00
parent b7992a11a9
commit 99a3071489
5 changed files with 39 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/casscf/EZFIO.cfg
View File

@ -27,5 +27,5 @@ default: False
type: Positive_float
doc: Energy shift on the virtual MOs to improve SCF convergence
interface: ezfio,provider,ocaml
default: 0.05
default: 0.005

4
src/casscf/bavard.irp.f
View File

@ -1,6 +1,6 @@
! -*- F90 -*-
BEGIN_PROVIDER [logical, bavard]
bavard=.true.
! bavard=.false.
! bavard=.true.
bavard=.false.
END_PROVIDER

26
src/casscf/neworbs.irp.f
View File

@ -102,10 +102,8 @@ END_PROVIDER
integer :: i
double precision :: c0
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
print*,'c0 = ',c0
do i=1,nMonoEx+1
SXvector(i)=SXeigenvec(i,best_vector_ovrlp_casscf)/c0
print*,'',i,SXvector(i)
end do
END_PROVIDER
@ -123,21 +121,23 @@ BEGIN_PROVIDER [double precision, NewOrbs, (ao_num,mo_num) ]
NatOrbsFCI, size(NatOrbsFCI,1), &
Umat, size(Umat,1), 0.d0, &
NewOrbs, size(NewOrbs,1))
level_shift_casscf *= 0.5D0
!touch level_shift_casscf
else
double precision :: damp
if(best_vector_ovrlp_casscf.ne.1.and.n_orb_swap.ne.0)then
print*,'Taking the lowest root for the CASSCF'
if(best_vector_ovrlp_casscf.ne.1)then
provide n_orb_swap
!call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
! NatOrbsFCI, size(NatOrbsFCI,1), &
! Umat, size(Umat,1), 0.d0, &
! NewOrbs, size(NewOrbs,1))
print*,'!!! SWAPPING MOS !!!!!!'
level_shift_casscf *= 2.D0
print*,'level_shift_casscf = ',level_shift_casscf
NewOrbs = switch_mo_coef
mo_coef = switch_mo_coef
soft_touch mo_coef
call save_mos_no_occ
stop
!mo_coef = switch_mo_coef
!soft_touch mo_coef
!call save_mos_no_occ
!stop
else
level_shift_casscf *= 0.5D0
!touch level_shift_casscf
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
NatOrbsFCI, size(NatOrbsFCI,1), &
Umat, size(Umat,1), 0.d0, &

30
src/casscf/swap_orb.irp.f
View File

@ -13,6 +13,7 @@
BEGIN_PROVIDER [integer, max_overlap, (nMonoEx)]
&BEGIN_PROVIDER [integer, n_max_overlap]
&BEGIN_PROVIDER [integer, dim_n_max_overlap]
implicit none
double precision, allocatable :: vec_tmp(:)
integer, allocatable :: iorder(:)
@ -21,20 +22,22 @@
do i = 1, nMonoEx
iorder(i) = i
vec_tmp(i) = -dabs(SXvector_lowest(i))
print*,'vec_tmp(i) = ',i,vec_tmp(i)
!print*,'vec_tmp(i) = ',i,vec_tmp(i)
enddo
call dsort(vec_tmp,iorder,nMonoEx)
n_max_overlap = 0
do i = 1, nMonoEx
if(dabs(vec_tmp(i)).gt.thresh_overlap_switch)then
print*,vec_tmp(i),iorder(i)
! print*,vec_tmp(i),iorder(i)
n_max_overlap += 1
max_overlap(n_max_overlap) = iorder(i)
endif
enddo
dim_n_max_overlap = max(1,n_max_overlap)
END_PROVIDER
BEGIN_PROVIDER [integer, orb_swap, (2,n_max_overlap)]
BEGIN_PROVIDER [integer, orb_swap, (2,dim_n_max_overlap)]
&BEGIN_PROVIDER [integer, index_orb_swap, (dim_n_max_overlap)]
&BEGIN_PROVIDER [integer, n_orb_swap ]
implicit none
use bitmasks ! you need to include the bitmasks_module.f90 features
@ -44,27 +47,33 @@
imono = max_overlap(i)
iorb = excit(1,imono)
jorb = excit(2,imono)
if (excit_class(imono) == "c-a")then ! core --> active rotation
if (excit_class(imono) == "c-a" .and.hessmat2(imono,imono).gt.0.d0)then ! core --> active rotation
n_orb_swap += 1
orb_swap(1,n_orb_swap) = iorb ! core
orb_swap(2,n_orb_swap) = jorb ! active
else if (excit_class(imono) == "a-v")then ! active --> virtual rotation
index_orb_swap(n_orb_swap) = imono
else if (excit_class(imono) == "a-v" .and.hessmat2(imono,imono).gt.0.d0)then ! active --> virtual rotation
n_orb_swap += 1
orb_swap(1,n_orb_swap) = jorb ! virtual
orb_swap(2,n_orb_swap) = iorb ! active
index_orb_swap(n_orb_swap) = imono
endif
enddo
print*,'n_orb_swap = ',n_orb_swap
integer,allocatable :: orb_swap_tmp(:,:)
allocate(orb_swap_tmp(2,dim_n_max_overlap))
do i = 1, n_orb_swap
print*,orb_swap(1,i),'-->',orb_swap(2,i)
orb_swap_tmp(1,i) = orb_swap(1,i)
orb_swap_tmp(2,i) = orb_swap(2,i)
enddo
orb_swap_tmp = orb_swap
integer :: orb_swap_tmp(2,n_max_overlap)
integer(bit_kind), allocatable :: det_i(:),det_j(:)
allocate(det_i(N_int),det_j(N_int))
logical, allocatable :: good_orb_rot(:)
allocate(good_orb_rot(n_orb_swap))
integer, allocatable :: index_orb_swap_tmp(:)
allocate(index_orb_swap_tmp(dim_n_max_overlap))
index_orb_swap_tmp = index_orb_swap
good_orb_rot = .True.
integer :: icount,k
do i = 1, n_orb_swap
@ -92,14 +101,15 @@
do i = 1, icount
if(good_orb_rot(i))then
n_orb_swap += 1
index_orb_swap(n_orb_swap) = index_orb_swap_tmp(i)
orb_swap(1,n_orb_swap) = orb_swap_tmp(1,i)
orb_swap(2,n_orb_swap) = orb_swap_tmp(2,i)
endif
enddo
print*,'Cleaning !!'
print*,'n_orb_swap = ',n_orb_swap
do i = 1, n_orb_swap
print*,'imono = ',index_orb_swap(i)
print*,orb_swap(1,i),'-->',orb_swap(2,i)
enddo
END_PROVIDER

4
src/mo_basis/utils.irp.f
View File

@ -4,7 +4,6 @@ subroutine save_mos
integer :: i,j
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
print*,'Saving MOs'
call ezfio_set_mo_basis_mo_num(mo_num)
call ezfio_set_mo_basis_mo_label(mo_label)
call ezfio_set_mo_basis_ao_md5(ao_md5)
@ -18,7 +17,6 @@ subroutine save_mos
call ezfio_set_mo_basis_mo_coef(buffer)
call ezfio_set_mo_basis_mo_occ(mo_occ)
deallocate (buffer)
print*,'End Saving MOs'
end
@ -29,7 +27,6 @@ subroutine save_mos_no_occ
integer :: i,j
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
print*,'Saving MOs'
!call ezfio_set_mo_basis_mo_num(mo_num)
!call ezfio_set_mo_basis_mo_label(mo_label)
!call ezfio_set_mo_basis_ao_md5(ao_md5)
@ -42,7 +39,6 @@ subroutine save_mos_no_occ
enddo
call ezfio_set_mo_basis_mo_coef(buffer)
deallocate (buffer)
print*,'End Saving MOs'
end