mirror of
https://github.com/QuantumPackage/qp2.git
synced 2025-01-03 09:05:39 +01:00
beginning the fit on 1s functions
This commit is contained in:
eginer
parent
bb8ecd90e8
commit
67d2301fde
@ -1,3 +1,9 @@
|
||||
[ao_extra_center]
|
||||
type: double precision
|
||||
doc: parameter for off-centering s functions to mimick p functions
|
||||
interface: ezfio, provider
|
||||
default:0.01
|
||||
|
||||
[ao_extra_basis]
|
||||
type: character*(256)
|
||||
doc: Name of the |ao_extra| basis set
|
||||
|
||||
68
plugins/local/ao_extra_basis/aos_transp.irp.f
Normal file
68
plugins/local/ao_extra_basis/aos_transp.irp.f
Normal file
@ -0,0 +1,68 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ integer, Nucl_ao_extras_transposed, (N_ao_extras_max,nucl_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! List of ao_extras attached on each atom
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i
|
||||
integer, allocatable :: nucl_tmp(:)
|
||||
|
||||
allocate(nucl_tmp(nucl_num))
|
||||
nucl_tmp = 0
|
||||
do i = 1, ao_extra_num
|
||||
nucl_tmp(ao_extra_nucl(i)) += 1
|
||||
Nucl_ao_extras_transposed(nucl_tmp(ao_extra_nucl(i)),ao_extra_nucl(i)) = i
|
||||
enddo
|
||||
deallocate(nucl_tmp)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, ao_extra_expo_ordered_transp_per_nucl, (ao_extra_prim_num_max,N_ao_extras_max,nucl_num) ]
|
||||
implicit none
|
||||
integer :: i,j,k,l
|
||||
do i = 1, nucl_num
|
||||
do j = 1,Nucl_N_ao_extras(i)
|
||||
k = Nucl_ao_extras_transposed(j,i)
|
||||
do l = 1, ao_extra_prim_num(k)
|
||||
ao_extra_expo_ordered_transp_per_nucl(l,j,i) = ao_extra_expo_ordered_transp(l,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, ao_extra_power_ordered_transp_per_nucl, (3,N_ao_extras_max,nucl_num) ]
|
||||
implicit none
|
||||
integer :: i,j,k,l
|
||||
do i = 1, nucl_num
|
||||
do j = 1,Nucl_N_ao_extras(i)
|
||||
k = Nucl_ao_extras_transposed(j,i)
|
||||
do l = 1, 3
|
||||
ao_extra_power_ordered_transp_per_nucl(l,j,i) = ao_extra_power(k,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, ao_extra_coef_normalized_ordered_transp_per_nucl, (ao_extra_prim_num_max,N_ao_extras_max,nucl_num) ]
|
||||
implicit none
|
||||
integer :: i,j,k,l
|
||||
do i = 1, nucl_num
|
||||
do j = 1,Nucl_N_ao_extras(i)
|
||||
k = Nucl_ao_extras_transposed(j,i)
|
||||
do l = 1, ao_extra_prim_num(k)
|
||||
ao_extra_coef_normalized_ordered_transp_per_nucl(l,j,i) = ao_extra_coef_normalized_ordered_transp(l,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
8
plugins/local/ao_extra_basis/fit_1s_basis.irp.f
Normal file
8
plugins/local/ao_extra_basis/fit_1s_basis.irp.f
Normal file
@ -0,0 +1,8 @@
|
||||
program fit_1s_basis
|
||||
implicit none
|
||||
provide lmax_too_big
|
||||
integer :: i
|
||||
! print*,'n_func_tot', n_func_tot
|
||||
provide new_nucl_coord
|
||||
|
||||
end
|
||||
159
plugins/local/ao_extra_basis/prov_fit_1s.irp.f
Normal file
159
plugins/local/ao_extra_basis/prov_fit_1s.irp.f
Normal file
@ -0,0 +1,159 @@
|
||||
BEGIN_PROVIDER [ integer, n_func_tot]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! n_func_tot :: total number of functions in the fitted basis set
|
||||
!
|
||||
! returned in an uncontracted way
|
||||
END_DOC
|
||||
integer :: i,prefact
|
||||
n_func_tot = 0
|
||||
print*,'n_func_tot '
|
||||
do i = 1, ao_num
|
||||
if(ao_l(i) == 0)then
|
||||
prefact = 1 ! s functions
|
||||
else
|
||||
! p functions are fitted with 2 functions
|
||||
! d functions are fitted with 4 functions etc ...
|
||||
prefact=2*ao_l(i)
|
||||
endif
|
||||
n_func_tot += prefact * ao_prim_num(i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_prim_tot_orig]
|
||||
implicit none
|
||||
integer :: i
|
||||
n_prim_tot_orig = 0
|
||||
do i = 1, ao_num
|
||||
n_prim_tot_orig += ao_prim_num(i)
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ logical, lmax_too_big]
|
||||
implicit none
|
||||
if (ao_l_max.gt.1)then
|
||||
lmax_too_big = .True.
|
||||
else
|
||||
lmax_too_big = .False.
|
||||
endif
|
||||
if(lmax_too_big)then
|
||||
print*,'STOPPING !! lmax is larger than 1 !'
|
||||
print*,'Cannot yet fit with 1s functions ...'
|
||||
stop
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, n_2p_func_orig]
|
||||
&BEGIN_PROVIDER [ integer, n_2p_func_tot]
|
||||
implicit none
|
||||
integer :: i
|
||||
BEGIN_DOC
|
||||
! n_2p_func_orig :: number of 2p functions in the original basis
|
||||
!
|
||||
! n_2p_func_tot :: total number of p functions in the fitted basis
|
||||
END_DOC
|
||||
n_2p_func_orig= 0
|
||||
n_2p_func_tot = 0
|
||||
do i = 1, ao_num
|
||||
if(ao_l(i)==1)then
|
||||
n_2p_func_orig+= 1
|
||||
n_2p_func_tot += ao_prim_num(i) * 2
|
||||
endif
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, list_2p_functions, (n_2p_func_orig)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! list of 2p functions in the original basis
|
||||
END_DOC
|
||||
integer :: i,j
|
||||
j=0
|
||||
do i = 1, ao_num
|
||||
if(ao_l(i)==1)then
|
||||
j+=1
|
||||
list_2p_functions(j) = i
|
||||
endif
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, new_nucl_num]
|
||||
implicit none
|
||||
new_nucl_num = n_func_tot
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, new_ao_expo_1s , (n_func_tot) ]
|
||||
implicit none
|
||||
integer :: i,j,ii,i_ao,k
|
||||
k = 0
|
||||
do i = 1, nucl_num
|
||||
do ii = 1, Nucl_N_Aos(i)
|
||||
i_ao = nucl_aos_transposed(ii,i)
|
||||
if(ao_l(i_ao)==0)then
|
||||
do j = 1, ao_prim_num(i_ao)
|
||||
k+=1
|
||||
new_ao_expo_1s(k)= ao_expo(i_ao,j)
|
||||
enddo
|
||||
else if(ao_l(i_ao)==1)then
|
||||
! for 'p' functions
|
||||
! you replace the function by 2 functions 's'
|
||||
do j = 1, ao_prim_num(i_ao)
|
||||
k+=1
|
||||
new_ao_expo_1s(k)= ao_expo(i_ao,j)
|
||||
k+=1
|
||||
new_ao_expo_1s(k)= ao_expo(i_ao,j)
|
||||
enddo
|
||||
else
|
||||
print*,'WARNING ! Lmax value not implemented yet !'
|
||||
print*,'stopping ...'
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
if(k.ne.n_func_tot)then
|
||||
print*,'pb !!! k NE n_func_tot !!'
|
||||
print*,k,n_func_tot
|
||||
stop
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, new_nucl_coord, (3,new_nucl_num)]
|
||||
implicit none
|
||||
integer :: i,ii,j,i_ao,k
|
||||
k = 0
|
||||
do i = 1, nucl_num
|
||||
do ii = 1, Nucl_N_Aos(i)
|
||||
i_ao = nucl_aos_transposed(ii,i)
|
||||
if(ao_l(i_ao)==0)then
|
||||
do j = 1, ao_prim_num(i_ao)
|
||||
k+=1
|
||||
new_nucl_coord(1:3,k)=nucl_coord_transp(1:3,i)
|
||||
enddo
|
||||
else if(ao_l(i_ao)==1)then
|
||||
! split the function into 2 s functions
|
||||
! one is centered in R_x + d
|
||||
do j = 1, ao_prim_num(i_ao)
|
||||
k+=1
|
||||
new_nucl_coord(2:3,k)= nucl_coord_transp(2:3,i)
|
||||
new_nucl_coord(1,k)= nucl_coord_transp(1,i)+ao_extra_center
|
||||
k+=1
|
||||
! one is centered in R_x - d
|
||||
new_nucl_coord(2:3,k)= nucl_coord_transp(2:3,i)
|
||||
new_nucl_coord(1,k)= nucl_coord_transp(1,i)-ao_extra_center
|
||||
enddo
|
||||
else
|
||||
print*,'WARNING ! Lmax value not implemented yet !'
|
||||
print*,'stopping ...'
|
||||
stop
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
if(k.ne.n_func_tot)then
|
||||
print*,'pb !!! k NE n_func_tot !!'
|
||||
print*,k,n_func_tot
|
||||
stop
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
@ -1,2 +1,3 @@
|
||||
ao_extra_basis
|
||||
ao_one_e_ints
|
||||
ao_two_e_ints
|
||||
|
||||
Loading…
Reference in New Issue
Block a user