Merge branch 'master' into dev-stable

This commit is contained in:
Anthony Scemama 2024-03-20 15:03:37 +01:00
commit f3a3c3ee63
5 changed files with 252 additions and 0 deletions

View File

@ -2,6 +2,9 @@
executables for Quantum Package. Please use ifort as long as you can, and executables for Quantum Package. Please use ifort as long as you can, and
consider switching to gfortran in the long term. consider switching to gfortran in the long term.
---
# Quantum Package 2.2 # Quantum Package 2.2
<!--- img src="https://raw.githubusercontent.com/QuantumPackage/qp2/master/data/qp2.png" width="250" ---> <!--- img src="https://raw.githubusercontent.com/QuantumPackage/qp2/master/data/qp2.png" width="250" --->

View File

@ -795,6 +795,11 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
if (do_ormas) then
logical, external :: det_allowed_ormas
if (.not.det_allowed_ormas(det)) cycle
endif
if(do_only_cas) then if(do_only_cas) then
if( number_of_particles(det) > 0 ) cycle if( number_of_particles(det) > 0 ) cycle
if( number_of_holes(det) > 0 ) cycle if( number_of_holes(det) > 0 ) cycle

View File

@ -3,3 +3,36 @@ type: integer
doc: Number of active |MOs| doc: Number of active |MOs|
interface: ezfio interface: ezfio
[do_ormas]
type: logical
doc: if |true| restrict selection based on ORMAS rules
interface: ezfio, provider, ocaml
default: false
[ormas_n_space]
type: integer
doc: Number of active spaces
interface: ezfio, provider, ocaml
default: 1
[ormas_mstart]
type: integer
doc: starting orb for each ORMAS space
size: (bitmask.ormas_n_space)
interface: ezfio
#default: (1)
[ormas_min_e]
type: integer
doc: min number of electrons in each ORMAS space
size: (bitmask.ormas_n_space)
interface: ezfio
#default: (0)
[ormas_max_e]
type: integer
doc: max number of electrons in each ORMAS space
size: (bitmask.ormas_n_space)
interface: ezfio
#default: (electrons.elec_num)

View File

