"""
Fortran module PyInterface:Containing the methods to start the MPS simulations.
**Authors**
* D. Jaschke
* M. L. Wall
**Details**
The following subroutines / functions are defined for the
convergence parameters.
"""
[docs]def runmps():
"""
fortran-subroutine - August 2017 (dj, update)
Run a MPS simulation for a single parameter set.
**Arguments**
infile : CHARACTER(132), OPTIONAL, in
name for the file `*Main.nml` containing the settings for the
simulation. If not given, the first argument from the command
line will be taken as filename fo `*Main.nlm`.
qtid : INTEGER, OPTIONAL, in
id for sampling over different realization of the same simulation,
e.g. for quantum trajectories. If infile is present, qtid must be
present. If infile is read as command line argument, qtid is read
as command line argument.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine runmps(infile, qtid)
use ioops, only : qnumunit, settingsunit, cpunit
character(len=132), intent(in), optional :: infile
integer, intent(in), optional :: qtid
! Local variables
! ---------------
! system size
integer :: ll
! number of excited states
integer :: ne
! total number of conserved quantities
integer :: snqs
! Number of U(1) and Z2 symmetries
integer :: nqns, npns
! distinguish cases for statics and dynamics
integer :: case_statics, case_dynamics
! logical if input state will be provided
logical :: wait4state!, state_exists
! flag for the log file
logical :: logfile
! logicals to indicate which simulations are executed
logical :: domps, doemps, dodynamics
! flag for real (false) or complex (true) operators
logical :: cmplx_op
! flag if time evolution should be picked up at the last point
logical :: timeevo_restore
! Flag for MPDO+ simulations
logical :: mpdoplus
! Flag for using HDF5 file format
logical :: use_h5
! temporary string to save number of excited states
!character(len=3) :: str3
! temporary string to read second command line argument qtid and copy
character(len=16) :: qtidstr
integer :: qtid_
! type of the simulation
character :: simtype
! name of the nml file with the basic setting
character(len=132) :: nmlname
! the name of the job and the unique ID
character(len=132) :: job_id, unique_id
! Keeping track of filenames
character(len=132) :: statics_initial, timeevo_mps_initial, &
timeevo_mpdo_initial
! directories
character(len=132) :: writedir, outdir
! combine ID and unique ID / filename for mpo
character(len=264) :: concat_id
! hash for results of statics
character(len=50) :: paramhash
! for building string specifiers
character(16) :: iwstring, specstring
! handling i/o
type(IOObject) :: IOObj
! Probe convergence parameters to get tensor network type etc
type(ConvParam), dimension(:), allocatable :: Cps
! quantum numbers
integer, dimension(:), allocatable :: qs
! error status
integer :: errst
! flag if MPDO+ should be used or not
!logical :: mpdoplus
! External function
real(KIND=rKind), external :: dlamch
namelist /SystemSettings/ job_ID, unique_ID, writedir, outdir, &
nqns, npns, ll, ne, verbose, domps, doemps, dodynamics, &
mpdoplus, simtype, cmplx_op, paramhash, wait4state, &
statics_initial, timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, logfile, use_h5
!errst = 0
! Read all parameters in /SystemSettings/ written in the file *Main.nml
! ---------------------------------------------------------------------
if(present(infile)) then
nmlname = infile
qtid_ = qtid
else
! f2003
call get_command_argument(1, nmlname)
call get_command_argument(2, qtidstr)
read(qtidstr, *) qtid_
end if
if(qtid_ /= 0) then
write(qtidstr, '(I9.9)') qtid_
nmlname = nmlname(:len(trim(nmlname)) - 4)//'_qt'//trim(qtidstr)//'.nml'
end if
! Read parameters in nml file
open(settingsunit, file=trim(adjustl(nmlName)))
read(settingsunit, SystemSettings)
close(settingsunit)
call create_IOObject(IOObj, writedir, outdir, job_id, unique_id, qtid_)
concat_id = trim(adjustl(job_id))//trim(adjustl(unique_id))
! Open the logfile (could implement switch and redirect to stdout later)
if(logfile) then
slog = 22
open(unit=slog, file=trim(outdir)//trim(job_id)//trim(unique_id)//&
trim(adjustl(IOObj%qtidstr))//'.log', &
status='replace', action='write')
else
! Redirect output to standard out (standard out should be on
! unit 6 for most fortran compilers).
slog = 6
end if
write(slog, *) 'running with', nqns, npns, max(4 * (nqns + npns), 1)
! Set numerical zero
numzero = dlamch('E')
! Reset random number seed if QT
if(qtid_ /= 0) then
call seed_init(qtid=qtid_)
else
call seed_init()
end if
! Wait for state logical for QT
! Set wait4state logical
if(len(trim(IOObj%qtidstr)) > 0 .and. &
IOObj%qtidstr /= '_qt000000001') then
wait4state = .true.
end if
if(verbose > 1) then
write(slog, *) 'input parameters:'
write(slog, NML=SystemSettings)
end if
! Set cases for finite systems
if(domps .and. simtype == 'F') then
! Variational search
call read(Cps, IOObj%convname, unit=cpunit)
if(Cps(1)%tn_type /= 'R') then
! ground and excited states
case_statics = 0
else
! OQS steady state search
case_statics = 3
end if
deallocate(Cps)
elseif(simtype == 'T') then
! Finite-T
case_statics = 1
else
! Assume we read from file
case_statics = 2
end if
if(.not. dodynamics) then
case_dynamics = 0
else
! Probe convergence parameters of first quench
call read(Cps, io_get_tconv(IOObj, 1), unit=cpunit)
if(Cps(1)%tn_type == 'D') case_dynamics = -1
if(Cps(1)%tn_type == 'M') case_dynamics = 1
if(Cps(1)%tn_type == 'Q') case_dynamics = 2
if(Cps(1)%tn_type == 'R') case_dynamics = 3
if(Cps(1)%tn_type == 'L') case_dynamics = 4
deallocate(Cps)
end if
if(nqns + npns > 0) then
! Simulations with quantum numbers
! --------------------------------
snqs = nqns + npns
! 4 for rank-4 tensor
! 2 for OQS doubling quantum numbers
call setupprimeroots(max(4 * 2 * (snqs), 1))
! Read in the total quantum numbers
open(unit=qnumunit, file=IOObj%qname, action='read')
write(iwstring, '(I4)') snqs
specString = "("//trim(adjustl(iwstring))//"I16)"
allocate(qs(snqs))
read(qnumunit, specstring) qs
close(qnumunit)
if(simtype == 'I') then
write(slog, *) 'Infinite-size simulations with '//&
'quantum numbers not yet supported!'
stop 237
elseif(mpdoplus) then
write(slog, *) 'MPDO+ (real time) with quantum numbers '//&
'not yet supported!'
stop 237
elseif(cmplx_op) then
! Number conservation and complex operators
call simulation_qmpoc(ll, ne, wait4state, &
[nqns, npns], qs, IOObj, case_statics, &
case_dynamics, doemps, paramhash, statics_initial, &
timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst=errst)
!if(prop_error('runMPS: simulation_qmpoc.', &
! 'PyInterface_include.f90:272', errst=errst)) return
else
! Number conservation and real operators
call simulation_qmpo(ll, ne, wait4state, &
[nqns, npns], qs, IOObj, case_statics, &
case_dynamics, doemps, paramhash, statics_initial, &
timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst=errst)
!if(prop_error('runMPS: simulation_qmpo.', &
! 'PyInterface_include.f90:282', errst=errst)) return
end if
call cleanup_qtensors()
deallocate(qs)
open(unit=qnumunit, file=IOObj%qname, action='read')
close(qnumunit, status='DELETE')
else
! Simulations without quantum numbers
! -----------------------------------
! Avoid unitialized variables
!allocate(qs(1))
!qs = -1
if((simtype == 'I') .and. cmplx_op) then
call infinitesimulation_mpoc(ll, [nqns, npns], IOObj, &
errst=errst)
!if(prop_error('runMPS: infinitesimulation_mpoc '//&
! 'failed.', 'PyInterface_include.f90:303', errst=errst)) return
elseif(simtype == 'I') then
call infinitesimulation_mpo(ll, [nqns, npns], IOObj, &
errst=errst)
!if(prop_error('runMPS: infinitesimulation_mpo '//&
! 'failed.', 'PyInterface_include.f90:309', errst=errst)) return
elseif(cmplx_op) then
call simulation_mpoc(ll, ne, wait4state, &
[nqns, npns], qs, IOObj, case_statics, &
case_dynamics, doemps, paramhash, statics_initial, &
timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst=errst)
!if(prop_error('runMPS: simulation_mpoc.', &
! 'PyInterface_include.f90:318', errst=errst)) return
else
call simulation_mpo(ll, ne, wait4state, &
[nqns, npns], qs, IOObj, case_statics, &
case_dynamics, doemps, paramhash, statics_initial, &
timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst=errst)
!if(prop_error('runMPS: simulation_mpo.', &
! 'PyInterface_include.f90:327', errst=errst)) return
end if
!deallocate(qs)
end if
open(settingsunit, file=trim(adjustl(nmlname)))
close(settingsunit, status='DELETE')
! Close log file if not redirected to stdout
if(slog == 22) then
close(slog)
end if
end subroutine runmps
"""
return
[docs]def simulation_mpo():
"""
fortran-subroutine - August 2017 (dj, updated)
Run a simulation with the corresponding type of MPO, i.e., mpo.
**Arguments**
ll : INTEGER, in
number of sites in the system
ne : INTEGER, in
number of excited states which should be found during the
algorithm.
wait4state : LOGICAL, in
Is set to True for dynamics if several simulations start with the
same initial state and those should not be calculated multiple times.
qs : INTEGER(*), inout
The quantum numbers for all symmetries.
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
case_statics : INTEGER, in
The following cases are considered: 0 for variational statics,
1 for finite T evolutions, 2 for reading states.
case_dynamics : INTEGER, in
No dynamics corresponds to 0, closed system dynamics to 1,
closed system dynamics with QT to 2, LPTN to 3, MPDO to 4.
statics_initial : CHARACTER(132), in
Filename for initial guess for statics (ground state). Can
replace random guess without symmetry or symmetric guess
with quantum numbers.
timeevo_mps_initial : CHARACTER(132), in
Filename for initial states represented as MPS.
timeevo_mpdo_initial : CHARACTER(132), in
Filename for initial states represented as MPDO.
**Details**
Fortran checks if a ground state with equivalent settings is
already present. The equivalent settings include all parameters which affect
the ground state (system size, convergence parameter, Hamiltonian, ...), but
not the measurements. The measurements are not carried out in the cases where
a saved state is found. This is meant primarly to speed-up real-time
evolutions from the same initial state.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine simulation_mpo(ll, ne, wait4state, nqs, qs, &
IOObj, case_statics, case_dynamics, do_emps, paramhash, &
statics_initial, timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst)
use ioops, only : mpounit, opsunit, hparamsunit, psiunit, cpunit
integer, intent(in) :: ll, ne
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
integer, intent(in) :: case_statics
integer, intent(inout) :: case_dynamics
logical, intent(in) :: do_emps
character(len=50), intent(in) :: paramhash
character(len=132), intent(in) :: statics_initial, &
timeevo_mps_initial, &
timeevo_mpdo_initial
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! position of the identity operator
integer :: iop
! logical to track if initial pure state has been set
logical :: psi0set
! for measuring time
real(KIND=rKind) :: tick, tock, totaltime
! Ground and excited states
type(mps), pointer :: Psi(:)
! Initial state for time evolution
type(mpsc) :: Psi0
type(mpdoc) :: Rho0
type(lptnc) :: XX0
! LPTN for statics
type(lptn) :: XX
! MPDO for statics
type(mpdo) :: Rho
! MPDO for steady state
type(mpdoc), pointer :: Steady(:)
! Hamiltonian as MPO
type(mpo) :: Ham
! List of all operators
type(tensorlist) :: OpABC
! Mapping from symmetries to non-symmetry
type(imap) :: Imapper
! Rule set to build Hamiltonian
type(MPORuleSet) :: Rs
! parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! logical for checking on open quantum system
logical :: is_oqs
! Character for storing type of MPS file (binary or human readable)
character :: read_flag
! For splitting links correctly in MPDOs
type(splitlink) :: Sl
! Probe network type for FiniteT evolutions
type(ConvParam), dimension(:), allocatable :: Cps
psi0set = .false.
! Initial CPU time
call cpu_time(tick)
call ReadOperators(OpABC, iop, IOObj%opsname, opsunit, Imapper, nqs)
! Read rule set
open(unit=mpounit, file=IOObj%mponame, action='read', status='old')
call read(Rs, mpounit)
close(mpounit)
call read(Hparams, IOObj%hparamsname, hparamsunit)
call ruleset_to_ham_mpo(Ham, Rs, ll, OpABC, Hparams, iop, errst=errst)
!if(prop_error('simulation_mpo: ruleset_to_ham failed.', &
! 'PyInterface_include.f90:537', errst=errst)) return
if(case_statics == 0) then
! Ground and excited states as MPS
! --------------------------------
allocate(Psi(ne + 1))
call static_simulation_mps_mpo(Psi, Ham, Hparams, Rs, OpABC, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, &
do_emps, paramhash, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpo: static_simulation_mps.', &
! 'PyInterface_include.f90:548', errst=errst)) return
if(case_dynamics /= 0) then
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_mpo: copy (1) failed.', &
! 'PyInterface_include.f90:553', errst=errst)) return
psi0set = .true.
end if
do ii = 1, (ne + 1)
call destroy(Psi(ii))
end do
deallocate(Psi)
elseif(case_statics == 1) then
! Finite-T simulations / imaginary time as MPDO or LPTN
! -----------------------------------------------------
call read(Cps, io_get_ftconv(IOObj, 1), unit=cpunit)
if((Cps(1)%tn_type == 'D') .or. (Cps(1)%tn_type == 'R')) then
! Finite T with MPDOs
! -------------------
call load_infiniteT(Rho, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_mpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:574', errst=errst)) return
call finiteT(Rho, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:579', errst=errst)) return
elseif(Cps(1)%tn_type == 'L') then
! Finite T with LPTN
! ------------------
call load_infiniteT(XX, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_mpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:587', errst=errst)) return
call finiteT(XX, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:592', errst=errst)) return
else
stop 'Wrong network flag for Finite T'
end if
deallocate(Cps)
elseif(case_statics == 2) then
! No static MPS simulation (ground/excited state)
! -----------------------------------------------
if(len(trim(timeevo_mps_initial)) /= 0) then
! Read the MPS in file as initial state
! .....................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mps_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mps_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
allocate(Psi(1))
call read(Psi(1), timeevo_mps_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPS for time evolution
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_mpo: copy failed.', &
! 'PyInterface_include.f90:641', errst=errst)) return
psi0set = .true.
end if
call destroy(Psi(1))
deallocate(Psi)
elseif(len(trim(timeevo_mpdo_initial)) /= 0) then
! Read the MPDP in file as initial state
! ......................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mpdo_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mpdo_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
call read(Rho, timeevo_mpdo_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPDO for time evolution
call copy(Rho0, Rho, errst=errst)
!if(prop_error('simulation_mpo: copy failed.', &
! 'PyInterface_include.f90:669', errst=errst)) return
end if
call destroy(Rho)
elseif(case_dynamics /= 0) then
errst = raise_error("simulation_mpo: No initial "//&
"state for dynamics!", 99, errst=errst)
return
end if
elseif(case_statics == 3) then
! Variational steady state search OQS
! -----------------------------------
allocate(Steady(ne + 1))
call static_simulation_mpdo_mpo(Steady, Ham, Hparams, &
Rs, OpABC, ll, ne, iop, statics_initial, wait4state, &
nqs, qs, IOObj, do_emps, paramhash, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_mpo: static_simulation_mps.', &
! 'PyInterface_include.f90:689', errst=errst)) return
if(case_dynamics /= 0) then
errst = raise_error('simulation_mpo: cannot do '//&
'dynamics after OQS steady state.', 99, &
'PyInterface_include.f90:694', errst=errst)
return
end if
do ii = 1, (ne + 1)
call destroy(Steady(ii))
end do
deallocate(Steady)
end if
is_oqs = has_lindblads(Rs)
if(is_oqs .and. (case_dynamics == -1)) then
case_dynamics = 3
elseif(case_dynamics == -1) then
case_dynamics = 1
end if
select case(case_dynamics)
case(1)
! Evolve with MPS
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpo: dynamics_mps '//&
! '(1) failed', 'PyInterface_include.f90:718', &
! errst=errst)) return
case(2)
! Evolve with MPS and quantum trajectories
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
qtid=IOObj%qtidstr, errst=errst)
!if(prop_error('simulation_mpo: dynamics_mps '//&
! '(2) failed', 'PyInterface_include.f90:726', &
! errst=errst)) return
case(3)
! Evolve with MPDOs
if(psi0set) then
call create(Sl, OpABC%Li(iop))
call copy(Rho0, Psi0, Sl)
call destroy(Sl)
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_mpo: dynamics_mpdo '//&
! ' (1) failed.', 'PyInterface_include.f90:739', &
! errst=errst)) return
else
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_mpo: dynamics_mpdo '//&
! ' (2) failed.', 'PyInterface_include.f90:746', &
! errst=errst)) return
end if
case(4)
! Evolve with LPTN
if(psi0set) then
call copy(XX0, Psi0)
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_mpo : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:758', errst=errst)) return
else
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_mpo : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:764', errst=errst)) return
end if
case(0)
! No dynamics
case default
! Wrong case_dynamics
errst = raise_error('simulation_mpo : case_dynamics '//&
'not valid.', 99, errst=errst)
end select
call destroy(Hparams, IOObj%hparamsname, hparamsunit, clearfile=.true.)
call destroy(Rs)
call destroy(Ham)
call destroy(OpABC)
call destroy(Imapper)
call delete_file(IOObj%opsname, opsunit)
call delete_file(IOObj%mponame, mpounit)
! Print out time
call cpu_time(tock)
totaltime = tock - tick
if(verbose > 0) then
write(slog, *) 'time taken:', totalTime, ' seconds!'
end if
end subroutine simulation_mpo
"""
return
[docs]def simulation_mpoc():
"""
fortran-subroutine - August 2017 (dj, updated)
Run a simulation with the corresponding type of MPO, i.e., mpoc.
**Arguments**
ll : INTEGER, in
number of sites in the system
ne : INTEGER, in
number of excited states which should be found during the
algorithm.
wait4state : LOGICAL, in
Is set to True for dynamics if several simulations start with the
same initial state and those should not be calculated multiple times.
qs : INTEGER(*), inout
The quantum numbers for all symmetries.
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
case_statics : INTEGER, in
The following cases are considered: 0 for variational statics,
1 for finite T evolutions, 2 for reading states.
case_dynamics : INTEGER, in
No dynamics corresponds to 0, closed system dynamics to 1,
closed system dynamics with QT to 2, LPTN to 3, MPDO to 4.
statics_initial : CHARACTER(132), in
Filename for initial guess for statics (ground state). Can
replace random guess without symmetry or symmetric guess
with quantum numbers.
timeevo_mps_initial : CHARACTER(132), in
Filename for initial states represented as MPS.
timeevo_mpdo_initial : CHARACTER(132), in
Filename for initial states represented as MPDO.
**Details**
Fortran checks if a ground state with equivalent settings is
already present. The equivalent settings include all parameters which affect
the ground state (system size, convergence parameter, Hamiltonian, ...), but
not the measurements. The measurements are not carried out in the cases where
a saved state is found. This is meant primarly to speed-up real-time
evolutions from the same initial state.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine simulation_mpoc(ll, ne, wait4state, nqs, qs, &
IOObj, case_statics, case_dynamics, do_emps, paramhash, &
statics_initial, timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst)
use ioops, only : mpounit, opsunit, hparamsunit, psiunit, cpunit
integer, intent(in) :: ll, ne
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
integer, intent(in) :: case_statics
integer, intent(inout) :: case_dynamics
logical, intent(in) :: do_emps
character(len=50), intent(in) :: paramhash
character(len=132), intent(in) :: statics_initial, &
timeevo_mps_initial, &
timeevo_mpdo_initial
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! position of the identity operator
integer :: iop
! logical to track if initial pure state has been set
logical :: psi0set
! for measuring time
real(KIND=rKind) :: tick, tock, totaltime
! Ground and excited states
type(mpsc), pointer :: Psi(:)
! Initial state for time evolution
type(mpsc) :: Psi0
type(mpdoc) :: Rho0
type(lptnc) :: XX0
! LPTN for statics
type(lptnc) :: XX
! MPDO for statics
type(mpdoc) :: Rho
! MPDO for steady state
type(mpdoc), pointer :: Steady(:)
! Hamiltonian as MPO
type(mpoc) :: Ham
! List of all operators
type(tensorlistc) :: OpABC
! Mapping from symmetries to non-symmetry
type(imap) :: Imapper
! Rule set to build Hamiltonian
type(MPORuleSet) :: Rs
! parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! logical for checking on open quantum system
logical :: is_oqs
! Character for storing type of MPS file (binary or human readable)
character :: read_flag
! For splitting links correctly in MPDOs
type(splitlink) :: Sl
! Probe network type for FiniteT evolutions
type(ConvParam), dimension(:), allocatable :: Cps
psi0set = .false.
! Initial CPU time
call cpu_time(tick)
call ReadOperators(OpABC, iop, IOObj%opsname, opsunit, Imapper, nqs)
! Read rule set
open(unit=mpounit, file=IOObj%mponame, action='read', status='old')
call read(Rs, mpounit)
close(mpounit)
call read(Hparams, IOObj%hparamsname, hparamsunit)
call ruleset_to_ham_mpo(Ham, Rs, ll, OpABC, Hparams, iop, errst=errst)
!if(prop_error('simulation_mpoc: ruleset_to_ham failed.', &
! 'PyInterface_include.f90:537', errst=errst)) return
if(case_statics == 0) then
! Ground and excited states as MPS
! --------------------------------
allocate(Psi(ne + 1))
call static_simulation_mps_mpoc(Psi, Ham, Hparams, Rs, OpABC, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, &
do_emps, paramhash, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpoc: static_simulation_mps.', &
! 'PyInterface_include.f90:548', errst=errst)) return
if(case_dynamics /= 0) then
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_mpoc: copy (1) failed.', &
! 'PyInterface_include.f90:553', errst=errst)) return
psi0set = .true.
end if
do ii = 1, (ne + 1)
call destroy(Psi(ii))
end do
deallocate(Psi)
elseif(case_statics == 1) then
! Finite-T simulations / imaginary time as MPDO or LPTN
! -----------------------------------------------------
call read(Cps, io_get_ftconv(IOObj, 1), unit=cpunit)
if((Cps(1)%tn_type == 'D') .or. (Cps(1)%tn_type == 'R')) then
! Finite T with MPDOs
! -------------------
call load_infiniteT(Rho, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_mpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:574', errst=errst)) return
call finiteT(Rho, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:579', errst=errst)) return
elseif(Cps(1)%tn_type == 'L') then
! Finite T with LPTN
! ------------------
call load_infiniteT(XX, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_mpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:587', errst=errst)) return
call finiteT(XX, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:592', errst=errst)) return
else
stop 'Wrong network flag for Finite T'
end if
deallocate(Cps)
elseif(case_statics == 2) then
! No static MPS simulation (ground/excited state)
! -----------------------------------------------
if(len(trim(timeevo_mps_initial)) /= 0) then
! Read the MPS in file as initial state
! .....................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mps_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mps_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
allocate(Psi(1))
call read(Psi(1), timeevo_mps_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPS for time evolution
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_mpoc: copy failed.', &
! 'PyInterface_include.f90:641', errst=errst)) return
psi0set = .true.
end if
call destroy(Psi(1))
deallocate(Psi)
elseif(len(trim(timeevo_mpdo_initial)) /= 0) then
! Read the MPDP in file as initial state
! ......................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mpdo_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mpdo_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
call read(Rho, timeevo_mpdo_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPDO for time evolution
call copy(Rho0, Rho, errst=errst)
!if(prop_error('simulation_mpoc: copy failed.', &
! 'PyInterface_include.f90:669', errst=errst)) return
end if
call destroy(Rho)
elseif(case_dynamics /= 0) then
errst = raise_error("simulation_mpoc: No initial "//&
"state for dynamics!", 99, errst=errst)
return
end if
elseif(case_statics == 3) then
! Variational steady state search OQS
! -----------------------------------
allocate(Steady(ne + 1))
call static_simulation_mpdo_mpoc(Steady, Ham, Hparams, &
Rs, OpABC, ll, ne, iop, statics_initial, wait4state, &
nqs, qs, IOObj, do_emps, paramhash, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_mpoc: static_simulation_mps.', &
! 'PyInterface_include.f90:689', errst=errst)) return
if(case_dynamics /= 0) then
errst = raise_error('simulation_mpoc: cannot do '//&
'dynamics after OQS steady state.', 99, &
'PyInterface_include.f90:694', errst=errst)
return
end if
do ii = 1, (ne + 1)
call destroy(Steady(ii))
end do
deallocate(Steady)
end if
is_oqs = has_lindblads(Rs)
if(is_oqs .and. (case_dynamics == -1)) then
case_dynamics = 3
elseif(case_dynamics == -1) then
case_dynamics = 1
end if
select case(case_dynamics)
case(1)
! Evolve with MPS
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_mpoc: dynamics_mps '//&
! '(1) failed', 'PyInterface_include.f90:718', &
! errst=errst)) return
case(2)
! Evolve with MPS and quantum trajectories
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
qtid=IOObj%qtidstr, errst=errst)
!if(prop_error('simulation_mpoc: dynamics_mps '//&
! '(2) failed', 'PyInterface_include.f90:726', &
! errst=errst)) return
case(3)
! Evolve with MPDOs
if(psi0set) then
call create(Sl, OpABC%Li(iop))
call copy(Rho0, Psi0, Sl)
call destroy(Sl)
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_mpoc: dynamics_mpdo '//&
! ' (1) failed.', 'PyInterface_include.f90:739', &
! errst=errst)) return
else
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_mpoc: dynamics_mpdo '//&
! ' (2) failed.', 'PyInterface_include.f90:746', &
! errst=errst)) return
end if
case(4)
! Evolve with LPTN
if(psi0set) then
call copy(XX0, Psi0)
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_mpoc : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:758', errst=errst)) return
else
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_mpoc : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:764', errst=errst)) return
end if
case(0)
! No dynamics
case default
! Wrong case_dynamics
errst = raise_error('simulation_mpoc : case_dynamics '//&
'not valid.', 99, errst=errst)
end select
call destroy(Hparams, IOObj%hparamsname, hparamsunit, clearfile=.true.)
call destroy(Rs)
call destroy(Ham)
call destroy(OpABC)
call destroy(Imapper)
call delete_file(IOObj%opsname, opsunit)
call delete_file(IOObj%mponame, mpounit)
! Print out time
call cpu_time(tock)
totaltime = tock - tick
if(verbose > 0) then
write(slog, *) 'time taken:', totalTime, ' seconds!'
end if
end subroutine simulation_mpoc
"""
return
[docs]def simulation_qmpo():
"""
fortran-subroutine - August 2017 (dj, updated)
Run a simulation with the corresponding type of MPO, i.e., qmpo.
**Arguments**
ll : INTEGER, in
number of sites in the system
ne : INTEGER, in
number of excited states which should be found during the
algorithm.
wait4state : LOGICAL, in
Is set to True for dynamics if several simulations start with the
same initial state and those should not be calculated multiple times.
qs : INTEGER(*), inout
The quantum numbers for all symmetries.
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
case_statics : INTEGER, in
The following cases are considered: 0 for variational statics,
1 for finite T evolutions, 2 for reading states.
case_dynamics : INTEGER, in
No dynamics corresponds to 0, closed system dynamics to 1,
closed system dynamics with QT to 2, LPTN to 3, MPDO to 4.
statics_initial : CHARACTER(132), in
Filename for initial guess for statics (ground state). Can
replace random guess without symmetry or symmetric guess
with quantum numbers.
timeevo_mps_initial : CHARACTER(132), in
Filename for initial states represented as MPS.
timeevo_mpdo_initial : CHARACTER(132), in
Filename for initial states represented as MPDO.
**Details**
Fortran checks if a ground state with equivalent settings is
already present. The equivalent settings include all parameters which affect
the ground state (system size, convergence parameter, Hamiltonian, ...), but
not the measurements. The measurements are not carried out in the cases where
a saved state is found. This is meant primarly to speed-up real-time
evolutions from the same initial state.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine simulation_qmpo(ll, ne, wait4state, nqs, qs, &
IOObj, case_statics, case_dynamics, do_emps, paramhash, &
statics_initial, timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst)
use ioops, only : mpounit, opsunit, hparamsunit, psiunit, cpunit
integer, intent(in) :: ll, ne
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
integer, intent(in) :: case_statics
integer, intent(inout) :: case_dynamics
logical, intent(in) :: do_emps
character(len=50), intent(in) :: paramhash
character(len=132), intent(in) :: statics_initial, &
timeevo_mps_initial, &
timeevo_mpdo_initial
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! position of the identity operator
integer :: iop
! logical to track if initial pure state has been set
logical :: psi0set
! for measuring time
real(KIND=rKind) :: tick, tock, totaltime
! Ground and excited states
type(qmps), pointer :: Psi(:)
! Initial state for time evolution
type(qmpsc) :: Psi0
type(qmpdoc) :: Rho0
type(qlptnc) :: XX0
! LPTN for statics
type(qlptn) :: XX
! MPDO for statics
type(qmpdo) :: Rho
! MPDO for steady state
type(qmpdoc), pointer :: Steady(:)
! Hamiltonian as MPO
type(qmpo) :: Ham
! List of all operators
type(qtensorlist) :: OpABC
! Mapping from symmetries to non-symmetry
type(imap) :: Imapper
! Rule set to build Hamiltonian
type(MPORuleSet) :: Rs
! parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! logical for checking on open quantum system
logical :: is_oqs
! Character for storing type of MPS file (binary or human readable)
character :: read_flag
! For splitting links correctly in MPDOs
type(splitlink) :: Sl
! Probe network type for FiniteT evolutions
type(ConvParam), dimension(:), allocatable :: Cps
psi0set = .false.
! Initial CPU time
call cpu_time(tick)
call ReadOperators(OpABC, iop, IOObj%opsname, opsunit, Imapper, nqs)
! Read rule set
open(unit=mpounit, file=IOObj%mponame, action='read', status='old')
call read(Rs, mpounit)
close(mpounit)
call read(Hparams, IOObj%hparamsname, hparamsunit)
call ruleset_to_ham_mpo(Ham, Rs, ll, OpABC, Hparams, iop, errst=errst)
!if(prop_error('simulation_qmpo: ruleset_to_ham failed.', &
! 'PyInterface_include.f90:537', errst=errst)) return
if(case_statics == 0) then
! Ground and excited states as MPS
! --------------------------------
allocate(Psi(ne + 1))
call static_simulation_mps_qmpo(Psi, Ham, Hparams, Rs, OpABC, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, &
do_emps, paramhash, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpo: static_simulation_mps.', &
! 'PyInterface_include.f90:548', errst=errst)) return
if(case_dynamics /= 0) then
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_qmpo: copy (1) failed.', &
! 'PyInterface_include.f90:553', errst=errst)) return
psi0set = .true.
end if
do ii = 1, (ne + 1)
call destroy(Psi(ii))
end do
deallocate(Psi)
elseif(case_statics == 1) then
! Finite-T simulations / imaginary time as MPDO or LPTN
! -----------------------------------------------------
call read(Cps, io_get_ftconv(IOObj, 1), unit=cpunit)
if((Cps(1)%tn_type == 'D') .or. (Cps(1)%tn_type == 'R')) then
! Finite T with MPDOs
! -------------------
call load_infiniteT(Rho, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_qmpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:574', errst=errst)) return
call finiteT(Rho, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:579', errst=errst)) return
elseif(Cps(1)%tn_type == 'L') then
! Finite T with LPTN
! ------------------
call load_infiniteT(XX, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_qmpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:587', errst=errst)) return
call finiteT(XX, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpo: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:592', errst=errst)) return
else
stop 'Wrong network flag for Finite T'
end if
deallocate(Cps)
elseif(case_statics == 2) then
! No static MPS simulation (ground/excited state)
! -----------------------------------------------
if(len(trim(timeevo_mps_initial)) /= 0) then
! Read the MPS in file as initial state
! .....................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mps_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mps_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
allocate(Psi(1))
call read(Psi(1), timeevo_mps_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPS for time evolution
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_qmpo: copy failed.', &
! 'PyInterface_include.f90:641', errst=errst)) return
psi0set = .true.
end if
call destroy(Psi(1))
deallocate(Psi)
elseif(len(trim(timeevo_mpdo_initial)) /= 0) then
! Read the MPDP in file as initial state
! ......................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mpdo_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mpdo_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
call read(Rho, timeevo_mpdo_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPDO for time evolution
call copy(Rho0, Rho, errst=errst)
!if(prop_error('simulation_qmpo: copy failed.', &
! 'PyInterface_include.f90:669', errst=errst)) return
end if
call destroy(Rho)
elseif(case_dynamics /= 0) then
errst = raise_error("simulation_qmpo: No initial "//&
"state for dynamics!", 99, errst=errst)
return
end if
elseif(case_statics == 3) then
! Variational steady state search OQS
! -----------------------------------
allocate(Steady(ne + 1))
call static_simulation_mpdo_qmpo(Steady, Ham, Hparams, &
Rs, OpABC, ll, ne, iop, statics_initial, wait4state, &
nqs, qs, IOObj, do_emps, paramhash, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_qmpo: static_simulation_mps.', &
! 'PyInterface_include.f90:689', errst=errst)) return
if(case_dynamics /= 0) then
errst = raise_error('simulation_qmpo: cannot do '//&
'dynamics after OQS steady state.', 99, &
'PyInterface_include.f90:694', errst=errst)
return
end if
do ii = 1, (ne + 1)
call destroy(Steady(ii))
end do
deallocate(Steady)
end if
is_oqs = has_lindblads(Rs)
if(is_oqs .and. (case_dynamics == -1)) then
case_dynamics = 3
elseif(case_dynamics == -1) then
case_dynamics = 1
end if
select case(case_dynamics)
case(1)
! Evolve with MPS
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpo: dynamics_mps '//&
! '(1) failed', 'PyInterface_include.f90:718', &
! errst=errst)) return
case(2)
! Evolve with MPS and quantum trajectories
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
qtid=IOObj%qtidstr, errst=errst)
!if(prop_error('simulation_qmpo: dynamics_mps '//&
! '(2) failed', 'PyInterface_include.f90:726', &
! errst=errst)) return
case(3)
! Evolve with MPDOs
if(psi0set) then
call create(Sl, OpABC%Li(iop))
call copy(Rho0, Psi0, Sl)
call destroy(Sl)
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_qmpo: dynamics_mpdo '//&
! ' (1) failed.', 'PyInterface_include.f90:739', &
! errst=errst)) return
else
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_qmpo: dynamics_mpdo '//&
! ' (2) failed.', 'PyInterface_include.f90:746', &
! errst=errst)) return
end if
case(4)
! Evolve with LPTN
if(psi0set) then
call copy(XX0, Psi0)
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_qmpo : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:758', errst=errst)) return
else
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_qmpo : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:764', errst=errst)) return
end if
case(0)
! No dynamics
case default
! Wrong case_dynamics
errst = raise_error('simulation_qmpo : case_dynamics '//&
'not valid.', 99, errst=errst)
end select
call destroy(Hparams, IOObj%hparamsname, hparamsunit, clearfile=.true.)
call destroy(Rs)
call destroy(Ham)
call destroy(OpABC)
call destroy(Imapper)
call delete_file(IOObj%opsname, opsunit)
call delete_file(IOObj%mponame, mpounit)
! Print out time
call cpu_time(tock)
totaltime = tock - tick
if(verbose > 0) then
write(slog, *) 'time taken:', totalTime, ' seconds!'
end if
end subroutine simulation_qmpo
"""
return
[docs]def simulation_qmpoc():
"""
fortran-subroutine - August 2017 (dj, updated)
Run a simulation with the corresponding type of MPO, i.e., qmpoc.
**Arguments**
ll : INTEGER, in
number of sites in the system
ne : INTEGER, in
number of excited states which should be found during the
algorithm.
wait4state : LOGICAL, in
Is set to True for dynamics if several simulations start with the
same initial state and those should not be calculated multiple times.
qs : INTEGER(*), inout
The quantum numbers for all symmetries.
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
case_statics : INTEGER, in
The following cases are considered: 0 for variational statics,
1 for finite T evolutions, 2 for reading states.
case_dynamics : INTEGER, in
No dynamics corresponds to 0, closed system dynamics to 1,
closed system dynamics with QT to 2, LPTN to 3, MPDO to 4.
statics_initial : CHARACTER(132), in
Filename for initial guess for statics (ground state). Can
replace random guess without symmetry or symmetric guess
with quantum numbers.
timeevo_mps_initial : CHARACTER(132), in
Filename for initial states represented as MPS.
timeevo_mpdo_initial : CHARACTER(132), in
Filename for initial states represented as MPDO.
**Details**
Fortran checks if a ground state with equivalent settings is
already present. The equivalent settings include all parameters which affect
the ground state (system size, convergence parameter, Hamiltonian, ...), but
not the measurements. The measurements are not carried out in the cases where
a saved state is found. This is meant primarly to speed-up real-time
evolutions from the same initial state.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine simulation_qmpoc(ll, ne, wait4state, nqs, qs, &
IOObj, case_statics, case_dynamics, do_emps, paramhash, &
statics_initial, timeevo_mps_initial, timeevo_mpdo_initial, &
timeevo_restore, use_h5, errst)
use ioops, only : mpounit, opsunit, hparamsunit, psiunit, cpunit
integer, intent(in) :: ll, ne
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
integer, intent(in) :: case_statics
integer, intent(inout) :: case_dynamics
logical, intent(in) :: do_emps
character(len=50), intent(in) :: paramhash
character(len=132), intent(in) :: statics_initial, &
timeevo_mps_initial, &
timeevo_mpdo_initial
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! position of the identity operator
integer :: iop
! logical to track if initial pure state has been set
logical :: psi0set
! for measuring time
real(KIND=rKind) :: tick, tock, totaltime
! Ground and excited states
type(qmpsc), pointer :: Psi(:)
! Initial state for time evolution
type(qmpsc) :: Psi0
type(qmpdoc) :: Rho0
type(qlptnc) :: XX0
! LPTN for statics
type(qlptnc) :: XX
! MPDO for statics
type(qmpdoc) :: Rho
! MPDO for steady state
type(qmpdoc), pointer :: Steady(:)
! Hamiltonian as MPO
type(qmpoc) :: Ham
! List of all operators
type(qtensorclist) :: OpABC
! Mapping from symmetries to non-symmetry
type(imap) :: Imapper
! Rule set to build Hamiltonian
type(MPORuleSet) :: Rs
! parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! logical for checking on open quantum system
logical :: is_oqs
! Character for storing type of MPS file (binary or human readable)
character :: read_flag
! For splitting links correctly in MPDOs
type(splitlink) :: Sl
! Probe network type for FiniteT evolutions
type(ConvParam), dimension(:), allocatable :: Cps
psi0set = .false.
! Initial CPU time
call cpu_time(tick)
call ReadOperators(OpABC, iop, IOObj%opsname, opsunit, Imapper, nqs)
! Read rule set
open(unit=mpounit, file=IOObj%mponame, action='read', status='old')
call read(Rs, mpounit)
close(mpounit)
call read(Hparams, IOObj%hparamsname, hparamsunit)
call ruleset_to_ham_mpo(Ham, Rs, ll, OpABC, Hparams, iop, errst=errst)
!if(prop_error('simulation_qmpoc: ruleset_to_ham failed.', &
! 'PyInterface_include.f90:537', errst=errst)) return
if(case_statics == 0) then
! Ground and excited states as MPS
! --------------------------------
allocate(Psi(ne + 1))
call static_simulation_mps_qmpoc(Psi, Ham, Hparams, Rs, OpABC, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, &
do_emps, paramhash, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpoc: static_simulation_mps.', &
! 'PyInterface_include.f90:548', errst=errst)) return
if(case_dynamics /= 0) then
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_qmpoc: copy (1) failed.', &
! 'PyInterface_include.f90:553', errst=errst)) return
psi0set = .true.
end if
do ii = 1, (ne + 1)
call destroy(Psi(ii))
end do
deallocate(Psi)
elseif(case_statics == 1) then
! Finite-T simulations / imaginary time as MPDO or LPTN
! -----------------------------------------------------
call read(Cps, io_get_ftconv(IOObj, 1), unit=cpunit)
if((Cps(1)%tn_type == 'D') .or. (Cps(1)%tn_type == 'R')) then
! Finite T with MPDOs
! -------------------
call load_infiniteT(Rho, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_qmpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:574', errst=errst)) return
call finiteT(Rho, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:579', errst=errst)) return
elseif(Cps(1)%tn_type == 'L') then
! Finite T with LPTN
! ------------------
call load_infiniteT(XX, ll, OpABC, timeevo_mpdo_initial, errst=errst)
!if(prop_error('simulation_qmpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:587', errst=errst)) return
call finiteT(XX, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpoc: static_simulation'//&
! '_mps.', 'PyInterface_include.f90:592', errst=errst)) return
else
stop 'Wrong network flag for Finite T'
end if
deallocate(Cps)
elseif(case_statics == 2) then
! No static MPS simulation (ground/excited state)
! -----------------------------------------------
if(len(trim(timeevo_mps_initial)) /= 0) then
! Read the MPS in file as initial state
! .....................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mps_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mps_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
allocate(Psi(1))
call read(Psi(1), timeevo_mps_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPS for time evolution
call copy(Psi0, Psi(1), errst=errst)
!if(prop_error('simulation_qmpoc: copy failed.', &
! 'PyInterface_include.f90:641', errst=errst)) return
psi0set = .true.
end if
call destroy(Psi(1))
deallocate(Psi)
elseif(len(trim(timeevo_mpdo_initial)) /= 0) then
! Read the MPDP in file as initial state
! ......................................
! Save end of the string in ii / set flag to not binary
ii = len(trim(timeevo_mpdo_initial))
read_flag = "H"
if(ii > 3) then
if(timeevo_mpdo_initial(ii-3:ii) == ".bin") then
read_flag = "B"
end if
end if
! read the actual file
call read(Rho, timeevo_mpdo_initial, psiunit, read_flag, &
skip=.false., errst=errst)
! Prepare dynamics
if(case_dynamics /= 0) then
! Copy to complex MPDO for time evolution
call copy(Rho0, Rho, errst=errst)
!if(prop_error('simulation_qmpoc: copy failed.', &
! 'PyInterface_include.f90:669', errst=errst)) return
end if
call destroy(Rho)
elseif(case_dynamics /= 0) then
errst = raise_error("simulation_qmpoc: No initial "//&
"state for dynamics!", 99, errst=errst)
return
end if
elseif(case_statics == 3) then
! Variational steady state search OQS
! -----------------------------------
allocate(Steady(ne + 1))
call static_simulation_mpdo_qmpoc(Steady, Ham, Hparams, &
Rs, OpABC, ll, ne, iop, statics_initial, wait4state, &
nqs, qs, IOObj, do_emps, paramhash, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_qmpoc: static_simulation_mps.', &
! 'PyInterface_include.f90:689', errst=errst)) return
if(case_dynamics /= 0) then
errst = raise_error('simulation_qmpoc: cannot do '//&
'dynamics after OQS steady state.', 99, &
'PyInterface_include.f90:694', errst=errst)
return
end if
do ii = 1, (ne + 1)
call destroy(Steady(ii))
end do
deallocate(Steady)
end if
is_oqs = has_lindblads(Rs)
if(is_oqs .and. (case_dynamics == -1)) then
case_dynamics = 3
elseif(case_dynamics == -1) then
case_dynamics = 1
end if
select case(case_dynamics)
case(1)
! Evolve with MPS
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, errst=errst)
!if(prop_error('simulation_qmpoc: dynamics_mps '//&
! '(1) failed', 'PyInterface_include.f90:718', &
! errst=errst)) return
case(2)
! Evolve with MPS and quantum trajectories
call dynamics_mps(Psi0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
qtid=IOObj%qtidstr, errst=errst)
!if(prop_error('simulation_qmpoc: dynamics_mps '//&
! '(2) failed', 'PyInterface_include.f90:726', &
! errst=errst)) return
case(3)
! Evolve with MPDOs
if(psi0set) then
call create(Sl, OpABC%Li(iop))
call copy(Rho0, Psi0, Sl)
call destroy(Sl)
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_qmpoc: dynamics_mpdo '//&
! ' (1) failed.', 'PyInterface_include.f90:739', &
! errst=errst)) return
else
call dynamics_mpdo(Rho0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_qmpoc: dynamics_mpdo '//&
! ' (2) failed.', 'PyInterface_include.f90:746', &
! errst=errst)) return
end if
case(4)
! Evolve with LPTN
if(psi0set) then
call copy(XX0, Psi0)
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
Psiinit=Psi0, errst=errst)
!if(prop_error('simulation_qmpoc : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:758', errst=errst)) return
else
call dynamics_lptn(XX0, OpABC, Rs, iop, Hparams, IOObj, &
timeevo_restore, Imapper, use_h5, &
errst=errst)
!if(prop_error('simulation_qmpoc : dynamics_lptn '//&
! 'failed.', 'PyInterface_include.f90:764', errst=errst)) return
end if
case(0)
! No dynamics
case default
! Wrong case_dynamics
errst = raise_error('simulation_qmpoc : case_dynamics '//&
'not valid.', 99, errst=errst)
end select
call destroy(Hparams, IOObj%hparamsname, hparamsunit, clearfile=.true.)
call destroy(Rs)
call destroy(Ham)
call destroy(OpABC)
call destroy(Imapper)
call delete_file(IOObj%opsname, opsunit)
call delete_file(IOObj%mponame, mpounit)
! Print out time
call cpu_time(tock)
totaltime = tock - tick
if(verbose > 0) then
write(slog, *) 'time taken:', totalTime, ' seconds!'
end if
end subroutine simulation_qmpoc
"""
return
[docs]def static_simulation_mps_mpo():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mps_mpo(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(mps), pointer, intent(inout) :: Psi(:)
type(mpo), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(tensorlist) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(mps) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(mpoc) :: Liou, Lsq
! Left-right overlap
type(tensorlist), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(obs_r) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(mps) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_tensor), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(mps), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mps' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mps_mpo: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mps_mpo: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mps_mpo: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
else
call grow_system(Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mps_mpo: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1), Hts, Ham, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_mpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mps' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1), Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mps_mpo: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
end if
end if
else
errst = raise_error('static_simulation_mps_mpo: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mps_mpo: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1))
call orthonormalize(Psi(jj + 1), 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Ham)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_system(Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mps_mpo: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi, Hts, Ham, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_mpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Ham)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Ham, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
if('mps' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii))
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1), Psi, jj, Hts, Ham, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_mpo: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mps' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1))
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mps' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mps' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mps_mpo
"""
return
[docs]def static_simulation_mps_mpoc():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mps_mpoc(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(mpsc), pointer, intent(inout) :: Psi(:)
type(mpoc), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(mpsc) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(mpoc) :: Liou, Lsq
! Left-right overlap
type(tensorlistc), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(obsc) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(mpsc) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_tensorc), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(mpsc), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mps' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
else
call grow_system(Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1), Hts, Ham, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mps' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1), Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
end if
end if
else
errst = raise_error('static_simulation_mps_mpoc: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1))
call orthonormalize(Psi(jj + 1), 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Ham)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_system(Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mps_mpoc: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi, Hts, Ham, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Ham)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Ham, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
if('mps' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii))
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1), Psi, jj, Hts, Ham, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_mpoc: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mps' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1))
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mps' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mps' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mps_mpoc
"""
return
[docs]def static_simulation_mps_qmpo():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mps_qmpo(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(qmps), pointer, intent(inout) :: Psi(:)
type(qmpo), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(qmps) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(qmpoc) :: Liou, Lsq
! Left-right overlap
type(qtensorlist), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(qobs_r) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(qmps) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_qtensor), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(qmps), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mps' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
else
call grow_system(Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1), Hts, Ham, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mps' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1), Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
end if
end if
else
errst = raise_error('static_simulation_mps_qmpo: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1))
call orthonormalize(Psi(jj + 1), 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Ham)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_system(Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mps_qmpo: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi, Hts, Ham, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Ham)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Ham, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
if('mps' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii))
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1), Psi, jj, Hts, Ham, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_qmpo: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mps' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1))
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mps' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mps' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mps_qmpo
"""
return
[docs]def static_simulation_mps_qmpoc():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mps_qmpoc(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(qmpsc), pointer, intent(inout) :: Psi(:)
type(qmpoc), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(qmpsc) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(qmpoc) :: Liou, Lsq
! Left-right overlap
type(qtensorclist), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(qobsc) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(qmpsc) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_qtensorc), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(qmpsc), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mps' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
else
call grow_system(Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1), Hts, Ham, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mps' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1), Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1), Ham, Psi(1), Psi(1)%oc)
end if
end if
else
errst = raise_error('static_simulation_mps_qmpoc: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1))
call orthonormalize(Psi(jj + 1), 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Ham)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_system(Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi, Hts, Ham, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Ham)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Ham, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Ham%Ws(ii), Ham%Ws(ii + 1))
end do
if('mps' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii))
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1), Psi, jj, Hts, Ham, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mps_qmpoc: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mps' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1))
end if
! Measure
if('mps' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mps' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mps' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mps_qmpoc
"""
return
[docs]def static_simulation_mpdo_mpo():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mpdo_mpo(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(mpdoc), pointer, intent(inout) :: Psi(:)
type(mpo), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(tensorlist) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(mpdoc) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(mpoc) :: Liou, Lsq
! Left-right overlap
type(tensorlistc), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(obs_c) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(mpdoc) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_tensorc), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(mpsc), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mpdo' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
else
call grow_mpdo(Lsq,Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1)%Superket, Hts, Lsq, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mpdo' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1)%Superket, Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%Superket%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
end if
end if
else
errst = raise_error('static_simulation_mpdo_mpo: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%Superket%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1)%Superket)
call orthonormalize(Psi(jj + 1)%Superket, 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Lsq)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_mpdo(Lsq,Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi%Superket, Hts, Lsq, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Lsq)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Lsq, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
if('mpdo' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii)%Superket)
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1)%Superket, Psip, jj, Hts, Lsq, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mpdo' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1)%Superket)
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mpdo' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mpdo' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mpdo_mpo
"""
return
[docs]def static_simulation_mpdo_mpoc():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mpdo_mpoc(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(mpdoc), pointer, intent(inout) :: Psi(:)
type(mpoc), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(mpdoc) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(mpoc) :: Liou, Lsq
! Left-right overlap
type(tensorlistc), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(obsc) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(mpdoc) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_tensorc), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(mpsc), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mpdo' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
else
call grow_mpdo(Lsq,Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1)%Superket, Hts, Lsq, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mpdo' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1)%Superket, Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%Superket%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
end if
end if
else
errst = raise_error('static_simulation_mpdo_mpoc: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%Superket%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1)%Superket)
call orthonormalize(Psi(jj + 1)%Superket, 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Lsq)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_mpdo(Lsq,Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi%Superket, Hts, Lsq, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Lsq)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Lsq, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
if('mpdo' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii)%Superket)
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1)%Superket, Psip, jj, Hts, Lsq, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mpdo' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1)%Superket)
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_mpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mpdo' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mpdo' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mpdo_mpoc
"""
return
[docs]def static_simulation_mpdo_qmpo():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mpdo_qmpo(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(qmpdoc), pointer, intent(inout) :: Psi(:)
type(qmpo), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(qmpdoc) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(qmpoc) :: Liou, Lsq
! Left-right overlap
type(qtensorclist), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(qobs_c) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(qmpdoc) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_qtensorc), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(qmpsc), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mpdo' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
else
call grow_mpdo(Lsq,Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1)%Superket, Hts, Lsq, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mpdo' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1)%Superket, Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%Superket%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
end if
end if
else
errst = raise_error('static_simulation_mpdo_qmpo: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%Superket%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1)%Superket)
call orthonormalize(Psi(jj + 1)%Superket, 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Lsq)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_mpdo(Lsq,Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi%Superket, Hts, Lsq, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Lsq)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Lsq, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
if('mpdo' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii)%Superket)
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1)%Superket, Psip, jj, Hts, Lsq, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mpdo' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1)%Superket)
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpo: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mpdo' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mpdo' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mpdo_qmpo
"""
return
[docs]def static_simulation_mpdo_qmpoc():
"""
fortran-subroutine - May 2016 (updated, dj)
Find ground and excited states in MPS representation.
**Arguments**
IOObj : TYPE(IOObject), in
Taking care of filename during the simulation.
statics_initial : CHARACTER(132), in
If not empty, the initial guess to be load into the
ground state search.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine static_simulation_mpdo_qmpoc(Psi, Ham, Hparams, Rs, Ops, &
ll, ne, iop, statics_initial, wait4state, nqs, qs, IOObj, doemps, &
paramhash, Imapper, use_h5, errst)
use basicops, only : eye
use ioops, only : obsunit, mpounit, psiunit, cpunit
type(qmpdoc), pointer, intent(inout) :: Psi(:)
type(qmpoc), intent(inout) :: Ham
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist) :: Ops
integer, intent(in) :: ll, ne, iop
character(len=132), intent(in) :: statics_initial
logical, intent(in) :: wait4state
integer, dimension(2), intent(in) :: nqs
integer, dimension(:), intent(in) :: qs
type(IOObject), intent(in) :: IOObj
logical, intent(in) :: doemps
character(len=50), intent(in) :: paramhash
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii, jj
! start of the loop for excited state / convergence parameters
integer :: start, cpstart
! Used in excited states
type(qmpdoc) :: Hpsi
! Liouville operators and Lsq = Ldagger L
type(qmpoc) :: Liou, Lsq
! Left-right overlap
type(qtensorclist), dimension(:), allocatable :: LR
! Flags on convergence / filename for reading convergence
logical :: converged
! Setup for measurements and corresponding filename
type(qobsc) :: Obsmps, Obsemps
character(len=132) :: obsname
! Read flag switching between human readable and binary
character :: read_flag
! Write / output directory to store states
character(len=132) :: outdir, writedir
! Dummy for interface
character(len=132) :: timeevo_mps_delete
! energy related measures (variance could be as well difference
! singular values)
real(KIND=rKind) :: energy, variance
! Eigenvalue Liouvillian
real(KIND=rKind) :: lioueval
! for eMPS
real(KIND=rKind) :: eshift, var
! String for integer of excited state, integer of convergence parameter
character(len=3) :: strst, strcp
integer :: nconv
! checking for existing file / status of i/o
logical :: file_exists
integer :: iostat
! Store the original dimension used for eMPS
type(qmpdoc) :: mps_dim
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
! All two-site MPO matrices
type(sr_matrix_qtensorc), dimension(:), allocatable :: Hts
! Cannot pass Psi(:) for MPDOs, have to construct a copy
type(qmpsc), pointer :: Psip(:)
logical, dimension(:), allocatable :: psipset
outdir = IOObj%outdir
writedir = IOObj%writedir
! Read observables (although we might never need them)
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, writedir, obsunit, mpounit, psiunit, ll, &
Ops, Hparams, iop)
!Obsmps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsmps%hdf5_target_file = ''
! Ground state calculations/loading
! =================================
!
! psi is real (complex) in this section for real (complex) MPOs
! Read in all convergence parameters
call read(Cps, IOObj%convname, unit=cpunit)
nconv = size(Cps, 1)
! String for ground state
write(strst, '(I3.3)') 0
if('mpdo' == 'mpdo') then
! Need Liouville Ldagger L for OQS steady states
call ruleset_to_liou_mpo(Liou, Rs, ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '//&
! 'ruleset 2 mpo failed.', 'PyInterface_include.f90:959', &
! errst=errst)) return
call scale(-eye, Liou)
call square(Lsq, Liou, trafol='D', errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '//&
! 'square failed.', 'PyInterface_include.f90:966', &
! errst=errst)) return
call destroy(Liou)
end if
if(wait4state) then
! Wait for the state and read it then
! ===================================
! Check for last convergence parameters
write(strcp, '(I3.3)') nconv
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//strcp//&
'.bin', exist=file_exists)
if(.not. file_exists) write(slog, *) 'Wait for ground state ...'
do while(.not. file_exists)
call sleep(30)
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
end do
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
call copy(mps_dim, Psi(1))
else
! Start or continue
! =================
if(verbose > 0) &
write(slog, *) 'Beginning ground state search!'
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
! Figure out if we can load any state
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
inquire(file=trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', exist=file_exists)
if(file_exists) cpstart = ii + 1
end do
if(cpstart == 1) then
! Build guess for ground state
ii = len(trim(adjustl(statics_initial)))
if(ii > 0) then
! Initial guess for statics is given
read_flag = "H"
if(ii > 3) then
if(statics_initial(ii - 3:ii) == ".bin") then
read_flag = "B"
end if
end if
call read(Psi(1), trim(adjustl(statics_initial)), &
psiunit, read_flag, skip=.false., errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'read failed.', 'PyInterface_include.f90:1031', &
! errst=errst)) return
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
else
call grow_mpdo(Lsq,Psi(1), ll, Ham, LR, nqs, qs, IOObj, &
Cps(1), hasexcited=doemps, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'grow failed.', 'PyInterface_include.f90:1039', &
! errst=errst)) return
end if
else
write(strcp, '(I3.3)') cpstart - 1
call read(Psi(1), trim(outdir)//paramhash//'_'//strst//'_'//&
strcp//'.bin', psiunit, 'B', errst=iostat)
end if
! Save for bond dimension excited states
call copy(mps_dim, Psi(1))
cploop: do ii = cpstart, nconv
! Setup if not first entry of convergence parameters
if((ii > 1) .and. (ii == cpstart))&
call SetupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
if(Cps(ii)%max_num_isteps < 0) then
! Variational ground state search
call find_groundstate_two(Psi(1)%Superket, Hts, Lsq, LR, Cps(ii), &
energy, converged, variance, &
Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1064', errst=errst)) return
elseif('mpdo' == 'mps') then
! Imaginary time evolution ground state search
call mps_itimeevo(Psi(1)%Superket, Ops, Rs, iop, Hparams, &
Cps(ii), energy, converged, variance, &
errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'mps_itimeevo failed.', &
! 'PyInterface_include.f90:1072', errst=errst)) return
if(ii < nconv) then
if(Cps(ii + 1)%max_num_isteps < 0) then
! Need to insert update of LR overlaps
if(allocated(LR)) then
do jj = 1, Psi(1)%Superket%ll
call destroy(LR(jj))
end do
deallocate(LR)
end if
call setupLR(LR, Psi(1)%Superket, Lsq, Psi(1)%Superket, Psi(1)%Superket%oc)
end if
end if
else
errst = raise_error('static_simulation_mpdo_qmpoc: '// &
'no imag time for steady state.', &
99, 'PyInterface_include.f90:1091', errst=errst)
return
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(1)), Psi(1))
lioueval = energy
Obsmps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1105', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, 0, ii)
call observe(Psi(1), Ops, Obsmps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, &
Cps(ii), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'observe (1) failed.', 'PyInterface_include.f90:1119', &
! errst=errst)) return
! Save MPS as checkpoint and delete previous if possible
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', action='write', status='replace', &
form='unformatted')
call write(Psi(1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', psiunit)
end if
end do cploop
if(cpstart <= nconv) then
do ii = 1, Psi(1)%Superket%ll
call destroy(LR(ii))
end do
deallocate(LR)
end if
deallocate(Cps)
call delete_file(IOObj%convname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if
! Compute excited states
! ======================
if(doemps) then
! Read the observables although we might never need it
obsname = io_get_obsin(IOObj, '1')
call read(Obsemps, obsname, writedir, obsunit, mpounit, psiunit, &
ll, Ops, Hparams, iop)
!Obsemps%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Obsemps%hdf5_target_file = ''
! Convergence parameters
call read(Cps, IOObj%econvname, unit=cpunit)
nconv = size(Cps, 1)
! Check for last excited state and convergence parameter
! ......................................................
!
! checkpoint; assumes no manually deleted files in the middle
! of a simulation
start = 1
cpstart = 1
do ii = 1, nconv
write(strcp, '(I3.3)') ii
do jj = 1, ne
write(strst, '(I3.3)') jj
inquire(file=trim(outdir)//paramhash//'_'//strst//&
'_'//strcp//'.bin', exist=file_exists)
if(file_exists .and. (jj == ne)) then
start = 1
cpstart = ii + 1
elseif(file_exists) then
start = jj + 1
cpstart = ii
end if
end do
end do
! Load last state or generate initial guess
! .........................................
! To-do: Check if we should call IMPS before or to what extend the dimensions
! To-do: play a role.
! To-do: the ground state has possibly a high bond dimension which might slow
! To-do: down calculations.
! To-Do: highest energy is not calculated with coarse setting anymore.
do jj = 1, ne
if(jj < start) then
! Load same convergence parameter cpstart
ii = cpstart
else
! Load previous convergence parameter (cpstart - 1)
ii = cpstart - 1
end if
if(ii == 0) then
call copy(Psi(jj + 1), Mps_dim)
call randomize(Psi(jj + 1)%Superket)
call orthonormalize(Psi(jj + 1)%Superket, 1)
else
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
call read(Psi(jj + 1), trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit, 'B', &
errst=iostat)
end if
end do
! Preliminary calculations
! ........................
! If the ground state energy is positive, find the highest energy
! and subtract it such that the energies of all eigenstates are
! positive scale MPO by -1.
call scale(-1.0_rKind, Lsq)
! Save tolerances and replace with coarse tolerances
if(verbose > 0) write(slog, *) &
'Beginning highest eigenvalue search!'
call grow_mpdo(Lsq,Hpsi, ll, Ham, LR, nqs, qs, IOObj, Cps(1), &
errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: grow (2).', &
! 'PyInterface_include.f90:1242', errst=errst)) return
! Build the two site MPO matrices
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
call find_groundstate_two(Hpsi%Superket, Hts, Lsq, LR, Cps(1), eshift, &
converged, var, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'find groundsate_two failed.', &
! 'PyInterface_include.f90:1254', errst=errst)) return
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
do ii = 1, ll
call destroy(LR(ii))
end do
deallocate(LR)
! unscale MPO
call scale(-1.0_rKind, Lsq)
IF(verbose > 0) write(slog, *) 'Highest eigenvalue', -eshift, &
var, converged
eshift = abs(eshift) + sqrt(abs(var))
if(verbose > 0) write(slog, *) 'shift', eshift
call shift(Lsq, eshift)
call destroy(Hpsi)
allocate(Hts(ll - 1))
do ii = 1, (ll - 1)
call sdot(Hts(ii), Lsq%Ws(ii), Lsq%Ws(ii + 1))
end do
if('mpdo' == 'mpdo') then
! Need actual array with MPS states
allocate(Psip(ne + 1), psipset(ne + 1))
psipset = .false.
do ii = 1, start
call copy(Psip(ii), Psi(ii)%Superket)
psipset(ii) = .true.
end do
end if
! Now calculate the excited states
! ................................
do ii = cpstart, nconv
do jj = start, ne
if(verbose > 0) write(slog, *) 'Beginning eMPS for '// &
'convergence parameter set/state:', ii, jj, '!'
call find_excited_two(Psi(jj + 1)%Superket, Psip, jj, Hts, Lsq, &
Cps(ii), energy, converged, &
variance, Rs%pbc, errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '//&
! 'find_excited_two failed.', &
! 'PyInterface_include.f90:1306', errst=errst)) return
energy = energy + eshift
if('mpdo' == 'mpdo') then
if(psipset(jj + 1)) call destroy(Psip(jj + 1))
call copy(Psip(jj + 1), Psi(jj + 1)%Superket)
end if
! Measure
if('mpdo' == 'mpdo') then
! Have to normalize, have to calculate energy
call scale(1.0_rkind / norm(Psi(jj + 1)), Psi(jj + 1))
lioueval = energy
Obsemps%static_eigenvalue = lioueval
call meas_mpo(energy, Ham, Psi(jj + 1), errst=errst)
!if(prop_error('static_simulation_mpdo_qmpoc: '// &
! 'meas_mpo failed.', &
! 'PyInterface_include.f90:1326', errst=errst)) return
if(verbose > 0) then
write(slog, *) 'eigenvalue excited / variance Liouvillian', &
lioueval, variance
end if
end if
obsname = io_get_obs(IOObj, jj, ii)
call observe(Psi(jj + 1), Ops, Obsemps, obsname, &
IOObj%baseout, timeevo_mps_delete, obsunit, &
energy, variance, converged, Imapper, Cps(ii))
! Save MPS as checkpoint and delete previous if possible
write(strst, '(I3.3)') jj
write(strcp, '(I3.3)') ii
open(unit=psiunit, file=trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', action='write', &
status='replace', form='unformatted')
call write(Psi(jj + 1), psiunit, 'B')
close(psiunit)
if(ii > 1) then
write(strcp, '(I3.3)') ii - 1
call delete_file(trim(outdir)//paramhash//'_'//&
strst//'_'//strcp//'.bin', psiunit)
end if
end do
! Now set start to 1 to start with the lowest excited state
start = 1
end do
if('mpdo' == 'mpdo') then
do ii = 1, ne + 1
if(psipset(ii)) call destroy(Psip(ii))
end do
deallocate(Psip)
end if
deallocate(Cps)
call destroy(Obsemps, obsunit, mpounit)
call delete_file(IOObj%econvname, cpunit)
do ii = 1, (ll -1)
call destroy(Hts(ii))
end do
deallocate(Hts)
end if ! doeMPS
if('mpdo' == 'mpdo') then
call destroy(Lsq)
end if
! Transfer for real time evoluton or clean up
! -------------------------------------------
call destroy(mps_dim)
call destroy(Obsmps, obsunit, mpounit)
end subroutine static_simulation_mpdo_qmpoc
"""
return
[docs]def dynamics_mps_mpo():
"""
fortran-subroutine - May 2016 (updated, dj)
Evolve a MPS in time according to the Schroedinger equation
(closed system or quantum trajectories).
**Arguments**
qtid : INTEGER, OPTIONAL, in
If present, instead of the Schrodinger equation the
quantum trajectories are used.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mps_mpo(Psi, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, qtid, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(mpsc), intent(inout) :: Psi
type(tensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
character(len=12), intent(in), optional :: qtid
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! Copy of the state at t=0 to calculate Loschmidt-echo
type(mpsc) :: Psiinit
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obs_c) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! keeping track of norm and random number for QT
real(KIND=rKind) :: qtnorm, qtrand
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! indicate initialization for QT
qtnorm = -1.0_rKind
! Copy initial state for Loschmidt echo
call copy(Psiinit, Psi, errst=errst)
!if(prop_error('dynamics_mps_mpo : copy (1) failed.', &
! 'PyInterface_include.f90:1602', errst=errst)) return
! Check if time evolution should be restored or not (and if possible)
call check_restore(Psi, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_mpo : check_restore failed.', &
! 'PyInterface_include.f90:1608', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Psi%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
if(.not. present(qtid)) then
! Time evolution pure state
call mps_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_mps_mpo : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1648', errst=errst)) return
else
! Pure state and quantum trajectories
call qt_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
qtid, qtnorm, qtrand, Imapper, errst=errst)
!if(prop_error('dynamics_mps_mpo : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1657', &
! errst=errst)) return
end if
deallocate(Cps)
end do
call destroy(Psiinit)
call destroy(Psi)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mps_mpo
"""
return
[docs]def dynamics_mps_mpoc():
"""
fortran-subroutine - May 2016 (updated, dj)
Evolve a MPS in time according to the Schroedinger equation
(closed system or quantum trajectories).
**Arguments**
qtid : INTEGER, OPTIONAL, in
If present, instead of the Schrodinger equation the
quantum trajectories are used.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mps_mpoc(Psi, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, qtid, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(mpsc), intent(inout) :: Psi
type(tensorlistc) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
character(len=12), intent(in), optional :: qtid
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! Copy of the state at t=0 to calculate Loschmidt-echo
type(mpsc) :: Psiinit
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! keeping track of norm and random number for QT
real(KIND=rKind) :: qtnorm, qtrand
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! indicate initialization for QT
qtnorm = -1.0_rKind
! Copy initial state for Loschmidt echo
call copy(Psiinit, Psi, errst=errst)
!if(prop_error('dynamics_mps_mpoc : copy (1) failed.', &
! 'PyInterface_include.f90:1602', errst=errst)) return
! Check if time evolution should be restored or not (and if possible)
call check_restore(Psi, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_mpoc : check_restore failed.', &
! 'PyInterface_include.f90:1608', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Psi%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
if(.not. present(qtid)) then
! Time evolution pure state
call mps_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_mps_mpoc : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1648', errst=errst)) return
else
! Pure state and quantum trajectories
call qt_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
qtid, qtnorm, qtrand, Imapper, errst=errst)
!if(prop_error('dynamics_mps_mpoc : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1657', &
! errst=errst)) return
end if
deallocate(Cps)
end do
call destroy(Psiinit)
call destroy(Psi)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mps_mpoc
"""
return
[docs]def dynamics_mps_qmpo():
"""
fortran-subroutine - May 2016 (updated, dj)
Evolve a MPS in time according to the Schroedinger equation
(closed system or quantum trajectories).
**Arguments**
qtid : INTEGER, OPTIONAL, in
If present, instead of the Schrodinger equation the
quantum trajectories are used.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mps_qmpo(Psi, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, qtid, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qmpsc), intent(inout) :: Psi
type(qtensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
character(len=12), intent(in), optional :: qtid
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! Copy of the state at t=0 to calculate Loschmidt-echo
type(qmpsc) :: Psiinit
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobs_c) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! keeping track of norm and random number for QT
real(KIND=rKind) :: qtnorm, qtrand
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! indicate initialization for QT
qtnorm = -1.0_rKind
! Copy initial state for Loschmidt echo
call copy(Psiinit, Psi, errst=errst)
!if(prop_error('dynamics_mps_qmpo : copy (1) failed.', &
! 'PyInterface_include.f90:1602', errst=errst)) return
! Check if time evolution should be restored or not (and if possible)
call check_restore(Psi, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_qmpo : check_restore failed.', &
! 'PyInterface_include.f90:1608', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Psi%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
if(.not. present(qtid)) then
! Time evolution pure state
call mps_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_mps_qmpo : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1648', errst=errst)) return
else
! Pure state and quantum trajectories
call qt_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
qtid, qtnorm, qtrand, Imapper, errst=errst)
!if(prop_error('dynamics_mps_qmpo : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1657', &
! errst=errst)) return
end if
deallocate(Cps)
end do
call destroy(Psiinit)
call destroy(Psi)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mps_qmpo
"""
return
[docs]def dynamics_mps_qmpoc():
"""
fortran-subroutine - May 2016 (updated, dj)
Evolve a MPS in time according to the Schroedinger equation
(closed system or quantum trajectories).
**Arguments**
qtid : INTEGER, OPTIONAL, in
If present, instead of the Schrodinger equation the
quantum trajectories are used.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mps_qmpoc(Psi, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, qtid, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qmpsc), intent(inout) :: Psi
type(qtensorclist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
character(len=12), intent(in), optional :: qtid
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! Copy of the state at t=0 to calculate Loschmidt-echo
type(qmpsc) :: Psiinit
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! keeping track of norm and random number for QT
real(KIND=rKind) :: qtnorm, qtrand
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! indicate initialization for QT
qtnorm = -1.0_rKind
! Copy initial state for Loschmidt echo
call copy(Psiinit, Psi, errst=errst)
!if(prop_error('dynamics_mps_qmpoc : copy (1) failed.', &
! 'PyInterface_include.f90:1602', errst=errst)) return
! Check if time evolution should be restored or not (and if possible)
call check_restore(Psi, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_qmpoc : check_restore failed.', &
! 'PyInterface_include.f90:1608', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Psi%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
if(.not. present(qtid)) then
! Time evolution pure state
call mps_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_mps_qmpoc : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1648', errst=errst)) return
else
! Pure state and quantum trajectories
call qt_timeevo(Psi, time, Ops, Rs, iop, Psiinit, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
qtid, qtnorm, qtrand, Imapper, errst=errst)
!if(prop_error('dynamics_mps_qmpoc : mps_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1657', &
! errst=errst)) return
end if
deallocate(Cps)
end do
call destroy(Psiinit)
call destroy(Psi)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mps_qmpoc
"""
return
[docs]def dynamics_mpdo_mpo():
"""
fortran-subroutine - September 2017 (updated, dj)
Evolve a MPDO in time according to the Lindblad equation.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mpdo_mpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(mpdoc), intent(inout) :: Rho
type(tensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
type(imap), intent(in) :: Imapper
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obs_c) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
if(Rho%Superket%oc == -1) call canonize(Rho%Superket, 1)
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mpdo_mpo : check_restore failed.', &
! 'PyInterface_include.f90:1766', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
! Time evolution density matrix
call mpdo_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_mpdo_mpo : mpdo_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1805', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mpdo_mpo
"""
return
[docs]def dynamics_mpdo_mpoc():
"""
fortran-subroutine - September 2017 (updated, dj)
Evolve a MPDO in time according to the Lindblad equation.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mpdo_mpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(mpdoc), intent(inout) :: Rho
type(tensorlistc) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
type(imap), intent(in) :: Imapper
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
if(Rho%Superket%oc == -1) call canonize(Rho%Superket, 1)
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mpdo_mpoc : check_restore failed.', &
! 'PyInterface_include.f90:1766', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
! Time evolution density matrix
call mpdo_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_mpdo_mpoc : mpdo_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1805', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mpdo_mpoc
"""
return
[docs]def dynamics_mpdo_qmpo():
"""
fortran-subroutine - September 2017 (updated, dj)
Evolve a MPDO in time according to the Lindblad equation.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mpdo_qmpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qmpdoc), intent(inout) :: Rho
type(qtensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
type(imap), intent(in) :: Imapper
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobs_c) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
if(Rho%Superket%oc == -1) call canonize(Rho%Superket, 1)
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mpdo_qmpo : check_restore failed.', &
! 'PyInterface_include.f90:1766', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
! Time evolution density matrix
call mpdo_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_mpdo_qmpo : mpdo_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1805', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mpdo_qmpo
"""
return
[docs]def dynamics_mpdo_qmpoc():
"""
fortran-subroutine - September 2017 (updated, dj)
Evolve a MPDO in time according to the Lindblad equation.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Details**
(template defined in PyInterface_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_mpdo_qmpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qmpdoc), intent(inout) :: Rho
type(qtensorclist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
logical, intent(in) :: use_h5
type(imap), intent(in) :: Imapper
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
if(Rho%Superket%oc == -1) call canonize(Rho%Superket, 1)
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mpdo_qmpoc : check_restore failed.', &
! 'PyInterface_include.f90:1766', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
! Time evolution density matrix
call mpdo_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_mpdo_qmpoc : mpdo_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1805', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_mpdo_qmpoc
"""
return
[docs]def dynamics_lptn_mpo():
"""
fortran-subroutine - 2018 (dj)
Evolve an LPTN in time according to the Lindblad master equation.
**Arguments**
Rho : TYPE(lptnc), inout
Density matrix for time evolution represented as an LPTN.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_lptn_mpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(lptnc), intent(inout) :: Rho
type(tensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obs_c) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_mpo : check_restore failed.', &
! 'PyInterface_include.f90:1909', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
call lptn_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_lptn_mpo : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1947', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_lptn_mpo
"""
return
[docs]def dynamics_lptn_mpoc():
"""
fortran-subroutine - 2018 (dj)
Evolve an LPTN in time according to the Lindblad master equation.
**Arguments**
Rho : TYPE(lptnc), inout
Density matrix for time evolution represented as an LPTN.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_lptn_mpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(lptnc), intent(inout) :: Rho
type(tensorlistc) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_mpoc : check_restore failed.', &
! 'PyInterface_include.f90:1909', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
call lptn_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_lptn_mpoc : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1947', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_lptn_mpoc
"""
return
[docs]def dynamics_lptn_qmpo():
"""
fortran-subroutine - 2018 (dj)
Evolve an LPTN in time according to the Lindblad master equation.
**Arguments**
Rho : TYPE(qlptnc), inout
Density matrix for time evolution represented as an LPTN.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_lptn_qmpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qlptnc), intent(inout) :: Rho
type(qtensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobs_c) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_qmpo : check_restore failed.', &
! 'PyInterface_include.f90:1909', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
call lptn_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_lptn_qmpo : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1947', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_lptn_qmpo
"""
return
[docs]def dynamics_lptn_qmpoc():
"""
fortran-subroutine - 2018 (dj)
Evolve an LPTN in time according to the Lindblad master equation.
**Arguments**
Rho : TYPE(qlptnc), inout
Density matrix for time evolution represented as an LPTN.
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine dynamics_lptn_qmpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, Psiinit, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qlptnc), intent(inout) :: Rho
type(qtensorclist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
call check_restore(Rho, timeevo_restore, time_restore, &
timeevo_state_delete, IOObj, errst=errst)
!if(prop_error('dynamics_mps_qmpoc : check_restore failed.', &
! 'PyInterface_include.f90:1909', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, 'Dynamics')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
if(.not. use_h5) Tobs%hdf5_target_file = ''
open(unit=metadynamicsunit, file=IOObj%dynname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_tobs(IOObj, ii)
quenchname = io_get_quench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_tconv(IOObj, ii), unit=cpunit)
call lptn_timeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, Psiinit=Psiinit, errst=errst)
!if(prop_error('dynamics_lptn_qmpoc : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:1947', errst=errst)) return
deallocate(Cps)
end do
if(present(Psiinit)) call destroy(Psiinit)
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%dynname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_tconv(IOObj, ii), cpunit)
call delete_file(io_get_quench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine dynamics_lptn_qmpoc
"""
return
[docs]def finiteT_lptn_mpo():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_lptn_mpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(lptn), intent(inout) :: Rho
type(tensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obs_r) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_mpo : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call lptn_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_mpo : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_lptn_mpo
"""
return
[docs]def finiteT_lptnc_mpoc():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_lptnc_mpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(lptnc), intent(inout) :: Rho
type(tensorlistc) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_mpoc : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call lptn_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_mpoc : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_lptnc_mpoc
"""
return
[docs]def finiteT_qlptn_qmpo():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_qlptn_qmpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qlptn), intent(inout) :: Rho
type(qtensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobs_r) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_qmpo : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call lptn_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_qmpo : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_qlptn_qmpo
"""
return
[docs]def finiteT_qlptnc_qmpoc():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_qlptnc_qmpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qlptnc), intent(inout) :: Rho
type(qtensorclist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_qmpoc : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call lptn_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_qmpoc : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_qlptnc_qmpoc
"""
return
[docs]def finiteT_mpdo_mpo():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_mpdo_mpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(mpdo), intent(inout) :: Rho
type(tensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obs_r) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_mpo : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call mpdo_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_mpo : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_mpdo_mpo
"""
return
[docs]def finiteT_mpdoc_mpoc():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_mpdoc_mpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(mpdoc), intent(inout) :: Rho
type(tensorlistc) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(obsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_mpoc : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call mpdo_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_mpoc : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_mpdoc_mpoc
"""
return
[docs]def finiteT_qmpdo_qmpo():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_qmpdo_qmpo(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qmpdo), intent(inout) :: Rho
type(qtensorlist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobs_r) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_qmpo : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call mpdo_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_qmpo : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_qmpdo_qmpo
"""
return
[docs]def finiteT_qmpdoc_qmpoc():
"""
fortran-subroutine - Evolve an LPTN in imaginary time representing a cooling process
according to the Gibbs distribution.
**Arguments**
use_h5 : logical, in
When .true. and HDF5 available, use this format. For false,
HDF5 is not used even if available.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finiteT_qmpdoc_qmpoc(Rho, Ops, Rs, iop, Hparams, &
IOObj, timeevo_restore, Imapper, use_h5, errst)
use ioops, only : cpunit, metadynamicsunit, mpounit, obsunit, &
psiunit, quenchunit
type(qmpdoc), intent(inout) :: Rho
type(qtensorclist) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(HamiltonianParameters), pointer, intent(inout) :: Hparams(:)
type(IOObject), intent(in) :: IOObj
logical, intent(inout) :: timeevo_restore
type(imap), intent(in) :: Imapper
logical, intent(in) :: use_h5
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / begin of a loop
integer :: ii
! number of quenches, array to store corresponding method, filename for
integer :: nquenches
integer, allocatable :: dynamicsmethod(:)
! Setup for measurements
type(qobsc) :: Tobs
! filename for convergence, quenches, and observables
character(len=132) :: quenchname, obsname
! write directory
character(len=132) :: writedir, baseout
! Dummy for interface
character(len=132) :: timeevo_state_delete
! keeping track of the time / start time when restoring time evolution
real(KIND=rKind) :: time, time_restore
! convergence parameters
type(ConvParam), dimension(:), allocatable :: Cps
writedir = IOObj%writedir
baseout = IOObj%baseout
! Check if time evolution should be restored or not (and if possible)
time_restore = -1.0_rKind
timeevo_state_delete = ""
!call check_restore(Rho, timeevo_restore, time_restore, &
! timeevo_state_delete, IOObj, errst=errst)
!!if(prop_error('dynamics_mps_qmpoc : check_restore failed.', &
!! 'PyInterface_include.f90:2121', errst=errst)) return
! Prepare dynanmics
! -----------------
time = 0.0_rKind
obsname = io_get_obsin(IOObj, '0')
call read(Tobs, obsname, writedir, obsunit, mpounit, psiunit, &
Rho%Superket%ll, Ops, Hparams, iop)
!if(use_h5) Tobs%hdf5_target_file = trim(IOObj%baseout)//'.h5'
open(unit=metadynamicsunit, file=IOObj%finitetname, status='old', &
action='read')
read(metadynamicsunit, '(1I16)') nquenches
allocate(dynamicsmethod(nquenches))
do ii = 1, nquenches
read(metadynamicsunit, '(1I16)') dynamicsmethod(ii)
end do
close(metadynamicsunit)
! Execute the list of quenches
! ----------------------------
do ii = 1, nquenches
! Base observables file / quench file
obsname = io_get_ftobs(IOObj, ii)
quenchname = io_get_ftquench(IOObj, ii)
!if(use_h5) write(Tobs%quench_ii, '(I6.6)') ii
call read(Cps, io_get_ftconv(IOObj, ii), unit=cpunit)
call mpdo_itimeevo(Rho, time, Ops, Rs, iop, Cps(1), &
quenchname, obsname, baseout, Hparams, Tobs, &
dynamicsmethod(ii), time_restore, timeevo_state_delete, &
Imapper, errst=errst)
!if(prop_error('dynamics_lptn_qmpoc : lptn_timeevo '//&
! 'failed.', 'PyInterface_include.f90:2158', errst=errst)) return
deallocate(Cps)
end do
call destroy(Rho)
! Deallocate dynamic variables / files
call delete_file(IOObj%finitetname, metadynamicsunit)
call destroy(Tobs, obsunit, mpounit)
do ii = 1, nquenches
call delete_file(io_get_ftconv(IOObj, ii), cpunit)
call delete_file(io_get_ftquench(IOObj, ii), quenchunit)
end do
deallocate(dynamicsmethod)
end subroutine finiteT_qmpdoc_qmpoc
"""
return
[docs]def infinitesimulation_mpo():
"""
fortran-subroutine - June 2018 (dj, updated)
Run an infinite simulation.
**Arguments**
qq : INTEGER, in
Size of the unit cell for iMPS
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine infinitesimulation_mpo(qq, nqs, IOObj, errst)
use ioops, only : hparamsunit, mpounit, obsunit, opsunit, psiunit
integer, intent(in) :: qq
integer, dimension(2), intent(in) :: nqs
type(IOObject), intent(in) :: IOObj
integer, intent(out), optional :: errst
! Local variables
! ---------------
! position of the identity operator
integer :: iop
! measuring cpu clock time
real(KIND=rKind) :: tick, tock, totaltime
! Setup for measurements and corresponding filename
character(len=132) :: obsname
type(obs_r) :: Obsmps
! Hamiltonian as MPO
type(mpo) :: Ham
! List of all operators
type(tensorlist) :: OpABC
! Mapping from symmetries to non-symmetry
type(imap) :: Imapper
! Rule set to build Hamiltonian
type(MPORuleSet) :: Rs
! parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
!if(present(errst)) errst = 0
!errst = raise_error('infinitesimulation_mpo : ARPACK'//&
! 'not linked - no iMPS.', 99, &
! 'PyInterface_include.f90:2243', errst=errst)
!return
call cpu_time(tick)
call readoperators(OpABC, iop, IOObj%opsname, opsunit, Imapper, nqs)
! Read rule set and build MPO
open(unit=mpounit, file=IOObj%mponame, action='read', status='old')
call read(Rs, mpounit)
close(mpounit)
call read(Hparams, IOObj%hparamsname, hparamsunit)
call ruleset_to_ham_mpo(Ham, Rs, qq, OpABC, Hparams, iop)
! Observables
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, IOObj%writedir, obsunit, mpounit, &
psiunit, qq, OpABC, Hparams, iop)
call infiniteMPS(Ham, qq, OpABC, Obsmps, IOObj, Imapper, &
Rs%pbc, errst=errst)
!if(prop_error('infinitesimulation_mpo: infiniteMPS '//&
! 'failed.', 'PyInterface_include.f90:2266', errst=errst)) return
! Delete derived types etc.
call destroy(Hparams, IOObj%hparamsname, hparamsunit, clearfile=.true.)
call destroy(Rs)
call destroy(Ham)
call destroy(OpABC)
call destroy(Obsmps, obsunit, mpounit)
call delete_file(IOObj%opsname, opsunit)
call delete_file(IOObj%mponame, mpounit)
call cpu_time(tock)
totaltime = tock - tick
if(verbose > 0) then
write(slog, *) 'time taken:', totaltime, ' seconds!'
end if
end subroutine infinitesimulation_mpo
"""
return
[docs]def infinitesimulation_mpoc():
"""
fortran-subroutine - June 2018 (dj, updated)
Run an infinite simulation.
**Arguments**
qq : INTEGER, in
Size of the unit cell for iMPS
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine infinitesimulation_mpoc(qq, nqs, IOObj, errst)
use ioops, only : hparamsunit, mpounit, obsunit, opsunit, psiunit
integer, intent(in) :: qq
integer, dimension(2), intent(in) :: nqs
type(IOObject), intent(in) :: IOObj
integer, intent(out), optional :: errst
! Local variables
! ---------------
! position of the identity operator
integer :: iop
! measuring cpu clock time
real(KIND=rKind) :: tick, tock, totaltime
! Setup for measurements and corresponding filename
character(len=132) :: obsname
type(obsc) :: Obsmps
! Hamiltonian as MPO
type(mpoc) :: Ham
! List of all operators
type(tensorlistc) :: OpABC
! Mapping from symmetries to non-symmetry
type(imap) :: Imapper
! Rule set to build Hamiltonian
type(MPORuleSet) :: Rs
! parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
!if(present(errst)) errst = 0
!errst = raise_error('infinitesimulation_mpoc : ARPACK'//&
! 'not linked - no iMPS.', 99, &
! 'PyInterface_include.f90:2243', errst=errst)
!return
call cpu_time(tick)
call readoperators(OpABC, iop, IOObj%opsname, opsunit, Imapper, nqs)
! Read rule set and build MPO
open(unit=mpounit, file=IOObj%mponame, action='read', status='old')
call read(Rs, mpounit)
close(mpounit)
call read(Hparams, IOObj%hparamsname, hparamsunit)
call ruleset_to_ham_mpo(Ham, Rs, qq, OpABC, Hparams, iop)
! Observables
obsname = io_get_obsin(IOObj, '0')
call read(Obsmps, obsname, IOObj%writedir, obsunit, mpounit, &
psiunit, qq, OpABC, Hparams, iop)
call infiniteMPS(Ham, qq, OpABC, Obsmps, IOObj, Imapper, &
Rs%pbc, errst=errst)
!if(prop_error('infinitesimulation_mpoc: infiniteMPS '//&
! 'failed.', 'PyInterface_include.f90:2266', errst=errst)) return
! Delete derived types etc.
call destroy(Hparams, IOObj%hparamsname, hparamsunit, clearfile=.true.)
call destroy(Rs)
call destroy(Ham)
call destroy(OpABC)
call destroy(Obsmps, obsunit, mpounit)
call delete_file(IOObj%opsname, opsunit)
call delete_file(IOObj%mponame, mpounit)
call cpu_time(tock)
totaltime = tock - tick
if(verbose > 0) then
write(slog, *) 'time taken:', totaltime, ' seconds!'
end if
end subroutine infinitesimulation_mpoc
"""
return