LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2025-01-03 09:05:39 +01:00
Code Releases Activity

fitting ok

Browse Source
This commit is contained in:
eginer 2024-12-12 12:32:41 +01:00
parent 67d2301fde
commit e4b9e4a901
7 changed files with 252 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ocaml/Input.ml
View File

@ -2,6 +2,7 @@ open Qputils;;
open Qptypes;;
include Input_ao_basis;;
include Input_ao_extra_basis;;
include Input_bitmasks;;
include Input_determinants_by_hand;;
include Input_electrons;;

6
plugins/local/ao_extra_basis/EZFIO.cfg
View File

@ -1,9 +1,3 @@
[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

24
plugins/local/ao_extra_basis/fit_1s_basis.irp.f
View File

@ -1,8 +1,24 @@
program fit_1s_basis
implicit none
provide lmax_too_big
integer :: i
! print*,'n_func_tot', n_func_tot
provide new_nucl_coord
integer :: i,j
print*,'////////////////////////////////////////////////////'
print*,'////////////////////////////////////////////////////'
print*,'Fitting the original basis set on uncontracted s only functions '
print*,'WARNING :: works for now with only P functions at most !!'
print*,'WARNING :: otherwise it will stop '
print*,'Writting the results in the extra_nuclei and ao_extra_basis folders of EZFIO'
print*,'New number of atomic functions : '
print*,'n_func_tot = ',n_func_tot
call ezfio_set_extra_nuclei_extra_nucl_num(new_nucl_num)
call ezfio_set_extra_nuclei_extra_nucl_charge(new_nucl_charge_1s)
call ezfio_set_extra_nuclei_extra_nucl_coord(new_nucl_coord_1s)
call ezfio_set_extra_nuclei_extra_nucl_label(new_nucl_label_1s)
call ezfio_set_ao_extra_basis_ao_extra_num(n_func_tot)
call ezfio_set_ao_extra_basis_ao_extra_nucl(new_ao_nucl_1s)
call ezfio_set_ao_extra_basis_ao_extra_prim_num(new_ao_prim_num_1s)
call ezfio_set_ao_extra_basis_ao_extra_coef(new_ao_coef_1s)
call ezfio_set_ao_extra_basis_ao_extra_expo(new_ao_expo_1s)
call ezfio_set_ao_extra_basis_ao_extra_power(new_ao_power_1s)
end

199
plugins/local/ao_extra_basis/prov_fit_1s.irp.f
View File

@ -1,3 +1,8 @@
BEGIN_PROVIDER [ double precision, ao_extra_center]
implicit none
ao_extra_center = 0.01d0
END_PROVIDER
BEGIN_PROVIDER [ integer, n_func_tot]
implicit none
BEGIN_DOC
@ -61,6 +66,7 @@ END_PROVIDER
n_2p_func_tot += ao_prim_num(i) * 2
endif
enddo
print*,'n_2p_func_tot = ',n_2p_func_tot
END_PROVIDER
BEGIN_PROVIDER [ integer, list_2p_functions, (n_2p_func_orig)]
@ -80,80 +86,167 @@ END_PROVIDER
BEGIN_PROVIDER [ integer, new_nucl_num]
implicit none
new_nucl_num = n_func_tot
new_nucl_num = nucl_num + n_2p_func_tot
print*,'new_nucl_num = ',new_nucl_num
END_PROVIDER
BEGIN_PROVIDER [ double precision, new_ao_expo_1s , (n_func_tot) ]
BEGIN_PROVIDER [ character*(32), new_nucl_label_1s , (new_nucl_num) ]
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
integer :: i
do i = 1, nucl_num
new_nucl_label_1s(i) = nucl_label(i)
enddo
do i = nucl_num+1,new_nucl_num
new_nucl_label_1s(i) = "X"
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)]
BEGIN_PROVIDER [ double precision, new_nucl_coord_1s, (new_nucl_num,3)]
implicit none
integer :: i,ii,j,i_ao,k
k = 0
integer :: i,j
do i = 1, new_nucl_num
new_nucl_coord_1s(i,1:3) = new_nucl_coord_1s_transp(1:3,i)
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, new_nucl_coord_1s_transp, (3,new_nucl_num)]
&BEGIN_PROVIDER [ double precision, new_nucl_charge_1s, (new_nucl_num)]
implicit none
BEGIN_DOC
! the real atoms are located in the first nucl_num entries
!
! then the fictious atoms are located after
END_DOC
integer :: i,ii,j,i_ao,k,n_ao
integer :: return_xyz_int,power(3),good_i
new_nucl_charge_1s = 0.d0
do i = 1, nucl_num
new_nucl_coord_1s_transp(1:3,i) = nucl_coord_transp(1:3,i)
new_nucl_charge_1s(i) = nucl_charge(i)
enddo
k = nucl_num
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
if(ao_l(i_ao)==1)then
! split the function into 2 s functions
! one is centered in R_x + d
power(1:3) = ao_power(i_ao,1:3)
good_i = return_xyz_int(power)
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
new_nucl_coord_1s_transp(1:3,k)= nucl_coord_transp(1:3,i)
new_nucl_coord_1s_transp(good_i,k)+= ao_extra_center
new_nucl_charge_1s(k) = 0.d0
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
new_nucl_coord_1s_transp(1:3,k)= nucl_coord_transp(1:3,i)
new_nucl_coord_1s_transp(good_i,k)-= ao_extra_center
new_nucl_charge_1s(k) = 0.d0
enddo
else
else if(ao_l(i_ao).gt.1)then
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 [ integer, new_n_AOs_max]
implicit none
new_n_AOs_max = ao_prim_num_max * n_AOs_max
END_PROVIDER
BEGIN_PROVIDER [ integer, new_Nucl_N_Aos, (new_nucl_num)]
&BEGIN_PROVIDER [ integer, new_nucl_aos_transposed, (new_n_AOs_max,new_nucl_num) ]
&BEGIN_PROVIDER [ double precision, new_ao_expo_1s , (n_func_tot) ]
&BEGIN_PROVIDER [ integer, new_ao_nucl_1s, (n_func_tot)]
implicit none
integer :: i,j,ii,i_ao,n_func,n_func_total,n_nucl
double precision :: coef
n_func_total = 0
do i = 1, nucl_num
n_func = 0
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)
coef= ao_expo(i_ao,j)
n_func_total += 1
n_func +=1
new_nucl_aos_transposed(n_func,i) = n_func_total
new_ao_expo_1s(n_func_total) = coef
new_ao_nucl_1s(n_func_total) = i
enddo
endif
enddo
new_Nucl_N_Aos(i) = n_func
enddo
n_nucl=nucl_num
do i = 1, nucl_num
do ii = 1, Nucl_N_Aos(i)
i_ao = nucl_aos_transposed(ii,i)
if(ao_l(i_ao)==1)then
do j = 1, ao_prim_num(i_ao)
coef= ao_expo(i_ao,j)
n_func_total+=1
n_nucl +=1
new_nucl_aos_transposed(1,n_nucl) = n_func_total
new_ao_expo_1s(n_func_total) = coef
new_Nucl_N_Aos(n_nucl)=1
new_ao_nucl_1s(n_func_total) = n_nucl
n_func_total+=1
n_nucl +=1
new_nucl_aos_transposed(1,n_nucl) = n_func_total
new_ao_expo_1s(n_func_total) = coef
new_Nucl_N_Aos(n_nucl)=1
new_ao_nucl_1s(n_func_total) = n_nucl
enddo
endif
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, new_ao_coef_1s , (n_func_tot) ]
implicit none
integer :: i
BEGIN_DOC
! Primitive coefficients, read from input. Those should not be used directly, as the MOs are expressed on the basis of **normalized** AOs.
END_DOC
do i = 1, n_func_tot
new_ao_coef_1s(i) = 1.d0
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, new_ao_prim_num_1s, (n_func_tot)]
implicit none
integer :: i
do i = 1, n_func_tot
new_ao_prim_num_1s(i) = 1
enddo
END_PROVIDER
BEGIN_PROVIDER [integer, new_ao_power_1s, (n_func_tot,3)]
implicit none
new_ao_power_1s = 0
END_PROVIDER
integer function return_xyz_int(power)
implicit none
integer,intent(in) :: power(3)
if(power(1) == 1 .and. power(2) ==0 .and. power(3) ==0)then
return_xyz_int = 1
else if (power(2) == 1 .and. power(1) ==0 .and. power(3) ==0)then
return_xyz_int = 2
else if (power(3) == 1 .and. power(1) ==0 .and. power(1) ==0)then
return_xyz_int = 3
else
return_xyz_int = -1000
endif
end

