mirror of
https://github.com/pfloos/quack
synced 2024-06-02 11:25:30 +02:00
432 lines
8.3 KiB
Fortran
432 lines
8.3 KiB
Fortran
subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,nCC,aCC, &
|
|
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 :: iCC
|
|
character(len=1) :: answer
|
|
double precision,allocatable :: nEl(:)
|
|
character(len=12) :: x_func
|
|
character(len=12) :: c_func
|
|
|
|
! Output variables
|
|
|
|
character(len=8),intent(out) :: method
|
|
integer,intent(out) :: x_rung,c_rung
|
|
integer,intent(out) :: x_DFA,c_DFA
|
|
integer,intent(out) :: SGn
|
|
integer,intent(out) :: nEns
|
|
logical,intent(out) :: doNcentered
|
|
double precision,intent(out) :: wEns(maxEns)
|
|
integer,intent(out) :: nCC
|
|
double precision,intent(out) :: aCC(maxCC,maxEns-1)
|
|
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 = 'eDFT-UKS'
|
|
x_rung = 1
|
|
c_rung = 1
|
|
x_DFA = 1
|
|
c_DFA = 1
|
|
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_func
|
|
|
|
select case (x_rung) ! exchange functionals
|
|
|
|
case (0) ! Hartree
|
|
|
|
select case (x_func)
|
|
|
|
case ('H')
|
|
|
|
x_DFA = 1
|
|
|
|
case default
|
|
|
|
call print_warning('!!! Hartree exchange functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (1) ! LDA
|
|
|
|
select case (x_func)
|
|
|
|
case ('S51')
|
|
|
|
x_DFA = 1
|
|
|
|
case ('CC-S51')
|
|
|
|
x_DFA = 2
|
|
|
|
case default
|
|
|
|
call print_warning('!!! LDA exchange functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (2) ! GGA
|
|
|
|
select case (x_func)
|
|
|
|
case ('G96')
|
|
|
|
x_DFA = 1
|
|
|
|
case ('B88')
|
|
|
|
x_DFA = 2
|
|
|
|
case ('PBE')
|
|
|
|
x_DFA = 3
|
|
|
|
case ('CC-B88')
|
|
|
|
x_DFA = 4
|
|
|
|
case default
|
|
|
|
call print_warning('!!! GGA exchange functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (3) ! MGGA
|
|
|
|
select case (x_func)
|
|
|
|
case default
|
|
|
|
call print_warning('!!! MGGA exchange functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (4) ! Hybrid
|
|
|
|
select case (x_func)
|
|
|
|
case ('HF')
|
|
|
|
x_DFA = 1
|
|
|
|
case ('B3LYP')
|
|
|
|
x_DFA = 2
|
|
|
|
case ('BHHLYP')
|
|
|
|
x_DFA = 3
|
|
|
|
case ('PBE')
|
|
|
|
x_DFA = 4
|
|
|
|
case default
|
|
|
|
call print_warning('!!! Hybrid exchange functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case default
|
|
|
|
call print_warning('!!! Exchange rung not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
! Select rung for exchange
|
|
|
|
write(*,*)
|
|
write(*,*) '*******************************************************************'
|
|
write(*,*) '* Exchange rung *'
|
|
write(*,*) '*******************************************************************'
|
|
|
|
call select_rung(x_rung,x_func)
|
|
|
|
!------------------------------------------!
|
|
! CORRELATION: read rung of Jacob's ladder !
|
|
!------------------------------------------!
|
|
|
|
read(1,*)
|
|
read(1,*)
|
|
read(1,*)
|
|
read(1,*)
|
|
read(1,*)
|
|
read(1,*)
|
|
read(1,*) c_rung,c_func
|
|
|
|
select case (c_rung) ! correlation functionals
|
|
|
|
case (0) ! Hartree
|
|
|
|
select case (c_func)
|
|
|
|
case ('H')
|
|
|
|
c_DFA = 1
|
|
|
|
case default
|
|
|
|
call print_warning('!!! Hartree correlation functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (1) ! LDA
|
|
|
|
select case (c_func)
|
|
|
|
case ('W38')
|
|
|
|
c_DFA = 1
|
|
|
|
case ('PW92')
|
|
|
|
c_DFA = 2
|
|
|
|
case ('VWN3')
|
|
|
|
c_DFA = 3
|
|
|
|
case ('VWN5')
|
|
|
|
c_DFA = 4
|
|
|
|
case ('eVWN5')
|
|
|
|
c_DFA = 5
|
|
|
|
case default
|
|
|
|
call print_warning('!!! LDA correlation functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (2) ! GGA
|
|
|
|
select case (c_func)
|
|
|
|
case ('LYP')
|
|
|
|
c_DFA = 1
|
|
|
|
case ('PBE')
|
|
|
|
c_DFA = 2
|
|
|
|
case default
|
|
|
|
call print_warning('!!! GGA correlation functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (3) ! MGGA
|
|
|
|
select case (c_func)
|
|
|
|
case default
|
|
|
|
call print_warning('!!! MGGA correlation functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case (4) ! Hybrid
|
|
|
|
select case (c_func)
|
|
|
|
case ('HF')
|
|
|
|
c_DFA = 1
|
|
|
|
case ('B3LYP')
|
|
|
|
c_DFA = 2
|
|
|
|
case ('BHHLYP')
|
|
|
|
c_DFA = 3
|
|
|
|
case ('PBE')
|
|
|
|
c_DFA = 4
|
|
|
|
case default
|
|
|
|
call print_warning('!!! Hybrid correlation functional not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
case default
|
|
|
|
call print_warning('!!! Correlation rung not available !!!')
|
|
stop
|
|
|
|
end select
|
|
|
|
! Select rung for correlation
|
|
|
|
write(*,*)
|
|
write(*,*) '*******************************************************************'
|
|
write(*,*) '* Correlation rung *'
|
|
write(*,*) '*******************************************************************'
|
|
|
|
call select_rung(c_rung,c_func)
|
|
|
|
! 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.
|
|
|
|
wEns(1) = 1d0
|
|
do iEns=2,nEns
|
|
wEns(1) = wEns(1) - wEns(iEns)
|
|
end do
|
|
|
|
if (doNcentered) then
|
|
|
|
do iEns=2,nEns
|
|
if(nEl(iEns) > 0d0) then
|
|
wEns(iEns) = (nEl(1)/nEl(iEns))*wEns(iEns)
|
|
else
|
|
wEns(iENs) = 0d0
|
|
end if
|
|
end do
|
|
|
|
end if
|
|
|
|
write(*,*)'----------------------------------------------------------'
|
|
write(*,*)' Ensemble weights '
|
|
write(*,*)'----------------------------------------------------------'
|
|
call matout(nEns,1,wEns)
|
|
write(*,*)
|
|
|
|
! Read parameters for weight-dependent functional
|
|
read(1,*)
|
|
read(1,*) nCC
|
|
do iEns=2,maxEns
|
|
read(1,*) (aCC(iCC,iEns-1),iCC=1,nCC)
|
|
end do
|
|
|
|
! Read choice of exchange coefficient
|
|
read(1,*)
|
|
read(1,*) Cx_choice
|
|
|
|
write(*,*)'----------------------------------------------------------'
|
|
write(*,*)' Parameters for weight-dependent exchange functional '
|
|
do iEns=2,maxEns
|
|
write(*,*)'----------------------------------------------------------'
|
|
write(*,'(A10,I2,A2)') ' State ',iEns,':'
|
|
write(*,*)'----------------------------------------------------------'
|
|
write(*,*)
|
|
call matout(nCC,1,acc(:,iEns-1))
|
|
write(*,*)
|
|
end do
|
|
write(*,*)
|
|
|
|
! Close file with options
|
|
|
|
close(unit=1)
|
|
|
|
end subroutine read_options_dft
|