SUBROUTINE IntReadInput(file_reader)
use SystemData, only: NEL, TUSEBRILLOUIN, OrbOrder, BasisFN
use UMatCache, only: tReadInCache, nSlotsInit, nMemInit, iDumpCacheFlag, iDFMethod
class(FileReader_t), intent(inout) :: file_reader
character(*), parameter :: this_routine = 'IntReadInput'
type(TokenIterator_t) :: tokens
CHARACTER(LEN=100) w
INTEGER :: i
integral: do while (file_reader%nextline(tokens, skip_empty=.true.))
w = to_upper(tokens%next())
select case(w)
case ("DUMPFCIDUMP")
tDumpFCIDUMP = .true.
case ("LINROOTCHANGE")
TLinRootChange = .true.
case ("RMROOTEXCITSTARSROOTCHANGE")
TRmRootExcitStarsRootChange = .true.
case ("EXCITSTARSROOTCHANGE")
TExcitStarsRootChange = .true.
case ("DIAGSTARSTARS")
TDiagStarStars = .true.
case ("STARQUADEXCITS")
TJustQuads = .true.
case ("STARNODOUBS")
TNoDoubs = .true.
case ("CALCEXCITSTAR")
TCalcExcitStar = .true.
case ("QUADVECMAX")
TQuadVecMax = .true.
case ("QUADVALMAX")
TQuadValMax = .true.
case ("NRCONV")
NRCONV = to_realdp(tokens%next())
case ("RFCONV")
RFCONV = to_realdp(tokens%next())
case ("NRSTEPSMAX")
NRSTEPSMAX = to_int(tokens%next())
case ("INCLUDEQUADRHO")
TQUADRHO = .true.
case ("EXPRHO")
TEXPRHO = .true.
case ("RHO-1STORDER")
NTAY(2) = 4
case ("FOCK-PARTITION")
NTAY(2) = 2
case ("FOCK-PARTITION-LOWDIAG")
NTAY(2) = 3
case ("FOCK-PARTITION-DCCORRECT-LOWDIAG")
NTAY(2) = 5
case ("DIAG-PARTITION")
NTAY(2) = 1
case ("CALCREALPROD")
TCALCREALPROD = .TRUE.
IF(.NOT. TUSEBRILLOUIN) THEN
call stop_all(this_routine, trim(w)//" will not work unless " &
& //"USEBRILLOUINTHEOREM set")
end if
case ("CALCRHOPROD")
TCALCRHOPROD = .TRUE.
case ("SUMPRODII")
TSUMPROD = .TRUE.
case ("DISCONNECTNODES")
TDISCONODES = .TRUE.
case ("HF")
THFBASIS = .true.
case ("CALCULATE")
THFCALC = .true.
case ("MAXITERATIONS")
NHFIT = to_int(tokens%next())
case ("MIX")
HFMIX = to_realdp(tokens%next())
case ("RAND")
HFRAND = to_realdp(tokens%next())
case ("THRESHOLD")
do while (tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case ("ENERGY")
HFEDELTA = to_realdp(tokens%next())
case ("ORBITAL")
HFCDELTA = to_realdp(tokens%next())
case default
call stop_all(this_routine, trim(w)//" not valid THRESHOLD" &
& //"OPTION. Specify ENERGY or ORBITAL convergence" &
& //" threshold.")
end select
end do
case ("RHF")
TRHF = .true.
case ("UHF")
TRHF = .false.
case ("HFMETHOD")
w = to_upper(tokens%next())
select case(w)
case ("DESCENT")
w = to_upper(tokens%next())
select case(w)
case ("OTHER")
IHFMETHOD = 2
case ("SINGLES")
IHFMETHOD = 1
case default
call stop_all(this_routine, trim(w)//" not valid DESCENT" &
& //" option")
end select
case ("STANDARD")
IHFMETHOD = 0
case ("MODIFIED")
IHFMETHOD = 3
case default
call stop_all(this_routine, trim(w)//" not valid HF method")
end select
case ("READ")
do while (tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case ("MATRIX")
TREADTUMAT = .true.
case ("BASIS")
TREADHF = .true.
case default
call stop_all(this_routine, trim(w)//" is an invalid HF read option.")
end select
end do
case ("FREEZE")
NFROZEN = to_int(tokens%next())
NTFROZEN = to_int(tokens%next())
if(mod(NFROZEN, 2) /= 0 .or. &
& (NTFROZEN > 0 .and. mod(NTFROZEN, 2) /= 0)) then
call stop_all(this_routine, "NFROZEN and (+ve) NTFROZEN must be multiples of 2")
end if
if( &
& (NTFROZEN < 0 .and. mod(NEL - NTFROZEN, 2) /= 0)) then
call stop_all(this_routine, "-ve NTFROZEN must be same parity as NEL")
end if
case ("FREEZEINNER")
!This option allows us to freeze orbitals 'from the inside'. This means that rather than freezing
!the lowest energy occupied orbitals, the NFROZENIN occupied (spin) orbitals with the highest energy are
!frozen, along with the NTFROZENIN lowest energy virtual (spin) orbitals.
!The main purpose of this is to select an active space and calculate the energy of the orbitals NOT in this
!active space.
NFROZENIN = to_int(tokens%next())
NTFROZENIN = to_int(tokens%next())
NFROZENIN = ABS(NFROZENIN)
NTFROZENIN = ABS(NTFROZENIN)
if((mod(NFROZENIN, 2) /= 0) .or. (mod(NTFROZENIN, 2) /= 0)) then
call stop_all(this_routine, "NFROZENIN and NTFROZENIN must be multiples of 2")
end if
case ("PARTIALLYFREEZE")
!This option chooses a set of NPartFrozen SPIN orbitals as a core, and partially freezes the electrons
!in these orbitals so that no more than NHolesFrozen holes may exist in this core at a time.
!In practice, a walker attempts to spawn on a determinant - if this determinant has more than the
!allowed number of holes in the partially frozen core, the spawning is forbidden.
tPartFreezeCore = .true.
NPartFrozen = to_int(tokens%next())
NHolesFrozen = to_int(tokens%next())
case ("PARTIALLYFREEZEVIRT")
!This option works very similarly to the one above. The integers following this keyword refer firstly to the number
!of *spin* orbitals that are frozen from the highest energy virtual orbitals down. The second integer refers to the
!number of electrons that are allowed to occupy these 'partially frozen' virtual orbitals. I.e. NElVirtFrozen = 1,
!means that spawning is accepted if is to a determinant that only has one or less of the partially frozen virtual
!orbitals occupied. Any more than this, and the spawning is rejected.
tPartFreezeVirt = .true.
NVirtPartFrozen = to_int(tokens%next())
NElVirtFrozen = to_int(tokens%next())
case ("ORDER")
I = 1
do while (tokens%remaining_items() > 0)
ORBORDER2(I) = to_realdp(tokens%next())
I = I + 1
end do
DO I = 1, 8
! two ways of specifying open orbitals
! if orborder2(I,1) is integral, then if it's odd, we have a single
! open orbital
IF(abs(ORBORDER2(I) - INT(ORBORDER2(I))) < 1.0e-12_dp) THEN
ORBORDER(I, 1) = IAND(INT(ORBORDER2(I)), 65534)
IF((INT(ORBORDER2(I)) - ORBORDER(I, 1)) > 0) THEN
! we have an open orbital
ORBORDER(I, 2) = 2
ELSE
ORBORDER(I, 2) = 0
end if
ELSE
! non-integral. The integral part is the number of closed oribtals,
! and the fractional*1000 is the number of open orbitals.
! e.g. 6.002 would mean 6 closed and 2 open
! which would have orborder(I,1)=6, orborder(I,2)=4
! but say 5.002 would be meaningless as the integral part must be a
! multiple of 2
ORBORDER(I, 1) = INT(ORBORDER2(I) + 0.000001_dp)
ORBORDER(I, 2) = INT((ORBORDER2(I) - ORBORDER(I, 1) + &
& 0.000001_dp) * 1000) * 2
end if
end do
case ("UMATCACHE")
w = to_upper(tokens%next())
select case(w)
case ("SLOTS")
NSLOTSINIT = to_int(tokens%next())
case ("MB")
NMEMINIT = to_int(tokens%next())
if(nMemInit == 0) then
! Not using the cache...
nSlotsInit = 0
else
nSlotsInit = 1
end if
case ("READ")
tReadInCache = .true.
case ("DUMP")
if(iDumpCacheFlag == 0) iDumpCacheFlag = 1
case ("FORCE")
iDumpCacheFlag = 2
case default
call tokens%reset(-1)
NSLOTSINIT = to_int(tokens%next())
end select
case ("NOUMATCACHE")
NSLOTSINIT = -1
case ("DFMETHOD")
w = to_upper(tokens%next())
select case(w)
case ("DFOVERLAP")
iDFMethod = 1
case ("DFOVERLAP2NDORD")
iDFMethod = 2
case ("DFOVERLAP2")
iDFMethod = 3
case ("DFCOULOMB")
iDFMethod = 4
case default
call stop_all(this_routine, "keyword "//trim(w)//" not recognized in DFMETHOD block")
end select
case ("POSTFREEZEHF")
tPostFreezeHF = .true.
case("TCHINT-LIB")
t_use_tchint_lib = .true.
if (tokens%remaining_items() > 0) then
tchint_mode = to_upper(tokens%next())
else
tchint_mode = "PC"
end if
case ("NO-HASH-LMAT-CALC")
t_hash_lmat_calc = .false.
case ("RS-FACTORS")
! read the range-separated factors instead of a TCDUMP file
t_rs_factors = .true.
case ("HDF5-INTEGRALS")
! Read the 6-index integrals from an hdf5 file
tHDF5LMat = .true.
case ("SPARSE-LMAT")
! Allows for storing the 6-index integrals in a sparse format
tSparseLMat = .true.
case ("SYM-BROKEN-LMAT")
! Can be used to disable the permuational symmetry of the 6-index integrals
tSymBrokenLMat = .true.
case ("UNSYMMETRIC-INTEGRALS")
! the 6-index integrals are not symmetrized yet (has to be done
! on the fly then)
tSymBrokenLMat = .true.
case ("DMATEPSILON")
DMatEpsilon = to_realdp(tokens%next())
case ("LMATCALC")
if(tSymBrokenLMat .or. t12FoldSym) then
call stop_all(this_routine, "LMATCALC assumes 48-fold symmetry")
end if
tLMatCalc = .true.
if(tokens%remaining_items() > 0) lMatCalcHFactor = to_realsp(tokens%next())
case ("ENDINT")
exit integral
case default
call stop_all(this_routine, "keyword "//trim(w)//" not recognized in integral block")
end select
end do integral
END SUBROUTINE IntReadInput