4
1
mirror of https://github.com/pfloos/quack synced 2024-07-06 19:36:05 +02:00
quack/src/utils/read_basis.f90

190 lines
5.5 KiB
Fortran
Raw Normal View History

2020-03-25 09:48:58 +01:00
subroutine read_basis(nNuc,rNuc,nBas,nO,nV,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, &
max_ang_mom,min_exponent,max_exponent)
2019-03-20 13:38:42 +01:00
! Read basis set information
implicit none
include 'parameters.h'
! Input variables
2020-09-21 16:54:38 +02:00
integer,intent(in) :: nNuc,nO(nspin)
2019-03-20 13:38:42 +01:00
double precision,intent(in) :: rNuc(nNuc,ncart)
! Local variables
integer :: nShAt,iNuc,iShell
2020-01-17 13:45:02 +01:00
integer :: i,j,k,kk
2019-03-20 13:38:42 +01:00
character :: shelltype
! Output variables
integer,intent(out) :: nShell,nBas
double precision,intent(out) :: CenterShell(maxShell,ncart)
integer,intent(out) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(out) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK)
2020-09-21 16:54:38 +02:00
integer,intent(out) :: nV(nspin)
2019-03-20 13:38:42 +01:00
2020-03-25 09:48:58 +01:00
integer,intent(out) :: max_ang_mom(nNuc)
double precision,intent(out) :: min_exponent(nNuc,maxL+1)
double precision,intent(out) :: max_exponent(nNuc)
2019-03-20 13:38:42 +01:00
!------------------------------------------------------------------------
! Primary basis set information
!------------------------------------------------------------------------
! Open file with basis set specification
open(unit=2,file='input/basis')
! Read basis information
write(*,'(A28)') 'Gaussian basis set'
write(*,'(A28)') '------------------'
2020-03-25 09:48:58 +01:00
! Initailization
2019-03-20 13:38:42 +01:00
nShell = 0
2020-03-25 09:48:58 +01:00
max_ang_mom(:) = 0
min_exponent(:,:) = huge(0d0)
max_exponent(:) = 0d0
!------------------------------------------------------------------------
! Loop over atoms
!------------------------------------------------------------------------
2023-06-30 16:47:26 +02:00
! do i=1,nNuc
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! read(2,*) iNuc,nShAt
! write(*,'(A28,1X,I16)') 'Atom n. ',iNuc
! write(*,'(A28,1X,I16)') 'number of shells ',nShAt
! write(*,'(A28)') '------------------'
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! !------------------------------------------------------------------------
! ! Loop over shells
! !------------------------------------------------------------------------
! do j=1,nShAt
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! nShell = nShell + 1
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! ! Basis function centers
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! do k=1,ncart
! CenterShell(nShell,k) = rNuc(iNuc,k)
! enddo
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! ! Shell type and contraction degree
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! read(2,*) shelltype,KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! select case (shelltype)
! case ("S")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 0
! write(*,'(A28,1X,I16)') 's-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("P")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 1
! write(*,'(A28,1X,I16)') 'p-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("D")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 2
! write(*,'(A28,1X,I16)') 'd-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("F")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 3
! write(*,'(A28,1X,I16)') 'f-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("G")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 4
! write(*,'(A28,1X,I16)') 'g-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("H")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 5
! write(*,'(A28,1X,I16)') 'h-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("I")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 6
! write(*,'(A28,1X,I16)') 'i-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case ("J")
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! TotAngMomShell(nShell) = 7
! write(*,'(A28,1X,I16)') 'j-type shell with K = ',KShell(nShell)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! case default
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! call print_warning('!!! Angular momentum too high !!!')
! stop
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! end select
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! ! Read exponents and contraction coefficients
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! write(*,'(A28,1X,A16,A16)') '','Exponents','Contraction'
! do k=1,Kshell(nShell)
! read(2,*) kk,ExpShell(nShell,k),DShell(nShell,k)
! write(*,'(A28,1X,F16.10,F16.10)') '',ExpShell(nShell,k),DShell(nShell,k)
! enddo
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! min_exponent(iNuc,TotAngMomShell(nShell)+1) &
! = min(min_exponent(iNuc,TotAngMomShell(nShell)+1),minval(ExpShell(nShell,1:KShell(nShell))))
! max_exponent(iNuc) = max(max_exponent(iNuc),maxval(ExpShell(nShell,:)))
! max_ang_mom(iNuc) = max(max_ang_mom(iNuc),TotAngMomShell(nShell))
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! enddo
! !------------------------------------------------------------------------
! ! End loop over shells
! !------------------------------------------------------------------------
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! write(*,'(A28)') '------------------'
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! ! print*,'maximum angular momemtum for atom n. ',iNuc,' = '
! ! print*,max_ang_mom(iNuc)
! ! print*,'maximum exponent for atom n. ',iNuc,' = '
! ! print*,max_exponent(iNuc)
! ! print*,'minimum exponent for atom n. ',iNuc,' = '
! ! print*,min_exponent(iNuc,1:max_ang_mom(iNuc)+1)
2020-03-25 09:48:58 +01:00
2023-06-30 16:47:26 +02:00
! enddo
! !------------------------------------------------------------------------
! ! End loop over atoms
! !------------------------------------------------------------------------
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! ! Total number of shells
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! write(*,'(A28,1X,I16)') 'Number of shells',nShell
! write(*,'(A28)') '------------------'
! write(*,*)
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! ! Close file with basis set specification
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! close(unit=2)
2019-03-20 13:38:42 +01:00
! Calculate number of basis functions
2023-06-30 16:47:26 +02:00
! nBas = 0
! do iShell=1,nShell
! nBas = nBas + (TotAngMomShell(iShell)*TotAngMomShell(iShell) + 3*TotAngMomShell(iShell) + 2)/2
! enddo
2019-03-20 13:38:42 +01:00
2023-06-30 16:47:26 +02:00
! write(*,'(A28)') '------------------'
! write(*,'(A28,1X,I16)') 'Number of basis functions',NBas
! write(*,'(A28)') '------------------'
! write(*,*)
open(unit=3,file='int/nBas.dat')
read(3,*) nBas
close(unit=3)
2019-03-20 13:38:42 +01:00
! Number of virtual orbitals
2020-09-21 16:54:38 +02:00
nV(:) = nBas - nO(:)
2019-03-20 13:38:42 +01:00
end subroutine read_basis