LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 03:23:29 +01:00
Code Releases Activity

Cleaning in bitmasks

Browse Source
This commit is contained in:
Anthony Scemama 2019-07-02 10:20:20 +02:00
parent e42a4d8fc5
commit e69b2d6b25
3 changed files with 766 additions and 661 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
src/bitmask/bitmasks.irp.f
View File

@ -92,7 +92,7 @@ END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), ref_bitmask, (N_int,2)] BEGIN_PROVIDER [ integer(bit_kind), ref_bitmask, (N_int,2)]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask ! Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask
END_DOC END_DOC
ref_bitmask = HF_bitmask ref_bitmask = HF_bitmask
END_PROVIDER END_PROVIDER
@ -292,7 +292,7 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_
logical :: exists logical :: exists
PROVIDE ezfio_filename full_ijkl_bitmask N_generators_bitmask PROVIDE ezfio_filename full_ijkl_bitmask N_generators_bitmask
if (mpi_master) then if (mpi_master) then
call ezfio_has_bitmasks_generators(exists) call ezfio_has_bitmasks_generators(exists)
if (exists) then if (exists) then
call ezfio_get_bitmasks_generators(generators_bitmask) call ezfio_get_bitmasks_generators(generators_bitmask)
@ -443,16 +443,7 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, n_core_inact_orb ] BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask, (N_int,2)]
implicit none
integer :: i
n_core_inact_orb = 0
do i = 1, N_int
n_core_inact_orb += popcnt(reunion_of_core_inact_bitmask(i,1))
enddo
ENd_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask, (N_int,2)]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Reunion of the core and inactive and virtual bitmasks ! Reunion of the core and inactive and virtual bitmasks
@ -462,10 +453,24 @@ END_PROVIDER
reunion_of_core_inact_bitmask(i,1) = ior(core_bitmask(i,1),inact_bitmask(i,1)) reunion_of_core_inact_bitmask(i,1) = ior(core_bitmask(i,1),inact_bitmask(i,1))
reunion_of_core_inact_bitmask(i,2) = ior(core_bitmask(i,2),inact_bitmask(i,2)) reunion_of_core_inact_bitmask(i,2) = ior(core_bitmask(i,2),inact_bitmask(i,2))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer(bit_kind), reunion_of_core_inact_act_bitmask, (N_int,2)] BEGIN_PROVIDER [integer(bit_kind), reunion_of_inact_act_bitmask, (N_int,2)]
implicit none
BEGIN_DOC
! Reunion of the inactive and active bitmasks
END_DOC
integer :: i,j
do i = 1, N_int
reunion_of_inact_act_bitmask(i,1) = ior(inact_bitmask(i,1),act_bitmask(i,1))
reunion_of_inact_act_bitmask(i,2) = ior(inact_bitmask(i,2),act_bitmask(i,2))
enddo
END_PROVIDER
BEGIN_PROVIDER [integer(bit_kind), reunion_of_core_inact_act_bitmask, (N_int,2)]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Reunion of the core, inactive and active bitmasks ! Reunion of the core, inactive and active bitmasks
@ -476,10 +481,10 @@ END_PROVIDER
reunion_of_core_inact_act_bitmask(i,1) = ior(reunion_of_core_inact_bitmask(i,1),act_bitmask(i,1)) reunion_of_core_inact_act_bitmask(i,1) = ior(reunion_of_core_inact_bitmask(i,1),act_bitmask(i,1))
reunion_of_core_inact_act_bitmask(i,2) = ior(reunion_of_core_inact_bitmask(i,2),act_bitmask(i,2)) reunion_of_core_inact_act_bitmask(i,2) = ior(reunion_of_core_inact_bitmask(i,2),act_bitmask(i,2))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_bitmask, (N_int,2)] BEGIN_PROVIDER [ integer(bit_kind), reunion_of_bitmask, (N_int,2)]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Reunion of the inactive, active and virtual bitmasks ! Reunion of the inactive, active and virtual bitmasks
@ -489,7 +494,7 @@ END_PROVIDER
reunion_of_bitmask(i,1) = ior(ior(cas_bitmask(i,1,1),inact_bitmask(i,1)),virt_bitmask(i,1)) reunion_of_bitmask(i,1) = ior(ior(cas_bitmask(i,1,1),inact_bitmask(i,1)),virt_bitmask(i,1))
reunion_of_bitmask(i,2) = ior(ior(cas_bitmask(i,2,1),inact_bitmask(i,2)),virt_bitmask(i,2)) reunion_of_bitmask(i,2) = ior(ior(cas_bitmask(i,2,1),inact_bitmask(i,2)),virt_bitmask(i,2))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), inact_virt_bitmask, (N_int,2)] BEGIN_PROVIDER [ integer(bit_kind), inact_virt_bitmask, (N_int,2)]
@ -505,7 +510,7 @@ END_PROVIDER
core_inact_virt_bitmask(i,1) = ior(core_bitmask(i,1),inact_virt_bitmask(i,1)) core_inact_virt_bitmask(i,1) = ior(core_bitmask(i,1),inact_virt_bitmask(i,1))
core_inact_virt_bitmask(i,2) = ior(core_bitmask(i,2),inact_virt_bitmask(i,2)) core_inact_virt_bitmask(i,2) = ior(core_bitmask(i,2),inact_virt_bitmask(i,2))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, i_bitmask_gen ] BEGIN_PROVIDER [ integer, i_bitmask_gen ]
implicit none implicit none
@ -516,7 +521,7 @@ BEGIN_PROVIDER [ integer, i_bitmask_gen ]
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), unpaired_alpha_electrons, (N_int)] BEGIN_PROVIDER [ integer(bit_kind), unpaired_alpha_electrons, (N_int)]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Bitmask reprenting the unpaired alpha electrons in the HF_bitmask ! Bitmask reprenting the unpaired alpha electrons in the HF_bitmask
@ -526,19 +531,19 @@ END_PROVIDER
do i = 1, N_int do i = 1, N_int
unpaired_alpha_electrons(i) = xor(HF_bitmask(i,1),HF_bitmask(i,2)) unpaired_alpha_electrons(i) = xor(HF_bitmask(i,1),HF_bitmask(i,2))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask, (N_int,2)] BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask, (N_int,2)]
implicit none implicit none
integer :: i,j integer :: i,j
do i = 1, N_int do i = 1, N_int
closed_shell_ref_bitmask(i,1) = ior(ref_bitmask(i,1),cas_bitmask(i,1,1)) closed_shell_ref_bitmask(i,1) = ior(ref_bitmask(i,1),cas_bitmask(i,1,1))
closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),cas_bitmask(i,2,1)) closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),cas_bitmask(i,2,1))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_cas_inact_bitmask, (N_int,2)] BEGIN_PROVIDER [ integer(bit_kind), reunion_of_cas_inact_bitmask, (N_int,2)]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! Reunion of the inactive, active and virtual bitmasks ! Reunion of the inactive, active and virtual bitmasks
@ -548,21 +553,5 @@ END_PROVIDER
reunion_of_cas_inact_bitmask(i,1) = ior(act_bitmask(i,1),inact_bitmask(i,1)) reunion_of_cas_inact_bitmask(i,1) = ior(act_bitmask(i,1),inact_bitmask(i,1))
reunion_of_cas_inact_bitmask(i,2) = ior(act_bitmask(i,2),inact_bitmask(i,2)) reunion_of_cas_inact_bitmask(i,2) = ior(act_bitmask(i,2),inact_bitmask(i,2))
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer, n_core_orb_allocate]
implicit none
n_core_orb_allocate = max(n_core_orb,1)
END_PROVIDER
BEGIN_PROVIDER [integer, n_inact_orb_allocate]
implicit none
n_inact_orb_allocate = max(n_inact_orb,1)
END_PROVIDER
BEGIN_PROVIDER [integer, n_virt_orb_allocate]
implicit none
n_virt_orb_allocate = max(n_virt_orb,1)
END_PROVIDER

