2009-05-11 23:43:45 +02:00
|
|
|
BEGIN_PROVIDER [ integer, ao_num ]
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
BEGIN_DOC
|
|
|
|
! Number of atomic orbitals
|
|
|
|
END_DOC
|
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
ao_num = -1
|
|
|
|
call get_ao_basis_ao_num(ao_num)
|
|
|
|
if (ao_num <= 0) then
|
|
|
|
call abrt(irp_here,'Number of contracted gaussians should be > 0')
|
|
|
|
endif
|
2009-05-11 23:43:45 +02:00
|
|
|
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ integer, ao_prim_num, (ao_num) ]
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
BEGIN_DOC
|
|
|
|
! Number of primitives per atomic orbital
|
|
|
|
END_DOC
|
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
ao_prim_num = -1
|
|
|
|
call get_ao_basis_ao_prim_num(ao_prim_num)
|
|
|
|
integer :: i
|
|
|
|
character*(80) :: message
|
|
|
|
do i=1,ao_num
|
|
|
|
if (ao_prim_num(i) <= 0) then
|
|
|
|
write(message,'(A,I6,A)') 'Number of primitives of contraction ',i,' should be > 0'
|
|
|
|
call abrt(irp_here,message)
|
|
|
|
endif
|
|
|
|
enddo
|
2009-05-11 23:43:45 +02:00
|
|
|
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ integer, ao_nucl, (ao_num) ]
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
BEGIN_DOC
|
|
|
|
! Nucleus on which the atomic orbital is centered
|
|
|
|
END_DOC
|
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
ao_nucl = -1
|
|
|
|
call get_ao_basis_ao_nucl(ao_nucl)
|
|
|
|
|
|
|
|
character*(80) :: message
|
|
|
|
character*(30) :: range
|
|
|
|
write(range,'(A,I5,A)') '(1,',nucl_num,')'
|
|
|
|
integer :: i
|
|
|
|
do i=1,ao_num
|
|
|
|
if ( (ao_nucl(i) <= 0) .or. (ao_nucl(i) > nucl_num) ) then
|
|
|
|
write(message,'(A,I6,A)') 'Contraction ',i,' should be centered on a nucleus in the range'//trim(range)
|
|
|
|
call abrt(irp_here,message)
|
|
|
|
endif
|
|
|
|
enddo
|
2009-05-11 23:43:45 +02:00
|
|
|
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ integer, ao_power, (ao_num,3) ]
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
BEGIN_DOC
|
|
|
|
! x,y,z powers of the atomic orbital
|
|
|
|
END_DOC
|
2009-10-12 17:37:07 +02:00
|
|
|
ao_power = 0
|
|
|
|
call get_ao_basis_ao_power(ao_power)
|
2009-05-11 23:43:45 +02:00
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
character*(80) :: message
|
|
|
|
integer :: i,j
|
2009-05-11 23:43:45 +02:00
|
|
|
do i=1,3
|
|
|
|
do j=1,ao_num
|
2009-10-12 17:37:07 +02:00
|
|
|
if (ao_power(j,i) < 0) then
|
|
|
|
write(message,'(A,I1,A,I6,A)') 'Power ',i,' of contraction ',j,' should be > 0'
|
|
|
|
call abrt(irp_here,message)
|
|
|
|
endif
|
2009-05-11 23:43:45 +02:00
|
|
|
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
|
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
BEGIN_PROVIDER [ real, ao_expo, (ao_num,ao_prim_num_max) ]
|
|
|
|
&BEGIN_PROVIDER [ real, ao_coef, (ao_num,ao_prim_num_max) ]
|
2009-05-11 23:43:45 +02:00
|
|
|
implicit none
|
|
|
|
BEGIN_DOC
|
|
|
|
! Exponents and coefficients of the atomic orbitals
|
|
|
|
END_DOC
|
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
ao_expo = 0.
|
|
|
|
call get_ao_basis_ao_expo(ao_expo)
|
2009-05-11 23:43:45 +02:00
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
integer :: i,j
|
2009-05-11 23:43:45 +02:00
|
|
|
do i=1,ao_num
|
|
|
|
do j=1,ao_prim_num(i)
|
2009-10-12 17:37:07 +02:00
|
|
|
if (ao_expo(i,j) <= 0.) then
|
|
|
|
character*(80) :: message
|
|
|
|
write(message,'(A,I6,A,I6,A)') 'Exponent ',j,' of contracted gaussian ',i,' is < 0'
|
|
|
|
call abrt(irp_here,message)
|
|
|
|
endif
|
2009-05-11 23:43:45 +02:00
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
ao_coef = 0.
|
|
|
|
call get_ao_basis_ao_coef(ao_coef)
|
2009-05-11 23:43:45 +02:00
|
|
|
|
2009-10-12 17:37:07 +02:00
|
|
|
! Normalization of the AO coefficients
|
|
|
|
! ------------------------------------
|
2009-05-11 23:43:45 +02:00
|
|
|
double precision :: norm, norm2
|
2009-06-15 11:33:16 +02:00
|
|
|
double precision :: goverlap
|
2009-10-12 17:37:07 +02:00
|
|
|
integer :: pow(3), l
|
2009-05-11 23:43:45 +02:00
|
|
|
do i=1,ao_num
|
|
|
|
do j=1,ao_prim_num(i)
|
2009-10-12 17:37:07 +02:00
|
|
|
pow(1) = ao_power(i,1)
|
|
|
|
pow(2) = ao_power(i,2)
|
|
|
|
pow(3) = ao_power(i,3)
|
|
|
|
norm = goverlap(ao_expo(i,j),ao_expo(i,j),pow)
|
|
|
|
ao_coef(i,j) = ao_coef(i,j)/sqrt(norm)
|
2009-05-11 23:43:45 +02:00
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
|
|
|
|
END_PROVIDER
|
|
|
|
|