59
plugins/local/ao_extra_basis/qp_copy_extra_basis_to_usual_basis Executable file
View File

@ -0,0 +1,59 @@
#!/bin/bash
# specify the QP folder
QP=$QP_ROOT
dir=${QP}
# sourcing the quantum_package.rc file
. ${QP}/quantum_package.rc
EZFIO_extra=${1%/}
EZFIO_target=${2%/}
echo "********** SCRIPT TO COPY DATA FROM EZFIO TO ANOTHER *********"
echo "Extracting data from "$EZFIO_extra
echo "and Copying data to "$EZFIO_target
### COPYING ALL DATA FROM $EZFIO_extra/nuclei/ to ${EZFIO_target}/extra_nuclei/
echo "COPYING ALL DATA FROM "$EZFIO_extra"/extra_nuclei/ to "${EZFIO_target}"/nuclei/"
direxists=false
if [ -d ${EZFIO_target}/extra_nuclei/ ] ; then
direxists=true
echo "The directory extra_nuclei exists"
else
echo "PB !!"
direxists=false
mkdir ${EZFIO_target}/extra_nuclei/
fi
data=`\ls $EZFIO_extra/extra_nuclei/`
for i in $data
do
echo $i
newfile=`echo $i | sed 's/extra_nucl/nucl/g' `
echo $newfile
cp ${EZFIO_extra}/extra_nuclei/$i ${EZFIO_target}/nuclei/$newfile
done
### COPYING ALL DATA FROM $EZFIO_extra/ao_basis/ to ${EZFIO_target}/ao_extra_basis/
direxists=false
if [ -d ${EZFIO_target}/ao_extra_basis/ ] ; then
direxists=true
echo "The directory exists ao_extra_basis"
else
echo "PB !!"
direxists=false
mkdir ${EZFIO_target}/ao_extra_basis/
fi
echo "COPYING ALL DATA FROM "$EZFIO_extra"/ao_basis/ to "${EZFIO_target}"/ao_extra_basis/"
data=`\ls $EZFIO_extra/ao_extra_basis/`
for i in $data
do
echo $i
newfile=`echo $i | sed 's/ao_extra/ao/g' `
echo $newfile
cp ${EZFIO_extra}/ao_extra_basis/$i ${EZFIO_target}/ao_basis/$newfile
done
#i=primitives_normalized
#newfile=primitives_normalized_extra
#cp ${EZFIO_extra}/ao_basis/$i ${EZFIO_target}/ao_extra_basis/$newfile

