subroutine inpgetmethod(tokens, I_HMAX, NWHTAY, I_V)
use constants
use fortran_strings, only: to_upper, to_lower, to_int, to_realdp
use CalcData, only: calcp_sub2vstar, calcp_logWeight, tMCDirectSum, &
g_multiweight, g_vmc_fac, tMPTheory, StarProd, &
tDiagNodes, tStarStars, tGraphMorph, tStarTrips, &
tHDiag, tMCStar, tFCIMC, tMCDets, tRhoElems, &
tReturnPathMC, tUseProcsAsNodes, tRPA_QBA, &
tDetermProj, tFTLM, TSpecLanc, tContTimeFCIMC, &
tExactSpec, tExactDiagAllSym
use RPA_Mod, only: tDirectRPA
use LoggingData, only: tCalcFCIMCPsi
use input_parser_mod, only: TokenIterator_t
use util_mod, only: stop_all
implicit none
integer I_HMAX, NWHTAY, I_V
type(TokenIterator_t), intent(inout) :: tokens
character(*), parameter :: this_routine = 'inpgetmethod'
CHARACTER(LEN=16) w
do while(tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case("VERTEX")
w = to_upper(tokens%next())
select case(w)
case("FCIMC")
I_HMAX = -21
TFCIMC = .true.
tUseProcsAsNodes = .true.
do while(tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case("CONT-TIME")
tContTimeFCIMC = .true.
case("MCDIFFUSION")
! TMCDiffusion=.true.
CALL Stop_All("inpgetmethod", "MCDIFFUSION option deprecated")
case("RESUMFCIMC")
! TResumFCIMC=.true.
CALL Stop_All("inpgetmethod", "MCDIFFUSION option deprecated")
case default
call stop_all(this_routine, "Keyword error with "//trim(w))
endselect
end do
case("RPA")
tRPA_QBA = .true.
tDirectRPA = .false.
do while(tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case("DIRECT")
tDirectRPA = .true.
endselect
end do
case("RETURNPATHMC")
I_HMAX = -21
TReturnPathMC = .true.
w = to_upper(tokens%next())
select case(w)
case("RHOELEMS")
TRhoElems = .true.
endselect
case("MCDets")
I_HMAX = -21
TMCDets = .true.
case("SUM")
do while(tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case("OLD")
I_HMAX = -1
case("NEW")
I_HMAX = -8
case("HDIAG")
I_HMAX = -20
case("READ")
I_HMAX = -14
case("SUB2VSTAR")
CALCP_SUB2VSTAR = .TRUE.
case("LOGWEIGHT")
CALCP_LOGWEIGHT = .TRUE.
case default
call stop_all(this_routine, "Error - must specify OLD or NEW vertex sum method")
end select
end do
case("MC", "MCMETROPOLIS")
I_HMAX = -7
w = to_upper(tokens%next())
select case(w)
case("HDIAG")
I_HMAX = -19
end select
tMCDirectSum = .FALSE.
IF(I_V > 0) g_MultiWeight(I_V) = 1.0_dp
case("MCDIRECT")
I_HMAX = -7
tMCDirectSum = .TRUE.
w = to_upper(tokens%next())
select case(w)
case("HDIAG")
I_HMAX = -19
end select
G_VMC_FAC = 0.0_dp
case("MCMP")
tMCDirectSum = .TRUE.
I_HMAX = -19
G_VMC_FAC = 0.0_dp
TMPTHEORY = .TRUE.
case("GRAPHMORPH")
TGraphMorph = .true.
I_HMAX = -21
w = to_upper(tokens%next())
select case(w)
case("HDIAG")
!If this is true, then it uses the hamiltonian matrix to determinant coupling to excitations,
!and to diagonalise to calculate the energy
THDiag = .true.
endselect
case("STAR")
I_HMAX = 0
do while(tokens%remaining_items() > 0)
w = to_upper(tokens%next())
select case(w)
case("NEW")
I_HMAX = -21
case("OLD")
I_HMAX = -9
case("NODAL")
TDIAGNODES = .TRUE.
case("STARSTARS")
TSTARSTARS = .true.
case("MCSTAR")
NWHTAY = IBSET(NWHTAY, 0)
TMCSTAR = .true.
case("STARPROD")
STARPROD = .TRUE.
case("TRIPLES")
TStarTrips = .TRUE.
case("COUNTEXCITS")
NWHTAY = IBSET(NWHTAY, 8)
case("ADDSINGLES")
NWHTAY = IBSET(NWHTAY, 7)
IF(I_HMAX /= -21) call stop_all(this_routine, &
& "Error - cannot use ADDSINGLES" &
& //" without STAR NEW")
case("DIAG")
NWHTAY = IBCLR(NWHTAY, 0)
case("POLY")
NWHTAY = IBSET(NWHTAY, 0)
case("POLYMAX")
NWHTAY = IBSET(NWHTAY, 0)
NWHTAY = IBSET(NWHTAY, 1)
case("POLYCONVERGE")
NWHTAY = IBSET(NWHTAY, 0)
NWHTAY = IBSET(NWHTAY, 2)
case("POLYCONVERGE2")
NWHTAY = IBSET(NWHTAY, 0)
NWHTAY = IBSET(NWHTAY, 6)
case("H0")
NWHTAY = IBSET(NWHTAY, 5)
if(I_HMAX /= -21) call stop_all(this_routine, "H0 " &
& //"can only be specified with POLY... NEW")
case default
call stop_all(this_routine, "Error - must specify DIAG" &
& //" or POLY vertex star method")
end select
end do
! IF(TSTARSTARS.and..not.BTEST(NWHTAY,0)) THEN
! call stop_all(this_routine, "STARSTARS must be used with " &
! & //"a poly option")
! end if
IF(STARPROD .and. BTEST(NWHTAY, 0)) THEN
call stop_all(this_routine, "STARPROD can only be " &
& //"specified with DIAG option")
end if
if(i_hmax == 0) &
& call stop_all(this_routine, "OLD/NEW not specified for STAR")
case("DETERM-PROJ")
tDetermProj = .true.
I_HMAX = -21
TFCIMC = .true.
tUseProcsAsNodes = .true.
case("FTLM")
tFTLM = .true.
I_HMAX = -21
TFCIMC = .true.
tUseProcsAsNodes = .true.
case("EXACT-SPECTRUM")
tExactSpec = .true.
I_HMAX = -21
TFCIMC = .true.
tUseProcsAsNodes = .true.
case("EXACT-DIAG")
tExactDiagAllSym = .true.
I_HMAX = -21
TFCIMC = .true.
tUseProcsAsNodes = .true.
case("SPECTRAL-LANCZOS")
tSpecLanc = .true.
I_HMAX = -21
TFCIMC = .true.
tUseProcsAsNodes = .true.
case default
call stop_all(this_routine, "Keyword error with "//trim(w))
end select
case default
call stop_all(this_routine, "Error. Method not specified." &
& //" Stopping.")
end select
end do
end subroutine inpgetmethod