TDVPOps¶
Fortran module TDVPOps: August 2017 (dj)
Contains the subroutines for the TDVP
Authors
Jaschke
Wall
Details
The following subroutines / functions are defined for the applicable data type
procedure |
include.f90 |
mpi.f90 |
|---|---|---|
tdvp2 |
X |
- TDVPOps_f90.tdvp2_symm_mpo_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_mpo_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(mpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(mpo), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(tensorlistc), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_tensor), dimension(:), allocatable :: Hts ! Tensor representing two sites type(tensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_mpo_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_mpo : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_mpo : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_mpo_complex
- TDVPOps_f90.tdvp2_symm_mpoc_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_mpoc_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(mpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(mpoc), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(tensorlistc), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_tensorc), dimension(:), allocatable :: Hts ! Tensor representing two sites type(tensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_mpoc_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_mpoc : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_mpoc : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_mpoc_complex
- TDVPOps_f90.tdvp2_symm_qmpo_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_qmpo_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(qmpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(qmpo), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(qtensorclist), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_qtensor), dimension(:), allocatable :: Hts ! Tensor representing two sites type(qtensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_qmpo_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_qmpo : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_qmpo : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_qmpo_complex
- TDVPOps_f90.tdvp2_symm_qmpoc_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_qmpoc_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(qmpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(qmpoc), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(qtensorclist), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_qtensorc), dimension(:), allocatable :: Hts ! Tensor representing two sites type(qtensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_qmpoc_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_qmpoc : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_qmpoc_complex
- TDVPOps_f90.tdvp2_gen_mpo_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_gen_mpo_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(mpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(mpo), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(tensorlistc), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_tensor), dimension(:), allocatable :: Hts ! Tensor representing two sites type(tensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_gen_mpo_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_mpo : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_mpo : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_gen_mpo_complex
- TDVPOps_f90.tdvp2_gen_mpoc_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_gen_mpoc_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(mpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(mpoc), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(tensorlistc), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_tensorc), dimension(:), allocatable :: Hts ! Tensor representing two sites type(tensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_gen_mpoc_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_mpoc : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_mpoc : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_gen_mpoc_complex
- TDVPOps_f90.tdvp2_gen_qmpo_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_gen_qmpo_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(qmpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(qmpo), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(qtensorclist), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_qtensor), dimension(:), allocatable :: Hts ! Tensor representing two sites type(qtensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_gen_qmpo_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_qmpo : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_qmpo : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_gen_qmpo_complex
- TDVPOps_f90.tdvp2_gen_qmpoc_complex()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_gen_qmpoc_complex(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(qmpsc), intent(inout) :: Psi complex(KIND=rKind), intent(in) :: deltat type(qmpoc), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(qtensorclist), dimension(:), allocatable :: LR ! Modified time step for certain parts complex(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_qtensorc), dimension(:), allocatable :: Hts ! Tensor representing two sites type(qtensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_gen_qmpoc_complex:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_arnoldi_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_arnoldi_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_qmpoc : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_gen_qmpoc_complex
- TDVPOps_f90.tdvp2_symm_mpo_real()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_mpo_real(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(mps), intent(inout) :: Psi real(KIND=rKind), intent(in) :: deltat type(mpo), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(tensorlist), dimension(:), allocatable :: LR ! Modified time step for certain parts real(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_tensor), dimension(:), allocatable :: Hts ! Tensor representing two sites type(tensor) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_mpo_real:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_mpo : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpo : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_mpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_mpo : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_mpo_real
- TDVPOps_f90.tdvp2_symm_mpoc_real()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_mpoc_real(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(mpsc), intent(inout) :: Psi real(KIND=rKind), intent(in) :: deltat type(mpoc), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(tensorlistc), dimension(:), allocatable :: LR ! Modified time step for certain parts real(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_tensorc), dimension(:), allocatable :: Hts ! Tensor representing two sites type(tensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_mpoc_real:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_mpoc : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_mpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_mpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_mpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_mpoc : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_mpoc_real
- TDVPOps_f90.tdvp2_symm_qmpo_real()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_qmpo_real(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(qmps), intent(inout) :: Psi real(KIND=rKind), intent(in) :: deltat type(qmpo), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(qtensorlist), dimension(:), allocatable :: LR ! Modified time step for certain parts real(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_qtensor), dimension(:), allocatable :: Hts ! Tensor representing two sites type(qtensor) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_qmpo_real:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_qmpo : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpo : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpo : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_qmpo : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_qmpo : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_qmpo_real
- TDVPOps_f90.tdvp2_symm_qmpoc_real()[source]¶
fortran-subroutine - August 2017 (dj, updated) Propagate psi with the TEBD algorithm.
Arguments
- convergedLOGICAL, out
Not referenced, only to provide equal interface.
- cerrREAL, inout
The cumulated error. The error done during this subroutine is added to the incoming value.
- renormCHARACTER, in
Flag if state vector should be renormalized to 1. ‘N’ : do not normalize (default); ‘M’ : normalize for MPS 1 / sqrt(norm);
- pbcLOGICAL, in
If PBC are used in any rule set. There is a check before, but the debugging mode should ensure for now that there are no calls with such a check.
Details
Currently uses complete reorthogonalization for stability. (defined in TimeEvolutionOps_include.f90)
Source Code
show / hide f90 codesubroutine tdvp2_symm_qmpoc_real(Psi, deltat, Ham, converged, & cerr, Cp, renorm, pbc, errst) TYPE(qmpsc), intent(inout) :: Psi real(KIND=rKind), intent(in) :: deltat type(qmpoc), intent(inout) :: Ham logical, intent(out) :: converged real(KIND=rKind), intent(inout) :: cerr type(ConvParam), intent(in) :: Cp character, intent(in) :: renorm logical, intent(in) :: pbc integer, intent(out), optional :: errst ! Local variables ! --------------- ! for looping integer :: ii, jj ! save orthogonality center integer :: ocsave ! provide local tolerance real(KIND=rKind) :: local_tol ! Error from one step inside the algorithm real(KIND=rKind) :: err ! Left-right overlaps type(qtensorclist), dimension(:), allocatable :: LR ! Modified time step for certain parts real(KIND=rKind) :: dt ! All two-site MPOs type(sr_matrix_qtensorc), dimension(:), allocatable :: Hts ! Tensor representing two sites type(qtensorc) :: Theta !if(present(errst)) errst = 0 !if(pbc) then ! errst = raise_error('tdvp2_symm_qmpoc_real:'//& ! 'TDVP does not have PBC.', 99, 'TDVPOps_include.f90:97', & ! errst=errst) ! return !end if ! Find criterion for convergence, right now always true 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 ocsave = Psi%oc if(ocsave /= 1) then call canonize(Psi, 1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : canonize (1) '//& ! 'failed.', errst=errst)) return end if dt = deltat / 2.0_rKind call setuplr(LR, Psi, Ham, Psi, Psi%oc) cerr = 0.0_rKind ! Prepare two site MPO matrices allocate(Hts(Psi%ll - 1)) do jj = 1, (Psi%ll - 1) call sdot(Hts(jj), Ham%Ws(jj), Ham%Ws(jj + 1)) end do ! Rightmoving sweep ! ----------------- do jj = 1, (Psi%ll - 2) call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), dt, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:145', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:152', errst=errst)) return cerr = cerr + err Psi%oc= jj + 1 Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, jj, 1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:161', errst=errst)) return ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj + 1), LR(jj), Ham%Ws(jj + 1), & LR(min(jj + 2, Psi%ll)), -dt, .false., & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:168', errst=errst)) return end do ! Full time step at last H^{(2)} ! ------------------------------ jj = Psi%ll - 1 call contr(Theta, Psi%Aa(jj), Psi%Aa(jj + 1), [3], [1]) call destroy(Psi%Aa(jj)) call destroy(Psi%Aa(jj + 1)) if(Psi%haslambda(jj + 1)) call destroy(Psi%Lambda(jj + 1)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 1)), Hts(jj), & LR(min(jj + 2, Psi%ll)), deltat, (1 == jj), & (jj + 1 == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:187', errst=errst)) return call split(Psi%Aa(jj), Psi%Lambda(jj + 1), Psi%Aa(jj + 1), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:194', errst=errst)) return cerr = cerr + err Psi%oc= jj Psi%haslambda(jj + 1) = .true. call destroy(Theta) call updatelr(LR, Psi, Ham, Psi, Psi%ll, -1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:202', errst=errst)) return ! Leftmoving sweep ! ---------------- do jj = (Psi%ll - 1), 2, (-1) ! Evolve under Heff_{j+1}^{(1)} call krylov_full_local(Psi%Aa(jj), LR(max(1, jj - 1)), Ham%Ws(jj), & LR(min(jj + 1, Psi%ll)), -dt, (jj == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:213', errst=errst)) return call contr(Theta, Psi%Aa(jj - 1), Psi%Aa(jj), [3], [1]) call destroy(Psi%Aa(jj - 1)) call destroy(Psi%Aa(jj)) if(Psi%haslambda(jj)) call destroy(Psi%Lambda(jj)) ! Evolve under Heff_j^{(2)} call krylov_full_local(Theta, LR(max(1, jj - 2)), Hts(jj -1), & LR(min(jj + 1, Psi%ll)), dt, (jj - 1 == 1), & (jj == Psi%ll), Cp, pbc, errst=errst) !if(prop_error('tdvp2_method_qmpoc : krylov_full_local'//& ! ' failed.', 'TDVPOps_include.f90:226', errst=errst)) return call split(Psi%Aa(jj - 1), Psi%Lambda(jj), Psi%Aa(jj), Theta, & [1, 2], [3, 4], multlr=-1, trunc=local_tol, & ncut=Cp%max_bond_dimension, err=err, renorm=renorm, & method='Y', errst=errst) !if(prop_error('tdvp2_method_qmpoc : split'//& ! ' failed.', 'TDVPOps_include.f90:233', errst=errst)) return cerr = cerr + err Psi%oc = jj - 1 Psi%haslambda(jj) = .true. call destroy(Theta) if(jj .ne. 2) then call updatelr(LR, Psi, Ham, Psi, jj, -1, errst=errst) !if(prop_error('tdvp2_method_qmpoc : updatelr'//& ! ' failed.', 'TDVPOps_include.f90:242', errst=errst)) return end if end do call canonize(Psi, ocsave, errst=errst) !if(prop_error('tdvp2_method_qmpoc : canonize (2) '//& ! 'failed.', errst=errst)) return do jj = 1, (Psi%ll - 1) call destroy(Hts(jj)) end do do ii = 1, size(LR, 1) do jj = 1, size(LR(ii)%Li, 1) call destroy(LR(ii)%Li(jj)) end do deallocate(LR(ii)%Li) end do deallocate(LR, Hts) end subroutine tdvp2_symm_qmpoc_real