mirror of
https://gitlab.com/scemama/eplf
synced 2024-11-12 17:13:56 +01:00
191 lines
3.5 KiB
FortranFixed
191 lines
3.5 KiB
FortranFixed
|
BEGIN_PROVIDER [ integer, ao_num ]
|
||
|
implicit none
|
||
|
|
||
|
BEGIN_DOC
|
||
|
! Number of atomic orbitals
|
||
|
END_DOC
|
||
|
|
||
|
!$OMP CRITICAL (qcio_critical)
|
||
|
call qcio_get_basis_num_contr(ao_num)
|
||
|
!$OMP END CRITICAL (qcio_critical)
|
||
|
assert (ao_num > 0)
|
||
|
|
||
|
END_PROVIDER
|
||
|
|
||
|
BEGIN_PROVIDER [ integer, ao_prim_num, (ao_num) ]
|
||
|
implicit none
|
||
|
|
||
|
BEGIN_DOC
|
||
|
! Number of primitives per atomic orbital
|
||
|
END_DOC
|
||
|
|
||
|
!$OMP CRITICAL (qcio_critical)
|
||
|
call qcio_get_basis_num_prim(ao_prim_num)
|
||
|
!$OMP END CRITICAL (qcio_critical)
|
||
|
|
||
|
END_PROVIDER
|
||
|
|
||
|
BEGIN_PROVIDER [ integer, ao_nucl, (ao_num) ]
|
||
|
implicit none
|
||
|
|
||
|
BEGIN_DOC
|
||
|
! Nucleus on which the atomic orbital is centered
|
||
|
END_DOC
|
||
|
|
||
|
!$OMP CRITICAL (qcio_critical)
|
||
|
call qcio_get_basis_atom(ao_nucl)
|
||
|
!$OMP END CRITICAL (qcio_critical)
|
||
|
|
||
|
END_PROVIDER
|
||
|
|
||
|
BEGIN_PROVIDER [ integer, ao_power, (ao_num,3) ]
|
||
|
implicit none
|
||
|
|
||
|
BEGIN_DOC
|
||
|
! x,y,z powers of the atomic orbital
|
||
|
END_DOC
|
||
|
integer :: buffer(3,ao_num)
|
||
|
integer :: i,j
|
||
|
|
||
|
!$OMP CRITICAL (qcio_critical)
|
||
|
call qcio_get_basis_power(buffer)
|
||
|
!$OMP END CRITICAL (qcio_critical)
|
||
|
|
||
|
do i=1,3
|
||
|
do j=1,ao_num
|
||
|
ao_power(j,i) = buffer(i,j)
|
||
|
enddo
|
||
|
enddo
|
||
|
END_PROVIDER
|
||
|
|
||
|
|
||
|
BEGIN_PROVIDER [ integer , ao_power_max ]
|
||
|
BEGIN_DOC
|
||
|
! Maximum power among x, y and z
|
||
|
END_DOC
|
||
|
ao_power_max = maxval(ao_power_max_nucl)
|
||
|
END_PROVIDER
|
||
|
|
||
|
BEGIN_PROVIDER [ integer , ao_power_max_nucl, (nucl_num,3) ]
|
||
|
implicit none
|
||
|
BEGIN_DOC
|
||
|
! Maximum powers of x, y and z per nucleus
|
||
|
END_DOC
|
||
|
integer :: i, j
|
||
|
do j=1,3
|
||
|
do i=1,nucl_num
|
||
|
ao_power_max_nucl(i,j) = 0
|
||
|
enddo
|
||
|
enddo
|
||
|
|
||
|
integer :: inucl
|
||
|
do j=1,3
|
||
|
do i=1,ao_num
|
||
|
inucl = ao_nucl(i)
|
||
|
ao_power_max_nucl(inucl,j) = max(ao_power(i,j),ao_power_max_nucl(inucl,j))
|
||
|
enddo
|
||
|
enddo
|
||
|
END_PROVIDER
|
||
|
|
||
|
|
||
|
BEGIN_PROVIDER [ integer, ao_prim_num_max ]
|
||
|
implicit none
|
||
|
|
||
|
BEGIN_DOC
|
||
|
! Max Number of primitives per atomic orbital
|
||
|
END_DOC
|
||
|
|
||
|
ao_prim_num_max = maxval(ao_prim_num)
|
||
|
|
||
|
END_PROVIDER
|
||
|
|
||
|
BEGIN_PROVIDER [ real, ao_expo, (ao_prim_num_max,ao_num) ]
|
||
|
&BEGIN_PROVIDER [ real, ao_coef, (ao_prim_num_max,ao_num) ]
|
||
|
implicit none
|
||
|
BEGIN_DOC
|
||
|
! Exponents and coefficients of the atomic orbitals
|
||
|
END_DOC
|
||
|
|
||
|
double precision :: buffer(ao_prim_num_max,ao_num)
|
||
|
integer :: i,j
|
||
|
|
||
|
!$OMP CRITICAL (qcio_critical)
|
||
|
call qcio_get_basis_exponent(buffer)
|
||
|
!$OMP END CRITICAL (qcio_critical)
|
||
|
do i=1,ao_num
|
||
|
do j=1,ao_prim_num(i)
|
||
|
ao_expo(j,i) = buffer(j,i)
|
||
|
enddo
|
||
|
enddo
|
||
|
|
||
|
!$OMP CRITICAL (qcio_critical)
|
||
|
call qcio_get_basis_coefficient(buffer)
|
||
|
!$OMP END CRITICAL (qcio_critical)
|
||
|
|
||
|
double precision :: norm, norm2
|
||
|
double precision :: overlap
|
||
|
do i=1,ao_num
|
||
|
do j=1,ao_prim_num(i)
|
||
|
norm = overlap(ao_expo(j,i),ao_expo(j,i),ao_power(i,:))
|
||
|
norm = sqrt(norm)
|
||
|
ao_coef(j,i) = buffer(j,i)/norm
|
||
|
enddo
|
||
|
enddo
|
||
|
|
||
|
END_PROVIDER
|
||
|
|
||
|
double precision function ddfact2(n)
|
||
|
implicit none
|
||
|
integer :: n
|
||
|
|
||
|
ASSERT (mod(n,2) /= 0)
|
||
|
|
||
|
integer :: i
|
||
|
ddfact2 = 1.
|
||
|
do i=1,n,2
|
||
|
ddfact2 = ddfact2 * float(i)
|
||
|
enddo
|
||
|
|
||
|
end function
|
||
|
|
||
|
double precision function rintgauss(n)
|
||
|
implicit none
|
||
|
|
||
|
integer :: n
|
||
|
double precision :: pi
|
||
|
pi = acos(-1.)
|
||
|
|
||
|
rintgauss = sqrt(pi)
|
||
|
if ( n == 0 ) then
|
||
|
return
|
||
|
else if ( n == 1 ) then
|
||
|
rintgauss = 0.
|
||
|
else if ( mod(n,2) == 1) then
|
||
|
rintgauss = 0.
|
||
|
else
|
||
|
double precision :: ddfact2
|
||
|
rintgauss = rintgauss/(2.**(n/2))
|
||
|
rintgauss = rintgauss * ddfact2(n-1)
|
||
|
endif
|
||
|
end function
|
||
|
|
||
|
double precision function overlap(gamA,gamB,nA)
|
||
|
implicit none
|
||
|
|
||
|
real :: gamA, gamB
|
||
|
integer :: nA(3)
|
||
|
|
||
|
double precision :: gamtot
|
||
|
gamtot = gamA+gamB
|
||
|
|
||
|
overlap=1.0
|
||
|
|
||
|
integer :: l
|
||
|
double precision :: rintgauss
|
||
|
do l=1,3
|
||
|
overlap = overlap * rintgauss(nA(l)+nA(l))/ (gamtot**(0.5+float(nA(l))))
|
||
|
enddo
|
||
|
|
||
|
end function
|
||
|
|