dtrsl Subroutine

public subroutine dtrsl(t, ldt, n, b, job, info)

dtrsl solves systems of the form

t * x = b

or

trans(t) * x = b

where t is a triangular matrix of order n. here trans(t) denotes the transpose of the matrix t.

History

  • linpack. this version dated 08/14/78 . g. w. stewart, university of maryland, argonne national lab.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: t(ldt,*)

t contains the matrix of the system. the zero elements of the matrix are not referenced, and the corresponding elements of the array can be used to store other information.
integer, intent(in) :: ldt

the leading dimension of the array t.
integer, intent(in) :: n

the order of the system.
real(kind=wp), intent(inout) :: b(*)

On entry: the right hand side of the system. On return: the solution, if info == 0. otherwise b is unaltered.
integer, intent(in) :: job

job specifies what kind of system is to be solved. if job is:

  • 00 solve t*x=b, t lower triangular,
  • 01 solve t*x=b, t upper triangular,
  • 10 solve trans(t)*x=b, t lower triangular,
  • 11 solve trans(t)*x=b, t upper triangular.
integer, intent(out) :: info

info contains zero if the system is nonsingular. otherwise info contains the index of the first zero diagonal element of t.

Calls

proc~~dtrsl~~CallsGraph proc~dtrsl lbfgsb_linpack_module::dtrsl proc~daxpy lbfgsb_blas_module::daxpy proc~dtrsl->proc~daxpy proc~ddot lbfgsb_blas_module::ddot proc~dtrsl->proc~ddot

Called by

proc~~dtrsl~~CalledByGraph proc~dtrsl lbfgsb_linpack_module::dtrsl proc~bmv lbfgsb_module::bmv proc~bmv->proc~dtrsl proc~formk lbfgsb_module::formk proc~formk->proc~dtrsl proc~subsm lbfgsb_module::subsm proc~subsm->proc~dtrsl proc~cauchy lbfgsb_module::cauchy proc~cauchy->proc~bmv proc~cmprlb lbfgsb_module::cmprlb proc~cmprlb->proc~bmv proc~mainlb lbfgsb_module::mainlb proc~mainlb->proc~formk proc~mainlb->proc~subsm proc~mainlb->proc~cauchy proc~mainlb->proc~cmprlb proc~setulb lbfgsb_module::setulb proc~setulb->proc~mainlb

Source Code

subroutine dtrsl(t,ldt,n,b,job,info)

integer,intent(in) :: ldt !! the leading dimension of the array t.
integer,intent(in) :: n !! the order of the system.
integer,intent(in) :: job !! job specifies what kind of system is to be solved.
                          !! if job is:
                          !!
                          !!  * `00`   solve `t*x=b`, t lower triangular,
                          !!  * `01`   solve `t*x=b`, t upper triangular,
                          !!  * `10`   solve `trans(t)*x=b`, t lower triangular,
                          !!  * `11`   solve `trans(t)*x=b`, t upper triangular.
integer,intent(out) :: info !! info contains zero if the system is nonsingular.
                            !! otherwise info contains the index of
                            !! the first zero diagonal element of t.
real(wp),intent(in) :: t(ldt,*) !! t contains the matrix of the system. the zero
                                !! elements of the matrix are not referenced, and
                                !! the corresponding elements of the array can be
                                !! used to store other information.
real(wp),intent(inout) :: b(*) !! On entry: the right hand side of the system.
                               !! On return: the solution, if info == 0. otherwise b is unaltered.

real(wp) :: temp
integer :: case,j,jj

   ! check for zero diagonal elements.
   do info = 1, n
      if (t(info,info) == 0.0_wp) return
   end do
   info = 0

   ! determine the task and go to it.
   case = 1
   if (mod(job,10) /= 0) case = 2
   if (mod(job,100)/10 /= 0) case = case + 2

   select case (case)
   case(1) ! solve t*x=b for t lower triangular
      b(1) = b(1)/t(1,1)
      if (n >= 2) then
         do j = 2, n
            temp = -b(j-1)
            call daxpy(n-j+1,temp,t(j,j-1),1,b(j),1)
            b(j) = b(j)/t(j,j)
         end do
      end if

   case(2) ! solve t*x=b for t upper triangular.
      b(n) = b(n)/t(n,n)
      if (n >= 2) then
         do jj = 2, n
            j = n - jj + 1
            temp = -b(j+1)
            call daxpy(j,temp,t(1,j+1),1,b(1),1)
            b(j) = b(j)/t(j,j)
         end do
      end if

   case(3) ! solve trans(t)*x=b for t lower triangular.
      b(n) = b(n)/t(n,n)
      if (n >= 2) then
         do jj = 2, n
            j = n - jj + 1
            b(j) = b(j) - ddot(jj-1,t(j+1,j),1,b(j+1),1)
            b(j) = b(j)/t(j,j)
         end do
      end if

   case(4) ! solve trans(t)*x=b for t upper triangular.
      b(1) = b(1)/t(1,1)
      if (n >= 2) then
         do j = 2, n
            b(j) = b(j) - ddot(j-1,t(1,j),1,b(1),1)
            b(j) = b(j)/t(j,j)
         end do
      end if

   end select

end subroutine dtrsl