psblas3:

base/modules/psb_error_mod.F90
 base/newserial/psbn_coo_mat.f03
 base/newserial/psbn_csr_mat.f03
 base/newserial/psbn_d_base_mat_mod.f03
 base/newserial/psbn_mat_mod.f03


First error handling in derived classes.

base/modules/psb_error_mod.F90

@@ -474,6 +474,8 @@ contains
     case(700)
       write (0,'("Base version has been called: the actual derived type is incomplete!")')
 
+    case (1121)
+      write (0,'("Invalid state for sparse matrix A")')
     case (1122)
       write (0,'("Invalid state for communication descriptor")')
     case (1123)

base/newserial/psbn_coo_mat.f03

@@ -28,6 +28,7 @@ contains
 
   subroutine d_coo_csmv(alpha,a,x,beta,y,info,trans) 
     use psb_const_mod
+    use psb_error_mod
     class(psbn_d_coo_sparse_mat), intent(in) :: a
     real(psb_dpk_), intent(in)          :: alpha, beta, x(:)
     real(psb_dpk_), intent(inout)       :: y(:)
@@ -38,6 +39,11 @@ contains
     integer   :: i,j,k,m,n, nnz, ir, jc
     real(psb_dpk_) :: acc
     logical   :: tra
+    Integer :: err_act
+    character(len=20)  :: name='d_co_csmv'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
 
     if (present(trans)) then
       trans_ = trans
@@ -47,6 +53,13 @@ contains
     
     tra = ((trans_=='T').or.(trans_=='t'))
 
+    if (.not.a%is_asb()) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+
     if (tra) then 
       m = a%get_ncols()
       n = a%get_nrows()
@@ -150,10 +163,23 @@ contains
       
     endif
 
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
   end subroutine d_coo_csmv
 
   subroutine d_coo_csmm(alpha,a,x,beta,y,info,trans) 
     use psb_const_mod