526
src/bitmask/core_inact_act_virt.irp.f
View File

@ -1,250 +1,366 @@
use bitmasks use bitmasks
BEGIN_PROVIDER [ integer, n_core_orb]
BEGIN_PROVIDER [ integer, n_core_orb]
&BEGIN_PROVIDER [ integer, n_inact_orb ]
&BEGIN_PROVIDER [ integer, n_act_orb]
&BEGIN_PROVIDER [ integer, n_virt_orb ]
&BEGIN_PROVIDER [ integer, n_del_orb ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! inact_bitmask : Bitmask of the inactive orbitals which are supposed to be doubly excited ! Number of core MOs
! in post CAS methods
! n_inact_orb : Number of inactive orbitals
! virt_bitmask : Bitmaks of vritual orbitals which are supposed to be recieve electrons
! in post CAS methods
! n_virt_orb : Number of virtual orbitals
! list_inact : List of the inactive orbitals which are supposed to be doubly excited
! in post CAS methods
! list_virt : List of vritual orbitals which are supposed to be recieve electrons
! in post CAS methods
! list_inact_reverse : reverse list of inactive orbitals
! list_inact_reverse(i) = 0 ::> not an inactive
! list_inact_reverse(i) = k ::> IS the kth inactive
! list_virt_reverse : reverse list of virtual orbitals
! list_virt_reverse(i) = 0 ::> not an virtual
! list_virt_reverse(i) = k ::> IS the kth virtual
! list_act(i) = index of the ith active orbital
!
! list_act_reverse : reverse list of active orbitals
! list_act_reverse(i) = 0 ::> not an active
! list_act_reverse(i) = k ::> IS the kth active orbital
END_DOC END_DOC
logical :: exists integer :: i
integer :: j,i
n_core_orb = 0 n_core_orb = 0
n_inact_orb = 0
n_act_orb = 0
n_virt_orb = 0
n_del_orb = 0
do i = 1, mo_num do i = 1, mo_num
if(mo_class(i) == 'Core')then if(mo_class(i) == 'Core')then
n_core_orb += 1 n_core_orb += 1
else if (mo_class(i) == 'Inactive')then endif
enddo
call write_int(6,n_core_orb, 'Number of core MOs')
END_PROVIDER
BEGIN_PROVIDER [ integer, n_inact_orb ]
implicit none
BEGIN_DOC
! Number of inactive MOs
END_DOC
integer :: i
n_inact_orb = 0
do i = 1, mo_num
if (mo_class(i) == 'Inactive')then
n_inact_orb += 1 n_inact_orb += 1
else if (mo_class(i) == 'Active')then endif
enddo
call write_int(6,n_inact_orb,'Number of inactive MOs')
END_PROVIDER
BEGIN_PROVIDER [ integer, n_act_orb]
implicit none
BEGIN_DOC
! Number of active MOs
END_DOC
integer :: i
n_act_orb = 0
do i = 1, mo_num
if (mo_class(i) == 'Active')then
n_act_orb += 1 n_act_orb += 1
else if (mo_class(i) == 'Virtual')then endif
enddo
call write_int(6,n_act_orb, 'Number of active MOs')
END_PROVIDER
BEGIN_PROVIDER [ integer, n_virt_orb ]
implicit none
BEGIN_DOC
! Number of virtual MOs
END_DOC
integer :: i
n_virt_orb = 0
do i = 1, mo_num
if (mo_class(i) == 'Virtual')then
n_virt_orb += 1 n_virt_orb += 1
else if (mo_class(i) == 'Deleted')then endif
enddo
call write_int(6,n_virt_orb, 'Number of virtual MOs')
END_PROVIDER
BEGIN_PROVIDER [ integer, n_del_orb ]
implicit none
BEGIN_DOC
! Number of deleted MOs
END_DOC
integer :: i
n_del_orb = 0
do i = 1, mo_num
if (mo_class(i) == 'Deleted')then
n_del_orb += 1 n_del_orb += 1
endif endif
enddo enddo
call write_int(6,n_core_orb, 'Number of core MOs')
call write_int(6,n_inact_orb,'Number of inactive MOs')
call write_int(6,n_act_orb, 'Number of active MOs')
call write_int(6,n_virt_orb, 'Number of virtual MOs')
call write_int(6,n_del_orb, 'Number of deleted MOs') call write_int(6,n_del_orb, 'Number of deleted MOs')
END_PROVIDER
BEGIN_PROVIDER [integer, dim_list_core_orb]
&BEGIN_PROVIDER [integer, dim_list_inact_orb]
&BEGIN_PROVIDER [integer, dim_list_virt_orb]
&BEGIN_PROVIDER [integer, dim_list_act_orb]
&BEGIN_PROVIDER [integer, dim_list_del_orb]
implicit none
BEGIN_DOC
! dimensions for the allocation of list_inact, list_virt, list_core and list_act
! it is at least 1
END_DOC
dim_list_core_orb = max(n_core_orb,1)
dim_list_inact_orb = max(n_inact_orb,1)
dim_list_virt_orb = max(n_virt_orb,1)
dim_list_act_orb = max(n_act_orb,1)
dim_list_del_orb = max(n_del_orb,1)
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, list_inact, (dim_list_inact_orb)]
&BEGIN_PROVIDER [ integer, list_virt, (dim_list_virt_orb)] BEGIN_PROVIDER [ integer, n_core_inact_orb ]
&BEGIN_PROVIDER [ integer, list_inact_reverse, (mo_num)]
&BEGIN_PROVIDER [ integer, list_virt_reverse, (mo_num)]
&BEGIN_PROVIDER [ integer, list_del_reverse, (mo_num)]
&BEGIN_PROVIDER [ integer, list_del, (mo_num)]
&BEGIN_PROVIDER [integer, list_core, (dim_list_core_orb)]
&BEGIN_PROVIDER [integer, list_core_reverse, (mo_num)]
&BEGIN_PROVIDER [integer, list_act, (dim_list_act_orb)]
&BEGIN_PROVIDER [integer, list_act_reverse, (mo_num)]
&BEGIN_PROVIDER [ integer(bit_kind), core_bitmask, (N_int,2)]
&BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask, (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), act_bitmask, (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask, (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), del_bitmask, (N_int,2) ]
implicit none implicit none
BEGIN_DOC BEGIN_DOC
! inact_bitmask : Bitmask of the inactive orbitals which are supposed to be doubly excited ! n_core + n_inact
! in post CAS methods
! n_inact_orb : Number of inactive orbitals
! virt_bitmask : Bitmaks of vritual orbitals which are supposed to be recieve electrons
! in post CAS methods
! n_virt_orb : Number of virtual orbitals
! list_inact : List of the inactive orbitals which are supposed to be doubly excited
! in post CAS methods
! list_virt : List of vritual orbitals which are supposed to be recieve electrons
! in post CAS methods
! list_inact_reverse : reverse list of inactive orbitals
! list_inact_reverse(i) = 0 ::> not an inactive
! list_inact_reverse(i) = k ::> IS the kth inactive
! list_virt_reverse : reverse list of virtual orbitals
! list_virt_reverse(i) = 0 ::> not an virtual
! list_virt_reverse(i) = k ::> IS the kth virtual
! list_act(i) = index of the ith active orbital
!
! list_act_reverse : reverse list of active orbitals
! list_act_reverse(i) = 0 ::> not an active
! list_act_reverse(i) = k ::> IS the kth active orbital
END_DOC END_DOC
logical :: exists integer :: i
integer :: j,i n_core_inact_orb = 0
integer :: n_core_orb_tmp, n_inact_orb_tmp, n_act_orb_tmp, n_virt_orb_tmp,n_del_orb_tmp do i = 1, N_int
integer :: list_core_tmp(N_int*bit_kind_size) n_core_inact_orb += popcnt(reunion_of_core_inact_bitmask(i,1))
integer :: list_inact_tmp(N_int*bit_kind_size)
integer :: list_act_tmp(N_int*bit_kind_size)
integer :: list_virt_tmp(N_int*bit_kind_size)
integer :: list_del_tmp(N_int*bit_kind_size)
list_core = 0
list_inact = 0
list_act = 0
list_virt = 0
list_del = 0
list_core_reverse = 0
list_inact_reverse = 0
list_act_reverse = 0
list_virt_reverse = 0
list_del_reverse = 0
n_core_orb_tmp = 0
n_inact_orb_tmp = 0
n_act_orb_tmp = 0
n_virt_orb_tmp = 0
n_del_orb_tmp = 0
core_bitmask = 0_bit_kind
inact_bitmask = 0_bit_kind
act_bitmask = 0_bit_kind
virt_bitmask = 0_bit_kind
do i = 1, mo_num
if(mo_class(i) == 'Core')then
n_core_orb_tmp += 1
list_core(n_core_orb_tmp) = i
list_core_tmp(n_core_orb_tmp) = i
list_core_reverse(i) = n_core_orb_tmp
else if (mo_class(i) == 'Inactive')then
n_inact_orb_tmp += 1
list_inact(n_inact_orb_tmp) = i
list_inact_tmp(n_inact_orb_tmp) = i
list_inact_reverse(i) = n_inact_orb_tmp
else if (mo_class(i) == 'Active')then
n_act_orb_tmp += 1
list_act(n_act_orb_tmp) = i
list_act_tmp(n_act_orb_tmp) = i
list_act_reverse(i) = n_act_orb_tmp
else if (mo_class(i) == 'Virtual')then
n_virt_orb_tmp += 1
list_virt(n_virt_orb_tmp) = i
list_virt_tmp(n_virt_orb_tmp) = i
list_virt_reverse(i) = n_virt_orb_tmp
else if (mo_class(i) == 'Deleted')then
n_del_orb_tmp += 1
list_del(n_del_orb_tmp) = i
list_del_tmp(n_del_orb_tmp) = i
list_del_reverse(i) = n_del_orb_tmp
endif
enddo enddo
if(n_core_orb.ne.0)then
call list_to_bitstring( core_bitmask(1,1), list_core, n_core_orb, N_int)
call list_to_bitstring( core_bitmask(1,2), list_core, n_core_orb, N_int)
endif
if(n_inact_orb.ne.0)then
call list_to_bitstring( inact_bitmask(1,1), list_inact, n_inact_orb, N_int)
call list_to_bitstring( inact_bitmask(1,2), list_inact, n_inact_orb, N_int)
endif
if(n_act_orb.ne.0)then
call list_to_bitstring( act_bitmask(1,1), list_act, n_act_orb, N_int)
call list_to_bitstring( act_bitmask(1,2), list_act, n_act_orb, N_int)
endif
if(n_virt_orb.ne.0)then
call list_to_bitstring( virt_bitmask(1,1), list_virt, n_virt_orb, N_int)
call list_to_bitstring( virt_bitmask(1,2), list_virt, n_virt_orb, N_int)
endif
if(n_del_orb.ne.0)then
call list_to_bitstring( del_bitmask(1,1), list_del, n_del_orb, N_int)
call list_to_bitstring( del_bitmask(1,2), list_del, n_del_orb, N_int)
endif
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer, n_inact_act_orb ] BEGIN_PROVIDER [integer, n_inact_act_orb ]
implicit none implicit none
BEGIN_DOC
! n_inact + n_act
END_DOC
n_inact_act_orb = (n_inact_orb+n_act_orb) n_inact_act_orb = (n_inact_orb+n_act_orb)
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer, list_inact_act, (n_inact_act_orb)] BEGIN_PROVIDER [integer, dim_list_core_orb]
integer :: i,itmp implicit none
itmp = 0 BEGIN_DOC
do i = 1, n_inact_orb ! dimensions for the allocation of list_core.
itmp += 1 ! it is at least 1
list_inact_act(itmp) = list_inact(i) END_DOC
enddo dim_list_core_orb = max(n_core_orb,1)
do i = 1, n_act_orb END_PROVIDER
itmp += 1
list_inact_act(itmp) = list_act(i) BEGIN_PROVIDER [integer, dim_list_inact_orb]
enddo implicit none
BEGIN_DOC
! dimensions for the allocation of list_inact.
! it is at least 1
END_DOC
dim_list_inact_orb = max(n_inact_orb,1)
END_PROVIDER
BEGIN_PROVIDER [integer, dim_list_act_orb]
implicit none
BEGIN_DOC
! dimensions for the allocation of list_act.
! it is at least 1
END_DOC
dim_list_act_orb = max(n_act_orb,1)
END_PROVIDER
BEGIN_PROVIDER [integer, dim_list_virt_orb]
implicit none
BEGIN_DOC
! dimensions for the allocation of list_virt.
! it is at least 1
END_DOC
dim_list_virt_orb = max(n_virt_orb,1)
END_PROVIDER
BEGIN_PROVIDER [integer, dim_list_del_orb]
implicit none
BEGIN_DOC
! dimensions for the allocation of list_del.
! it is at least 1
END_DOC
dim_list_del_orb = max(n_del_orb,1)
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer, n_core_inact_act_orb ] BEGIN_PROVIDER [integer, n_core_inact_act_orb ]
implicit none implicit none
BEGIN_DOC
! Number of core inactive and active MOs
END_DOC
n_core_inact_act_orb = (n_core_orb + n_inact_orb + n_act_orb) n_core_inact_act_orb = (n_core_orb + n_inact_orb + n_act_orb)
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), core_bitmask , (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask, (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), act_bitmask , (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask , (N_int,2) ]
&BEGIN_PROVIDER [ integer(bit_kind), del_bitmask , (N_int,2) ]
implicit none
BEGIN_DOC
! Bitmask identifying the core/inactive/active/virtual/deleted MOs
END_DOC
core_bitmask = 0_bit_kind
inact_bitmask = 0_bit_kind
act_bitmask = 0_bit_kind
virt_bitmask = 0_bit_kind
del_bitmask = 0_bit_kind
if(n_core_orb > 0)then
call list_to_bitstring( core_bitmask(1,1), list_core, n_core_orb, N_int)
call list_to_bitstring( core_bitmask(1,2), list_core, n_core_orb, N_int)
endif
if(n_inact_orb > 0)then
call list_to_bitstring( inact_bitmask(1,1), list_inact, n_inact_orb, N_int)
call list_to_bitstring( inact_bitmask(1,2), list_inact, n_inact_orb, N_int)
endif
if(n_act_orb > 0)then
call list_to_bitstring( act_bitmask(1,1), list_act, n_act_orb, N_int)
call list_to_bitstring( act_bitmask(1,2), list_act, n_act_orb, N_int)
endif
if(n_virt_orb > 0)then
call list_to_bitstring( virt_bitmask(1,1), list_virt, n_virt_orb, N_int)
call list_to_bitstring( virt_bitmask(1,2), list_virt, n_virt_orb, N_int)
endif
if(n_del_orb > 0)then
call list_to_bitstring( del_bitmask(1,1), list_del, n_del_orb, N_int)
call list_to_bitstring( del_bitmask(1,2), list_del, n_del_orb, N_int)
endif
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [integer, list_core_inact_act, (n_core_inact_act_orb)]
&BEGIN_PROVIDER [ integer, list_core_inact_act_reverse, (n_core_inact_act_orb)]
integer :: i,itmp
itmp = 0
do i = 1, n_core_orb BEGIN_PROVIDER [ integer, list_core , (dim_list_core_orb) ]
itmp += 1 &BEGIN_PROVIDER [ integer, list_core_reverse, (mo_num) ]
list_core_inact_act(itmp) = list_core(i) implicit none
enddo BEGIN_DOC
do i = 1, n_inact_orb ! List of MO indices which are in the core.
itmp += 1 END_DOC
list_core_inact_act(itmp) = list_inact(i) integer :: i, n
enddo list_core = 0
do i = 1, n_act_orb list_core_reverse = 0
itmp += 1
list_core_inact_act(itmp) = list_act(i) n=0
do i = 1, mo_num
if(mo_class(i) == 'Core')then
n += 1
list_core(n) = i
list_core_reverse(i) = n
endif
enddo enddo
integer :: occ_inact(N_int*bit_kind_size) END_PROVIDER
occ_inact = 0
call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), occ_inact(1), itest, N_int) BEGIN_PROVIDER [ integer, list_inact , (dim_list_inact_orb) ]
&BEGIN_PROVIDER [ integer, list_inact_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of MO indices which are inactive.
END_DOC
integer :: i, n
list_inact = 0
list_inact_reverse = 0 list_inact_reverse = 0
do i = 1, n_core_inact_act_orb
list_core_inact_act_reverse(occ_inact(i)) = i n=0
do i = 1, mo_num
if (mo_class(i) == 'Inactive')then
n += 1
list_inact(n) = i
list_inact_reverse(i) = n
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, list_virt , (dim_list_virt_orb) ]
&BEGIN_PROVIDER [ integer, list_virt_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of MO indices which are virtual
END_DOC
integer :: i, n
list_virt = 0
list_virt_reverse = 0
n=0
do i = 1, mo_num
if (mo_class(i) == 'Virtual')then
n += 1
list_virt(n) = i
list_virt_reverse(i) = n
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, list_del , (dim_list_del_orb) ]
&BEGIN_PROVIDER [ integer, list_del_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of MO indices which are deleted.
END_DOC
integer :: i, n
list_del = 0
list_del_reverse = 0
n=0
do i = 1, mo_num
if (mo_class(i) == 'Deleted')then
n += 1
list_del(n) = i
list_del_reverse(i) = n
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, list_act , (dim_list_act_orb) ]
&BEGIN_PROVIDER [ integer, list_act_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of MO indices which are in the active.
END_DOC
integer :: i, n
list_act = 0
list_act_reverse = 0
n=0
do i = 1, mo_num
if (mo_class(i) == 'Active')then
n += 1
list_act(n) = i
list_act_reverse(i) = n
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, list_core_inact , (n_core_inact_orb) ]
&BEGIN_PROVIDER [ integer, list_core_inact_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of indices of the core and inactive MOs
END_DOC
integer :: i,itmp
call bitstring_to_list(reunion_of_core_inact_bitmask(1,1), list_core_inact, itmp, N_int)
list_core_inact_reverse = 0
ASSERT (itmp == n_core_inact_orb)
do i = 1, n_core_inact_orb
list_core_inact_reverse(list_core_inact(i)) = i
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, list_core_inact_act , (n_core_inact_act_orb) ]
&BEGIN_PROVIDER [ integer, list_core_inact_act_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of indices of the core inactive and active MOs
END_DOC
integer :: i,itmp
call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), list_core_inact_act, itmp, N_int)
list_core_inact_act_reverse = 0
ASSERT (itmp == n_core_inact_act_orb)
do i = 1, n_core_inact_act_orb
list_core_inact_act_reverse(list_core_inact_act(i)) = i
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, list_inact_act , (n_inact_act_orb) ]
&BEGIN_PROVIDER [ integer, list_inact_act_reverse, (mo_num) ]
implicit none
BEGIN_DOC
! List of indices of the inactive and active MOs
END_DOC
integer :: i,itmp
call bitstring_to_list(reunion_of_inact_act_bitmask(1,1), list_inact_act, itmp, N_int)
list_inact_act_reverse = 0
ASSERT (itmp == n_inact_act_orb)
do i = 1, n_inact_act_orb
list_inact_act_reverse(list_inact_act(i)) = i
enddo
END_PROVIDER

