gasci_singles_pc_weighted Module



Contents


Variables

Type Visibility Attributes Name Initial
type(PC_singles_drawing_vals_t), private, parameter :: PC_singles_drawing_vals = PC_singles_drawing_vals_t()

Derived Types

type, private, extends(EnumBase_t) ::  PC_singles_drawing_t

Components

Type Visibility Attributes Name Initial
integer, public :: val
character(len=9), private :: str

Type-Bound Procedures

generic, public :: operator(==) => eq_EnumBase_t
generic, public :: operator(/=) => neq_EnumBase_t
procedure , public , :: to_str Function

type, private ::  PC_singles_drawing_vals_t

Components

Type Visibility Attributes Name Initial
type(PC_singles_drawing_t), public :: UNDEFINED = PC_singles_drawing_t(-1, 'UNDEFINED')

We draw from and then and both probabilites come from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t We only guarantee that is occupied.

type(PC_singles_drawing_t), public :: FULL_FULL = PC_singles_drawing_t(1, 'FULL:FULL')

We draw from and then and both probabilites come from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t We only guarantee that is occupied.

type(PC_singles_drawing_t), public :: UNIF_FULL = PC_singles_drawing_t(2, 'UNIF:FULL')

We draw from and then and both probabilites come from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t We only guarantee that is occupied.

type(PC_singles_drawing_t), public :: UNIF_FAST = PC_singles_drawing_t(3, 'UNIF:FAST')

We draw from and then and both probabilites come from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t. We guarantee that is occupied and is unoccupied. We draw from uniformly and then from . I.e. only the second electron comes from the weighting scheme given in possible_PC_singles_weighting_t We only guarantee that is occupied.

Type-Bound Procedures

procedure , public , nopass :: from_str => drawing_from_keyword Function

type, public ::  PC_WeightedSinglesOptions_t

Components

Type Visibility Attributes Name Initial
type(PC_singles_drawing_t), public :: drawing

Components

Type Visibility Attributes Name Initial
type(PC_singles_drawing_vals_t), public :: drawing = PC_singles_drawing_vals_t()

type, public, extends(SingleExcitationGenerator_t) ::  PC_Weighted_t

Components

Type Visibility Attributes Name Initial
type(AliasSampler_1D_t), public :: I_sampler

p(I | i_sg) The probability of picking particle I in the supergroup i_sg.

type(AliasSampler_2D_t), public :: A_sampler

p(A | I, i_sg) The probability of picking the hole A after having picked particle I in the supergroup i_sg.

real(kind=dp), public, allocatable :: weights(:,:,:)

The weights w_{A, I, i_sg} for the excitation of I -> A. They are made independent of the determinant by various approximations: For example setting where runs over all orbitals instead of only the occupied.

class(GASSpec_t), public, allocatable :: GAS_spec

The GAS specification

type(SuperGroupIndexer_t), public, pointer :: indexer => null()

