quack/src/utils/read_basis.f90

subroutine read_basis(nNuc,rNuc,nBas,nO,nV,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & 
                      max_ang_mom,min_exponent,max_exponent)

! Read basis set information

  implicit none
  include 'parameters.h'

! Input variables

  integer,intent(in)            :: nNuc,nO
  double precision,intent(in)   :: rNuc(nNuc,ncart)

! Local variables

  integer                       :: nShAt,iNuc,iShell
  integer                       :: i,j,k,kk
  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)
  integer,intent(out)           :: nV

  integer,intent(out)           :: max_ang_mom(nNuc)
  double precision,intent(out)  :: min_exponent(nNuc,maxL+1)
  double precision,intent(out)  :: max_exponent(nNuc)

!------------------------------------------------------------------------
! 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)') '------------------'

! Initailization

  nShell = 0
  max_ang_mom(:)    = 0
  min_exponent(:,:) = huge(0d0)
  max_exponent(:)   = 0d0

!------------------------------------------------------------------------
! Loop over atoms
!------------------------------------------------------------------------
  do i=1,nNuc

    read(2,*) iNuc,nShAt
    write(*,'(A28,1X,I16)') 'Atom n. ',iNuc
    write(*,'(A28,1X,I16)') 'number of shells ',nShAt
    write(*,'(A28)') '------------------'

!------------------------------------------------------------------------
! Loop over shells
!------------------------------------------------------------------------
    do j=1,nShAt

      nShell = nShell + 1

     ! Basis function centers

      do k=1,ncart
        CenterShell(nShell,k) = rNuc(iNuc,k)
      enddo

      ! Shell type and contraction degree

      read(2,*) shelltype,KShell(nShell)

      select case (shelltype)
        case ("S") 

          TotAngMomShell(nShell) = 0
          write(*,'(A28,1X,I16)') 's-type shell with K = ',KShell(nShell)

        case ("P")

          TotAngMomShell(nShell) = 1
           write(*,'(A28,1X,I16)') 'p-type shell with K = ',KShell(nShell)

        case ("D")

          TotAngMomShell(nShell) = 2
          write(*,'(A28,1X,I16)') 'd-type shell with K = ',KShell(nShell)

        case ("F")

          TotAngMomShell(nShell) = 3
          write(*,'(A28,1X,I16)') 'f-type shell with K = ',KShell(nShell)

        case ("G")

          TotAngMomShell(nShell) = 4
          write(*,'(A28,1X,I16)') 'g-type shell with K = ',KShell(nShell)

        case ("H")

          TotAngMomShell(nShell) = 5
          write(*,'(A28,1X,I16)') 'h-type shell with K = ',KShell(nShell)

        case ("I")

          TotAngMomShell(nShell) = 6
          write(*,'(A28,1X,I16)') 'i-type shell with K = ',KShell(nShell)

        case ("J")

          TotAngMomShell(nShell) = 7
          write(*,'(A28,1X,I16)') 'j-type shell with K = ',KShell(nShell)

        case default 

         call print_warning('!!! Angular momentum too high !!!')
         stop

      end select

! Read exponents and contraction coefficients

      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

      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))

    enddo
!------------------------------------------------------------------------
!   End loop over shells
!------------------------------------------------------------------------

    write(*,'(A28)') '------------------'

!   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)

  enddo
!------------------------------------------------------------------------
! End loop over atoms
!------------------------------------------------------------------------

! Total number of shells

  write(*,'(A28,1X,I16)') 'Number of shells',nShell
  write(*,'(A28)') '------------------'
  write(*,*)

! Close file with basis set specification

  close(unit=2)

! Calculate number of basis functions

  nBas = 0
  do iShell=1,nShell
    nBas = nBas + (TotAngMomShell(iShell)*TotAngMomShell(iShell) + 3*TotAngMomShell(iShell) + 2)/2
  enddo

  write(*,'(A28)') '------------------'
  write(*,'(A28,1X,I16)') 'Number of basis functions',NBas
  write(*,'(A28)') '------------------'
  write(*,*)

! Number of virtual orbitals

  nV = nBas - nO

end subroutine read_basis