@ -0,0 +1,206 @@
use bitmasks
BEGIN_PROVIDER [integer, ormas_mstart, (ormas_n_space) ]
implicit none
BEGIN_DOC
! first orbital idx in each active space
END_DOC
logical :: has
PROVIDE ezfio_filename
if (mpi_master) then
call ezfio_has_bitmask_ormas_mstart(has)
if (has) then
! write(6,'(A)') '.. >>>>> [ IO READ: ormas_mstart ] <<<<< ..'
call ezfio_get_bitmask_ormas_mstart(ormas_mstart)
ASSERT (ormas_mstart(1).eq.1)
else if (ormas_n_space.eq.1) then
ormas_mstart = 1
else
print *, 'bitmask/ormas_mstart not found in EZFIO file'
stop 1
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( ormas_mstart, ormas_n_space, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read ormas_mstart with MPI'
endif
IRP_ENDIF
! call write_time(6)
END_PROVIDER
BEGIN_PROVIDER [integer, ormas_min_e, (ormas_n_space) ]
implicit none
BEGIN_DOC
! min nelec in each active space
END_DOC
logical :: has
PROVIDE ezfio_filename
if (mpi_master) then
call ezfio_has_bitmask_ormas_min_e(has)
if (has) then
! write(6,'(A)') '.. >>>>> [ IO READ: ormas_min_e ] <<<<< ..'
call ezfio_get_bitmask_ormas_min_e(ormas_min_e)
else if (ormas_n_space.eq.1) then
ormas_min_e = 0
else
print *, 'bitmask/ormas_min_e not found in EZFIO file'
stop 1
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( ormas_min_e, ormas_n_space, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read ormas_min_e with MPI'
endif
IRP_ENDIF
! call write_time(6)
END_PROVIDER
BEGIN_PROVIDER [integer, ormas_max_e, (ormas_n_space) ]
implicit none
BEGIN_DOC
! max nelec in each active space
END_DOC
logical :: has
PROVIDE ezfio_filename
if (mpi_master) then
call ezfio_has_bitmask_ormas_max_e(has)
if (has) then
! write(6,'(A)') '.. >>>>> [ IO READ: ormas_max_e ] <<<<< ..'
call ezfio_get_bitmask_ormas_max_e(ormas_max_e)
else if (ormas_n_space.eq.1) then
ormas_max_e = elec_num
else
print *, 'bitmask/ormas_max_e not found in EZFIO file'
stop 1
endif
endif
IRP_IF MPI_DEBUG
print *, irp_here, mpi_rank
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
IRP_ENDIF
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( ormas_max_e, ormas_n_space, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read ormas_max_e with MPI'
endif
IRP_ENDIF
! call write_time(6)
END_PROVIDER
BEGIN_PROVIDER [ integer, ormas_n_orb, (ormas_n_space) ]
&BEGIN_PROVIDER [ integer, ormas_max_n_orb ]
implicit none
BEGIN_DOC
! number of orbitals in each ormas space
END_DOC
integer :: i
ormas_n_orb = 0
ormas_n_orb(ormas_n_space) = mo_num + 1 - ormas_mstart(ormas_n_space)
do i = ormas_n_space-1, 1, -1
ormas_n_orb(i) = ormas_mstart(i+1) - ormas_mstart(i)
ASSERT (ormas_n_orb(i).ge.1)
enddo
ormas_max_n_orb = maxval(ormas_n_orb)
END_PROVIDER
BEGIN_PROVIDER [ integer, ormas_list_orb, (ormas_max_n_orb, ormas_n_space) ]
implicit none
BEGIN_DOC
! list of orbitals in each ormas space
END_DOC
integer :: i,j,k
ormas_list_orb = 0
i = 1
do j = 1, ormas_n_space
do k = 1, ormas_n_orb(j)
ormas_list_orb(k,j) = i
i += 1
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), ormas_bitmask, (N_int, ormas_n_space) ]
implicit none
BEGIN_DOC
! bitmask for each ormas space
END_DOC
integer :: j
ormas_bitmask = 0_bit_kind
do j = 1, ormas_n_space
call list_to_bitstring(ormas_bitmask(1,j), ormas_list_orb(:,j), ormas_n_orb(j), N_int)
enddo
END_PROVIDER
subroutine ormas_occ(key_in, occupancies)
implicit none
BEGIN_DOC
! number of electrons in each ormas space
END_DOC
integer(bit_kind), intent(in) :: key_in(N_int,2)
integer, intent(out) :: occupancies(ormas_n_space)
integer :: i,ispin,ispace
occupancies = 0
! TODO: get start/end of each space within N_int
do ispace=1,ormas_n_space
do ispin=1,2
do i=1,N_int
occupancies(ispace) += popcnt(iand(ormas_bitmask(i,ispace),key_in(i,ispin)))
enddo
enddo
enddo
end
logical function det_allowed_ormas(key_in)
implicit none
BEGIN_DOC
! return true if det has allowable ormas occupations
END_DOC
integer(bit_kind), intent(in) :: key_in(N_int,2)
integer :: i,ispin,ispace,occ
det_allowed_ormas = .True.
if (ormas_n_space.eq.1) return
det_allowed_ormas = .False.
! TODO: get start/end of each space within N_int
do ispace=1,ormas_n_space
occ = 0
do ispin=1,2
do i=1,N_int
occ += popcnt(iand(ormas_bitmask(i,ispace),key_in(i,ispin)))
enddo
enddo
if ((occ.lt.ormas_min_e(ispace)).or.(occ.gt.ormas_max_e(ispace))) return
enddo
det_allowed_ormas = .True.
end

View File

@ -627,6 +627,11 @@ subroutine fill_buffer_$DOUBLE(i_generator, sp, h1, h2, bannedOrb, banned, fock_
call apply_particle(mask, s1, p1, det, ok, N_int) call apply_particle(mask, s1, p1, det, ok, N_int)
endif endif
if (do_ormas) then
logical, external :: det_allowed_ormas
if (.not.det_allowed_ormas(det)) cycle
endif
if (do_only_cas) then if (do_only_cas) then
integer, external :: number_of_holes, number_of_particles integer, external :: number_of_holes, number_of_particles
if (number_of_particles(det)>0) then if (number_of_particles(det)>0) then