"""
Fortran module TEBDOps: August 2017 (dj)
Contains the subroutines for the TEBD
**Authors**
* D. Jaschke
* M. L. Wall
**Details**
The following subroutines / functions are defined for the
applicable data type
+--------------------+-------------+---------+
| procedure | include.f90 | mpi.f90 |
+====================+=============+=========+
| tebd2 | X | |
+--------------------+-------------+---------+
| tebd4 | X | |
+--------------------+-------------+---------+
"""
[docs]def tebd2_mpsc_tensorlist_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(mpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_mpsc_tensorlist_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
complex(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_tensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_mpsc_tensorlist_complex : prepare_op2_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mpsc_tensor_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mpsc_tensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_mpsc_tensorlist_complex : tebd_method_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_mpsc_tensorlist_complex
"""
return
[docs]def tebd2_mpsc_tensorlistc_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(mpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlistc), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_mpsc_tensorlistc_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
complex(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_tensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_mpsc_tensorlistc_complex : prepare_op2_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mpsc_tensorc_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mpsc_tensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_mpsc_tensorlistc_complex : tebd_method_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_mpsc_tensorlistc_complex
"""
return
[docs]def tebd2_qmpsc_qtensorlist_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(qmpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_qmpsc_qtensorlist_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
complex(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_qtensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_qmpsc_qtensorlist_complex : prepare_op2_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmpsc_qtensor_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmpsc_qtensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_qmpsc_qtensorlist_complex : tebd_method_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_qmpsc_qtensorlist_complex
"""
return
[docs]def tebd2_qmpsc_qtensorclist_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(qmpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorclist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_qmpsc_qtensorclist_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
complex(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_qtensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_qmpsc_qtensorclist_complex : prepare_op2_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmpsc_qtensorc_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmpsc_qtensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_qmpsc_qtensorclist_complex : tebd_method_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_qmpsc_qtensorclist_complex
"""
return
[docs]def tebd2_mps_tensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(mps), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_mps_tensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mps), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_tensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_mps_tensorlist_real : prepare_op2_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mps_tensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mps_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_mps_tensorlist_real : tebd_method_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_mps_tensorlist_real
"""
return
[docs]def tebd2_mpsc_tensorlistc_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(mpsc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlistc), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_mpsc_tensorlistc_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mpsc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_tensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_mpsc_tensorlistc_real : prepare_op2_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mpsc_tensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mpsc_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_mpsc_tensorlistc_real : tebd_method_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_mpsc_tensorlistc_real
"""
return
[docs]def tebd2_qmps_qtensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(qmps), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_qmps_qtensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmps), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_qtensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_qmps_qtensorlist_real : prepare_op2_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmps_qtensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmps_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_qmps_qtensorlist_real : tebd_method_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_qmps_qtensorlist_real
"""
return
[docs]def tebd2_qmpsc_qtensorclist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(qmpsc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorclist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_qmpsc_qtensorclist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmpsc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_qtensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_qmpsc_qtensorclist_real : prepare_op2_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmpsc_qtensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmpsc_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_qmpsc_qtensorclist_real : tebd_method_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_qmpsc_qtensorclist_real
"""
return
[docs]def tebd2_lptn_tensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(lptn), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_lptn_tensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(lptn), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_tensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_lptn_tensorlist_real : prepare_op2_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_lptn_tensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_lptn_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_lptn_tensorlist_real : tebd_method_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_lptn_tensorlist_real
"""
return
[docs]def tebd2_lptnc_tensorlistc_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(lptnc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlistc), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_lptnc_tensorlistc_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(lptnc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_tensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_lptnc_tensorlistc_real : prepare_op2_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_lptnc_tensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_lptnc_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_lptnc_tensorlistc_real : tebd_method_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_lptnc_tensorlistc_real
"""
return
[docs]def tebd2_qlptn_qtensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(qlptn), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_qlptn_qtensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qlptn), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_qtensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_qlptn_qtensorlist_real : prepare_op2_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qlptn_qtensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qlptn_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_qlptn_qtensorlist_real : tebd_method_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_qlptn_qtensorlist_real
"""
return
[docs]def tebd2_qlptnc_qtensorclist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 2nd order implementation.
**Arguments**
Psi : TYPE(qlptnc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorclist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true). This
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_qlptnc_qtensorclist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qlptnc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 2) :: loop
real(KIND=rKind), dimension(2) :: weight
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
loop(:, 1) = [1, up, 1]
loop(:, 2) = [up, 1, -1]
weight = [deltat / 2.0_rKind, deltat / 2.0_rKind]
call prepare_op2_qtensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_qlptnc_qtensorclist_real : prepare_op2_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qlptnc_qtensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qlptnc_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd2_qlptnc_qtensorclist_real : tebd_method_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd2_qlptnc_qtensorclist_real
"""
return
[docs]def tebd4_mpsc_tensorlist_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(mpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_mpsc_tensorlist_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
complex(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_tensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_mpsc_tensorlist_complex : prepare_op2_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mpsc_tensor_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mpsc_tensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_mpsc_tensorlist_complex : tebd_method_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_mpsc_tensorlist_complex
"""
return
[docs]def tebd4_mpsc_tensorlistc_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(mpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlistc), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_mpsc_tensorlistc_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
complex(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_tensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_mpsc_tensorlistc_complex : prepare_op2_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mpsc_tensorc_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mpsc_tensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_mpsc_tensorlistc_complex : tebd_method_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_mpsc_tensorlistc_complex
"""
return
[docs]def tebd4_qmpsc_qtensorlist_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(qmpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_qmpsc_qtensorlist_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
complex(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_qtensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_qmpsc_qtensorlist_complex : prepare_op2_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmpsc_qtensor_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmpsc_qtensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_qmpsc_qtensorlist_complex : tebd_method_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_qmpsc_qtensorlist_complex
"""
return
[docs]def tebd4_qmpsc_qtensorclist_complex():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(qmpsc), inout
Propagate this state in time.
deltat : complex, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorclist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_qmpsc_qtensorclist_complex(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmpsc), intent(inout) :: Psi
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
complex(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_qtensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_qmpsc_qtensorclist_complex : prepare_op2_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmpsc_qtensorc_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmpsc_qtensorc_complex(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_qmpsc_qtensorclist_complex : tebd_method_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_qmpsc_qtensorclist_complex
"""
return
[docs]def tebd4_mps_tensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(mps), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_mps_tensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mps), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_tensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_mps_tensorlist_real : prepare_op2_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mps_tensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mps_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_mps_tensorlist_real : tebd_method_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_mps_tensorlist_real
"""
return
[docs]def tebd4_mpsc_tensorlistc_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(mpsc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlistc), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_mpsc_tensorlistc_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(mpsc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_tensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_mpsc_tensorlistc_real : prepare_op2_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_mpsc_tensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_mpsc_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_mpsc_tensorlistc_real : tebd_method_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_mpsc_tensorlistc_real
"""
return
[docs]def tebd4_qmps_qtensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(qmps), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_qmps_qtensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmps), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_qtensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_qmps_qtensorlist_real : prepare_op2_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmps_qtensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmps_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_qmps_qtensorlist_real : tebd_method_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_qmps_qtensorlist_real
"""
return
[docs]def tebd4_qmpsc_qtensorclist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(qmpsc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorclist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_qmpsc_qtensorclist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qmpsc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_qtensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_qmpsc_qtensorclist_real : prepare_op2_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qmpsc_qtensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qmpsc_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_qmpsc_qtensorclist_real : tebd_method_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_qmpsc_qtensorclist_real
"""
return
[docs]def tebd4_lptn_tensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(lptn), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_lptn_tensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(lptn), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_tensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_lptn_tensorlist_real : prepare_op2_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_lptn_tensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_lptn_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_lptn_tensorlist_real : tebd_method_tensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_lptn_tensorlist_real
"""
return
[docs]def tebd4_lptnc_tensorlistc_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(lptnc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(tensorlistc), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_lptnc_tensorlistc_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(lptnc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(tensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_tensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_lptnc_tensorlistc_real : prepare_op2_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_lptnc_tensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_lptnc_tensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_lptnc_tensorlistc_real : tebd_method_tensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_lptnc_tensorlistc_real
"""
return
[docs]def tebd4_qlptn_qtensorlist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(qlptn), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorlist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_qlptn_qtensorlist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qlptn), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_qtensor(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_qlptn_qtensorlist_real : prepare_op2_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qlptn_qtensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qlptn_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_qlptn_qtensorlist_real : tebd_method_qtensor '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_qlptn_qtensorlist_real
"""
return
[docs]def tebd4_qlptnc_qtensorclist_real():
"""
fortran-subroutine - August 2017 (dj, updated)
Propagate psi with the TEBD algorithm. 4th order implementation.
**Arguments**
Psi : TYPE(qlptnc), inout
Propagate this state in time.
deltat : real, in
Time step for evolution.
Rs : TYPE(MPORuleSet), in
Rule set for the construction of the Hamiltonian.
Ops : TYPE(qtensorclist), in
Operators needed to build the Hamiltonian.
Hparams : TYPE(HamiltonianParameters)(\*), in
The couplings for the terms in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
renorm : LOGICAL, in
Flag if state vector should be renormalized to 1 (true).
'N' : do not normalize (default); 'M' : normalize for MPS
1 / sqrt(norm);
mpo_is_hermitian : LOGICAL, in
Flag if the MPO is hermitian, i.e. for Hamiltonian, or if it is
a non-hermitian Liouville operator.
qt : LOGICAL, in
Flag if quantum trajectories are used.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Details**
Currently uses complete reorthogonalization for stability.
(defined in TimeEvolutionOps_include.f90)
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd4_qlptnc_qtensorclist_real(Psi, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, renorm, mpo_is_hermitian, qt, finitet, Cp, errst)
type(qlptnc), intent(inout) :: Psi
real(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian, qt, finitet
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! second last site / last site in PBC
integer :: up
! Settings for TEBD loops
integer, dimension(3, 24) :: loop
real(KIND=rKind), dimension(24) :: weight
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two-site operators as tensors for Liouville operator
type(qtensorc), dimension(:), pointer :: Lts
! Define looping parameters and weight
if(.not. Rs%pbc) then
up = Psi%ll - 1
else
up = Psi%ll
end if
jj = 1
do ii = 1, 12
loop(:, jj) = [ 1, up, 1]
loop(:, jj + 1) = [up, 1, -1]
jj = jj + 2
end do
weight = deltat / 12.0_rKind
weight( 4) = - 2.0_rKind * weight(4)
weight( 6) = 0.0_rKind
weight( 8) = 0.0_rKind
weight(10) = 0.0_rKind
weight(15) = 0.0_rKind
weight(17) = 0.0_rKind
weight(19) = 0.0_rKind
weight(21) = - 2.0_rKind * weight(21)
call prepare_op2_qtensorc(Hts, Lts, Rs, Psi%ll, Ops, Hparams, &
iop, mpo_is_hermitian, qt, finitet, &
Rs%pbc, errst=errst)
!if(prop_error('tebd4_qlptnc_qtensorclist_real : prepare_op2_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
call tebd_method_qlptnc_qtensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
else
call tebd_method_qlptnc_qtensorc_real(Psi, Lts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, Rs%pbc, errst=errst)
end if
!if(prop_error('tebd4_qlptnc_qtensorclist_real : tebd_method_qtensorc '//&
! 'failed.', errst=errst)) return
if(mpo_is_hermitian) then
do ii = 1, up
call destroy(Hts(ii))
end do
deallocate(Hts)
else
do ii = 1, up
call destroy(Lts(ii))
end do
deallocate(Lts)
end if
end subroutine tebd4_qlptnc_qtensorclist_real
"""
return
[docs]def tebd_method_mpsc_tensor_complex():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_mpsc_tensor_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(mpsc), intent(inout) :: Psi
type(tensor), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
complex(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(tensorc) :: Theta
! temporary tensor
type(tensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_mpsc_tensor_complex
"""
return
[docs]def tebd_method_mpsc_tensorc_complex():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_mpsc_tensorc_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
complex(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(tensorc) :: Theta
! temporary tensor
type(tensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_mpsc_tensorc_complex
"""
return
[docs]def tebd_method_qmpsc_qtensor_complex():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qmpsc_qtensor_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensor), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
complex(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(qtensorc) :: Theta
! temporary tensor
type(qtensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qmpsc_qtensor_complex
"""
return
[docs]def tebd_method_qmpsc_qtensorc_complex():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qmpsc_qtensorc_complex(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
complex(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(qtensorc) :: Theta
! temporary tensor
type(qtensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qmpsc_qtensorc_complex
"""
return
[docs]def tebd_method_mps_tensor_real():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_mps_tensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(mps), intent(inout) :: Psi
type(tensor), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(tensor) :: Theta
! temporary tensor
type(tensor) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_mps_tensor_real
"""
return
[docs]def tebd_method_mpsc_tensorc_real():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_mpsc_tensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(mpsc), intent(inout) :: Psi
type(tensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(tensorc) :: Theta
! temporary tensor
type(tensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_mpsc_tensorc_real
"""
return
[docs]def tebd_method_qmps_qtensor_real():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qmps_qtensor_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qmps), intent(inout) :: Psi
type(qtensor), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(qtensor) :: Theta
! temporary tensor
type(qtensor) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qmps_qtensor_real
"""
return
[docs]def tebd_method_qmpsc_qtensorc_real():
"""
fortran-subroutine -
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qmpsc_qtensorc_real(Psi, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qmpsc), intent(inout) :: Psi
type(qtensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(qtensorc) :: Theta
! temporary tensor
type(qtensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Psi%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Psi%ll)
ocsave = Psi%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Psi%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Psi, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:486', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Psi%oc /= jp) .and. (Psi%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Psi, jp, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Psi, jp + 1, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call contr(Theta, Psi%Aa(jp), Psi%Aa(jp + 1), [3], [1], &
errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Psi%Aa(jp))
call destroy(Psi%Aa(jp + 1))
if(Psi%haslambda(jp + 1)) call destroy(Psi%Lambda(jp + 1))
if(mpo_is_hermitian .and. (Cp%ktebd == 0)) then
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:531', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:536', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
elseif(mpo_is_hermitian) then
call krylov_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'krylov_local failed.', &
! errst=errst)) return
elseif(Cp%ktebd == 0) then
call copy(Tmp, Hts(jj))
call expm(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'exp failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Theta, Prop, [2, 3], [3, 4], errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:559', &
! errst=errst)) return
call transposed(Tmp, [1, 3, 4, 2], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:564', &
! errst=errst)) return
call destroy(Theta)
call pointto(Theta, Tmp)
!call destroy(Tmp)
call destroy(Prop)
else
!call TwoSite_Propagator_MPO_TYPE(Psi%Theta, H%H%W(j),
! H%H%W(j + 1),dt)
call krylov_arnoldi_local(Theta, Hts(jj), weight(ii), Cp, &
pbc, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'krylov_arnoldi_local failed.', &
! errst=errst)) return
end if
call split(Psi%Aa(jp), Psi%Lambda(jp + 1), Psi%Aa(jp + 1), &
Theta, [1, 2], [3, 4], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Psi%oc = jp + 1
else
Psi%oc = jp
end if
Psi%haslambda(jp + 1) = .true.
call destroy(Theta)
if(jj == Psi%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Psi, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:605', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Psi, ocsave, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qmpsc_qtensorc_real
"""
return
[docs]def tebd_method_lptn_tensor_real():
"""
fortran-subroutine - October 2017 (dj)
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_lptn_tensor_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(lptn), intent(inout) :: Rho
type(tensor), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(tensor) :: Theta
! temporary tensor
type(tensor) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Rho%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Rho%ll)
ocsave = Rho%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Rho%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Rho, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:741', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Rho%oc /= jp) .and. (Rho%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Rho, jp, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Rho, jp + 1, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call set_0_kappa(Rho%Aa(jp))
call set_0_kappa(Rho%Aa(jp + 1))
call contr(Theta, Rho%Aa(jp), Rho%Aa(jp + 1), [4], [1], &
errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Rho%Aa(jp))
call destroy(Rho%Aa(jp + 1))
if(Rho%haslambda(jp + 1)) call destroy(Rho%Lambda(jp + 1))
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Prop, Theta, [3, 4], [2, 4], errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:789', &
! errst=errst)) return
call transposed(Tmp, [3, 1, 4, 2, 5, 6], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:794', &
! errst=errst)) return
call destroy(Theta)
call destroy(Prop)
call split(Rho%Aa(jp), Rho%Lambda(jp + 1), Rho%Aa(jp + 1), &
Tmp, [1, 2, 3], [4, 5, 6], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Rho%oc = jp + 1
else
Rho%oc = jp
end if
Rho%haslambda(jp + 1) = .true.
call destroy(Tmp)
call set_q_kappa(Rho%Aa(jp))
call set_q_kappa(Rho%Aa(jp + 1))
if(jj == Rho%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Rho, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:827', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Rho, ocsave, errst=errst)
!if(prop_error('tebd_method_tensor : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_lptn_tensor_real
"""
return
[docs]def tebd_method_lptnc_tensorc_real():
"""
fortran-subroutine - October 2017 (dj)
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_lptnc_tensorc_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(lptnc), intent(inout) :: Rho
type(tensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(tensorc) :: Theta
! temporary tensor
type(tensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Rho%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Rho%ll)
ocsave = Rho%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Rho%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Rho, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:741', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Rho%oc /= jp) .and. (Rho%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Rho, jp, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Rho, jp + 1, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call set_0_kappa(Rho%Aa(jp))
call set_0_kappa(Rho%Aa(jp + 1))
call contr(Theta, Rho%Aa(jp), Rho%Aa(jp + 1), [4], [1], &
errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Rho%Aa(jp))
call destroy(Rho%Aa(jp + 1))
if(Rho%haslambda(jp + 1)) call destroy(Rho%Lambda(jp + 1))
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Prop, Theta, [3, 4], [2, 4], errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:789', &
! errst=errst)) return
call transposed(Tmp, [3, 1, 4, 2, 5, 6], doperm=.true., errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:794', &
! errst=errst)) return
call destroy(Theta)
call destroy(Prop)
call split(Rho%Aa(jp), Rho%Lambda(jp + 1), Rho%Aa(jp + 1), &
Tmp, [1, 2, 3], [4, 5, 6], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Rho%oc = jp + 1
else
Rho%oc = jp
end if
Rho%haslambda(jp + 1) = .true.
call destroy(Tmp)
call set_q_kappa(Rho%Aa(jp))
call set_q_kappa(Rho%Aa(jp + 1))
if(jj == Rho%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Rho, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:827', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Rho, ocsave, errst=errst)
!if(prop_error('tebd_method_tensorc : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_lptnc_tensorc_real
"""
return
[docs]def tebd_method_qlptn_qtensor_real():
"""
fortran-subroutine - October 2017 (dj)
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qlptn_qtensor_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qlptn), intent(inout) :: Rho
type(qtensor), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(qtensor) :: Theta
! temporary tensor
type(qtensor) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Rho%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Rho%ll)
ocsave = Rho%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Rho%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Rho, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:741', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Rho%oc /= jp) .and. (Rho%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Rho, jp, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Rho, jp + 1, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call set_0_kappa(Rho%Aa(jp))
call set_0_kappa(Rho%Aa(jp + 1))
call contr(Theta, Rho%Aa(jp), Rho%Aa(jp + 1), [4], [1], &
errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Rho%Aa(jp))
call destroy(Rho%Aa(jp + 1))
if(Rho%haslambda(jp + 1)) call destroy(Rho%Lambda(jp + 1))
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Prop, Theta, [3, 4], [2, 4], errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:789', &
! errst=errst)) return
call transposed(Tmp, [3, 1, 4, 2, 5, 6], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:794', &
! errst=errst)) return
call destroy(Theta)
call destroy(Prop)
call split(Rho%Aa(jp), Rho%Lambda(jp + 1), Rho%Aa(jp + 1), &
Tmp, [1, 2, 3], [4, 5, 6], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Rho%oc = jp + 1
else
Rho%oc = jp
end if
Rho%haslambda(jp + 1) = .true.
call destroy(Tmp)
call set_q_kappa(Rho%Aa(jp))
call set_q_kappa(Rho%Aa(jp + 1))
if(jj == Rho%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Rho, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'transposed failed.', 'TEBDOps_include.f90:827', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Rho, ocsave, errst=errst)
!if(prop_error('tebd_method_qtensor : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qlptn_qtensor_real
"""
return
[docs]def tebd_method_qlptnc_qtensorc_real():
"""
fortran-subroutine - October 2017 (dj)
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qlptnc_qtensorc_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qlptnc), intent(inout) :: Rho
type(qtensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! save original orthogonality center
integer :: ocsave
! local tolerance
real(KIND=rKind) :: local_tol
! error from one single step
real(KIND=rKind) :: err
! Two-site tensor
type(qtensorc) :: Theta
! temporary tensor
type(qtensorc) :: Prop, Tmp
! for PBC
integer, dimension(:), allocatable :: perma, permb
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Rho%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Rho%ll)
ocsave = Rho%oc
do ii = 1, size(weight, 1)
! No weight is not applied
if(weight(ii) == 0.0_rKind) cycle
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Rho%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Rho, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:741', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
! Check canonization (Non optimal for weight = 0.0)
if((Rho%oc /= jp) .and. (Rho%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Rho, jp, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (1) failed.', &
! errst=errst)) return
else
call canonize(Rho, jp + 1, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (2) failed.', &
! errst=errst)) return
end if
end if
call set_0_kappa(Rho%Aa(jp))
call set_0_kappa(Rho%Aa(jp + 1))
call contr(Theta, Rho%Aa(jp), Rho%Aa(jp + 1), [4], [1], &
errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (1) failed.', &
! errst=errst)) return
call destroy(Rho%Aa(jp))
call destroy(Rho%Aa(jp + 1))
if(Rho%haslambda(jp + 1)) call destroy(Rho%Lambda(jp + 1))
call copy(Tmp, Hts(jj))
call expmh(Prop, weight(ii), Tmp, 2, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'exph failed.', &
! errst=errst)) return
call destroy(Tmp)
call contr(Tmp, Prop, Theta, [3, 4], [2, 4], errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'contr (2) failed.', 'TEBDOps_include.f90:789', &
! errst=errst)) return
call transposed(Tmp, [3, 1, 4, 2, 5, 6], doperm=.true., errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transpose (1) failed.', 'TEBDOps_include.f90:794', &
! errst=errst)) return
call destroy(Theta)
call destroy(Prop)
call split(Rho%Aa(jp), Rho%Lambda(jp + 1), Rho%Aa(jp + 1), &
Tmp, [1, 2, 3], [4, 5, 6], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm=renorm, method='Y', errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'split failed.', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Rho%oc = jp + 1
else
Rho%oc = jp
end if
Rho%haslambda(jp + 1) = .true.
call destroy(Tmp)
call set_q_kappa(Rho%Aa(jp))
call set_q_kappa(Rho%Aa(jp + 1))
if(jj == Rho%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Rho, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:827', &
! errst=errst)) return
cerr = cerr + err
end if
end do
end do
call canonize(Rho, ocsave, errst=errst)
!if(prop_error('tebd_method_qtensorc : '//&
! 'canonize (3) failed.', errst=errst)) return
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qlptnc_qtensorc_real
"""
return
[docs]def tebd_method_lptn_tensorc_real():
"""
fortran-subroutine - October 2017 (dj)
Dummy interface for Liouville space evolution on LPTN/MPS.
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_lptn_tensorc_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(lptn), intent(inout) :: Rho
type(tensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
errst = raise_error('tebd_method_lptn_tensorc', &
99, 'TEBDOps_include.f90:917', errst=errst)
end subroutine tebd_method_lptn_tensorc_real
"""
return
[docs]def tebd_method_qlptn_qtensorc_real():
"""
fortran-subroutine - October 2017 (dj)
Dummy interface for Liouville space evolution on LPTN/MPS.
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qlptn_qtensorc_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qlptn), intent(inout) :: Rho
type(qtensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
errst = raise_error('tebd_method_qlptn_qtensorc', &
99, 'TEBDOps_include.f90:917', errst=errst)
end subroutine tebd_method_qlptn_qtensorc_real
"""
return
[docs]def tebd_method_mps_tensorc_real():
"""
fortran-subroutine - October 2017 (dj)
Dummy interface for Liouville space evolution on LPTN/MPS.
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_mps_tensorc_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(mps), intent(inout) :: Rho
type(tensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
errst = raise_error('tebd_method_mps_tensorc', &
99, 'TEBDOps_include.f90:917', errst=errst)
end subroutine tebd_method_mps_tensorc_real
"""
return
[docs]def tebd_method_qmps_qtensorc_real():
"""
fortran-subroutine - October 2017 (dj)
Dummy interface for Liouville space evolution on LPTN/MPS.
**Arguments**
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Details**
The Hamiltonian is assumed to be hermitian. Effective Hamiltonian
does not make sense on a density matrix and Lindblad master equation would
be evolved with Kraus operators.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qmps_qtensorc_real(Rho, Hts, loop, weight, Cp, &
converged, cerr, renorm, mpo_is_hermitian, pbc, errst)
type(qmps), intent(inout) :: Rho
type(qtensorc), dimension(:), intent(inout) :: Hts
integer, dimension(:, :) :: loop
real(KIND=rKind), dimension(:) :: weight
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
character, intent(in) :: renorm
logical, intent(in) :: mpo_is_hermitian
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
errst = raise_error('tebd_method_qmps_qtensorc', &
99, 'TEBDOps_include.f90:917', errst=errst)
end subroutine tebd_method_qmps_qtensorc_real
"""
return
[docs]def tebd2_22122_tensorlist():
"""
fortran-subroutine - October 2017 (dj)
Evolve an LPTN under a second order TEBD decomposition. This is the
"local Lindblads only" version.
**Arguments**
Rho : TYPE(MP, inout
Density matrix to be evolved.
deltat : COMPLEX, in
Time step for this step.
Rs : TYPE(MPORuleSet), in
The rule set for the Lindblad master equation.
Ops : TYPE(tensorlist), in
Contains the operators necessary to build the Lindblad equation.
Hparams : TYPE(HamiltonianParameters), in
Contains the coupling constants for each term in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
**Details**
We first use a second order Trotter decomposition on the
Hamiltonian H and dissipative part D of the system leading to
epx(H + D) = exp(H / 2) exp(D) exp(H / 2). We apply the usual
Sornborger second order decomposition to the exp(H / 2) term.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_22122_tensorlist(Rho, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, Cp, errst)
type(lptnc), intent(inout) :: Rho
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! last site
integer :: ll
! second last site
integer :: up
! number of terms used in the following arrays loop, idx, term_type
integer :: nn
! Settings for TEBD loops
integer, dimension(3, 5) :: loop
integer, dimension(5) :: idx
character, dimension(5) :: term_type
! Two-site operators as tensors
type(tensor), dimension(:), pointer :: Hts
! Two site operators as tensors for Liouville operator (dummy)
type(tensorc), dimension(:), pointer :: Ldummy
! For propagators
type(tensorc), dimension(:, :), pointer :: Props
! For Kraus operators
type(tensorc), dimension(:, :), pointer :: Ks
!if(present(errst)) errst = 0
ll = Rho%ll
if(.not. Rs%pbc) then
up = ll - 1
else
up = ll
end if
! Define looping parameters, weights, and term types
loop(:, 1) = [ 1, up, 1]
loop(:, 2) = [up, 1, -1]
loop(:, 3) = [ 1, ll, 1]
loop(:, 4) = [ 1, up, 1]
loop(:, 5) = [up, 1, -1]
idx = [1, 1, 1, 1, 1]
term_type = ['H', 'H', 'K', 'H', 'H']
! Construct Hamiltonians
call prepare_op2_tensor(Hts, Ldummy, Rs, Rho%ll, Ops, Hparams, &
iop, .true., .false., .false., &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_tensorlist : prepare_op2 failed.', &
! 'TEBDOps_include.f90:1072', errst=errst)) return
! Exponentiate Hamiltonians to build propagator
allocate(Props(size(Hts, 1), 1))
do ii = 1, size(Hts, 1)
! We have two factors 1/2 here
call expmh(Props(ii, 1), 0.25_rKind * deltat, Hts(ii), 2, errst=errst)
!if(prop_error('tebd2_22122_tensorlist : exph failed.', &
! 'TEBDOps_include.f90:1081', errst=errst)) return
call destroy(Hts(ii))
end do
deallocate(Hts)
! Construct Lindblad operators
allocate(Ks(ll, 1))
do ii = 1, ll
call build_kraus_first_order(Ks(ii, 1), Ops, Rs, Hparams, iop, &
ii, real(eye * deltat, KIND=rKind), errst=errst)
!if(prop_error('tebd2_22122_tensorlist : build_kraus_first'//&
! '_order failed.', 'TEBDOps_include.f90:1095', &
! errst=errst)) return
end do
call tebd_method(Rho, Props, Ks, loop, idx, term_type, Cp, converged, &
cerr, Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_tensorlist : tebd_method failed.', &
! 'TEBDOps_include.f90:1102', errst=errst)) return
! Deallocate arrays
do ii = 1, size(Props, 1)
call destroy(Props(ii, 1))
end do
do ii = 1, ll
call destroy(Ks(ii, 1))
end do
deallocate(Props, Ks)
end subroutine tebd2_22122_tensorlist
"""
return
[docs]def tebd2_22122_tensorlistc():
"""
fortran-subroutine - October 2017 (dj)
Evolve an LPTN under a second order TEBD decomposition. This is the
"local Lindblads only" version.
**Arguments**
Rho : TYPE(MP, inout
Density matrix to be evolved.
deltat : COMPLEX, in
Time step for this step.
Rs : TYPE(MPORuleSet), in
The rule set for the Lindblad master equation.
Ops : TYPE(tensorlistc), in
Contains the operators necessary to build the Lindblad equation.
Hparams : TYPE(HamiltonianParameters), in
Contains the coupling constants for each term in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
**Details**
We first use a second order Trotter decomposition on the
Hamiltonian H and dissipative part D of the system leading to
epx(H + D) = exp(H / 2) exp(D) exp(H / 2). We apply the usual
Sornborger second order decomposition to the exp(H / 2) term.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_22122_tensorlistc(Rho, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, Cp, errst)
type(lptnc), intent(inout) :: Rho
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! last site
integer :: ll
! second last site
integer :: up
! number of terms used in the following arrays loop, idx, term_type
integer :: nn
! Settings for TEBD loops
integer, dimension(3, 5) :: loop
integer, dimension(5) :: idx
character, dimension(5) :: term_type
! Two-site operators as tensors
type(tensorc), dimension(:), pointer :: Hts
! Two site operators as tensors for Liouville operator (dummy)
type(tensorc), dimension(:), pointer :: Ldummy
! For propagators
type(tensorc), dimension(:, :), pointer :: Props
! For Kraus operators
type(tensorc), dimension(:, :), pointer :: Ks
!if(present(errst)) errst = 0
ll = Rho%ll
if(.not. Rs%pbc) then
up = ll - 1
else
up = ll
end if
! Define looping parameters, weights, and term types
loop(:, 1) = [ 1, up, 1]
loop(:, 2) = [up, 1, -1]
loop(:, 3) = [ 1, ll, 1]
loop(:, 4) = [ 1, up, 1]
loop(:, 5) = [up, 1, -1]
idx = [1, 1, 1, 1, 1]
term_type = ['H', 'H', 'K', 'H', 'H']
! Construct Hamiltonians
call prepare_op2_tensorc(Hts, Ldummy, Rs, Rho%ll, Ops, Hparams, &
iop, .true., .false., .false., &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_tensorlistc : prepare_op2 failed.', &
! 'TEBDOps_include.f90:1072', errst=errst)) return
! Exponentiate Hamiltonians to build propagator
allocate(Props(size(Hts, 1), 1))
do ii = 1, size(Hts, 1)
! We have two factors 1/2 here
call expmh(Props(ii, 1), 0.25_rKind * deltat, Hts(ii), 2, errst=errst)
!if(prop_error('tebd2_22122_tensorlistc : exph failed.', &
! 'TEBDOps_include.f90:1081', errst=errst)) return
call destroy(Hts(ii))
end do
deallocate(Hts)
! Construct Lindblad operators
allocate(Ks(ll, 1))
do ii = 1, ll
call build_kraus_first_order(Ks(ii, 1), Ops, Rs, Hparams, iop, &
ii, real(eye * deltat, KIND=rKind), errst=errst)
!if(prop_error('tebd2_22122_tensorlistc : build_kraus_first'//&
! '_order failed.', 'TEBDOps_include.f90:1095', &
! errst=errst)) return
end do
call tebd_method(Rho, Props, Ks, loop, idx, term_type, Cp, converged, &
cerr, Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_tensorlistc : tebd_method failed.', &
! 'TEBDOps_include.f90:1102', errst=errst)) return
! Deallocate arrays
do ii = 1, size(Props, 1)
call destroy(Props(ii, 1))
end do
do ii = 1, ll
call destroy(Ks(ii, 1))
end do
deallocate(Props, Ks)
end subroutine tebd2_22122_tensorlistc
"""
return
[docs]def tebd2_22122_qtensorlist():
"""
fortran-subroutine - October 2017 (dj)
Evolve an LPTN under a second order TEBD decomposition. This is the
"local Lindblads only" version.
**Arguments**
Rho : TYPE(MP, inout
Density matrix to be evolved.
deltat : COMPLEX, in
Time step for this step.
Rs : TYPE(MPORuleSet), in
The rule set for the Lindblad master equation.
Ops : TYPE(qtensorlist), in
Contains the operators necessary to build the Lindblad equation.
Hparams : TYPE(HamiltonianParameters), in
Contains the coupling constants for each term in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
**Details**
We first use a second order Trotter decomposition on the
Hamiltonian H and dissipative part D of the system leading to
epx(H + D) = exp(H / 2) exp(D) exp(H / 2). We apply the usual
Sornborger second order decomposition to the exp(H / 2) term.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_22122_qtensorlist(Rho, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, Cp, errst)
type(qlptnc), intent(inout) :: Rho
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! last site
integer :: ll
! second last site
integer :: up
! number of terms used in the following arrays loop, idx, term_type
integer :: nn
! Settings for TEBD loops
integer, dimension(3, 5) :: loop
integer, dimension(5) :: idx
character, dimension(5) :: term_type
! Two-site operators as tensors
type(qtensor), dimension(:), pointer :: Hts
! Two site operators as tensors for Liouville operator (dummy)
type(qtensorc), dimension(:), pointer :: Ldummy
! For propagators
type(qtensorc), dimension(:, :), pointer :: Props
! For Kraus operators
type(qtensorc), dimension(:, :), pointer :: Ks
!if(present(errst)) errst = 0
ll = Rho%ll
if(.not. Rs%pbc) then
up = ll - 1
else
up = ll
end if
! Define looping parameters, weights, and term types
loop(:, 1) = [ 1, up, 1]
loop(:, 2) = [up, 1, -1]
loop(:, 3) = [ 1, ll, 1]
loop(:, 4) = [ 1, up, 1]
loop(:, 5) = [up, 1, -1]
idx = [1, 1, 1, 1, 1]
term_type = ['H', 'H', 'K', 'H', 'H']
! Construct Hamiltonians
call prepare_op2_qtensor(Hts, Ldummy, Rs, Rho%ll, Ops, Hparams, &
iop, .true., .false., .false., &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_qtensorlist : prepare_op2 failed.', &
! 'TEBDOps_include.f90:1072', errst=errst)) return
! Exponentiate Hamiltonians to build propagator
allocate(Props(size(Hts, 1), 1))
do ii = 1, size(Hts, 1)
! We have two factors 1/2 here
call expmh(Props(ii, 1), 0.25_rKind * deltat, Hts(ii), 2, errst=errst)
!if(prop_error('tebd2_22122_qtensorlist : exph failed.', &
! 'TEBDOps_include.f90:1081', errst=errst)) return
call destroy(Hts(ii))
end do
deallocate(Hts)
! Construct Lindblad operators
allocate(Ks(ll, 1))
do ii = 1, ll
call build_kraus_first_order(Ks(ii, 1), Ops, Rs, Hparams, iop, &
ii, real(eye * deltat, KIND=rKind), errst=errst)
!if(prop_error('tebd2_22122_qtensorlist : build_kraus_first'//&
! '_order failed.', 'TEBDOps_include.f90:1095', &
! errst=errst)) return
end do
call tebd_method(Rho, Props, Ks, loop, idx, term_type, Cp, converged, &
cerr, Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_qtensorlist : tebd_method failed.', &
! 'TEBDOps_include.f90:1102', errst=errst)) return
! Deallocate arrays
do ii = 1, size(Props, 1)
call destroy(Props(ii, 1))
end do
do ii = 1, ll
call destroy(Ks(ii, 1))
end do
deallocate(Props, Ks)
end subroutine tebd2_22122_qtensorlist
"""
return
[docs]def tebd2_22122_qtensorclist():
"""
fortran-subroutine - October 2017 (dj)
Evolve an LPTN under a second order TEBD decomposition. This is the
"local Lindblads only" version.
**Arguments**
Rho : TYPE(MP, inout
Density matrix to be evolved.
deltat : COMPLEX, in
Time step for this step.
Rs : TYPE(MPORuleSet), in
The rule set for the Lindblad master equation.
Ops : TYPE(qtensorclist), in
Contains the operators necessary to build the Lindblad equation.
Hparams : TYPE(HamiltonianParameters), in
Contains the coupling constants for each term in the Hamiltonian.
iop : INTEGER, in
Position of the identity operator in the list of operators Ops.
converged : LOGICAL, out
Not referenced, only to provide equal interface.
cerr : REAL, inout
The cumulated error. The error done during this subroutine is
added to the incoming value.
Cp : TYPE(ConvParam), in
Contains the convergence parameters for the simulation.
**Details**
We first use a second order Trotter decomposition on the
Hamiltonian H and dissipative part D of the system leading to
epx(H + D) = exp(H / 2) exp(D) exp(H / 2). We apply the usual
Sornborger second order decomposition to the exp(H / 2) term.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd2_22122_qtensorclist(Rho, deltat, Rs, Ops, Hparams, iop, &
converged, cerr, Cp, errst)
type(qlptnc), intent(inout) :: Rho
complex(KIND=rKind), intent(in) :: deltat
type(MPORuleSet), intent(in) :: Rs
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
type(ConvParam), intent(in) :: Cp
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! last site
integer :: ll
! second last site
integer :: up
! number of terms used in the following arrays loop, idx, term_type
integer :: nn
! Settings for TEBD loops
integer, dimension(3, 5) :: loop
integer, dimension(5) :: idx
character, dimension(5) :: term_type
! Two-site operators as tensors
type(qtensorc), dimension(:), pointer :: Hts
! Two site operators as tensors for Liouville operator (dummy)
type(qtensorc), dimension(:), pointer :: Ldummy
! For propagators
type(qtensorc), dimension(:, :), pointer :: Props
! For Kraus operators
type(qtensorc), dimension(:, :), pointer :: Ks
!if(present(errst)) errst = 0
ll = Rho%ll
if(.not. Rs%pbc) then
up = ll - 1
else
up = ll
end if
! Define looping parameters, weights, and term types
loop(:, 1) = [ 1, up, 1]
loop(:, 2) = [up, 1, -1]
loop(:, 3) = [ 1, ll, 1]
loop(:, 4) = [ 1, up, 1]
loop(:, 5) = [up, 1, -1]
idx = [1, 1, 1, 1, 1]
term_type = ['H', 'H', 'K', 'H', 'H']
! Construct Hamiltonians
call prepare_op2_qtensorc(Hts, Ldummy, Rs, Rho%ll, Ops, Hparams, &
iop, .true., .false., .false., &
Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_qtensorclist : prepare_op2 failed.', &
! 'TEBDOps_include.f90:1072', errst=errst)) return
! Exponentiate Hamiltonians to build propagator
allocate(Props(size(Hts, 1), 1))
do ii = 1, size(Hts, 1)
! We have two factors 1/2 here
call expmh(Props(ii, 1), 0.25_rKind * deltat, Hts(ii), 2, errst=errst)
!if(prop_error('tebd2_22122_qtensorclist : exph failed.', &
! 'TEBDOps_include.f90:1081', errst=errst)) return
call destroy(Hts(ii))
end do
deallocate(Hts)
! Construct Lindblad operators
allocate(Ks(ll, 1))
do ii = 1, ll
call build_kraus_first_order(Ks(ii, 1), Ops, Rs, Hparams, iop, &
ii, real(eye * deltat, KIND=rKind), errst=errst)
!if(prop_error('tebd2_22122_qtensorclist : build_kraus_first'//&
! '_order failed.', 'TEBDOps_include.f90:1095', &
! errst=errst)) return
end do
call tebd_method(Rho, Props, Ks, loop, idx, term_type, Cp, converged, &
cerr, Rs%pbc, errst=errst)
!if(prop_error('tebd2_22122_qtensorclist : tebd_method failed.', &
! 'TEBDOps_include.f90:1102', errst=errst)) return
! Deallocate arrays
do ii = 1, size(Props, 1)
call destroy(Props(ii, 1))
end do
do ii = 1, ll
call destroy(Ks(ii, 1))
end do
deallocate(Props, Ks)
end subroutine tebd2_22122_qtensorclist
"""
return
[docs]def tebd_method_lptnc_TENSOR_HTYPE():
"""
fortran-subroutine - September 2017 (dj)
Apply Trotter decomposition to an LPTN tensor network.
**Arguments**
Rho : TYPE(lptnc), inout
Density matrix to be propagated as LPTN.
Pts : TYPE(tensorc)(\*, \*), inout
The 2-site propagators containing the unitary part of the
time evolution. The first dimension runs of the sites, the
second index over different weights.
Ks : TYPE(tensorc)(\*, \*), inout
Contains the local Kraus operators. The first dimension
runs again over the sites, the second index over different
weights in the Trotter decomposition.
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
idxs : INTEGER(\*), in
Defines for each loop which second dimension is accessed in Pts and
Ks.
term : CHARACTER(\*), in
Specifies if 2-site propagator of the Hamiltonian or Kraus operator
is applied.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_lptnc_TENSOR_HTYPE(Rho, Pts, Ks, loop, &
idxs, term, Cp, converged, cerr, pbc, errst)
type(lptnc), intent(inout) :: Rho
type(tensorc), dimension(:, :), intent(inout) :: Pts
type(tensorc), dimension(:, :), intent(inout) :: Ks
integer, dimension(:, :), intent(in) :: loop
integer, dimension(:), intent(in) :: idxs
character, dimension(:), intent(in) :: term
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! local tolerance
real(KIND=rKind) :: local_tol
! error from on single step
real(KIND=rKind) :: err
! Temporary tensors
type(tensorc) :: Theta, Tmp, Tmpb
! for PBC
integer, dimension(:), allocatable :: perma, permb
!if(present(errst)) errst = 0
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Rho%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Rho%ll)
do ii = 1, size(idxs, 1)
if(term(ii) == 'H') then
! Apply Hamiltonian
! -----------------
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Rho%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Rho, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_lptnc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:1266', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
if((Rho%oc /= jp) .and. (Rho%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Rho, jp)
else
call canonize(Rho, jp + 1)
end if
end if
call set_0_kappa(Rho%Aa(jp))
call set_0_kappa(Rho%Aa(jp + 1))
call contr(Theta, Rho%Aa(jp), Rho%Aa(jp + 1), [4], [1], &
errst=errst)
!if(prop_error('tebd_method_lptnc_TENSOR_HTYPE'//&
! ': contr failed.', 'TEBDOps_include.f90:1289', &
! errst=errst)) return
call destroy(Rho%Aa(jp))
call destroy(Rho%Aa(jp + 1))
if(Rho%haslambda(jp + 1)) call destroy(Rho%Lambda(jp + 1))
call copy(Tmpb, Pts(jj, idxs(ii)))
call contr(Tmp, Tmpb, Theta, [3, 4], [2, 4], errst=errst)
!if(prop_error('tebd_method_lptnc_TENSOR_HTYPE'//&
! ': contr failed.', 'TEBDOps_include.f90:1299', &
! errst=errst)) return
call transposed(Tmp, [3, 1, 4, 2, 5, 6], doperm=.true.)
call split(Rho%Aa(jp), Rho%Lambda(jp + 1), Rho%Aa(jp + 1), &
Tmp, [1, 2, 3], [4, 5, 6], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm='M', method='Y', errst=errst)
!if(prop_error('tebd_lptn_method_lptnc_'//&
! 'TENSOR_HTYPE : split failed.', &
! 'TEBDOps_include.f90:1310', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Rho%oc = jp + 1
else
Rho%oc = jp
end if
Rho%haslambda(jp + 1) = .true.
call destroy(Theta)
call destroy(Tmp)
call destroy(Tmpb)
call set_q_kappa(Rho%Aa(jp))
call set_q_kappa(Rho%Aa(jp + 1))
if(jj == Rho%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Rho, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_TENSOR_HTYPE : '//&
! 'transposed failed.', 'TEBDOps_include.f90:1334', &
! errst=errst)) return
cerr = cerr + err
end if
end do
elseif(term(ii) == 'K') then
! Apply Kraus operators
! ---------------------
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(Rho%oc /= jj) then
call canonize(Rho, jj)
end if
call apply_kraus(Rho%Aa(jj), Ks(jj, idxs(ii)), &
Cp%max_kappa, local_tol, &
'M', cerr, errst=errst)
!if(prop_error('tebd_lptn_method_lptnc_'//&
! 'TENSOR_HTYPE : apply_kraus failed.', &
! errst=errst)) return
end do
else
errst = raise_error('tebd_lptn_method_lptnc_TENSOR_HTYPE'//&
' : term(ii) not valid.', 99, errst=errst)
return
end if
end do
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_lptnc_TENSOR_HTYPE
"""
return
[docs]def tebd_method_qlptnc_TENSOR_HTYPE():
"""
fortran-subroutine - September 2017 (dj)
Apply Trotter decomposition to an LPTN tensor network.
**Arguments**
Rho : TYPE(qlptnc), inout
Density matrix to be propagated as LPTN.
Pts : TYPE(qtensorc)(\*, \*), inout
The 2-site propagators containing the unitary part of the
time evolution. The first dimension runs of the sites, the
second index over different weights.
Ks : TYPE(qtensorc)(\*, \*), inout
Contains the local Kraus operators. The first dimension
runs again over the sites, the second index over different
weights in the Trotter decomposition.
loop : INTEGER(\*, \*), in
Defines the loops of the decomposition. The second dimension
corresponds to the number of loops. The first dimension is
always of size three and contains the first site in the loop,
the final site in the loop, and the increment of the loop, in
this order.
idxs : INTEGER(\*), in
Defines for each loop which second dimension is accessed in Pts and
Ks.
term : CHARACTER(\*), in
Specifies if 2-site propagator of the Hamiltonian or Kraus operator
is applied.
Cp : TYPE(ConvParam), in
Specifies the convergence parameters for the algorithms.
converged : LOGICAL, out
Flag if TEBD step converged.
cerr : REAL, inout
Cumulative truncation error.
pbc : LOGICAL, in
Flag if PBC are used (then true).
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine tebd_method_qlptnc_TENSOR_HTYPE(Rho, Pts, Ks, loop, &
idxs, term, Cp, converged, cerr, pbc, errst)
type(qlptnc), intent(inout) :: Rho
type(qtensorc), dimension(:, :), intent(inout) :: Pts
type(qtensorc), dimension(:, :), intent(inout) :: Ks
integer, dimension(:, :), intent(in) :: loop
integer, dimension(:), intent(in) :: idxs
character, dimension(:), intent(in) :: term
type(ConvParam), intent(in) :: Cp
logical, intent(out) :: converged
real(KIND=rKind), intent(inout) :: cerr
logical, intent(in) :: pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii, jj
! jj prime to account to PBC
integer :: jp
! local tolerance
real(KIND=rKind) :: local_tol
! error from on single step
real(KIND=rKind) :: err
! Temporary tensors
type(qtensorc) :: Theta, Tmp, Tmpb
! for PBC
integer, dimension(:), allocatable :: perma, permb
!if(present(errst)) errst = 0
! Right now, TEBD by default converged
converged = .true.
if(Cp%psi_local_tol < 0.0_rKind) then
! One sweep = 2 * L local truncations
local_tol = Cp%psi_tol / (4.0_rKind * Rho%ll)
else
local_tol = Cp%psi_local_tol
end if
call init_permarrays_pbc(pbc, perma, permb, Rho%ll)
do ii = 1, size(idxs, 1)
if(term(ii) == 'H') then
! Apply Hamiltonian
! -----------------
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(jj == Rho%ll) then
! PBC - have to permute
err = 0.0_rKind
call transposed(Rho, perma, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_qlptnc : '//&
! 'transposed failed.', 'TEBDOps_include.f90:1266', &
! errst=errst)) return
cerr = cerr + err
jp = 1
else
jp = jj
end if
if((Rho%oc /= jp) .and. (Rho%oc /= (jp + 1))) then
if(loop(3, ii) > 0) then
call canonize(Rho, jp)
else
call canonize(Rho, jp + 1)
end if
end if
call set_0_kappa(Rho%Aa(jp))
call set_0_kappa(Rho%Aa(jp + 1))
call contr(Theta, Rho%Aa(jp), Rho%Aa(jp + 1), [4], [1], &
errst=errst)
!if(prop_error('tebd_method_qlptnc_TENSOR_HTYPE'//&
! ': contr failed.', 'TEBDOps_include.f90:1289', &
! errst=errst)) return
call destroy(Rho%Aa(jp))
call destroy(Rho%Aa(jp + 1))
if(Rho%haslambda(jp + 1)) call destroy(Rho%Lambda(jp + 1))
call copy(Tmpb, Pts(jj, idxs(ii)))
call contr(Tmp, Tmpb, Theta, [3, 4], [2, 4], errst=errst)
!if(prop_error('tebd_method_qlptnc_TENSOR_HTYPE'//&
! ': contr failed.', 'TEBDOps_include.f90:1299', &
! errst=errst)) return
call transposed(Tmp, [3, 1, 4, 2, 5, 6], doperm=.true.)
call split(Rho%Aa(jp), Rho%Lambda(jp + 1), Rho%Aa(jp + 1), &
Tmp, [1, 2, 3], [4, 5, 6], multlr=loop(3, ii), &
trunc=local_tol, ncut=Cp%max_bond_dimension, &
err=err, renorm='M', method='Y', errst=errst)
!if(prop_error('tebd_lptn_method_qlptnc_'//&
! 'TENSOR_HTYPE : split failed.', &
! 'TEBDOps_include.f90:1310', errst=errst)) return
cerr = cerr + err
if(loop(3, ii) > 0) then
Rho%oc = jp + 1
else
Rho%oc = jp
end if
Rho%haslambda(jp + 1) = .true.
call destroy(Theta)
call destroy(Tmp)
call destroy(Tmpb)
call set_q_kappa(Rho%Aa(jp))
call set_q_kappa(Rho%Aa(jp + 1))
if(jj == Rho%ll) then
! PBC - have to permute back
err = 0.0_rKind
call transposed(Rho, permb, local_tol, &
Cp%max_bond_dimension, &
cerr=err, errst=errst)
!if(prop_error('tebd_method_TENSOR_HTYPE : '//&
! 'transposed failed.', 'TEBDOps_include.f90:1334', &
! errst=errst)) return
cerr = cerr + err
end if
end do
elseif(term(ii) == 'K') then
! Apply Kraus operators
! ---------------------
do jj = loop(1, ii), loop(2, ii), loop(3, ii)
if(Rho%oc /= jj) then
call canonize(Rho, jj)
end if
call apply_kraus(Rho%Aa(jj), Ks(jj, idxs(ii)), &
Cp%max_kappa, local_tol, &
'M', cerr, errst=errst)
!if(prop_error('tebd_lptn_method_qlptnc_'//&
! 'TENSOR_HTYPE : apply_kraus failed.', &
! errst=errst)) return
end do
else
errst = raise_error('tebd_lptn_method_qlptnc_TENSOR_HTYPE'//&
' : term(ii) not valid.', 99, errst=errst)
return
end if
end do
call finalize_permarrays_pbc(pbc, perma, permb)
end subroutine tebd_method_qlptnc_TENSOR_HTYPE
"""
return
[docs]def prepare_op2_tensor():
"""
fortran-subroutine - September 2017 (dj)
Build all two-site operators.
**Arguments**
mpo_is_hermitian : LOGICAL, in
Flag if term in the exponential is hermitian.
qt : LOGICAL, in
Flag if quantum trajectories are used.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine prepare_op2_tensor(Hts, Lts, Rs, ll, Ops, Hparams, iop, &
mpo_is_hermitian, qt, finitet, pbc, errst)
type(tensor), dimension(:), pointer, intent(inout) :: Hts
type(tensorc), dimension(:), pointer, intent(inout) :: Lts
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: ll
type(tensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(in) :: mpo_is_hermitian, qt, finitet, pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! translational invariance
logical :: ti
!if(present(errst)) errst = 0
if(pbc) then
up = ll
else
up = ll - 1
end if
ti = .true.
do ii = 1, size(Hparams)
ti = ti .and. Hparams(ii - 1)%ti
end do
if(mpo_is_hermitian) then
allocate(Hts(up))
else
allocate(Lts(up))
end if
if(ti .and. finitet) then
! Translational invariance Hamiltonian in Liouville space
!
! First and last site are different if OBC
call ruleset_to_clliou_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1455', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1461', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1467', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_tensor : copy '//&
! 'failed.', 'TEBDOps_include.f90:1473', errst=errst)) return
end do
elseif(finitet) then
! Spatial dependent Hamiltonian in Liouville space
do ii = 1, up
call ruleset_to_clliou_2site(Hts(ii), ii, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_'//&
! 'clliou_2site failed.', 'TEBDOps_include.f90:1483', &
! errst=errst)) return
end do
elseif(ti .and. qt) then
! Translational invariant effective Hamiltonian
call ruleset_to_effham_2site(Lts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_effham'//&
! '_2site (1) failed.', 'TEBDOps_include.f90:1493', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_effham'//&
! '_2site (2) failed.', 'TEBDOps_include.f90:1499', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_effham'//&
! '_2site (3) failed.', 'TEBDOps_include.f90:1505', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_tensor : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(qt) then
! Effective Hamitlonian with space-dependent coupling
do ii = 1, (ll - 1)
call ruleset_to_effham_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to'//&
! '_ham_2site_tensorlist failed.', &
! 'TEBDOps_include.f90:1522', errst=errst)) return
end do
elseif(ti .and. mpo_is_hermitian) then
! Translational invariant Hamiltonian
call ruleset_to_ham_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_ham'//&
! '_2site (1) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_ham'//&
! '_2site (2) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_ham'//&
! '_2site (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_tensor : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(mpo_is_hermitian) then
! Hamiltonian with space-dependent coupling
do ii = 1, up
call ruleset_to_ham_2site(Hts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to'//&
! '_ham_2site_tensorlist (3) failed.', &
! errst=errst)) return
end do
elseif(ti) then
! Translational invariant Lindblad master equation
call ruleset_to_liou_2site(Lts(1), 1, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_liou'//&
! '_2site_tensorlist (1) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(2), 2, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_liou'//&
! '_2site_tensorlist (2) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(up), up, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to_liou'//&
! '_2site_tensorlist (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_tensor : copy (2) '//&
! 'failed.', errst=errst)) return
end do
else
! Lindblad master equation with space-dependent coupling
do ii = 1, up
call ruleset_to_liou_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensor : ruleset_to'//&
! '_liou_2site (4) failed.', &
! errst=errst)) return
end do
end if
end subroutine prepare_op2_tensor
"""
return
[docs]def prepare_op2_tensorc():
"""
fortran-subroutine - September 2017 (dj)
Build all two-site operators.
**Arguments**
mpo_is_hermitian : LOGICAL, in
Flag if term in the exponential is hermitian.
qt : LOGICAL, in
Flag if quantum trajectories are used.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine prepare_op2_tensorc(Hts, Lts, Rs, ll, Ops, Hparams, iop, &
mpo_is_hermitian, qt, finitet, pbc, errst)
type(tensorc), dimension(:), pointer, intent(inout) :: Hts
type(tensorc), dimension(:), pointer, intent(inout) :: Lts
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: ll
type(tensorlistc), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(in) :: mpo_is_hermitian, qt, finitet, pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! translational invariance
logical :: ti
!if(present(errst)) errst = 0
if(pbc) then
up = ll
else
up = ll - 1
end if
ti = .true.
do ii = 1, size(Hparams)
ti = ti .and. Hparams(ii - 1)%ti
end do
if(mpo_is_hermitian) then
allocate(Hts(up))
else
allocate(Lts(up))
end if
if(ti .and. finitet) then
! Translational invariance Hamiltonian in Liouville space
!
! First and last site are different if OBC
call ruleset_to_clliou_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1455', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1461', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1467', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_tensorc : copy '//&
! 'failed.', 'TEBDOps_include.f90:1473', errst=errst)) return
end do
elseif(finitet) then
! Spatial dependent Hamiltonian in Liouville space
do ii = 1, up
call ruleset_to_clliou_2site(Hts(ii), ii, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_'//&
! 'clliou_2site failed.', 'TEBDOps_include.f90:1483', &
! errst=errst)) return
end do
elseif(ti .and. qt) then
! Translational invariant effective Hamiltonian
call ruleset_to_effham_2site(Lts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_effham'//&
! '_2site (1) failed.', 'TEBDOps_include.f90:1493', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_effham'//&
! '_2site (2) failed.', 'TEBDOps_include.f90:1499', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_effham'//&
! '_2site (3) failed.', 'TEBDOps_include.f90:1505', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_tensorc : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(qt) then
! Effective Hamitlonian with space-dependent coupling
do ii = 1, (ll - 1)
call ruleset_to_effham_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to'//&
! '_ham_2site_tensorlistc failed.', &
! 'TEBDOps_include.f90:1522', errst=errst)) return
end do
elseif(ti .and. mpo_is_hermitian) then
! Translational invariant Hamiltonian
call ruleset_to_ham_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_ham'//&
! '_2site (1) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_ham'//&
! '_2site (2) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_ham'//&
! '_2site (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_tensorc : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(mpo_is_hermitian) then
! Hamiltonian with space-dependent coupling
do ii = 1, up
call ruleset_to_ham_2site(Hts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to'//&
! '_ham_2site_tensorlistc (3) failed.', &
! errst=errst)) return
end do
elseif(ti) then
! Translational invariant Lindblad master equation
call ruleset_to_liou_2site(Lts(1), 1, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_liou'//&
! '_2site_tensorlistc (1) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(2), 2, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_liou'//&
! '_2site_tensorlistc (2) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(up), up, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to_liou'//&
! '_2site_tensorlistc (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_tensorc : copy (2) '//&
! 'failed.', errst=errst)) return
end do
else
! Lindblad master equation with space-dependent coupling
do ii = 1, up
call ruleset_to_liou_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_tensorc : ruleset_to'//&
! '_liou_2site (4) failed.', &
! errst=errst)) return
end do
end if
end subroutine prepare_op2_tensorc
"""
return
[docs]def prepare_op2_qtensor():
"""
fortran-subroutine - September 2017 (dj)
Build all two-site operators.
**Arguments**
mpo_is_hermitian : LOGICAL, in
Flag if term in the exponential is hermitian.
qt : LOGICAL, in
Flag if quantum trajectories are used.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine prepare_op2_qtensor(Hts, Lts, Rs, ll, Ops, Hparams, iop, &
mpo_is_hermitian, qt, finitet, pbc, errst)
type(qtensor), dimension(:), pointer, intent(inout) :: Hts
type(qtensorc), dimension(:), pointer, intent(inout) :: Lts
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: ll
type(qtensorlist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(in) :: mpo_is_hermitian, qt, finitet, pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! translational invariance
logical :: ti
!if(present(errst)) errst = 0
if(pbc) then
up = ll
else
up = ll - 1
end if
ti = .true.
do ii = 1, size(Hparams)
ti = ti .and. Hparams(ii - 1)%ti
end do
if(mpo_is_hermitian) then
allocate(Hts(up))
else
allocate(Lts(up))
end if
if(ti .and. finitet) then
! Translational invariance Hamiltonian in Liouville space
!
! First and last site are different if OBC
call ruleset_to_clliou_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1455', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1461', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1467', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_qtensor : copy '//&
! 'failed.', 'TEBDOps_include.f90:1473', errst=errst)) return
end do
elseif(finitet) then
! Spatial dependent Hamiltonian in Liouville space
do ii = 1, up
call ruleset_to_clliou_2site(Hts(ii), ii, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_'//&
! 'clliou_2site failed.', 'TEBDOps_include.f90:1483', &
! errst=errst)) return
end do
elseif(ti .and. qt) then
! Translational invariant effective Hamiltonian
call ruleset_to_effham_2site(Lts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_effham'//&
! '_2site (1) failed.', 'TEBDOps_include.f90:1493', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_effham'//&
! '_2site (2) failed.', 'TEBDOps_include.f90:1499', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_effham'//&
! '_2site (3) failed.', 'TEBDOps_include.f90:1505', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_qtensor : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(qt) then
! Effective Hamitlonian with space-dependent coupling
do ii = 1, (ll - 1)
call ruleset_to_effham_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to'//&
! '_ham_2site_qtensorlist failed.', &
! 'TEBDOps_include.f90:1522', errst=errst)) return
end do
elseif(ti .and. mpo_is_hermitian) then
! Translational invariant Hamiltonian
call ruleset_to_ham_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_ham'//&
! '_2site (1) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_ham'//&
! '_2site (2) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_ham'//&
! '_2site (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_qtensor : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(mpo_is_hermitian) then
! Hamiltonian with space-dependent coupling
do ii = 1, up
call ruleset_to_ham_2site(Hts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to'//&
! '_ham_2site_qtensorlist (3) failed.', &
! errst=errst)) return
end do
elseif(ti) then
! Translational invariant Lindblad master equation
call ruleset_to_liou_2site(Lts(1), 1, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_liou'//&
! '_2site_qtensorlist (1) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(2), 2, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_liou'//&
! '_2site_qtensorlist (2) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(up), up, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to_liou'//&
! '_2site_qtensorlist (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_qtensor : copy (2) '//&
! 'failed.', errst=errst)) return
end do
else
! Lindblad master equation with space-dependent coupling
do ii = 1, up
call ruleset_to_liou_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensor : ruleset_to'//&
! '_liou_2site (4) failed.', &
! errst=errst)) return
end do
end if
end subroutine prepare_op2_qtensor
"""
return
[docs]def prepare_op2_qtensorc():
"""
fortran-subroutine - September 2017 (dj)
Build all two-site operators.
**Arguments**
mpo_is_hermitian : LOGICAL, in
Flag if term in the exponential is hermitian.
qt : LOGICAL, in
Flag if quantum trajectories are used.
finitet : LOGICAL, in
Flag if finitet simulation. If .true., the Liouville propagator of
the Hamiltonian is returned. Must be hermitian then.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine prepare_op2_qtensorc(Hts, Lts, Rs, ll, Ops, Hparams, iop, &
mpo_is_hermitian, qt, finitet, pbc, errst)
type(qtensorc), dimension(:), pointer, intent(inout) :: Hts
type(qtensorc), dimension(:), pointer, intent(inout) :: Lts
type(MPORuleSet), intent(in) :: Rs
integer, intent(in) :: ll
type(qtensorclist), intent(inout) :: Ops
type(HamiltonianParameters), pointer, intent(in) :: Hparams(:)
integer, intent(in) :: iop
logical, intent(in) :: mpo_is_hermitian, qt, finitet, pbc
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
! second last site / last site in PBC
integer :: up
! translational invariance
logical :: ti
!if(present(errst)) errst = 0
if(pbc) then
up = ll
else
up = ll - 1
end if
ti = .true.
do ii = 1, size(Hparams)
ti = ti .and. Hparams(ii - 1)%ti
end do
if(mpo_is_hermitian) then
allocate(Hts(up))
else
allocate(Lts(up))
end if
if(ti .and. finitet) then
! Translational invariance Hamiltonian in Liouville space
!
! First and last site are different if OBC
call ruleset_to_clliou_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1455', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1461', &
! errst=errst)) return
call ruleset_to_clliou_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_clliou'//&
! '_2site failed.', 'TEBDOps_include.f90:1467', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_qtensorc : copy '//&
! 'failed.', 'TEBDOps_include.f90:1473', errst=errst)) return
end do
elseif(finitet) then
! Spatial dependent Hamiltonian in Liouville space
do ii = 1, up
call ruleset_to_clliou_2site(Hts(ii), ii, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_'//&
! 'clliou_2site failed.', 'TEBDOps_include.f90:1483', &
! errst=errst)) return
end do
elseif(ti .and. qt) then
! Translational invariant effective Hamiltonian
call ruleset_to_effham_2site(Lts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_effham'//&
! '_2site (1) failed.', 'TEBDOps_include.f90:1493', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_effham'//&
! '_2site (2) failed.', 'TEBDOps_include.f90:1499', &
! errst=errst)) return
call ruleset_to_effham_2site(Lts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_effham'//&
! '_2site (3) failed.', 'TEBDOps_include.f90:1505', &
! errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_qtensorc : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(qt) then
! Effective Hamitlonian with space-dependent coupling
do ii = 1, (ll - 1)
call ruleset_to_effham_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to'//&
! '_ham_2site_qtensorclist failed.', &
! 'TEBDOps_include.f90:1522', errst=errst)) return
end do
elseif(ti .and. mpo_is_hermitian) then
! Translational invariant Hamiltonian
call ruleset_to_ham_2site(Hts(1), 1, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_ham'//&
! '_2site (1) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(2), 2, ll, Rs, Ops, Hparams, iop, &
errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_ham'//&
! '_2site (2) failed.', errst=errst)) return
call ruleset_to_ham_2site(Hts(up), up, ll, Rs, Ops, &
Hparams, iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_ham'//&
! '_2site (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Hts(ii), Hts(2), errst=errst)
!if(prop_error('prepare_op2_qtensorc : copy (1) '//&
! 'failed.', errst=errst)) return
end do
elseif(mpo_is_hermitian) then
! Hamiltonian with space-dependent coupling
do ii = 1, up
call ruleset_to_ham_2site(Hts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to'//&
! '_ham_2site_qtensorclist (3) failed.', &
! errst=errst)) return
end do
elseif(ti) then
! Translational invariant Lindblad master equation
call ruleset_to_liou_2site(Lts(1), 1, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_liou'//&
! '_2site_qtensorclist (1) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(2), 2, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_liou'//&
! '_2site_qtensorclist (2) failed.', errst=errst)) return
call ruleset_to_liou_2site(Lts(up), up, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to_liou'//&
! '_2site_qtensorclist (3) failed.', errst=errst)) return
do ii = 3, (up - 1)
call copy(Lts(ii), Lts(2), errst=errst)
!if(prop_error('prepare_op2_qtensorc : copy (2) '//&
! 'failed.', errst=errst)) return
end do
else
! Lindblad master equation with space-dependent coupling
do ii = 1, up
call ruleset_to_liou_2site(Lts(ii), ii, ll, Rs, Ops, Hparams, &
iop, errst=errst)
!if(prop_error('prepare_op2_qtensorc : ruleset_to'//&
! '_liou_2site (4) failed.', &
! errst=errst)) return
end do
end if
end subroutine prepare_op2_qtensorc
"""
return
[docs]def init_permarrays_pbc():
"""
fortran-subroutine - February 2019 (dj)
Destroys permutation arrays for PBC.
**Arguments**
pbc : LOGICAL, in
Flag if PBC are used (true) or not used (false).
perma : INTEGER(\*), in
Allocated and initialized on exit.
permb : INTEGER(\*), in
Allocated and initialized on exit.
ll : INTEGER, in
Number of sites in the system.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine init_permarrays_pbc(pbc, perma, permb, ll, errst)
logical, intent(in) :: pbc
integer, dimension(:), allocatable, intent(inout) :: perma, permb
integer, intent(in) :: ll
integer, intent(out), optional :: errst
! Local variables
! ---------------
! for looping
integer :: ii
!if(present(errst)) errst = 0
allocate(perma(ll), permb(ll))
perma(1) = ll
permb(ll) = 1
do ii = 2, ll
perma(ii) = ii - 1
permb(ii - 1) = ii
end do
end subroutine init_permarrays_pbc
"""
return
[docs]def finalize_permarrays_pbc():
"""
fortran-subroutine - February 2019 (dj)
Destroys permutation arrays for PBC.
**Arguments**
pbc : LOGICAL, in
Flag if PBC are used (true) or not used (false).
perma : INTEGER(\*), inout
Deallocated on exit.
permb : INTEGER(\*), inout
Deallocated on exit.
**Source Code**
.. hidden-code-block:: fortran
:label: show / hide f90 code
subroutine finalize_permarrays_pbc(pbc, perma, permb, errst)
logical, intent(in) :: pbc
integer, dimension(:), allocatable, intent(inout) :: perma, permb
integer, intent(out), optional :: errst
! No local variables
!if(present(errst)) errst = 0
if(pbc) then
deallocate(perma)
deallocate(permb)
end if
end subroutine finalize_permarrays_pbc
"""
return