calculate_log_der_matrix Subroutine

private subroutine calculate_log_der_matrix(step_, number_of_channels_, t_matrix_minus_, t_matrix_, t_matrix_plus_, r_matrix_, r_matrix_plus_, log_der_matrix_)

calculates the log-derivative matrix from called by numerov at the end of the propagation

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: step_

propagator step

integer(kind=int32), intent(in) :: number_of_channels_

number of scattering channels in the block

real(kind=dp), intent(in) :: t_matrix_minus_(number_of_channels_,number_of_channels_)

T-matrix at R_{max - 1}

real(kind=dp), intent(in) :: t_matrix_(number_of_channels_,number_of_channels_)

T-matrix at R_{max}

real(kind=dp), intent(in) :: t_matrix_plus_(number_of_channels_,number_of_channels_)

T-matrix at R_{max + 1}

real(kind=dp), intent(in) :: r_matrix_(number_of_channels_,number_of_channels_)

R-matrix at R_{max}

real(kind=dp), intent(in) :: r_matrix_plus_(number_of_channels_,number_of_channels_)

R-matrix at R_{max + 1}

real(kind=dp), intent(inout) :: log_der_matrix_(number_of_channels_,number_of_channels_)

log-derivative matrix


Calls

proc~~calculate_log_der_matrix~~CallsGraph proc~calculate_log_der_matrix calculate_log_der_matrix interface~add_scalar_to_diagonal add_scalar_to_diagonal proc~calculate_log_der_matrix->interface~add_scalar_to_diagonal interface~invert_symmetric_matrix invert_symmetric_matrix proc~calculate_log_der_matrix->interface~invert_symmetric_matrix interface~fill_symmetric_matrix fill_symmetric_matrix proc~calculate_log_der_matrix->interface~fill_symmetric_matrix dgemm dgemm proc~calculate_log_der_matrix->dgemm

Called by

proc~~calculate_log_der_matrix~~CalledByGraph proc~calculate_log_der_matrix calculate_log_der_matrix proc~numerov numerov proc~numerov->proc~calculate_log_der_matrix program~scattering SCATTERING program~scattering->proc~numerov

Contents


Variables

Type Visibility Attributes Name Initial
integer(kind=int32), private :: channel_index_1_
real(kind=dp), private :: left_matrix_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_a_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_ab_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_b_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_c_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_cd_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_d_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_difference_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: matrix_e_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: right_matrix_(number_of_channels_,number_of_channels_)
real(kind=dp), private :: working_r_matrix_(number_of_channels_,number_of_channels_)