+    use psb_error_mod
     class(psbn_d_coo_sparse_mat), intent(in) :: a
     real(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
     real(psb_dpk_), intent(inout)       :: y(:,:)
@@ -164,6 +190,11 @@ contains
     integer   :: i,j,k,m,n, nnz, ir, jc, nc
     real(psb_dpk_), allocatable  :: acc(:)
     logical   :: tra
+    Integer :: err_act
+    character(len=20)  :: name='d_coo_csmm'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
 
     if (present(trans)) then
       trans_ = trans
@@ -171,6 +202,13 @@ contains
       trans_ = 'N'
     end if
     
+    if (.not.a%is_asb()) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
+
     tra = ((trans_=='T').or.(trans_=='t'))
 
     if (tra) then 
@@ -182,12 +220,14 @@ contains
     end if
     nnz = a%get_nzeros()
 
-    nc = size(x,2) 
+    nc = min(size(x,2), size(y,2))
-    if (nc /= size(y,2)) then 
+    allocate(acc(nc),stat=info)
-      write(0,*) 'Mismatch in column sizes!!'
+    if(info /= 0) then
-      return
+      info=4010
+      call psb_errpush(info,name,a_err='allocate')
+      goto 9999
     end if
-    allocate(acc(nc))
+
 
     if (alpha == dzero) then
       if (beta == dzero) then
@@ -283,6 +323,18 @@ contains
       
     endif
 
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
   end subroutine d_coo_csmm
   
 end module psbn_d_coo_sparse_mat_mod

base/newserial/psbn_csr_mat.f03

@@ -28,6 +28,7 @@ contains
 
   subroutine d_csr_csmv(alpha,a,x,beta,y,info,trans) 
     use psb_const_mod
+    use psb_error_mod
     class(psbn_d_csr_sparse_mat), intent(in) :: a
     real(psb_dpk_), intent(in)          :: alpha, beta, x(:)
     real(psb_dpk_), intent(inout)       :: y(:)
@@ -38,6 +39,12 @@ contains
     integer   :: i,j,k,m,n, nnz, ir, jc
     real(psb_dpk_) :: acc
     logical   :: tra
+    Integer :: err_act
+    character(len=20)  :: name='d_csr_csmv'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    info = 0 
 
     if (present(trans)) then
       trans_ = trans
@@ -47,7 +54,11 @@ contains
 
     if (.not.a%is_asb()) then 
       write(0,*) 'Error: csmv called on an unassembled mat'
-    end if
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
 
     tra = ((trans_=='T').or.(trans_=='t'))
 
@@ -265,11 +276,22 @@ contains
       end do
     end if
 
+    call psb_erractionrestore(err_act)
+    return
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
 
   end subroutine d_csr_csmv
 
   subroutine d_csr_csmm(alpha,a,x,beta,y,info,trans) 
     use psb_const_mod
+    use psb_error_mod
     class(psbn_d_csr_sparse_mat), intent(in) :: a
     real(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
     real(psb_dpk_), intent(inout)       :: y(:,:)
@@ -280,6 +302,11 @@ contains
     integer   :: i,j,k,m,n, nnz, ir, jc, nc
     real(psb_dpk_), allocatable  :: acc(:)
     logical   :: tra
+    Integer :: err_act
+    character(len=20)  :: name='d_csr_csmm'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
 
     if (present(trans)) then
       trans_ = trans
@@ -289,8 +316,10 @@ contains
     
     tra = ((trans_=='T').or.(trans_=='t'))
     if (.not.a%is_asb()) then 
-      write(0,*) 'Error: csmv called on an unassembled mat'
+      info = 1121
-    end if
+      call psb_errpush(info,name)
+      goto 9999
+    endif
     
     if (tra) then 
       m = a%get_ncols()
@@ -300,12 +329,14 @@ contains
       m = a%get_nrows()
     end if
 
-    nc = size(x,2) 
+    nc = min(size(x,2) , size(y,2) )
-    if (nc /= size(y,2)) then 
+
-      write(0,*) 'Mismatch in column sizes!!'
+    allocate(acc(nc), stat=info)
-      return
+    if(info /= 0) then
+      info=4010
+      call psb_errpush(info,name,a_err='allocate')
+      goto 9999
     end if
-    allocate(acc(nc))
 
    if (alpha == dzero) then
       if (beta == dzero) then
@@ -512,12 +543,23 @@ contains
       end do
     end if
     
+    call psb_erractionrestore(err_act)
+    return
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
 
   end subroutine d_csr_csmm
 
 
   subroutine d_csr_cssv(alpha,a,x,beta,y,info,trans) 
     use psb_const_mod
+    use psb_error_mod
     class(psbn_d_csr_sparse_mat), intent(in) :: a
     real(psb_dpk_), intent(in)          :: alpha, beta, x(:)
     real(psb_dpk_), intent(inout)       :: y(:)
@@ -529,6 +571,11 @@ contains
     real(psb_dpk_) :: acc
     real(psb_dpk_), allocatable :: tmp(:)
     logical   :: tra
+    Integer :: err_act
+    character(len=20)  :: name='d_csr_cssv'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
 
     if (present(trans)) then
       trans_ = trans
@@ -536,14 +583,18 @@ contains
       trans_ = 'N'
     end if
     if (.not.a%is_asb()) then 
-      write(0,*) 'Error: cssv called on an unassembled mat'
+      info = 1121
-    end if
+      call psb_errpush(info,name)
+      goto 9999
+    endif
         
     tra = ((trans_=='T').or.(trans_=='t'))
     m = a%get_nrows()
     
     if (.not. (a%is_triangle())) then 
-      write(0,*) 'Called SV on a non-triangular mat!'
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
     end if
 
 
@@ -578,6 +629,17 @@ contains
       end do
     end if
     
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
 
   contains 
 
@@ -690,6 +752,7 @@ contains
 
   subroutine d_csr_cssm(alpha,a,x,beta,y,info,trans) 
     use psb_const_mod
+    use psb_error_mod
     class(psbn_d_csr_sparse_mat), intent(in) :: a
     real(psb_dpk_), intent(in)          :: alpha, beta, x(:,:)
     real(psb_dpk_), intent(inout)       :: y(:,:)
@@ -701,6 +764,11 @@ contains
     real(psb_dpk_) :: acc
     real(psb_dpk_), allocatable :: tmp(:,:)
     logical   :: tra
+    Integer :: err_act
+    character(len=20)  :: name='d_base_csmm'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
 
     if (present(trans)) then
       trans_ = trans
@@ -708,19 +776,21 @@ contains
       trans_ = 'N'
     end if
     if (.not.a%is_asb()) then 
-      write(0,*) 'Error: cssm called on an unassembled mat'
+      info = 1121
-    end if
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+
         
     tra = ((trans_=='T').or.(trans_=='t'))
     m   = a%get_nrows()
-    nc  = size(x,2) 
+    nc  = min(size(x,2) , size(y,2)) 
-    if (nc /= size(y,2)) then 
-      write(0,*) 'Mismatch in column sizes!!'
-      return
-    end if
     
     if (.not. (a%is_triangle())) then 
       write(0,*) 'Called SM on a non-triangular mat!'
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
     end if
 
 
@@ -744,10 +814,12 @@ contains
       end do
     else 
       allocate(tmp(m,nc), stat=info) 
-      if (info /= 0) then 
+      if(info /= 0) then
-        write(0,*) 'Memory allocation error in CSRSM '
+        info=4010
-        return
+        call psb_errpush(info,name,a_err='allocate')
+        goto 9999
       end if
+
       tmp(1:m,:) = x(1:m,:)
       call inner_csrsm(tra,a,tmp,y,info)
       do  i = 1, m
@@ -755,6 +827,25 @@ contains
       end do
     end if
 
+    if(info /= 0) then
+      info=4010
+      call psb_errpush(info,name,a_err='inner_csrsm')
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+    
 
   contains 
 
@@ -769,8 +860,8 @@ contains
       real(psb_dpk_), allocatable  :: acc(:)
       
       allocate(acc(size(x,2)), stat=info)
-      if (info /= 0) then 
+      if(info /= 0) then
-        write(0,*) 'Memory allocation error in CSRSM '
+        info=4010
         return
       end if
       

base/newserial/psbn_mat_mod.f03

@@ -22,47 +22,140 @@ module psbn_d_mat_mod
 contains 
 
   subroutine d_csmm(alpha,a,x,beta,y,info,trans) 
+    use psb_error_mod
     class(psbn_d_sparse_mat), intent(in) :: a
     real(kind(1.d0)), intent(in)    :: alpha, beta, x(:,:)
     real(kind(1.d0)), intent(inout) :: y(:,:)
     integer, intent(out)            :: info
     character, optional, intent(in) :: trans
+    Integer :: err_act
+    character(len=20)  :: name='psbn_csmm'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    if (.not.allocated(a%a)) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
 
     call a%a%psbn_csmm(alpha,x,beta,y,info,trans) 
 
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
   end subroutine d_csmm
 
   subroutine d_csmv(alpha,a,x,beta,y,info,trans) 
+    use psb_error_mod
     class(psbn_d_sparse_mat), intent(in) :: a
     real(kind(1.d0)), intent(in)    :: alpha, beta, x(:)
     real(kind(1.d0)), intent(inout) :: y(:)
     integer, intent(out)            :: info
     character, optional, intent(in) :: trans
+    Integer :: err_act
+    character(len=20)  :: name='psbn_csmv'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    if (.not.allocated(a%a)) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
 
     call a%a%psbn_csmm(alpha,x,beta,y,info,trans) 
 
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
   end subroutine d_csmv
 
   subroutine d_cssm(alpha,a,x,beta,y,info,trans) 
+    use psb_error_mod
     class(psbn_d_sparse_mat), intent(in) :: a
     real(kind(1.d0)), intent(in)    :: alpha, beta, x(:,:)
     real(kind(1.d0)), intent(inout) :: y(:,:)
     integer, intent(out)            :: info
     character, optional, intent(in) :: trans
+    Integer :: err_act
+    character(len=20)  :: name='psbn_cssm'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    if (.not.allocated(a%a)) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
     
     call a%a%psbn_cssm(alpha,x,beta,y,info,trans) 
 
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
   end subroutine d_cssm
 
   subroutine d_cssv(alpha,a,x,beta,y,info,trans) 
+    use psb_error_mod
     class(psbn_d_sparse_mat), intent(in) :: a
     real(kind(1.d0)), intent(in)    :: alpha, beta, x(:)
     real(kind(1.d0)), intent(inout) :: y(:)
     integer, intent(out)            :: info
     character, optional, intent(in) :: trans
+    Integer :: err_act
+    character(len=20)  :: name='psbn_cssv'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    if (.not.allocated(a%a)) then 
+      info = 1121
+      call psb_errpush(info,name)
+      goto 9999
+    endif
 
     call a%a%psbn_cssm(alpha,x,beta,y,info,trans) 
 
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
   end subroutine d_cssv
 
 end module psbn_d_mat_mod