setup_virtual_mask Subroutine

public subroutine setup_virtual_mask()

Arguments

None

Contents

Source Code


Source Code

    subroutine setup_virtual_mask()
        ! routine to setup the list of virtual orbitals in the current
        ! reference determinant, these are then used to choose the electrons
        ! for non-initiator determinants
        ! for now this is only done for single-runs! not dneci, mneci for now!
        character(*), parameter :: this_routine = "setup_virtual_mask"
        integer :: i, j, k

        ! and assure that this routine is called after the first HFDET is
        ! already assigned
        ASSERT(allocated(projedet))
        if (.not. allocated(projedet)) then
            call stop_all(this_routine, &
                          "init_back_spawn() called to early; run reference not yet setup!")
        end if

        ASSERT(allocated(ilutref))
        if (.not. allocated(ilutref)) then
            call stop_all(this_routine, &
                          "init_back_spawn() called to early; run reference not yet setup!")
        end if

        ! first use the most simple implementation of an nI style
        ! virtual orbital indication:
        if (allocated(mask_virt_ni)) deallocate(mask_virt_ni)

        ! i need to adapt that for replica runs
        allocate(mask_virt_ni(nBasis - nel, inum_runs))

        ! i guess the easiest way to do that is to loop over all the
        ! spin-orbitals and only write an entry if this orbital is not
        ! occupied in the reference

        ! ok now for more efficiency i also want to have an ilut version of
        ! mask_virt_ni!
        if (allocated(mask_virt_ilut)) deallocate(mask_virt_ilut)
        allocate(mask_virt_ilut(0:niftot, inum_runs))

        mask_virt_ilut = 0_n_int
        mask_virt_ni = 0

        do k = 1, inum_runs
            j = 1
            do i = 1, nbasis
                ! if (i) is in the reference cycle
                if (is_in_ref(i, k)) cycle
!                 if (any(i == projedet(:,k))) cycle
                ! otherwise fill up the virtual mask
                mask_virt_ni(j, k) = i
                j = j + 1
            end do
            if (any(mask_virt_ni(:, k) == 0)) then
                call stop_all(this_routine, &
                              "something went wrong in the mask_virt_ni setup")
            end if

            ! and also encode the the ilut version
            ! oh thats true.. mask_virt_ni is not always of length(nel)
            call encode_mask_virt(mask_virt_ni(:, k), mask_virt_ilut(:, k))
        end do

    end subroutine setup_virtual_mask