Source Code

      subroutine calculate_log_der_matrix(step_, number_of_channels_,          &
         t_matrix_minus_, t_matrix_, t_matrix_plus_, r_matrix_, r_matrix_plus_,&
         log_der_matrix_)
         !! calculates the log-derivative matrix from
         !! \begin{equation}
         !! {Y}_{\rm N} = \frac{1}{h} \Biggl(\Bigl(\frac{1}{2}\mathbf{I}-{T}_{\rm{N}+1}\Bigr)
         !! \Bigl(\mathbf{I}-{T}_{\rm{N}+1}\Bigr)^{-1} {R}_{\rm{N}+1} -
         !! \Bigl(\frac{1}{2}\mathbf{I}-{T}_{\rm{N}-1}\Bigr)
         !! \Bigl(\mathbf{I}-\mathbf{T}_{\rm{N}-1}\Bigr)^{-1}\mathbf{R}_{\rm{N}}^{-1}
         !! \Biggr)\Bigl(\mathbf{I}-{T}_{\rm{N}}\Bigr) 
         !! \end{equation}
         !! called by numerov at the end of the propagation
         !---------------------------------------------------------------------!
         real(dp), intent(in) :: step_
            !! propagator step
         integer(int32), intent(in) :: number_of_channels_
            !! number of scattering channels in the block
         real(dp), intent(in) :: t_matrix_minus_(number_of_channels_, number_of_channels_)
            !! T-matrix at R_{max - 1}
         real(dp), intent(in) :: t_matrix_(number_of_channels_, number_of_channels_)
            !! T-matrix at R_{max}
         real(dp), intent(in) :: t_matrix_plus_(number_of_channels_, number_of_channels_)
            !! T-matrix at R_{max + 1} 
         real(dp), intent(in) :: r_matrix_(number_of_channels_, number_of_channels_)
            !! R-matrix at R_{max} 
         real(dp), intent(in) :: r_matrix_plus_(number_of_channels_, number_of_channels_)
            !! R-matrix at R_{max + 1}
         real(dp), intent(inout) :: log_der_matrix_(number_of_channels_, number_of_channels_)
            !! log-derivative matrix
         !---------------------------------------------------------------------!
         integer(int32) :: channel_index_1_
         real(dp) :: matrix_a_(number_of_channels_,number_of_channels_),       &
            matrix_b_(number_of_channels_,number_of_channels_),                &
            matrix_c_(number_of_channels_,number_of_channels_),                &
            matrix_d_(number_of_channels_,number_of_channels_),                &
            matrix_e_(number_of_channels_,number_of_channels_),                &
            matrix_ab_(number_of_channels_,number_of_channels_),               &
            matrix_cd_(number_of_channels_,number_of_channels_),               &
            left_matrix_(number_of_channels_,number_of_channels_),             &
            right_matrix_(number_of_channels_,number_of_channels_),            &
            working_r_matrix_(number_of_channels_,number_of_channels_),        &
            matrix_difference_(number_of_channels_,number_of_channels_)
         !---------------------------------------------------------------------!
         log_der_matrix_ = 0
         !---------------------------------------------------------------------!
         ! First bracket: (1/2 I - T_{N+1})
         !---------------------------------------------------------------------!
         matrix_a_ = - t_matrix_plus_
         call add_scalar_to_diagonal(matrix_a_, 0.5_dp)
         !---------------------------------------------------------------------!
         ! Second bracket: (I - T_{N+1})^{-1}
         !---------------------------------------------------------------------!
         matrix_b_ = - t_matrix_plus_
         call add_scalar_to_diagonal(matrix_b_, 1.0_dp)
         call invert_symmetric_matrix(matrix_b_)
         call fill_symmetric_matrix(matrix_b_, "u")
         !---------------------------------------------------------------------!
         ! Third bracket: (1/2 I - T_{N-1})
         !---------------------------------------------------------------------!
         matrix_c_ = - t_matrix_minus_
         call add_scalar_to_diagonal(matrix_c_, 0.5_dp)
         !---------------------------------------------------------------------!
         ! Fourth bracket: (I - T_{N-1})^{-1}
         !---------------------------------------------------------------------!
         matrix_d_ = - t_matrix_minus_
         call add_scalar_to_diagonal(matrix_d_, 1.0_dp)
         call invert_symmetric_matrix(matrix_d_)
         call fill_symmetric_matrix(matrix_d_, "u")
         !---------------------------------------------------------------------!
         ! Last bracket: (I - T_{N})
         !---------------------------------------------------------------------!
         matrix_e_ = - t_matrix_
         call add_scalar_to_diagonal(matrix_e_, 1.0_dp)
         !---------------------------------------------------------------------!
         ! Copy R_{N} to another matrix (r_matrix_ is protected as intent(in))
         !---------------------------------------------------------------------!
         working_r_matrix_ = r_matrix_
         call invert_symmetric_matrix(working_r_matrix_)
         call fill_symmetric_matrix(working_r_matrix_, "u")
         !---------------------------------------------------------------------!
         ! The first term in the large bracket:
         ! (1/2 I - T_{N+1}) (I - T_{N+1})^{-1} R_{N+1}
         !---------------------------------------------------------------------!
         CALL DGEMM('N','N',number_of_channels_,number_of_channels_,           &
            number_of_channels_,1.0_dp,matrix_a_,number_of_channels_,matrix_b_,&
            number_of_channels_,0.0_dp,matrix_ab_,number_of_channels_)
         CALL DGEMM('N','N',number_of_channels_,number_of_channels_,           &
            number_of_channels_,1.0_dp,matrix_ab_,number_of_channels_,         &
            r_matrix_plus_,number_of_channels_,0.0_dp,left_matrix_,number_of_channels_)
         !---------------------------------------------------------------------!
         ! The second term in the large bracket:
         ! (1/2 I - T_{N-1}) (I - T_{N-1})^{-1} R_{N}^{-1}
         !---------------------------------------------------------------------!
         CALL DGEMM('N','N',number_of_channels_,number_of_channels_,           &
            number_of_channels_,1.0_dp,matrix_c_,number_of_channels_,matrix_d_,&
            number_of_channels_,0.0_dp,matrix_cd_,number_of_channels_)
         CALL DGEMM('N','N',number_of_channels_,number_of_channels_,           &
            number_of_channels_,1.0_dp,matrix_cd_,number_of_channels_,         &
            working_r_matrix_,number_of_channels_,0.0_dp,right_matrix_,        &
            number_of_channels_)
         !---------------------------------------------------------------------!
         ! Substract the two terms in the large bracket
         !---------------------------------------------------------------------!
         matrix_difference_ = left_matrix_ - right_matrix_
         !---------------------------------------------------------------------!
         ! Multiply the product by (I - T_{N})
         !---------------------------------------------------------------------!
         CALL DGEMM('N','N',number_of_channels_,number_of_channels_,           &
            number_of_channels_,1.0_dp/step_,matrix_difference_,               &
            number_of_channels_,matrix_e_,number_of_channels_,0.0_dp,          &
            log_der_matrix_,number_of_channels_)
         !---------------------------------------------------------------------!
      end subroutine calculate_log_der_matrix