The Supergroup indexer. This is only a pointer because components cannot be targets otherwise. :-(

logical, public :: use_lookup = .false.

Use a lookup for the supergroup index in global_det_data.

logical, public :: create_lookup = .false.
integer(kind=n_int), private :: last_possible_occupied

The last element of the ilut array has some elements which are not used, if the number of spinorbitals is not a multiple of bitsize_n_int. To correctly zero them this bitmask is 1 wherever a determinant could be occupied in the last element, and 0 otherwise.

Type-Bound Procedures

procedure (BoundGenExc_t) , public :: gen_exc
procedure (BoundGetPgen_t) , public :: get_pgen
procedure , public :: init Subroutine
procedure , public :: finalize Subroutine
procedure , public :: gen_all_excits => gen_all_excits_PC_Weighted_t Subroutine
procedure , private , :: get_unoccupied Subroutine

type, private, extends(PC_Weighted_t) ::  PC_SinglesFullyWeighted_t

Components

Type Visibility Attributes Name Initial
type(AliasSampler_1D_t), public :: I_sampler

p(I | i_sg) The probability of picking particle I in the supergroup i_sg.

type(AliasSampler_2D_t), public :: A_sampler

p(A | I, i_sg) The probability of picking the hole A after having picked particle I in the supergroup i_sg.

real(kind=dp), public, allocatable :: weights(:,:,:)

The weights w_{A, I, i_sg} for the excitation of I -> A. They are made independent of the determinant by various approximations: For example setting where runs over all orbitals instead of only the occupied.

class(GASSpec_t), public, allocatable :: GAS_spec

The GAS specification

type(SuperGroupIndexer_t), public, pointer :: indexer => null()

The Supergroup indexer. This is only a pointer because components cannot be targets otherwise. :-(

logical, public :: use_lookup = .false.

Use a lookup for the supergroup index in global_det_data.

logical, public :: create_lookup = .false.

Type-Bound Procedures

procedure , public :: init Subroutine
procedure , public :: finalize Subroutine
procedure , public :: gen_all_excits => gen_all_excits_PC_Weighted_t Subroutine
procedure , public :: gen_exc => PC_SinglesFullyWeighted_gen_exc Subroutine
procedure , public :: get_pgen => PC_SinglesFullyWeighted_get_pgen Function

type, private, extends(PC_Weighted_t) ::  PC_SinglesWeighted_t

Components

Type Visibility Attributes Name Initial
type(AliasSampler_1D_t), public :: I_sampler

p(I | i_sg) The probability of picking particle I in the supergroup i_sg.

type(AliasSampler_2D_t), public :: A_sampler

p(A | I, i_sg) The probability of picking the hole A after having picked particle I in the supergroup i_sg.

real(kind=dp), public, allocatable :: weights(:,:,:)

The weights w_{A, I, i_sg} for the excitation of I -> A. They are made independent of the determinant by various approximations: For example setting where runs over all orbitals instead of only the occupied.

class(GASSpec_t), public, allocatable :: GAS_spec

The GAS specification

type(SuperGroupIndexer_t), public, pointer :: indexer => null()

The Supergroup indexer. This is only a pointer because components cannot be targets otherwise. :-(

logical, public :: use_lookup = .false.

Use a lookup for the supergroup index in global_det_data.

logical, public :: create_lookup = .false.

Type-Bound Procedures

procedure , public :: init Subroutine
procedure , public :: finalize Subroutine
procedure , public :: gen_all_excits => gen_all_excits_PC_Weighted_t Subroutine
procedure , public :: gen_exc => PC_SinglesWeighted_gen_exc Subroutine
procedure , public :: get_pgen => PC_SinglesWeighted_get_pgen Function

type, private, extends(PC_Weighted_t) ::  PC_SinglesFastWeighted_t

Components

Type Visibility Attributes Name Initial
type(AliasSampler_1D_t), public :: I_sampler

p(I | i_sg) The probability of picking particle I in the supergroup i_sg.

type(AliasSampler_2D_t), public :: A_sampler

p(A | I, i_sg) The probability of picking the hole A after having picked particle I in the supergroup i_sg.

real(kind=dp), public, allocatable :: weights(:,:,:)

The weights w_{A, I, i_sg} for the excitation of I -> A. They are made independent of the determinant by various approximations: For example setting where runs over all orbitals instead of only the occupied.

class(GASSpec_t), public, allocatable :: GAS_spec

The GAS specification

type(SuperGroupIndexer_t), public, pointer :: indexer => null()

The Supergroup indexer. This is only a pointer because components cannot be targets otherwise. :-(

logical, public :: use_lookup = .false.

Use a lookup for the supergroup index in global_det_data.

logical, public :: create_lookup = .false.

Type-Bound Procedures

procedure , public :: init Subroutine
procedure , public :: finalize Subroutine
procedure , public :: gen_all_excits => gen_all_excits_PC_Weighted_t Subroutine
procedure , public :: gen_exc => PC_SinglesFastWeighted_gen_exc Subroutine
procedure , public :: get_pgen => PC_SinglesFastWeighted_get_pgen Function

Functions

private pure function drawing_from_keyword(w) result(res)

Parse a given keyword into the possible drawing schemes.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: w

Return Value type(PC_singles_drawing_t)

private pure function to_str(options) result(res)

Parse a given keyword into the possible drawing schemes.

Arguments

Type IntentOptional Attributes Name
class(PC_singles_drawing_t), intent(in) :: options

Return Value character(len=9)

private function PC_SinglesFullyWeighted_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(p_gen)

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesFullyWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(in) :: ex(2,maxExcit)
integer, intent(in) :: ic
integer, intent(in) :: ClassCount2(ScratchSize)
integer, intent(in) :: ClassCountUnocc2(ScratchSize)

Return Value real(kind=dp)

private function PC_SinglesWeighted_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(p_gen)

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(in) :: ex(2,maxExcit)
integer, intent(in) :: ic
integer, intent(in) :: ClassCount2(ScratchSize)
integer, intent(in) :: ClassCountUnocc2(ScratchSize)

Return Value real(kind=dp)

private function PC_SinglesFastWeighted_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(p_gen)

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesFastWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(in) :: ex(2,maxExcit)
integer, intent(in) :: ic
integer, intent(in) :: ClassCount2(ScratchSize)
integer, intent(in) :: ClassCountUnocc2(ScratchSize)

Return Value real(kind=dp)

private pure function get_weight(exc) result(w)

Arguments

Type IntentOptional Attributes Name
type(Excite_1_t), intent(in) :: exc

Return Value real(kind=dp)

private elemental function h(I, A)

Return the 1el integral

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: I
integer, intent(in) :: A

Return Value real(kind=dp)

private elemental function g(I, A, J, B)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: I

Return the 2el integral

Read more…
integer, intent(in) :: A

Return the 2el integral

Read more…
integer, intent(in) :: J

Return the 2el integral

Read more…
integer, intent(in) :: B

Return the 2el integral

Read more…

Return Value real(kind=dp)


Subroutines

public subroutine do_allocation(generator, PC_singles_drawing)

Arguments

Type IntentOptional Attributes Name
class(SingleExcitationGenerator_t), intent(inout), allocatable :: generator
type(PC_singles_drawing_t), intent(in) :: PC_singles_drawing

private subroutine print_drawing_option(drawing, iunit)

Arguments

Type IntentOptional Attributes Name
type(PC_singles_drawing_t), intent(in) :: drawing
integer, intent(in) :: iunit

public subroutine print_options(options, iunit)

Arguments

Type IntentOptional Attributes Name
type(PC_WeightedSinglesOptions_t), intent(in) :: options
integer, intent(in) :: iunit

private subroutine init(this, GAS_spec, use_lookup, create_lookup)

Arguments

Type IntentOptional Attributes Name
class(PC_Weighted_t), intent(inout) :: this
class(GASSpec_t), intent(in) :: GAS_spec
logical, intent(in) :: use_lookup
logical, intent(in) :: create_lookup

private pure subroutine get_unoccupied(this, ilutI, ilut_unoccupied, unoccupied)

Return a bitmask and enumeration of the unoccupied spin orbitals.

Arguments

Type IntentOptional Attributes Name
class(PC_Weighted_t), intent(in) :: this
integer(kind=n_int), intent(in) :: ilutI(0:nIfD)
integer(kind=n_int), intent(out) :: ilut_unoccupied(0:nIfD)
integer, intent(out) :: unoccupied(nBasis-nEl)

private subroutine PC_SinglesFullyWeighted_gen_exc(this, nI, ilutI, nJ, ilutJ, exFlag, ic, ex, tParity, pGen, hel, store, part_type)

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesFullyWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(out) :: nJ(nel)
integer(kind=n_int), intent(out) :: ilutJ(0:NifTot)
integer, intent(in) :: exFlag
integer, intent(out) :: ic
integer, intent(out) :: ex(2,maxExcit)
logical, intent(out) :: tParity
real(kind=dp), intent(out) :: pGen
real(kind=dp), intent(out) :: hel
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: part_type

private subroutine PC_SinglesWeighted_gen_exc(this, nI, ilutI, nJ, ilutJ, exFlag, ic, ex, tParity, pGen, hel, store, part_type)

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(out) :: nJ(nel)
integer(kind=n_int), intent(out) :: ilutJ(0:NifTot)
integer, intent(in) :: exFlag
integer, intent(out) :: ic
integer, intent(out) :: ex(2,maxExcit)
logical, intent(out) :: tParity
real(kind=dp), intent(out) :: pGen
real(kind=dp), intent(out) :: hel
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: part_type

private subroutine PC_SinglesFastWeighted_gen_exc(this, nI, ilutI, nJ, ilutJ, exFlag, ic, ex, tParity, pGen, hel, store, part_type)

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesFastWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(out) :: nJ(nel)
integer(kind=n_int), intent(out) :: ilutJ(0:NifTot)
integer, intent(in) :: exFlag
integer, intent(out) :: ic
integer, intent(out) :: ex(2,maxExcit)
logical, intent(out) :: tParity
real(kind=dp), intent(out) :: pGen
real(kind=dp), intent(out) :: hel
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: part_type

private subroutine finalize(this)

Arguments

Type IntentOptional Attributes Name
class(PC_Weighted_t), intent(inout) :: this

private subroutine gen_all_excits_PC_Weighted_t(this, nI, n_excits, det_list)

Arguments

Type IntentOptional Attributes Name
class(PC_Weighted_t), intent(in) :: this
integer, intent(in) :: nI(nEl)
integer, intent(out) :: n_excits
integer(kind=n_int), intent(out), allocatable :: det_list(:,:)