Commit 87da910f authored by Florian Goth's avatar Florian Goth
Browse files

sort out mscb parts.

parent 2da1a178
Pipeline #12981 failed with stages
in 11 minutes and 3 seconds
......@@ -63,7 +63,8 @@ module Exponentials_mod
procedure :: rmultinv => EulerExp_rmultinv
procedure :: rmult_T => EulerExp_rmult_T
procedure :: lmult_T => EulerExp_lmult_T
procedure :: adjointaction => EulerExp_adjointaction
procedure :: adjoint => EulerExp_adjoint
procedure :: adjoint_T => EulerExp_adjoint_T
procedure :: adjoint_over_two => EulerExp_adjoint_over_two
procedure :: adjoint_over_two_T => EulerExp_adjoint_over_two_T
procedure :: rmultinv_T => EulerExp_rmultinv_T
......@@ -95,6 +96,7 @@ module Exponentials_mod
procedure :: rmult => FullExp_rmult
procedure :: rmultinv => FullExp_rmultinv
procedure :: lmult_T => FullExp_lmult_T
procedure :: adjoint => FullExp_adjoint
procedure :: adjoint_over_two => FullExp_adjoint_over_two
end type FullExp
......@@ -232,6 +234,16 @@ subroutine FullExp_adjoint_over_two(this, mat)
enddo
end subroutine FullExp_adjoint_over_two
subroutine FullExp_adjoint(this, mat)
class(FullExp) :: this
complex(kind=kind(0.D0)), intent(inout) :: mat(:,:)
integer :: i
do i = this%evals-1, 1, -2
call this%stages(i+1)%adjoint_T(mat)
call this%stages(i)%adjoint(mat)
enddo
end subroutine FullExp_adjoint
subroutine FullExp_lmultinv(this, mat)
class(FullExp) :: this
complex(kind=kind(0.D0)), intent(inout), contiguous :: mat(:,:)
......@@ -340,14 +352,23 @@ subroutine EulerExp_lmult(this, mat)
enddo
end subroutine EulerExp_lmult
subroutine EulerExp_adjointaction(this, mat)
subroutine EulerExp_adjoint(this, mat)
class(EulerExp) :: this
complex(kind=kind(0.D0)), dimension(:, :) :: mat
integer :: i
do i = this%nrofcols, 1, -1
call this%singleexps(i)%dat%adjointaction(mat)
enddo
end subroutine EulerExp_adjointaction
end subroutine EulerExp_adjoint
subroutine EulerExp_adjoint_T(this, mat)
class(EulerExp) :: this
complex(kind=kind(0.D0)), dimension(:, :) :: mat
integer :: i
do i = 1,this%nrofcols
call this%singleexps(i)%dat%adjointaction(mat)
enddo
end subroutine EulerExp_adjoint_T
subroutine EulerExp_adjoint_over_two(this, mat)
class(EulerExp) :: this
......
......@@ -59,6 +59,8 @@ module mscbOpT_mod
procedure :: rmultinv => CmplxmscbOpT_rmultinv ! right multiplication with Op_T inverse
procedure :: lmultinv => CmplxmscbOpT_lmultinv ! left multiplication with Op_T inverse
procedure :: adjointaction => CmplxmscbOpT_adjointaction
procedure :: adjoint => CmplxmscbOpT_adjoint
procedure :: adjoint_over_two => CmplxmscbOpT_adjoint_over_two
procedure :: dump => CmplxmscbOpT_dump ! dump matrices for debugging to screen
end type CmplxmscbOpT
......@@ -83,6 +85,8 @@ module mscbOpT_mod
procedure :: rmultinv => CmplxEulermscbOpT_rmultinv ! right multiplication with Op_T inverse
procedure :: lmultinv => CmplxEulermscbOpT_lmultinv
procedure :: adjointaction => CmplxEulermscbOpT_adjointaction
procedure :: adjoint => CmplxEulermscbOpT_adjointaction
procedure :: adjoint_over_two => CmplxEulermscbOpT_adjointaction
procedure :: dump => CmplxEulermscbOpT_dump ! dump matrices for debugging to screen
end type CmplxEulermscbOpT
......@@ -173,6 +177,26 @@ contains
call this%fe%adjoint_over_two(arg)
Endif
end subroutine
subroutine CmplxmscbOpT_adjoint(this, arg)
class(CmplxmscbOpT), intent(in) :: this
Complex(kind=kind(0.D0)), intent(inout), dimension(:,:) :: arg
!FIXME: P
If ( dble(this%g*conjg(this%g)) > this%Zero ) then
call this%fe%adjoint(arg)
Endif
end subroutine
subroutine CmplxmscbOpT_adjoint_over_two(this, arg)
class(CmplxmscbOpT), intent(in) :: this
Complex(kind=kind(0.D0)), intent(inout), dimension(:,:) :: arg
!FIXME: P
If ( dble(this%g*conjg(this%g)) > this%Zero ) then
call this%fe%adjoint_over_two(arg)
Endif
end subroutine
subroutine CmplxmscbOpT_rmult(this, arg)
class(CmplxmscbOpT), intent(in) :: this
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment