LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-09 06:53:38 +01:00
Code Releases Activity
570a710de5
qp2/src/ao_basis/aos.irp.f

353 lines
10 KiB
Fortran
Raw Normal View History

Initial commit
2019-01-25 11:39:31 +01:00
BEGIN_PROVIDER [ integer, ao_prim_num_max ]
implicit none
BEGIN_DOC
! Max number of primitives.
END_DOC
ao_prim_num_max = maxval(ao_prim_num)
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num,ao_prim_num_max) ]
&BEGIN_PROVIDER [ double precision, ao_coef_normalization_factor, (ao_num) ]
implicit none
BEGIN_DOC
! Coefficients including the |AO| normalization
END_DOC
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz
integer :: i,j,k
nz=100
C_A(1) = 0.d0
C_A(2) = 0.d0
C_A(3) = 0.d0
ao_coef_normalized = 0.d0
do i=1,ao_num
powA(1) = ao_power(i,1)
powA(2) = ao_power(i,2)
powA(3) = ao_power(i,3)
do j=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j),powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm)
enddo
! Normalization of the contracted basis functions
norm = 0.d0
do j=1,ao_prim_num(i)
do k=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
norm = norm+c*ao_coef_normalized(i,j)*ao_coef_normalized(i,k)
enddo
enddo
ao_coef_normalization_factor(i) = 1.d0/sqrt(norm)
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef_normalization_libint_factor, (ao_num) ]
implicit none
BEGIN_DOC
! |AO| normalization for interfacing with libint
END_DOC
double precision :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
integer :: l, powA(3), nz
integer :: i,j,k
nz=100
C_A(1) = 0.d0
C_A(2) = 0.d0
C_A(3) = 0.d0
do i=1,ao_num
powA(1) = ao_l(i)
powA(2) = 0
powA(3) = 0
! Normalization of the contracted basis functions
norm = 0.d0
do j=1,ao_prim_num(i)
do k=1,ao_prim_num(i)
call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
norm = norm+c*ao_coef_normalized(i,j)*ao_coef_normalized(i,k)
enddo
enddo
ao_coef_normalization_libint_factor(i) = ao_coef_normalization_factor(i) * sqrt(norm)
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered, (ao_num,ao_prim_num_max) ]
&BEGIN_PROVIDER [ double precision, ao_expo_ordered, (ao_num,ao_prim_num_max) ]
implicit none
BEGIN_DOC
! Sorted primitives to accelerate 4 index |MO| transformation
END_DOC
integer :: iorder(ao_prim_num_max)
double precision :: d(ao_prim_num_max,2)
integer :: i,j
do i=1,ao_num
do j=1,ao_prim_num(i)
iorder(j) = j
d(j,1) = ao_expo(i,j)
d(j,2) = ao_coef_normalized(i,j)
enddo
call dsort(d(1,1),iorder,ao_prim_num(i))
call dset_order(d(1,2),iorder,ao_prim_num(i))
do j=1,ao_prim_num(i)
ao_expo_ordered(i,j) = d(j,1)
ao_coef_normalized_ordered(i,j) = d(j,2)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_coef_normalized_ordered_transp, (ao_prim_num_max,ao_num) ]
implicit none
BEGIN_DOC
! Transposed :c:data:`ao_coef_normalized_ordered`
END_DOC
integer :: i,j
do j=1, ao_num
do i=1, ao_prim_num_max
ao_coef_normalized_ordered_transp(i,j) = ao_coef_normalized_ordered(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, ao_expo_ordered_transp, (ao_prim_num_max,ao_num) ]
implicit none
BEGIN_DOC
! Transposed :c:data:`ao_expo_ordered`
END_DOC
integer :: i,j
do j=1, ao_num
do i=1, ao_prim_num_max
ao_expo_ordered_transp(i,j) = ao_expo_ordered(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, ao_l, (ao_num) ]
&BEGIN_PROVIDER [ integer, ao_l_max ]
&BEGIN_PROVIDER [ character*(128), ao_l_char, (ao_num) ]
implicit none
BEGIN_DOC
! :math:`l` value of the |AO|: :math`a+b+c` in :math:`x^a y^b z^c`
END_DOC
integer :: i
do i=1,ao_num
ao_l(i) = ao_power(i,1) + ao_power(i,2) + ao_power(i,3)
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
ao_l_char(i) = l_to_character(ao_l(i))
Initial commit
2019-01-25 11:39:31 +01:00
enddo
ao_l_max = maxval(ao_l)
END_PROVIDER
integer function ao_power_index(nx,ny,nz)
implicit none
integer, intent(in) :: nx, ny, nz
BEGIN_DOC
! Unique index given to a triplet of powers:
!
! :math:`\frac{1}{2} (l-n_x) (l-n_x+1) + n_z + 1`
END_DOC
integer :: l
l = nx + ny + nz
ao_power_index = ((l-nx)*(l-nx+1))/2 + nz + 1
end
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
BEGIN_PROVIDER [ character*(128), l_to_character, (0:7)]
Initial commit
2019-01-25 11:39:31 +01:00
BEGIN_DOC
! Character corresponding to the "l" value of an |AO|
END_DOC
implicit none
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
l_to_character(0)='s'
l_to_character(1)='p'
l_to_character(2)='d'
l_to_character(3)='f'
l_to_character(4)='g'
l_to_character(5)='h'
l_to_character(6)='i'
l_to_character(7)='j'
Initial commit
2019-01-25 11:39:31 +01:00
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_N_Aos, (nucl_num)]
&BEGIN_PROVIDER [ integer, N_AOs_max ]
implicit none
BEGIN_DOC
! Number of |AOs| per atom
END_DOC
integer :: i
Nucl_N_Aos = 0
do i = 1, ao_num
Nucl_N_Aos(ao_nucl(i)) +=1
enddo
N_AOs_max = maxval(Nucl_N_Aos)
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_Aos, (nucl_num,N_AOs_max)]
implicit none
BEGIN_DOC
! List of |AOs| centered on each atom
END_DOC
integer :: i
integer, allocatable :: nucl_tmp(:)
allocate(nucl_tmp(nucl_num))
nucl_tmp = 0
Nucl_Aos = 0
do i = 1, ao_num
nucl_tmp(ao_nucl(i))+=1
Nucl_Aos(ao_nucl(i),nucl_tmp(ao_nucl(i))) = i
enddo
deallocate(nucl_tmp)
END_PROVIDER
BEGIN_PROVIDER [ integer, Nucl_list_shell_Aos, (nucl_num,N_AOs_max)]
&BEGIN_PROVIDER [ integer, Nucl_num_shell_Aos, (nucl_num)]
implicit none
integer :: i,j,k
BEGIN_DOC
! Index of the shell type |AOs| and of the corresponding |AOs|
! By convention, for p,d,f and g |AOs|, we take the index
! of the |AO| with the the corresponding power in the x axis
END_DOC
do i = 1, nucl_num
Nucl_num_shell_Aos(i) = 0
do j = 1, Nucl_N_Aos(i)
if(ao_l(Nucl_Aos(i,j))==0)then
! S type function
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
elseif(ao_l(Nucl_Aos(i,j))==1)then
! P type function
if(ao_power(Nucl_Aos(i,j),1)==1)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==2)then
! D type function
if(ao_power(Nucl_Aos(i,j),1)==2)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==3)then
! F type function
if(ao_power(Nucl_Aos(i,j),1)==3)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
elseif(ao_l(Nucl_Aos(i,j))==4)then
! G type function
if(ao_power(Nucl_Aos(i,j),1)==4)then
Nucl_num_shell_Aos(i)+=1
Nucl_list_shell_Aos(i,Nucl_num_shell_Aos(i))=Nucl_Aos(i,j)
endif
endif
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ character*(4), ao_l_char_space, (ao_num) ]
implicit none
BEGIN_DOC
! Converts an l value to a string
END_DOC
integer :: i
character*(4) :: give_ao_character_space
do i=1,ao_num
if(ao_l(i)==0)then
! S type AO
give_ao_character_space = 'S '
elseif(ao_l(i) == 1)then
! P type AO
if(ao_power(i,1)==1)then
give_ao_character_space = 'X '
elseif(ao_power(i,2) == 1)then
give_ao_character_space = 'Y '
else
give_ao_character_space = 'Z '
endif
elseif(ao_l(i) == 2)then
! D type AO
if(ao_power(i,1)==2)then
give_ao_character_space = 'XX '
elseif(ao_power(i,2) == 2)then
give_ao_character_space = 'YY '
elseif(ao_power(i,3) == 2)then
give_ao_character_space = 'ZZ '
elseif(ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XY '
elseif(ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XZ '
else
give_ao_character_space = 'YZ '
endif
elseif(ao_l(i) == 3)then
! F type AO
if(ao_power(i,1)==3)then
give_ao_character_space = 'XXX '
elseif(ao_power(i,2) == 3)then
give_ao_character_space = 'YYY '
elseif(ao_power(i,3) == 3)then
give_ao_character_space = 'ZZZ '
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XXY '
elseif(ao_power(i,1) == 2 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXZ '
elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'YYX '
elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYZ '
elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'ZZX '
elseif(ao_power(i,3) == 2 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZY '
elseif(ao_power(i,3) == 1 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XYZ '
endif
elseif(ao_l(i) == 4)then
! G type AO
if(ao_power(i,1)==4)then
give_ao_character_space = 'XXXX'
elseif(ao_power(i,2) == 4)then
give_ao_character_space = 'YYYY'
elseif(ao_power(i,3) == 4)then
give_ao_character_space = 'ZZZZ'
elseif(ao_power(i,1) == 3 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'XXXY'
elseif(ao_power(i,1) == 3 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXXZ'
elseif(ao_power(i,2) == 3 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'YYYX'
elseif(ao_power(i,2) == 3 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYYZ'
elseif(ao_power(i,3) == 3 .and. ao_power(i,1) == 1)then
give_ao_character_space = 'ZZZX'
elseif(ao_power(i,3) == 3 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZZY'
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 2)then
give_ao_character_space = 'XXYY'
elseif(ao_power(i,2) == 2 .and. ao_power(i,3) == 2)then
give_ao_character_space = 'YYZZ'
elseif(ao_power(i,1) == 2 .and. ao_power(i,2) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'XXYZ'
elseif(ao_power(i,2) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,3) == 1)then
give_ao_character_space = 'YYXZ'
elseif(ao_power(i,3) == 2 .and. ao_power(i,1) == 1 .and. ao_power(i,2) == 1)then
give_ao_character_space = 'ZZXY'
endif
endif
ao_l_char_space(i) = give_ao_character_space
enddo
END_PROVIDER
Copy Permalink