mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-22 12:23:48 +01:00
Forgot file
This commit is contained in:
parent
17126c779e
commit
44e4cbe4b3
114
src/Dets/psi_cas.irp.f
Normal file
114
src/Dets/psi_cas.irp.f
Normal file
@ -0,0 +1,114 @@
|
||||
use bitmasks
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_cas, (N_int,2,psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_cas_coef, (psi_det_size,n_states) ]
|
||||
&BEGIN_PROVIDER [ integer, idx_cas, (psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ integer, N_det_cas ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! CAS wave function, defined from the application of the CAS bitmask on the
|
||||
! determinants. idx_cas gives the indice of the CAS determinant in psi_det.
|
||||
END_DOC
|
||||
integer :: i, k, l
|
||||
logical :: good
|
||||
N_det_cas = 0
|
||||
do i=1,N_det
|
||||
do l=1,n_cas_bitmask
|
||||
good = .True.
|
||||
do k=1,N_int
|
||||
good = good .and. ( &
|
||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,i)) == &
|
||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,1)) ) .and. ( &
|
||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,i)) == &
|
||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,1)) )
|
||||
enddo
|
||||
if (good) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (good) then
|
||||
N_det_cas = N_det_cas+1
|
||||
do k=1,N_int
|
||||
psi_cas(k,1,N_det_cas) = psi_det(k,1,i)
|
||||
psi_cas(k,2,N_det_cas) = psi_det(k,2,i)
|
||||
enddo
|
||||
idx_cas(N_det_cas) = i
|
||||
do k=1,N_states
|
||||
psi_cas_coef(N_det_cas,k) = psi_coef(i,k)
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
call write_int(output_dets,N_det_cas, 'Number of determinants in the CAS')
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_cas_sorted_bit, (N_int,2,psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_cas_coef_sorted_bit, (psi_det_size,N_states) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! CAS determinants sorted to accelerate the search of a random determinant in the wave
|
||||
! function.
|
||||
END_DOC
|
||||
call sort_dets_by_det_search_key(N_det_cas, psi_cas, psi_cas_coef, &
|
||||
psi_cas_sorted_bit, psi_cas_coef_sorted_bit)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas, (N_int,2,psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_non_cas_coef, (psi_det_size,n_states) ]
|
||||
&BEGIN_PROVIDER [ integer, idx_non_cas, (psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ integer, N_det_non_cas ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Set of determinants which are not part of the CAS, defined from the application
|
||||
! of the CAS bitmask on the determinants.
|
||||
! idx_non_cas gives the indice of the determinant in psi_det.
|
||||
END_DOC
|
||||
integer :: i_non_cas,j,k
|
||||
integer :: degree
|
||||
logical :: in_cas
|
||||
i_non_cas =0
|
||||
do k=1,N_det
|
||||
in_cas = .False.
|
||||
do j=1,N_det_cas
|
||||
call get_excitation_degree(psi_cas(1,1,j), psi_det(1,1,k), degree, N_int)
|
||||
if (degree == 0) then
|
||||
in_cas = .True.
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
if (.not.in_cas) then
|
||||
double precision :: hij
|
||||
i_non_cas += 1
|
||||
do j=1,N_int
|
||||
psi_non_cas(j,1,i_non_cas) = psi_det(j,1,k)
|
||||
psi_non_cas(j,2,i_non_cas) = psi_det(j,2,k)
|
||||
enddo
|
||||
do j=1,N_states
|
||||
psi_non_cas_coef(i_non_cas,j) = psi_coef(k,j)
|
||||
enddo
|
||||
idx_non_cas(i_non_cas) = k
|
||||
endif
|
||||
enddo
|
||||
N_det_non_cas = i_non_cas
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas_sorted_bit, (N_int,2,psi_det_size) ]
|
||||
&BEGIN_PROVIDER [ double precision, psi_non_cas_coef_sorted_bit, (psi_det_size,N_states) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! CAS determinants sorted to accelerate the search of a random determinant in the wave
|
||||
! function.
|
||||
END_DOC
|
||||
call sort_dets_by_det_search_key(N_det_cas, psi_non_cas, psi_non_cas_coef, &
|
||||
psi_non_cas_sorted_bit, psi_non_cas_coef_sorted_bit)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user