"""
Fortran module TimeEvolutionOps: August 2017 (dj)
Contains the subroutines for all time evolutions.
**Authors**
* D. Jaschke
* M. L. Wall
**Details**
The following subroutines / functions are defined for the
applicable data type
+--------------------+-------------+---------+
| procedure | include.f90 | mpi.f90 |
+====================+=============+=========+
| mps_timeevo | X | |
+--------------------+-------------+---------+
"""
[docs]def mps_timeevo_mpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(mpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(mpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mps_timeevo_mpo(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(mpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(mpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mps_timeevo_mpo : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:174', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_mpo: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_mpo: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_mpo : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_mpo: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_mpo: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_mpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mps_timeevo_mpo
"""
return
[docs]def mps_timeevo_mpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(mpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(mpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mps_timeevo_mpoc(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(mpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(mpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mps_timeevo_mpoc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:174', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_mpoc: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_mpoc : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_mpoc: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_mpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mps_timeevo_mpoc
"""
return
[docs]def mps_timeevo_qmpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(qmpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(qmpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mps_timeevo_qmpo(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qmpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(qmpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mps_timeevo_qmpo : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:174', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_qmpo: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_qmpo: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_qmpo : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_qmpo: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_qmpo: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_qmpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mps_timeevo_qmpo
"""
return
[docs]def mps_timeevo_qmpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(qmpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(qmpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mps_timeevo_qmpoc(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qmpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(qmpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mps_timeevo_qmpoc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:174', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_qmpoc: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_qmpoc : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'M', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call tdvp2_symm(Psi, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mps_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mps_timeevo_qmpoc: selector for time evo not valid'
end select
!if(prop_error('mps_timeevo_qmpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mps_timeevo_qmpoc
"""
return
[docs]def qt_timeevo_tensorlist():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time with quantum trajectories
according to a Lindblad master equation. The time evolution methods
available are Krylov, TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(mpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(mpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine qt_timeevo_tensorlist(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, qtid, qtnorm, qtrand, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(mpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(mpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
character(len=12), intent(in) :: qtid
real(KIND=rKind), intent(inout) :: qtnorm, qtrand
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! current norm after time step
real(KIND=rKind) :: normt
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
if(qtnorm < 0.0_rKind) then
! Initialization
qtnorm = norm(Psi)
call get_random_number(qtrand)
end if
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with effective Hamiltonian
mpo_is_hermitian = .false.
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:647', errst=errst)) return
! Have to adapt HDF5 target
ii = len(trim(adjustl(Tobs%hdf5_target_file)))
if(ii > 0) then
Tobs%hdf5_target_file = Tobs%hdf5_target_file(1:ii - 3)//&
'ObsOutDynamics/Sim'//qtid//'.h5'
end if
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:695', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:735', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:748', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:761', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:771', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_mpoc : time step '//&
! '(1) failed.', 'TimeEvolutionOps_include.f90:776', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_mpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:794', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:866', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:909', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:922', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:935', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:945', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_mpoc : time step '//&
! '(2) failed.', 'TimeEvolutionOps_include.f90:950', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_mpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:968', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
Tobs%step_ii = 'extras'
obsname2 = trim(obsname)//'step_extra'//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine qt_timeevo_tensorlist
"""
return
[docs]def qt_timeevo_tensorlistc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time with quantum trajectories
according to a Lindblad master equation. The time evolution methods
available are Krylov, TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(mpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(mpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine qt_timeevo_tensorlistc(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, qtid, qtnorm, qtrand, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(mpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(mpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
character(len=12), intent(in) :: qtid
real(KIND=rKind), intent(inout) :: qtnorm, qtrand
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! current norm after time step
real(KIND=rKind) :: normt
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
if(qtnorm < 0.0_rKind) then
! Initialization
qtnorm = norm(Psi)
call get_random_number(qtrand)
end if
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with effective Hamiltonian
mpo_is_hermitian = .false.
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:647', errst=errst)) return
! Have to adapt HDF5 target
ii = len(trim(adjustl(Tobs%hdf5_target_file)))
if(ii > 0) then
Tobs%hdf5_target_file = Tobs%hdf5_target_file(1:ii - 3)//&
'ObsOutDynamics/Sim'//qtid//'.h5'
end if
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:695', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:735', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:748', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:761', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:771', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_mpoc : time step '//&
! '(1) failed.', 'TimeEvolutionOps_include.f90:776', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_mpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:794', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:866', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:909', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:922', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_tensorlistc : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:935', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:945', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_mpoc : time step '//&
! '(2) failed.', 'TimeEvolutionOps_include.f90:950', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_mpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:968', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
Tobs%step_ii = 'extras'
obsname2 = trim(obsname)//'step_extra'//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine qt_timeevo_tensorlistc
"""
return
[docs]def qt_timeevo_qtensorlist():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time with quantum trajectories
according to a Lindblad master equation. The time evolution methods
available are Krylov, TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(qmpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(qmpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine qt_timeevo_qtensorlist(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, qtid, qtnorm, qtrand, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qmpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(qmpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
character(len=12), intent(in) :: qtid
real(KIND=rKind), intent(inout) :: qtnorm, qtrand
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! current norm after time step
real(KIND=rKind) :: normt
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
if(qtnorm < 0.0_rKind) then
! Initialization
qtnorm = norm(Psi)
call get_random_number(qtrand)
end if
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with effective Hamiltonian
mpo_is_hermitian = .false.
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:647', errst=errst)) return
! Have to adapt HDF5 target
ii = len(trim(adjustl(Tobs%hdf5_target_file)))
if(ii > 0) then
Tobs%hdf5_target_file = Tobs%hdf5_target_file(1:ii - 3)//&
'ObsOutDynamics/Sim'//qtid//'.h5'
end if
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:695', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:735', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:748', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:761', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:771', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_qmpoc : time step '//&
! '(1) failed.', 'TimeEvolutionOps_include.f90:776', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_qmpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:794', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:866', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:909', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:922', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorlist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:935', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:945', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_qmpoc : time step '//&
! '(2) failed.', 'TimeEvolutionOps_include.f90:950', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_qmpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:968', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
Tobs%step_ii = 'extras'
obsname2 = trim(obsname)//'step_extra'//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine qt_timeevo_qtensorlist
"""
return
[docs]def qt_timeevo_qtensorclist():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time with quantum trajectories
according to a Lindblad master equation. The time evolution methods
available are Krylov, TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(qmpsc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Psiinit : TYPE(qmpsc), inout
Initial state for the measurement of the Loschmidt echo.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine qt_timeevo_qtensorclist(Psi, time, Ops, Rs, iop, Psiinit, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, qtid, qtnorm, qtrand, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qmpsc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(qmpsc), intent(inout) :: Psiinit
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
character(len=12), intent(in) :: qtid
real(KIND=rKind), intent(inout) :: qtnorm, qtrand
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! current norm after time step
real(KIND=rKind) :: normt
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
if(qtnorm < 0.0_rKind) then
! Initialization
qtnorm = norm(Psi)
call get_random_number(qtrand)
end if
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with effective Hamiltonian
mpo_is_hermitian = .false.
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:647', errst=errst)) return
! Have to adapt HDF5 target
ii = len(trim(adjustl(Tobs%hdf5_target_file)))
if(ii > 0) then
Tobs%hdf5_target_file = Tobs%hdf5_target_file(1:ii - 3)//&
'ObsOutDynamics/Sim'//qtid//'.h5'
end if
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:695', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:735', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:748', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:761', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:771', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_qmpoc : time step '//&
! '(1) failed.', 'TimeEvolutionOps_include.f90:776', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_qmpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:794', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:866', &
! errst=errst)) return
! Check for energy initialization
if(init_energy) then
call meas_mpo(energy, Ham, Psi)
init_energy = .false.
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_method(Psi, mydeltat, Ham, converged, &
variance, Cp, init_random, 'N', &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.true., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:909', &
! errst=errst)) return
call tdvp2_gen(Psi, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:922', &
! errst=errst)) return
call lrk2(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_effham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('qt_timeevo_qtensorclist : ruleset_...'//&
! 'failed.', 'TimeEvolutionOps_include.f90:935', &
! errst=errst)) return
call lrk4(Psi, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('qt_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, 'TimeEvolutionOps_include.f90:945', errst=errst)
!return
end select
!if(prop_error('qt_timeevo_qmpoc : time step '//&
! '(2) failed.', 'TimeEvolutionOps_include.f90:950', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Check if there is a quantum jump to carry out
! ---------------------------------------------
normt = norm(Psi)
qtnorm = qtnorm * normt
call scale(1.0_rKind / sqrt(normt), Psi)
if(qtnorm < qtrand) then
! Quantum jump
call quantum_jump(Psi, Ops, Rs, Hparams, errst=errst)
!if(prop_error('qt_timeevo_qmpoc : quantum_jump '//&
! 'failed.', 'TimeEvolutionOps_include.f90:968', errst=errst)) return
qtnorm = 1.0_rKind
call get_random_number(qtrand)
end if
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Psi)
call destroy(Ham)
! Loschmidt echo
le = dot(Psiinit, Psi)
write(slog, *) 'time LE', time, LE
Tobs%step_ii = 'extras'
obsname2 = trim(obsname)//'step_extra'//qtid//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, qtid=qtid, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine qt_timeevo_qtensorclist
"""
return
[docs]def mpdo_timeevo_tensorlist():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(mpdoc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(mpdoc), OPTIONAL, inout
Initial state for the measurement of the distance.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_timeevo_tensorlist(Psi, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(mpdoc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPDO is evolved with Hamiltonian
mpo_is_hermitian = .false.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_timeevo_tensorlist : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1189', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlist : '//&
!C HECK_ 'meas_mpo (1) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_mpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_mpoc : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Renormalize
call scale(1.0_rKind / norm(Psi), Psi%Superket%AA(Psi%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
!write(slog, *) ''
!write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlist : '//&
!C HECK_ 'meas_mpo (2) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
!if(prop_error('mpdo_timeevo_mpoc: '//&
! 'observe failed.', errst=errst)) return
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlist : '//&
!C HECK_ 'meas_mpo (3) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_mpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_mpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlist : '//&
!C HECK_ 'meas_mpo (4) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_timeevo_tensorlist
"""
return
[docs]def mpdo_timeevo_tensorlistc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(mpdoc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(mpdoc), OPTIONAL, inout
Initial state for the measurement of the distance.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_timeevo_tensorlistc(Psi, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(mpdoc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPDO is evolved with Hamiltonian
mpo_is_hermitian = .false.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_timeevo_tensorlistc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1189', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlistc : '//&
!C HECK_ 'meas_mpo (1) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_mpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_mpoc : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Renormalize
call scale(1.0_rKind / norm(Psi), Psi%Superket%AA(Psi%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
!write(slog, *) ''
!write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlistc : '//&
!C HECK_ 'meas_mpo (2) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
!if(prop_error('mpdo_timeevo_mpoc: '//&
! 'observe failed.', errst=errst)) return
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlistc : '//&
!C HECK_ 'meas_mpo (3) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_mpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_mpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_mpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_tensorlistc : '//&
!C HECK_ 'meas_mpo (4) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_timeevo_tensorlistc
"""
return
[docs]def mpdo_timeevo_qtensorlist():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(qmpdoc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(qmpdoc), OPTIONAL, inout
Initial state for the measurement of the distance.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_timeevo_qtensorlist(Psi, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(qmpdoc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPDO is evolved with Hamiltonian
mpo_is_hermitian = .false.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_timeevo_qtensorlist : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1189', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorlist : '//&
!C HECK_ 'meas_mpo (1) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_qmpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_qmpoc : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Renormalize
call scale(1.0_rKind / norm(Psi), Psi%Superket%AA(Psi%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
!write(slog, *) ''
!write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorlist : '//&
!C HECK_ 'meas_mpo (2) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
!if(prop_error('mpdo_timeevo_qmpoc: '//&
! 'observe failed.', errst=errst)) return
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorlist : '//&
!C HECK_ 'meas_mpo (3) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_qmpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_qmpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorlist : '//&
!C HECK_ 'meas_mpo (4) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_timeevo_qtensorlist
"""
return
[docs]def mpdo_timeevo_qtensorclist():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2, TEBD4, TDVP2, LRK2, or LRK4.
**Arguments**
Psi : TYPE(qmpdoc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(qmpdoc), OPTIONAL, inout
Initial state for the measurement of the distance.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_timeevo_qtensorclist(Psi, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(qmpdoc), intent(inout) :: Psi
real(KIND=rKind), intent(inout) :: time
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPDO is evolved with Hamiltonian
mpo_is_hermitian = .false.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_timeevo_qtensorclist : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1189', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorclist : '//&
!C HECK_ 'meas_mpo (1) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'N', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
! To-Do : count Lindblad terms and switch to Ham in Liouspace evolution
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'N', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_qmpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_qmpoc : time step '//&
! '(1) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Renormalize
call scale(1.0_rKind / norm(Psi), Psi%Superket%AA(Psi%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
!write(slog, *) ''
!write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorclist : '//&
!C HECK_ 'meas_mpo (2) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
!if(prop_error('mpdo_timeevo_qmpoc: '//&
! 'observe failed.', errst=errst)) return
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
! Check for energy initialization
if(init_energy) then
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorclist : '//&
!C HECK_ 'meas_mpo (3) failed.', &
!C HECK_ errst=errst)) return
!init_energy = .false.
energy = 1.0_rKind
end if
! Check H | psi > is too small
if(abs(energy) < 1e-10) then
! Start with random state instead of guess H | psi >
init_random = 'R'
else
init_random = 'N'
end if
call krylov_arnoldi(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, init_random, &
Rs%pbc, errst=errst)
call destroy(Ham)
case(1)
! TEBD - 2nd order
call tebd2(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Psi%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', mpo_is_hermitian, &
.false., .false., Cp, errst=errst)
case(3)
! TDVP (always second order)
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call tdvp2_gen(Psi%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(4)
! LRK - 2nd order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk2(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case(5)
! LRK - 4th order
call ruleset_to_liou_mpo(Ham, Rs, Psi%Superket%ll, Ops, &
Hparams, iop)
call lrk4(Psi%Superket, mydeltat, Ham, Cp, mpo_is_hermitian, &
converged, variance, 'M', Rs%pbc, errst=errst)
call destroy(Ham)
case default
!errst = raise_error('mpdo_timeevo_qmpoc: '//&
! 'selector for time evo not '//&
! 'valid.', 99, errst=errst)
!return
stop 'mpdo_timeevo_qmpoc: selector for time evo not valid'
end select
!if(prop_error('mpdo_timeevo_qmpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
!call ruleset_to_ham_mpo(Ham, Rs, Psi%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi, errst=errst)
!C HECK_if(prop_error('mpdo_timeevo_qtensorclist : '//&
!C HECK_ 'meas_mpo (4) failed.', &
!C HECK_ errst=errst)) return
!call destroy(Ham)
energy = 0.0_rKind
! Distance (can only be calculated for pure states right now)
if(present(Psiinit)) then
le = distance(Psi, Psiinit)
else
le = -10.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Psi, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_timeevo_qtensorclist
"""
return
[docs]def lptn_timeevo_mpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2.
**Arguments**
Rho : TYPE(lptnc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(mpsc), OPTIONAL, inout
Initial state for the measurement of the Loschmidt echo.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_timeevo_mpo(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(lptnc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_timeevo_mpo : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1697', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1730', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_mpo : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1742', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1748', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1754', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1760', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_mpo : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1772', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit, errst=errst)
!if(prop_error('lptn_timeevo_mpo : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1802', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1850', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_mpo : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1862', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1868', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1874', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1880', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_mpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit)
!if(prop_error('lptn_timeevo_mpo : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1919', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_timeevo_mpo
"""
return
[docs]def lptn_timeevo_mpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2.
**Arguments**
Rho : TYPE(lptnc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(mpsc), OPTIONAL, inout
Initial state for the measurement of the Loschmidt echo.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_timeevo_mpoc(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(lptnc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(mpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_timeevo_mpoc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1697', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1730', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_mpoc : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1742', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1748', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1754', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1760', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_mpoc : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1772', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit, errst=errst)
!if(prop_error('lptn_timeevo_mpoc : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1802', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1850', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_mpoc : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1862', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1868', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1874', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1880', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_mpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit)
!if(prop_error('lptn_timeevo_mpoc : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1919', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_timeevo_mpoc
"""
return
[docs]def lptn_timeevo_qmpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2.
**Arguments**
Rho : TYPE(qlptnc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(qmpsc), OPTIONAL, inout
Initial state for the measurement of the Loschmidt echo.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_timeevo_qmpo(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(qlptnc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobs_c), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_timeevo_qmpo : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1697', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1730', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_qmpo : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1742', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1748', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1754', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1760', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_qmpo : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1772', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit, errst=errst)
!if(prop_error('lptn_timeevo_qmpo : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1802', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1850', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_qmpo : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1862', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1868', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1874', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1880', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_qmpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit)
!if(prop_error('lptn_timeevo_qmpo : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1919', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_timeevo_qmpo
"""
return
[docs]def lptn_timeevo_qmpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in real time according to a time evolution method
of choice from TEBD2.
**Arguments**
Rho : TYPE(qlptnc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
Psiinit : TYPE(qmpsc), OPTIONAL, inout
Initial state for the measurement of the Loschmidt echo.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_timeevo_qmpoc(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, Psiinit, errst)
use ioops, only : obsunit, quenchunit
type(qlptnc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
type(qmpsc), intent(inout), optional :: Psiinit
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with (- eye) and the additional scalefactor
complex(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_timeevo_qmpoc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1697', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1730', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_qmpoc : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1742', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1748', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1754', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1760', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_qmpoc : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:1772', errst=errst)) return
end do
! Increment the time
time = time + deltat
! Check if there is measurement to carry out
! ------------------------------------------
if(mod(ii, stepsforoutput) == 0) then
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
write(slog, *) ''
write(slog, *) 'hp actual', Hparams(whichhpchanged)%s
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit, errst=errst)
!if(prop_error('lptn_timeevo_qmpoc : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1802', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE, ABS(LE)**2
write(slog, *) ''
write(Tobs%step_ii, '(I6.6)') ii
obsname2 = trim(obsname)//'step_'//Tobs%step_ii//'.dat'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - eye * scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:1850', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2_22122(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, Cp, errst=errst)
case(2)
! TEBD - 4th order
errst = raise_error('lptn_timeevo_qmpoc : no TEBD4.', &
99, 'TimeEvolutionOps_include.f90:1862', errst=errst)
return
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:1868', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:1874', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:1880', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_qmpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
!call meas_mpo(energy, Ham, Psi)
energy = 0.0_rKind
call destroy(Ham)
! Loschmidt echo
if(present(Psiinit)) then
le = distance(Rho, Psiinit)
!if(prop_error('lptn_timeevo_qmpoc : '//&
! 'distance failed', 'TimeEvolutionOps_include.f90:1919', &
! errst=errst)) return
else
le = 0.0_rKind
end if
write(slog, *) 'time LE', time, LE
obsname2 = trim(obsname)//'step_extra.dat'
Tobs%step_ii = 'extras'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
end if ! hasextradt
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_timeevo_qmpoc
"""
return
[docs]def check_pbc_evomethod():
"""
fortran-subroutine - February 2019 (dj)
Checks that PBC are only enabled for TEBD using matrix exponentials.
**Arguments**
pbc : LOGICAL, in
Flag on periodic boundary conditions.
evomethod : INTEGER, in
Flag on time evolution method.
ktebd : INTEGER, in
Flag on usage of Krylov-TEBD or matrix exponential TEBD.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine check_pbc_evomethod(pbc, evomethod, ktebd, errst)
logical, intent(in) :: pbc
integer, intent(in) :: evomethod, ktebd
integer, intent(out), optional :: errst
! No local variables
!if(present(errst)) errst = 0
if(pbc) then
if(.not. ((evomethod == 1) .or. (evomethod == 2))) then
errst = raise_error('mps_timeevo_MPO_TYPE: time evolution'//&
' method not enabled with PBC.', 99, 'TimeEvolutionOps_include.f90:1990', &
errst=errst)
return
elseif(ktebd == 1) then
! KTEBD could work if no overlaps are stored, where
! a permutation would be problem. We enable KTEBD
! if somebody really needs this after we checked it
errst = raise_error('mps_timeevo_MPO_TYPE: KTEBD'//&
' method not enabled yet with PBC.', 99, 'TimeEvolutionOps_include.f90:1998', &
errst=errst)
return
end if
end if
end subroutine check_pbc_evomethod
"""
return
[docs]def quantum_jump_lexp_tensorlist():
"""
fortran-subroutine - December 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
Lindblad exponential operator.
**Arguments**
Psi : TYPE(mpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(tensorlist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
Lindblad exponential term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the Lindblad exponential term.
rr : INTEGER, in
Select the rule set of Lindblad exponential terms in the array
of all many-body string Lindblad terms.
idx : INTEGER, inout
Next entry to be set in array ``sc``.
sc : REAL(\*), inout
Unweighted probability of the exponential rule set.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_lexp_tensorlist(Psi, Ops, Rs, Hparams, xx, &
rr, idx, sc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
integer, intent(inout) :: idx
real(KIND=rKind), dimension(:), intent(inout) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling for the Lindblad operator
real(KIND=rKind) :: coupl
! outcome of measurement (is in general complex)
complex(KIND=rKind) :: csc
! Intermediate result for correlation measurement
type(tensorc) :: Ltheta
! Temporary operators
type(tensor) :: Tmp, Tmpd
coupl = sqrt(Rs%Lexp(rr)%w * get_coupl(Hparams, Rs%Lexp(rr)%h, xx))
! Get temporary operator and initialize correlation measurement
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%ol), Ops%Li(Rs%Lexp(rr)%ol), &
[1], [1], transl='C')
call corr_init_mps(Psi%Aa(xx), Ltheta, Tmp)
call destroy(Tmp)
! Get temporary operators for phase operator and right operator
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%or), Ops%Li(Rs%Lexp(rr)%or), &
[1], [1], transl='C')
call contr(Tmpd, Ops%Li(Rs%Lexp(rr)%od), Ops%Li(Rs%Lexp(rr)%od), &
[1], [1], transl='C')
call scale(Rs%Lexp(rr)%dp**2, Tmpd)
do ii = (xx + 1), Psi%ll
call corr_meas_mps(csc, Psi%Aa(ii), ii, Psi%ll, &
Ltheta, Tmp, Tmpd, .true., errst=errst)
!if(prop_error('quantum_jump_nlexp_tensorlist : '//&
! 'corr_meas_mps failed.', 'TimeEvolutionOps_include.f90:2615', &
! errst=errst)) return
sc(idx) = coupl**2 * real(csc, KIND=rKind)
idx = idx + 1
end do
call destroy(Tmp)
call destroy(Tmpd)
! Ltheta is always destroyed; xx is never Psi%ll
end subroutine quantum_jump_lexp_tensorlist
"""
return
[docs]def quantum_jump_lexp_tensorlistc():
"""
fortran-subroutine - December 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
Lindblad exponential operator.
**Arguments**
Psi : TYPE(mpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(tensorlistc), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
Lindblad exponential term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the Lindblad exponential term.
rr : INTEGER, in
Select the rule set of Lindblad exponential terms in the array
of all many-body string Lindblad terms.
idx : INTEGER, inout
Next entry to be set in array ``sc``.
sc : REAL(\*), inout
Unweighted probability of the exponential rule set.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_lexp_tensorlistc(Psi, Ops, Rs, Hparams, xx, &
rr, idx, sc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
integer, intent(inout) :: idx
real(KIND=rKind), dimension(:), intent(inout) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling for the Lindblad operator
real(KIND=rKind) :: coupl
! outcome of measurement (is in general complex)
complex(KIND=rKind) :: csc
! Intermediate result for correlation measurement
type(tensorc) :: Ltheta
! Temporary operators
type(tensorc) :: Tmp, Tmpd
coupl = sqrt(Rs%Lexp(rr)%w * get_coupl(Hparams, Rs%Lexp(rr)%h, xx))
! Get temporary operator and initialize correlation measurement
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%ol), Ops%Li(Rs%Lexp(rr)%ol), &
[1], [1], transl='C')
call corr_init_mps(Psi%Aa(xx), Ltheta, Tmp)
call destroy(Tmp)
! Get temporary operators for phase operator and right operator
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%or), Ops%Li(Rs%Lexp(rr)%or), &
[1], [1], transl='C')
call contr(Tmpd, Ops%Li(Rs%Lexp(rr)%od), Ops%Li(Rs%Lexp(rr)%od), &
[1], [1], transl='C')
call scale(Rs%Lexp(rr)%dp**2, Tmpd)
do ii = (xx + 1), Psi%ll
call corr_meas_mps(csc, Psi%Aa(ii), ii, Psi%ll, &
Ltheta, Tmp, Tmpd, .true., errst=errst)
!if(prop_error('quantum_jump_nlexp_tensorlistc : '//&
! 'corr_meas_mps failed.', 'TimeEvolutionOps_include.f90:2615', &
! errst=errst)) return
sc(idx) = coupl**2 * real(csc, KIND=rKind)
idx = idx + 1
end do
call destroy(Tmp)
call destroy(Tmpd)
! Ltheta is always destroyed; xx is never Psi%ll
end subroutine quantum_jump_lexp_tensorlistc
"""
return
[docs]def quantum_jump_lexp_qtensorlist():
"""
fortran-subroutine - December 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
Lindblad exponential operator.
**Arguments**
Psi : TYPE(qmpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(qtensorlist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
Lindblad exponential term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the Lindblad exponential term.
rr : INTEGER, in
Select the rule set of Lindblad exponential terms in the array
of all many-body string Lindblad terms.
idx : INTEGER, inout
Next entry to be set in array ``sc``.
sc : REAL(\*), inout
Unweighted probability of the exponential rule set.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_lexp_qtensorlist(Psi, Ops, Rs, Hparams, xx, &
rr, idx, sc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
integer, intent(inout) :: idx
real(KIND=rKind), dimension(:), intent(inout) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling for the Lindblad operator
real(KIND=rKind) :: coupl
! outcome of measurement (is in general complex)
complex(KIND=rKind) :: csc
! Intermediate result for correlation measurement
type(qtensorc) :: Ltheta
! Temporary operators
type(qtensor) :: Tmp, Tmpd
coupl = sqrt(Rs%Lexp(rr)%w * get_coupl(Hparams, Rs%Lexp(rr)%h, xx))
! Get temporary operator and initialize correlation measurement
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%ol), Ops%Li(Rs%Lexp(rr)%ol), &
[1], [1], transl='C')
call corr_init_mps(Psi%Aa(xx), Ltheta, Tmp)
call destroy(Tmp)
! Get temporary operators for phase operator and right operator
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%or), Ops%Li(Rs%Lexp(rr)%or), &
[1], [1], transl='C')
call contr(Tmpd, Ops%Li(Rs%Lexp(rr)%od), Ops%Li(Rs%Lexp(rr)%od), &
[1], [1], transl='C')
call scale(Rs%Lexp(rr)%dp**2, Tmpd)
do ii = (xx + 1), Psi%ll
call corr_meas_mps(csc, Psi%Aa(ii), ii, Psi%ll, &
Ltheta, Tmp, Tmpd, .true., errst=errst)
!if(prop_error('quantum_jump_nlexp_qtensorlist : '//&
! 'corr_meas_mps failed.', 'TimeEvolutionOps_include.f90:2615', &
! errst=errst)) return
sc(idx) = coupl**2 * real(csc, KIND=rKind)
idx = idx + 1
end do
call destroy(Tmp)
call destroy(Tmpd)
! Ltheta is always destroyed; xx is never Psi%ll
end subroutine quantum_jump_lexp_qtensorlist
"""
return
[docs]def quantum_jump_lexp_qtensorclist():
"""
fortran-subroutine - December 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
Lindblad exponential operator.
**Arguments**
Psi : TYPE(qmpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(qtensorclist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
Lindblad exponential term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the Lindblad exponential term.
rr : INTEGER, in
Select the rule set of Lindblad exponential terms in the array
of all many-body string Lindblad terms.
idx : INTEGER, inout
Next entry to be set in array ``sc``.
sc : REAL(\*), inout
Unweighted probability of the exponential rule set.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_lexp_qtensorclist(Psi, Ops, Rs, Hparams, xx, &
rr, idx, sc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
integer, intent(inout) :: idx
real(KIND=rKind), dimension(:), intent(inout) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling for the Lindblad operator
real(KIND=rKind) :: coupl
! outcome of measurement (is in general complex)
complex(KIND=rKind) :: csc
! Intermediate result for correlation measurement
type(qtensorc) :: Ltheta
! Temporary operators
type(qtensorc) :: Tmp, Tmpd
coupl = sqrt(Rs%Lexp(rr)%w * get_coupl(Hparams, Rs%Lexp(rr)%h, xx))
! Get temporary operator and initialize correlation measurement
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%ol), Ops%Li(Rs%Lexp(rr)%ol), &
[1], [1], transl='C')
call corr_init_mps(Psi%Aa(xx), Ltheta, Tmp)
call destroy(Tmp)
! Get temporary operators for phase operator and right operator
call contr(Tmp, Ops%Li(Rs%Lexp(rr)%or), Ops%Li(Rs%Lexp(rr)%or), &
[1], [1], transl='C')
call contr(Tmpd, Ops%Li(Rs%Lexp(rr)%od), Ops%Li(Rs%Lexp(rr)%od), &
[1], [1], transl='C')
call scale(Rs%Lexp(rr)%dp**2, Tmpd)
do ii = (xx + 1), Psi%ll
call corr_meas_mps(csc, Psi%Aa(ii), ii, Psi%ll, &
Ltheta, Tmp, Tmpd, .true., errst=errst)
!if(prop_error('quantum_jump_nlexp_qtensorclist : '//&
! 'corr_meas_mps failed.', 'TimeEvolutionOps_include.f90:2615', &
! errst=errst)) return
sc(idx) = coupl**2 * real(csc, KIND=rKind)
idx = idx + 1
end do
call destroy(Tmp)
call destroy(Tmpd)
! Ltheta is always destroyed; xx is never Psi%ll
end subroutine quantum_jump_lexp_qtensorclist
"""
return
[docs]def quantum_jump_mbsl_tensorlist():
"""
fortran-subroutine - November 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad operator.
**Arguments**
Psi : TYPE(mpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(tensorlist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbsl_tensorlist(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorlist), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! temporary tensor for contraction
type(tensorc) :: Tmp
! Parts of the MPS
type(mpsc) :: Phi
!if(present(errst)) errst = 0
call copy(Phi, Psi, xx, xx + Rs%Mbsl(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbsl_tensorlist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2719', errst=errst)) return
coupl = sqrt(Rs%Mbsl(rr)%w * get_coupl(Hparams, Rs%Mbsl(rr)%h, xx))
do ii = 1, Rs%Mbsl(rr)%n
call mcontr(Tmp, Phi%Aa(ii), Operators%Li(Rs%Mbsl(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbsl_tensorlist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2727', errst=errst)) return
call destroy(Phi%Aa(ii))
call copy(Phi%Aa(ii), Tmp)
call destroy(Tmp)
end do
call canonize(Phi, 1)
sc = coupl**2 * norm(Phi)
call destroy(Phi)
end subroutine quantum_jump_mbsl_tensorlist
"""
return
[docs]def quantum_jump_mbsl_tensorlistc():
"""
fortran-subroutine - November 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad operator.
**Arguments**
Psi : TYPE(mpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(tensorlistc), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbsl_tensorlistc(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorlistc), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! temporary tensor for contraction
type(tensorc) :: Tmp
! Parts of the MPS
type(mpsc) :: Phi
!if(present(errst)) errst = 0
call copy(Phi, Psi, xx, xx + Rs%Mbsl(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbsl_tensorlistc : copy failed.', &
! 'TimeEvolutionOps_include.f90:2719', errst=errst)) return
coupl = sqrt(Rs%Mbsl(rr)%w * get_coupl(Hparams, Rs%Mbsl(rr)%h, xx))
do ii = 1, Rs%Mbsl(rr)%n
call mcontr(Tmp, Phi%Aa(ii), Operators%Li(Rs%Mbsl(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbsl_tensorlistc : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2727', errst=errst)) return
call destroy(Phi%Aa(ii))
call copy(Phi%Aa(ii), Tmp)
call destroy(Tmp)
end do
call canonize(Phi, 1)
sc = coupl**2 * norm(Phi)
call destroy(Phi)
end subroutine quantum_jump_mbsl_tensorlistc
"""
return
[docs]def quantum_jump_mbsl_qtensorlist():
"""
fortran-subroutine - November 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad operator.
**Arguments**
Psi : TYPE(qmpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(qtensorlist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbsl_qtensorlist(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorlist), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! temporary tensor for contraction
type(qtensorc) :: Tmp
! Parts of the MPS
type(qmpsc) :: Phi
!if(present(errst)) errst = 0
call copy(Phi, Psi, xx, xx + Rs%Mbsl(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbsl_qtensorlist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2719', errst=errst)) return
coupl = sqrt(Rs%Mbsl(rr)%w * get_coupl(Hparams, Rs%Mbsl(rr)%h, xx))
do ii = 1, Rs%Mbsl(rr)%n
call mcontr(Tmp, Phi%Aa(ii), Operators%Li(Rs%Mbsl(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbsl_qtensorlist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2727', errst=errst)) return
call destroy(Phi%Aa(ii))
call copy(Phi%Aa(ii), Tmp)
call destroy(Tmp)
end do
call canonize(Phi, 1)
sc = coupl**2 * norm(Phi)
call destroy(Phi)
end subroutine quantum_jump_mbsl_qtensorlist
"""
return
[docs]def quantum_jump_mbsl_qtensorclist():
"""
fortran-subroutine - November 2017 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad operator.
**Arguments**
Psi : TYPE(qmpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(qtensorclist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbsl_qtensorclist(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorclist), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! temporary tensor for contraction
type(qtensorc) :: Tmp
! Parts of the MPS
type(qmpsc) :: Phi
!if(present(errst)) errst = 0
call copy(Phi, Psi, xx, xx + Rs%Mbsl(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbsl_qtensorclist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2719', errst=errst)) return
coupl = sqrt(Rs%Mbsl(rr)%w * get_coupl(Hparams, Rs%Mbsl(rr)%h, xx))
do ii = 1, Rs%Mbsl(rr)%n
call mcontr(Tmp, Phi%Aa(ii), Operators%Li(Rs%Mbsl(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbsl_qtensorclist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2727', errst=errst)) return
call destroy(Phi%Aa(ii))
call copy(Phi%Aa(ii), Tmp)
call destroy(Tmp)
end do
call canonize(Phi, 1)
sc = coupl**2 * norm(Phi)
call destroy(Phi)
end subroutine quantum_jump_mbsl_qtensorclist
"""
return
[docs]def quantum_jump_mbslxy_tensorlist():
"""
fortran-subroutine - March 2018 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad XY operator.
**Arguments**
Psi : TYPE(mpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(tensorlist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad XY term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbslxy_tensorlist(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorlist), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! offset for MBSLXY term
integer :: os
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! overlap between two states
complex(KIND=rKind) :: overlap
! temporary tensor for contraction
type(tensorc) :: Tmp
! Parts of the MPS
type(mpsc) :: Phia, Phib
!if(present(errst)) errst = 0
call copy(Phia, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2838', errst=errst)) return
call copy(Phib, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2842', errst=errst)) return
coupl = Rs%Mbslxy(rr)%w * get_coupl(Hparams, Rs%Mbslxy(rr)%h, xx)
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phia%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2850', errst=errst)) return
call destroy(Phia%Aa(ii))
call copy(Phia%Aa(ii), Tmp)
call destroy(Tmp)
end do
os = Rs%Mbslxy(rr)%n
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phib%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(os + ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2862', errst=errst)) return
call destroy(Phib%Aa(ii))
call copy(Phib%Aa(ii), Tmp)
call destroy(Tmp)
end do
overlap = dot(Phib, Phia, errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlist : dot '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2871', errst=errst)) return
sc = coupl**2 * abs(overlap)
call destroy(Phia)
call destroy(Phib)
end subroutine quantum_jump_mbslxy_tensorlist
"""
return
[docs]def quantum_jump_mbslxy_tensorlistc():
"""
fortran-subroutine - March 2018 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad XY operator.
**Arguments**
Psi : TYPE(mpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(tensorlistc), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad XY term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbslxy_tensorlistc(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorlistc), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! offset for MBSLXY term
integer :: os
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! overlap between two states
complex(KIND=rKind) :: overlap
! temporary tensor for contraction
type(tensorc) :: Tmp
! Parts of the MPS
type(mpsc) :: Phia, Phib
!if(present(errst)) errst = 0
call copy(Phia, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlistc : copy failed.', &
! 'TimeEvolutionOps_include.f90:2838', errst=errst)) return
call copy(Phib, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlistc : copy failed.', &
! 'TimeEvolutionOps_include.f90:2842', errst=errst)) return
coupl = Rs%Mbslxy(rr)%w * get_coupl(Hparams, Rs%Mbslxy(rr)%h, xx)
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phia%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlistc : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2850', errst=errst)) return
call destroy(Phia%Aa(ii))
call copy(Phia%Aa(ii), Tmp)
call destroy(Tmp)
end do
os = Rs%Mbslxy(rr)%n
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phib%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(os + ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlistc : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2862', errst=errst)) return
call destroy(Phib%Aa(ii))
call copy(Phib%Aa(ii), Tmp)
call destroy(Tmp)
end do
overlap = dot(Phib, Phia, errst=errst)
!if(prop_error('quantum_jump_mbslxy_tensorlistc : dot '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2871', errst=errst)) return
sc = coupl**2 * abs(overlap)
call destroy(Phia)
call destroy(Phib)
end subroutine quantum_jump_mbslxy_tensorlistc
"""
return
[docs]def quantum_jump_mbslxy_qtensorlist():
"""
fortran-subroutine - March 2018 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad XY operator.
**Arguments**
Psi : TYPE(qmpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(qtensorlist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad XY term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbslxy_qtensorlist(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorlist), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! offset for MBSLXY term
integer :: os
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! overlap between two states
complex(KIND=rKind) :: overlap
! temporary tensor for contraction
type(qtensorc) :: Tmp
! Parts of the MPS
type(qmpsc) :: Phia, Phib
!if(present(errst)) errst = 0
call copy(Phia, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorlist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2838', errst=errst)) return
call copy(Phib, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorlist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2842', errst=errst)) return
coupl = Rs%Mbslxy(rr)%w * get_coupl(Hparams, Rs%Mbslxy(rr)%h, xx)
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phia%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorlist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2850', errst=errst)) return
call destroy(Phia%Aa(ii))
call copy(Phia%Aa(ii), Tmp)
call destroy(Tmp)
end do
os = Rs%Mbslxy(rr)%n
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phib%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(os + ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorlist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2862', errst=errst)) return
call destroy(Phib%Aa(ii))
call copy(Phib%Aa(ii), Tmp)
call destroy(Tmp)
end do
overlap = dot(Phib, Phia, errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorlist : dot '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2871', errst=errst)) return
sc = coupl**2 * abs(overlap)
call destroy(Phia)
call destroy(Phib)
end subroutine quantum_jump_mbslxy_qtensorlist
"""
return
[docs]def quantum_jump_mbslxy_qtensorclist():
"""
fortran-subroutine - March 2018 (dj)
Calculate the unweighted probability for a quantum jump due to a
many-body string Lindblad XY operator.
**Arguments**
Psi : TYPE(qmpsc), inout
Calculate the probability for this wave-function.
Operators : TYPE(qtensorclist), inout
The operators for the simulations, containing the Lindblad operators.
Rs : TYPE(MPORuleSet), in
The rule set for the evolution containing the setup for the
many-body string Lindblad XY term.
Hparams : TYPE(HamiltonianParameters)(\*), in
Contains the possibly space and time dependent coupling for the
terms in the Lindblad master equation.
xx : INTEGER, in
The left-most site in the many-body string Lindblad term.
rr : INTEGER, in
Select the rule set of many-body string Lindblad term in the array
of all many-body string Lindblad terms.
sc : REAL, out
Unweighted probability.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine quantum_jump_mbslxy_qtensorclist(Psi, Operators, Rs, Hparams, xx, &
rr, sc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorclist), intent(inout) :: Operators
type(MPORuleSet), intent(in) :: Rs
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: xx, rr
real(KIND=rKind), intent(out) :: sc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! offset for MBSLXY term
integer :: os
! Coupling of this MBS Lindblad operator
real(KIND=rKind) :: coupl
! overlap between two states
complex(KIND=rKind) :: overlap
! temporary tensor for contraction
type(qtensorc) :: Tmp
! Parts of the MPS
type(qmpsc) :: Phia, Phib
!if(present(errst)) errst = 0
call copy(Phia, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorclist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2838', errst=errst)) return
call copy(Phib, Psi, xx, xx + Rs%Mbslxy(rr)%n - 1, errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorclist : copy failed.', &
! 'TimeEvolutionOps_include.f90:2842', errst=errst)) return
coupl = Rs%Mbslxy(rr)%w * get_coupl(Hparams, Rs%Mbslxy(rr)%h, xx)
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phia%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorclist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2850', errst=errst)) return
call destroy(Phia%Aa(ii))
call copy(Phia%Aa(ii), Tmp)
call destroy(Tmp)
end do
os = Rs%Mbslxy(rr)%n
do ii = 1, Rs%Mbslxy(rr)%n
call mcontr(Tmp, Phib%Aa(ii), Operators%Li(Rs%Mbslxy(rr)%o(os + ii)), &
[2], [2], errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorclist : mcontr '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2862', errst=errst)) return
call destroy(Phib%Aa(ii))
call copy(Phib%Aa(ii), Tmp)
call destroy(Tmp)
end do
overlap = dot(Phib, Phia, errst=errst)
!if(prop_error('quantum_jump_mbslxy_qtensorclist : dot '//&
! 'failed.', 'TimeEvolutionOps_include.f90:2871', errst=errst)) return
sc = coupl**2 * abs(overlap)
call destroy(Phia)
call destroy(Phib)
end subroutine quantum_jump_mbslxy_qtensorclist
"""
return
[docs]def lptn_itimeevo_mpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(lptn), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_itimeevo_mpo(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(lptn), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obs_r), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_itimeevo_mpo : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3051', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3084', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3104', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3110', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3116', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_mpo : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3128', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3166', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3185', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3191', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3197', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_mpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_itimeevo_mpo
"""
return
[docs]def lptn_itimeevo_mpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(lptnc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_itimeevo_mpoc(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(lptnc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_itimeevo_mpoc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3051', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3084', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3104', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3110', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3116', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_mpoc : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3128', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_mpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3166', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_mpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3185', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_mpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3191', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_mpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3197', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_mpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_itimeevo_mpoc
"""
return
[docs]def lptn_itimeevo_qmpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(qlptn), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_itimeevo_qmpo(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qlptn), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobs_r), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_itimeevo_qmpo : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3051', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3084', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3104', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3110', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3116', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_qmpo : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3128', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpo : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3166', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpo : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3185', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3191', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3197', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_qmpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_itimeevo_qmpo
"""
return
[docs]def lptn_itimeevo_qmpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(qlptnc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine lptn_itimeevo_qmpoc(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qlptnc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('lptn_itimeevo_qmpoc : check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3051', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3084', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3104', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3110', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3116', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('lptn_timeevo_qmpoc : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3128', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
errst = raise_error('lptn_timeevo_qmpoc : no Krylov.', &
99, 'TimeEvolutionOps_include.f90:3166', errst=errst)
return
case(1)
! TEBD - 2nd order
call tebd2(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.false., Cp, errst=errst)
case(3)
! TDVP (always second order)
errst = raise_error('lptn_timeevo_qmpoc : no TDVP.', &
99, 'TimeEvolutionOps_include.f90:3185', errst=errst)
return
case(4)
! LRK - 2nd order
errst = raise_error('lptn_timeevo_qmpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3191', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('lptn_timeevo_qmpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3197', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_qmpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
! Measurement
! -----------
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine lptn_itimeevo_qmpoc
"""
return
[docs]def mpdo_itimeevo_mpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(mpdo), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_itimeevo_mpo(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(mpdo), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(tensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obs_r), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! flag if MPO is allocated
logical :: mpo_alloc
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! We can build MPO right now, parameters are not allowed to change
! during imaginary time evolution
mpo_alloc = any(([0, 3, 4, 5] - evomethod) == 0)
if(mpo_alloc) then
call ruleset_to_clliou_mpo(Ham, Rs, Rho%Superket%ll, Ops, &
Hparams, iop)
end if
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_itimeevo_mpo: check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3436', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', Rs%pbc, &
errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_mpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3496', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_mpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3502', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mpdo_timeevo_mpo : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3514', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', &
Rs%pbc, errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_mpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3578', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_mpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3584', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_mpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
if(mpo_alloc) call destroy(Ham)
! Measurement
! -----------
! Renormalize
call scale(1.0_rKind / norm(Rho), Rho%Superket%AA(Rho%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%Superket%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_itimeevo_mpo
"""
return
[docs]def mpdo_itimeevo_mpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(mpdoc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_itimeevo_mpoc(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(mpdoc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(tensorlistc), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(obsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! flag if MPO is allocated
logical :: mpo_alloc
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(mpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! We can build MPO right now, parameters are not allowed to change
! during imaginary time evolution
mpo_alloc = any(([0, 3, 4, 5] - evomethod) == 0)
if(mpo_alloc) then
call ruleset_to_clliou_mpo(Ham, Rs, Rho%Superket%ll, Ops, &
Hparams, iop)
end if
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_itimeevo_mpoc: check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3436', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', Rs%pbc, &
errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_mpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3496', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_mpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3502', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mpdo_timeevo_mpoc : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3514', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', &
Rs%pbc, errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_mpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3578', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_mpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3584', errst=errst)
return
case default
errst = raise_error('mps_timeevo_mpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_mpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
if(mpo_alloc) call destroy(Ham)
! Measurement
! -----------
! Renormalize
call scale(1.0_rKind / norm(Rho), Rho%Superket%AA(Rho%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%Superket%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_itimeevo_mpoc
"""
return
[docs]def mpdo_itimeevo_qmpo():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(qmpdo), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_itimeevo_qmpo(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qmpdo), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(qtensorlist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobs_r), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! flag if MPO is allocated
logical :: mpo_alloc
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpo) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! We can build MPO right now, parameters are not allowed to change
! during imaginary time evolution
mpo_alloc = any(([0, 3, 4, 5] - evomethod) == 0)
if(mpo_alloc) then
call ruleset_to_clliou_mpo(Ham, Rs, Rho%Superket%ll, Ops, &
Hparams, iop)
end if
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_itimeevo_qmpo: check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3436', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', Rs%pbc, &
errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_qmpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3496', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_qmpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3502', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mpdo_timeevo_qmpo : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3514', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', &
Rs%pbc, errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_qmpo : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3578', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_qmpo : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3584', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpo: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_qmpo : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
if(mpo_alloc) call destroy(Ham)
! Measurement
! -----------
! Renormalize
call scale(1.0_rKind / norm(Rho), Rho%Superket%AA(Rho%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%Superket%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_itimeevo_qmpo
"""
return
[docs]def mpdo_itimeevo_qmpoc():
"""
fortran-subroutine - April 2016 (updated, dj)
Evolve the quantum state in imaginary time according to a time
evolution method of choice from TEBD2.
**Arguments**
Rho : TYPE(qmpdoc), inout
Evolve the wave function in real time.
time : REAL, inout
The time of the evolution; due to multiple quenches, the starting
point can differ from 0.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Hamiltonian.
Rs : TYPE(MPORuleSet), in
Defines the rules how to define the Hamiltonian.
iop : INTEGER, in
Position of the identity matrix.
Cp : TYPE(ConvParam), in
Contains the convergence parameters of the algorithms.
quenchname : CHARACTER(\*), in
Filename defining the quench.
obsname : CHARACTER(\*), in
Target file where to store the observables.
Imapper : TYPE(imap), in
Mapping for the symmetric subspaces of a local Hilbert space
to the complete local Hilbert space.
**Details**
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine mpdo_itimeevo_qmpoc(Rho, time, Ops, Rs, iop, &
Cp, quenchname, obsname, baseout, RecentHparams, Tobs, evomethod, &
start_time, timeevo_state_delete, Imapper, errst)
use ioops, only : obsunit, quenchunit
type(qmpdoc), intent(inout) :: Rho
real(KIND=rKind), intent(inout) :: time
type(qtensorclist), intent(inout) :: Ops
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: iop
type(ConvParam), intent(in) :: Cp
character(len=*), intent(in) :: quenchname, obsname, baseout
type(HamiltonianParameters), pointer, intent(inout) :: RecentHparams(:)
type(qobsc), intent(inout) :: Tobs
integer, intent(in) :: evomethod
real(KIND=rKind), intent(in) :: start_time
character(len=*), intent(inout) :: timeevo_state_delete
type(imap), intent(in) :: Imapper
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping / reading
integer :: ii
! for looping
integer :: jj
! flag if time evolution has to be done
logical :: skip
! flag if energy measurement available (only referenced for Krylov)
logical :: init_energy
! flag if states for fitting should be randomized because | psi > orthogonal
! to H | psi >
character :: init_random
! Extending the basis filename with the time step
character(len=200) :: obsname2
! Flag if there is an additional smaller time step
logical :: hasextradt
! flag if MPO is allocated
logical :: mpo_alloc
! value of time step and extra time step
real(KIND=rKind) :: deltat, exdt
! Flag if algorithms have converged
logical :: converged
! time step scaled with the additional scalefactor (imaginary
! time does not need and eye)
real(KIND=rKind) :: mydeltat
! Scalar weight for the Magnus expansion
real(KIND=rKind), dimension(:), allocatable :: scalefactors
! Representing the Hamiltonian as MPO
type(qmpoc) :: Ham
! Couplings for the parameters in the Hamiltonian
type(HamiltonianParameters), pointer :: Hparams(:)
! Indices of parameters in the Hamiltonian changing
integer, dimension(:), allocatable :: whichhpchanged
! Loschmidt echo
complex(KIND=rKind) :: le
integer :: nexp, nsteps, stepsforoutput
real(KIND=rKind) :: energy, variance
! Flag if operator is hermitian
logical :: mpo_is_hermitian
variance = 0.0_rKind
converged = .true.
init_energy = .true.
! MPS is evolved with Hamiltonian
mpo_is_hermitian = .true.
call prepare_steps(quenchname, nsteps, stepsforoutput, nexp, &
deltat, exdt, hasextradt, scalefactors, whichhpchanged)
call copy(Hparams, RecentHparams)
! We can build MPO right now, parameters are not allowed to change
! during imaginary time evolution
mpo_alloc = any(([0, 3, 4, 5] - evomethod) == 0)
if(mpo_alloc) then
call ruleset_to_clliou_mpo(Ham, Rs, Rho%Superket%ll, Ops, &
Hparams, iop)
end if
! Check restrictions PBC (this is outside of time step loop)
call check_pbc_evomethod(Rs%pbc, evomethod, Cp%ktebd, errst=errst)
!if(prop_error('mpdo_itimeevo_qmpoc: check_pbc_evomethod '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3436', errst=errst)) return
! Loop over the time-steps
! ========================
do ii = 1, nsteps
! Check for restoring time evolution (deltat * 1e-10 to prevent
! numerical errors)
skip = (time - start_time + deltat * 1e-10 < 0)
! Loop over the Commutator Free Magnus Expansion (CFME)
! -----------------------------------------------------
!
! Looping over the CFME is one time-step dt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
! Mapping in python is ..
! methodsmap = {'krylov' : 0 , 'TEBD_2' : 1, 'TEBD_4' : 2,
! 'TDVP_2' : 3, 'LRK_2' : 4, 'LRK_4' : 5}
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', Rs%pbc, &
errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_qmpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3496', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_qmpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3502', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mpdo_timeevo_qmpoc : time step '//&
! 'failed.', 'TimeEvolutionOps_include.f90:3514', errst=errst)) return
end do
! Increment the time
time = time + deltat
! There is only one measurement at the end of the quench
! Each quench leads to one temperature.
end do
! Carry out an extra time step including a measurement
! ====================================================
if(hasextradt) then
! Check for restoring time evolution
skip = time - start_time + exdt * 1e-10 < 0
! Time step
! ---------
write(slog, *) 'has extra dt'
deltat = exdt
do jj = 1, nexp
! Read in changed parameters
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
! Can only skip after updating hparam - have to read them
if(skip) cycle
mydeltat = - scalefactors(jj) * deltat
select case(evomethod)
case(0)
! Krylov method
call krylov_method(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'N', 'M', &
Rs%pbc, errst=errst)
case(1)
! TEBD - 2nd order
call tebd2(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(2)
! TEBD - 4th order
call tebd4(Rho%Superket, mydeltat, Rs, Ops, Hparams, iop, &
converged, variance, 'M', .true., .false., &
.true., Cp, errst=errst)
case(3)
! TDVP (always second order)
call tdvp2_symm(Rho%Superket, mydeltat, Ham, converged, &
variance, Cp, 'M', Rs%pbc, errst=errst)
case(4)
! LRK - 2nd order
errst = raise_error('mpdo_timeevo_qmpoc : no LRK2.', &
99, 'TimeEvolutionOps_include.f90:3578', errst=errst)
return
case(5)
! LRK - 4th order
errst = raise_error('mpdo_timeevo_qmpoc : no LRK4.', &
99, 'TimeEvolutionOps_include.f90:3584', errst=errst)
return
case default
errst = raise_error('mps_timeevo_qmpoc: '//&
'selector for time evo not '//&
'valid.', 99, errst=errst)
return
end select
!if(prop_error('mps_timeevo_qmpoc : time step '//&
! '(2) failed.', errst=errst)) return
end do
! Increment the time
time = time + deltat
write(slog, *) 'before final'
end if ! hasextradt
if(mpo_alloc) call destroy(Ham)
! Measurement
! -----------
! Renormalize
call scale(1.0_rKind / norm(Rho), Rho%Superket%AA(Rho%Superket%oc))
! Get Hamiltonian parameters at actual time
call update_hamiltonianparameter(Hparams, quenchunit, &
whichhpchanged)
if(.not. skip) then
call ruleset_to_ham_mpo(Ham, Rs, Rho%Superket%ll, Ops, Hparams, iop)
! calculate energy
call meas_mpo(energy, Ham, Rho)
call destroy(Ham)
le = 0.0_rKind
obsname2 = trim(obsname)//'.dat'
Tobs%step_ii = '000000'
call observe(Rho, Ops, Tobs, trim(obsname2), baseout, &
timeevo_state_delete, obsunit, energy, &
variance, converged, Imapper, Cp, time=time, &
le=le, errst=errst)
variance = 0.0_rKind
end if
call destroy(RecentHparams, '', 1, clearfile=.false.)
call copy(RecentHparams, Hparams)
call destroy(Hparams, '', 1, clearfile=.false.)
deallocate(scalefactors, whichhpchanged)
close(quenchunit)
end subroutine mpdo_itimeevo_qmpoc
"""
return