quack/src/eDFT/read_options_dft.f90

subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,aCC_w1,aCC_w2, & 
                            doNcentered,occnum,Cx_choice)

! Read DFT options

  implicit none

  include 'parameters.h'

! Input variables
  integer,intent(in)           :: nBas

! Local variables

  integer                       :: iBas
  integer                       :: iEns
  integer                       :: iParam
  character(len=1)              :: answer
  double precision,allocatable  :: nEl(:)

! Output variables

  character(len=8),intent(out)  :: method
  integer,intent(out)           :: x_rung,c_rung
  character(len=12),intent(out) :: x_DFA, c_DFA
  integer,intent(out)           :: SGn
  integer,intent(out)           :: nEns
  logical,intent(out)           :: doNcentered
  double precision,intent(out)  :: wEns(maxEns)
  double precision,intent(out)  :: aCC_w1(3)
  double precision,intent(out)  :: aCC_w2(3)
  double precision,intent(out)  :: occnum(nBas,nspin,maxEns)

  integer,intent(out)           :: Cx_choice

! Open file with method specification

  open(unit=1,file='input/dft')

! Default values

  method  = 'GOK-RKS'
  x_rung  = 1
  c_rung  = 1
  x_DFA   = 'RS51'
  c_DFA   = 'RVWN5'
  SGn     = 0
  wEns(:) = 0d0

! Restricted or unrestricted calculation

  read(1,*)
  read(1,*) method

! EXCHANGE: read rung of Jacob's ladder

  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*) x_rung,x_DFA

! CORRELATION: read rung of Jacob's ladder

  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*)
  read(1,*) c_rung,c_DFA

! Read SG-n grid

  read(1,*)
  read(1,*) SGn

! Read number of states in ensemble

  read(1,*)
  read(1,*) nEns

  if(nEns.gt.maxEns) then
    write(*,*) ' Number of states in ensemble too big!! ' 
    stop
  endif

  write(*,*)'----------------------------------------------------------'
  write(*,'(A33,I3)')'  Number of states in ensemble = ',nEns
  write(*,*)'----------------------------------------------------------'
  write(*,*) 
  
! Read occupation numbers for orbitals nO and nO+1

  occnum(:,:,:) = 0d0

  do iEns=1,maxEns
    read(1,*)
    read(1,*) (occnum(iBas,1,iEns),iBas=1,nBas)
    read(1,*) (occnum(iBas,2,iEns),iBas=1,nBas)
  end do

  do iEns=1,nEns
    write(*,*) 
    write(*,*) '==============='
    write(*,*) 'State n.',iEns
    write(*,*) '==============='
    write(*,*)
    write(*,*) 'Spin-up   occupation numbers'
    write(*,*) (int(occnum(iBas,1,iEns)),iBas=1,nBas)
    write(*,*) 'Spin-down occupation numbers'
    write(*,*) (int(occnum(iBas,2,iEns)),iBas=1,nBas)
    write(*,*)
  end do

! Read ensemble weights for real physical (fractional number of electrons) ensemble (w1,w2)

  allocate(nEl(maxEns))
  nEl(:) = 0d0
  do iEns=1,maxEns
    do iBas=1,nBas
      nEl(iEns) = nEl(iEns) + occnum(iBas,1,iEns) + occnum(iBas,2,iEns)
    end do
  end do

  doNcentered = .false.

  read(1,*)
  read(1,*) (wEns(iEns),iEns=2,nEns)
  read(1,*)
  read(1,*) answer

  if(answer == 'T') doNcentered = .true.

  if (doNcentered) then

    wEns(1) = 1d0 - wEns(2) - wEns(3) 

  else

!   wEns(1) = 1d0 -  nEl(2)/nEl(1)*wEns(2) - nEl(3)/nEl(1)*wEns(3) 

    wEns(1) = 1d0 - wEns(2) - wEns(3)
    wEns(2) = nEl(1)/nEl(2)*wEns(2)
    wEns(3) = nEl(1)/nEl(3)*wEns(3)

  end if

  write(*,*)'----------------------------------------------------------'
  write(*,*)' Ensemble weights '
  write(*,*)'----------------------------------------------------------'
  call matout(nEns,1,wEns)
  write(*,*) 
  
! Read parameters for weight-dependent functional
  read(1,*)
  read(1,*) (aCC_w1(iParam),iParam=1,3)
  read(1,*) (aCC_w2(iParam),iParam=1,3)
! Read choice of exchange coefficient
  read(1,*)
  read(1,*) Cx_choice

  write(*,*)'----------------------------------------------------------'
  write(*,*)' parameters for w1-dependent exchange functional coefficient '
  write(*,*)'----------------------------------------------------------'
  call matout(3,1,aCC_w1)
  write(*,*)

  write(*,*)'----------------------------------------------------------'
  write(*,*)' parameters for w2-dependent exchange functional coefficient '
  write(*,*)'----------------------------------------------------------'
  call matout(3,1,aCC_w2)
  write(*,*) 

! Close file with options

  close(unit=1)

end subroutine read_options_dft