24
src/casscf/bielec.irp.f
View File

@ -1,4 +1,4 @@
BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_orb+n_act_orb,n_core_orb+n_act_orb)] BEGIN_PROVIDER [real*8, bielec_PQxx, (mo_num, mo_num,n_core_inact_orb+n_act_orb,n_core_inact_orb+n_act_orb)]
BEGIN_DOC BEGIN_DOC
! bielec_PQxx : integral (pq|xx) with p,q arbitrary, x core or active ! bielec_PQxx : integral (pq|xx) with p,q arbitrary, x core or active
! indices are unshifted orbital numbers ! indices are unshifted orbital numbers
@ -9,16 +9,16 @@
bielec_PQxx = 0.d0 bielec_PQxx = 0.d0
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core(i)
do j=i,n_core_orb do j=i,n_core_inact_orb
jj=list_core(j) jj=list_core(j)
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j),mo_integrals_map) call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j),mo_integrals_map)
bielec_PQxx(:,:,j,i)=bielec_PQxx(:,:,i,j) bielec_PQxx(:,:,j,i)=bielec_PQxx(:,:,i,j)
end do end do
do j=1,n_act_orb do j=1,n_act_orb
jj=list_act(j) jj=list_act(j)
j3=j+n_core_orb j3=j+n_core_inact_orb
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j3),mo_integrals_map) call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i,j3),mo_integrals_map)
bielec_PQxx(:,:,j3,i)=bielec_PQxx(:,:,i,j3) bielec_PQxx(:,:,j3,i)=bielec_PQxx(:,:,i,j3)
end do end do
@ -28,10 +28,10 @@
! (ij|pq) ! (ij|pq)
do i=1,n_act_orb do i=1,n_act_orb
ii=list_act(i) ii=list_act(i)
i3=i+n_core_orb i3=i+n_core_inact_orb
do j=i,n_act_orb do j=i,n_act_orb
jj=list_act(j) jj=list_act(j)
j3=j+n_core_orb j3=j+n_core_inact_orb
call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i3,j3),mo_integrals_map) call get_mo_two_e_integrals_i1j1(ii,jj,mo_num,bielec_PQxx(1,1,i3,j3),mo_integrals_map)
bielec_PQxx(:,:,j3,i3)=bielec_PQxx(:,:,i3,j3) bielec_PQxx(:,:,j3,i3)=bielec_PQxx(:,:,i3,j3)
end do end do
@ -41,7 +41,7 @@ END_PROVIDER
BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_orb+n_act_orb,n_core_orb+n_act_orb, mo_num)] BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_inact_orb+n_act_orb,n_core_inact_orb+n_act_orb, mo_num)]
BEGIN_DOC BEGIN_DOC
! bielec_PxxQ : integral (px|xq) with p,q arbitrary, x core or active ! bielec_PxxQ : integral (px|xq) with p,q arbitrary, x core or active
! indices are unshifted orbital numbers ! indices are unshifted orbital numbers
@ -55,9 +55,9 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_orb+n_act_orb,n_core_orb+n_a
bielec_PxxQ = 0.d0 bielec_PxxQ = 0.d0
do i=1,n_core_orb do i=1,n_core_inact_orb
ii=list_core(i) ii=list_core(i)
do j=i,n_core_orb do j=i,n_core_inact_orb
jj=list_core(j) jj=list_core(j)
call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map) call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map)
do p=1,mo_num do p=1,mo_num
@ -69,7 +69,7 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_orb+n_act_orb,n_core_orb+n_a
end do end do
do j=1,n_act_orb do j=1,n_act_orb
jj=list_act(j) jj=list_act(j)
j3=j+n_core_orb j3=j+n_core_inact_orb
call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map) call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map)
do p=1,mo_num do p=1,mo_num
do q=1,mo_num do q=1,mo_num
@ -84,10 +84,10 @@ BEGIN_PROVIDER [real*8, bielec_PxxQ, (mo_num,n_core_orb+n_act_orb,n_core_orb+n_a
! (ip|qj) ! (ip|qj)
do i=1,n_act_orb do i=1,n_act_orb
ii=list_act(i) ii=list_act(i)
i3=i+n_core_orb i3=i+n_core_inact_orb
do j=i,n_act_orb do j=i,n_act_orb
jj=list_act(j) jj=list_act(j)
j3=j+n_core_orb j3=j+n_core_inact_orb
call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map) call get_mo_two_e_integrals_ij (ii,jj,mo_num,integrals_array,mo_integrals_map)
do p=1,mo_num do p=1,mo_num
do q=1,mo_num do q=1,mo_num