Merge pull request #323 from kgasperich/ormas-clean

ORMAS implementation

plugins/local/cipsi_tc_bi_ortho/selection.irp.f

@@ -785,6 +785,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)
 
+      if (do_ormas) then
+        logical, external :: det_allowed_ormas
+        if (.not.det_allowed_ormas(det)) cycle
+      endif
+
       if(do_only_cas) then
         if( number_of_particles(det) > 0 ) cycle
         if( number_of_holes(det) > 0 ) cycle

src/bitmask/EZFIO.cfg

@@ -3,3 +3,36 @@ type: integer
 doc: Number of active |MOs| 
 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)
+

src/bitmask/bitmasks_ormas.irp.f

@@ -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
+  

src/cipsi/selection.irp.f

@@ -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)
       endif
 
+      if (do_ormas) then
+        logical, external :: det_allowed_ormas
+        if (.not.det_allowed_ormas(det)) cycle
+      endif
+
       if (do_only_cas) then
         integer, external :: number_of_holes, number_of_particles
         if (number_of_particles(det)>0) then