23
scripts/ezfio_interface/qp_edit_template
View File

@ -17,6 +17,7 @@ This file is automatically generated by
(** Keywords used to define input sections *)
type keyword =
| Ao_basis
| Ao_extra_basis
| Determinants_by_hand
| Electrons
| Mo_basis
@ -27,6 +28,7 @@ type keyword =
let keyword_to_string = function
| Ao_basis -> "AO basis"
| Ao_extra_basis -> "AO extra_basis"
| Determinants_by_hand -> "Determinants_by_hand"
| Electrons -> "Electrons"
| Mo_basis -> "MO basis"
@ -76,6 +78,8 @@ let get s =
f Electrons.(read, to_rst)
| Nuclei_by_hand ->
f Nuclei_by_hand.(read, to_rst)
| Ao_extra_basis ->
f Ao_extra_basis.(read, to_rst)
| Ao_basis ->
f Ao_basis.(read, to_rst)
| Determinants_by_hand ->
@ -123,6 +127,7 @@ let set str s =
| Determinants_by_hand -> write Determinants_by_hand.(of_rst, write ~force:false) s
| Nuclei_by_hand -> write Nuclei_by_hand.(of_rst, write) s
| Ao_basis -> () (* TODO *)
| Ao_extra_basis -> () (* TODO *)
| Mo_basis -> () (* TODO *)
end
@ -199,6 +204,22 @@ let run check_only ?ndet ?state ?read ?write ezfio_filename =
| _ -> ()
end;
(* Reorder extra basis set *)
begin
match Input.Ao_extra_basis.read() with
| Some aos ->
let ordering = Input.Ao_extra_basis.ordering aos in
let test = Array.copy ordering in
Array.sort compare test ;
if test <> ordering then
begin
Printf.eprintf "Warning: Basis set is not properly ordered. Redordering.\n";
let new_aos = Input.Ao_extra_basis.reorder aos in
Input.Ao_extra_basis.write new_aos;
end
| _ -> ()
end;
begin
match ndet with
| None -> ()
@ -219,6 +240,7 @@ let run check_only ?ndet ?state ?read ?write ezfio_filename =
let output = (file_header ezfio_filename) :: (
List.map get [
Ao_basis ;
Ao_extra_basis ;
Mo_basis ;
])
in
@ -229,6 +251,7 @@ let run check_only ?ndet ?state ?read ?write ezfio_filename =
let tasks = [
Nuclei_by_hand ;
Ao_basis;
Ao_extra_basis;
Electrons ;
{tasks}
Mo_basis;

3
src/nuclei/nuclei.irp.f
View File

@ -201,6 +201,9 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ]
x(2) = nucl_coord(k,2) - nucl_coord(l,2)
x(3) = nucl_coord(k,3) - nucl_coord(l,3)
r2 = x(1)*x(1) + x(2)*x(2) + x(3)*x(3)
if(r2.lt.1.d-6)then
r2 = 1.d-6
endif
nuclear_repulsion += Z12/dsqrt(r2)
enddo
enddo