Implemented right triangular solve

base/modules/psblas/psb_d_psblas_mod.F90

@@ -543,7 +543,7 @@ module psb_d_psblas_mod
     subroutine psb_dmlt_multivect(x, y, res, desc_a,info,global)
       import :: psb_desc_type, psb_dpk_, psb_ipk_, &
            & psb_d_multivect_type, psb_dspmat_type
-      real(psb_dpk_), dimension(:,:), allocatable :: res
+      real(psb_dpk_), dimension(:,:), allocatable, intent(inout) :: res
       type(psb_d_multivect_type), intent(inout) :: x, y
       type(psb_desc_type), intent(in)      :: desc_a
       integer(psb_ipk_), intent(out)       :: info
@@ -588,6 +588,18 @@ module psb_d_psblas_mod
       integer(psb_ipk_), intent(out)        :: info
       logical, intent(in)                   :: flag
     end subroutine psb_ddiv_vect2_check
+    subroutine psb_ddiv_trslv(x,a,desc_a,uplo,info,alpha,trans,diag)
+      import :: psb_desc_type, psb_ipk_, &
+           & psb_dpk_, psb_d_multivect_type
+      type(psb_d_multivect_type), intent (inout)  :: x
+      real(psb_dpk_), intent (in), dimension(:,:) :: a
+      type(psb_desc_type), intent (in)            :: desc_a
+      character(len=1), intent(in)                :: uplo
+      integer(psb_ipk_), intent(out)              :: info
+      real(psb_dpk_), intent (in), optional       :: alpha
+      character(len=1), intent(in), optional      :: trans
+      character(len=1), intent(in), optional      :: diag
+    end subroutine psb_ddiv_trslv
   end interface
 
   interface psb_geinv

base/modules/serial/psb_d_base_vect_mod.F90

@@ -2911,8 +2911,8 @@ contains
     if (x%is_dev()) call x%sync()
     if (x%is_sync()) then
       ! Call BLAS function to solve the system
-      lda = n
-      ldb = n
+      lda = size(a,1)
+      ldb = x%get_nrows()
       side = 'R'  ! X*op( A ) = alpha*B.
       call dtrsm(side, uplo, trans_, diag_, n, x%get_ncols(), alpha_, a, lda, x%v, ldb)
     end if
@@ -3141,9 +3141,10 @@ contains
   !! \param y    The class(base_mlv_vect) to be multiplied by
   !! \param a    The resulting matrix
   !! \param info   return code
-  subroutine d_base_mlv_mlt_mv2(x,y,a,info)
+  subroutine d_base_mlv_mlt_mv2(n,x,y,a,info)
     use psi_serial_mod
     implicit none
+    integer(psb_ipk_), intent(in)                    :: n
     class(psb_d_base_multivect_type), intent(inout)  :: x
     class(psb_d_base_multivect_type), intent(inout)  :: y
     real(psb_dpk_), intent(inout), allocatable :: a(:,:)
@@ -3171,7 +3172,7 @@ contains
     ! C = alpha*op( A )*op( B ) + beta*C
     ! In our case, we want to compute
     ! C = X'*Y  
-    call dgemm('T', 'N', x%get_ncols(), y%get_ncols(), x%get_nrows(), done, &
+    call dgemm('T', 'N', x%get_ncols(), y%get_ncols(), n, done, &
       & x%v, x%get_nrows(), y%v, y%get_nrows(), dzero, a, x%get_ncols())
 
   end subroutine d_base_mlv_mlt_mv2

base/modules/serial/psb_d_vect_mod.F90

@@ -1976,16 +1976,17 @@ contains
     end if
   end subroutine d_mlv_trslv
 
-  subroutine d_mvect_mlt_mv2(x,y,a,info)
+  subroutine d_mvect_mlt_mv2(n,x,y,a,info)
     use psi_serial_mod
     implicit none
+    integer(psb_ipk_), intent(in)              :: n
     class(psb_d_multivect_type), intent(inout) :: x
     class(psb_d_multivect_type), intent(inout) :: y
     real(psb_dpk_), intent(inout), allocatable :: a(:,:)
     integer(psb_ipk_), intent(out)             :: info
 
     if (allocated(x%v).and.allocated(y%v)) then
-      call y%v%mlt(x%v,a,info)
+      call y%v%mlt(n,x%v,a,info)
     else
       info = psb_err_invalid_vect_state_
       return