psblas3:

Makefile
 psbn_base_mat_mod.f03
 psbn_d_base_mat_mod.f03
 psbn_mat_mod.f03

Implementd many basic methods. 
Reviewed visibility, make names of subroutines/functions always
private (thus only accessible via the object).

base/newserial/Makefile

@@ -1,6 +1,6 @@
 include ../../Make.inc
 
-MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o 
+MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o  psbn_mat_mod.o
 #	psbn_csr_mat.o 
 
 

base/newserial/psbn_base_mat_mod.f03

@@ -71,6 +71,13 @@ module psbn_base_mat_mod
     generic,   public  :: reallocate => reallocate_nz
     
   end type psbn_base_sparse_mat
+  private :: set_nrows, set_ncols, set_dupl, set_state, &
+       & set_null, set_bld, set_upd, set_asb, set_sorted, set_upper, &
+       & set_lower, set_triangle, set_unit, get_nrows, get_ncols, &
+       & get_nzeros, get_size, get_state, get_dupl, is_null, is_bld, &
+       & is_upd, is_asb, is_sorted, is_upper, is_lower, is_triangle, &
+       & is_unit, get_neigh, allocate_mn, allocate_mnnz, reallocate_nz, &
+       & free
   
 contains
  

base/newserial/psbn_d_base_mat_mod.f03

@@ -16,6 +16,9 @@ module psbn_d_base_mat_mod
     procedure, pass(a) :: from_coo
 
   end type psbn_d_base_sparse_mat
+  private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,&
+       & csins, to_coo, from_coo
+
 
   type, extends(psbn_d_base_sparse_mat) :: psbn_d_coo_sparse_mat
 
@@ -33,11 +36,19 @@ module psbn_d_base_mat_mod
     procedure, pass(a)  :: d_base_cssv => d_coo_cssv
     procedure, pass(a)  :: csins => d_coo_csins
     procedure, pass(a)  :: reallocate_nz => d_coo_reallocate_nz
+    procedure, pass(a)  :: allocate_mnnz => d_coo_allocate_mnnz
+    procedure, pass(a)  :: allocate_mn => d_coo_allocate_mn
     procedure, pass(a)  :: to_coo => d_coo_to_coo
     procedure, pass(a)  :: from_coo => d_coo_from_coo
     procedure, pass(a)  :: fix => d_fix_coo
+    procedure, pass(a)  :: free => d_coo_free
 
   end type psbn_d_coo_sparse_mat
+  private :: d_coo_get_nzeros, d_coo_set_nzeros, &
+       & d_coo_csmm, d_coo_csmv, d_coo_cssm, d_coo_cssv, &
+       & d_coo_csins, d_coo_reallocate_nz, d_coo_allocate_mnnz, &
+       & d_coo_allocate_mn, d_coo_to_coo, d_coo_from_coo, &
+       & d_fix_coo, d_coo_free
 
 
   interface 
@@ -707,6 +718,124 @@ contains
   end subroutine d_coo_cssm
 
 
+  subroutine  d_coo_free(a) 
+
+    class(psbn_d_coo_sparse_mat), intent(inout) :: a
+
+    if (allocated(a%ia)) deallocate(a%ia)
+    if (allocated(a%ja)) deallocate(a%ja)
+    if (allocated(a%val)) deallocate(a%val)
+    call a%set_null()
+    call a%set_nrows(0)
+    call a%set_ncols(0)
+    
+    return
+
+  end subroutine d_coo_free
+
+  subroutine  d_coo_allocate_mnnz(m,n,nz,a) 
+    use psb_error_mod
+    use psb_realloc_mod
+    integer, intent(in) :: m,n,nz
+    class(psbn_d_coo_sparse_mat), intent(inout) :: a
+    Integer :: err_act, info
+    character(len=20)  :: name='allocate_mnz'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    info = 0
+    if (m < 0) then 
+      info = 10
+      call psb_errpush(info,name,i_err=(/1,0,0,0,0/))
+      goto 9999
+    endif
+    if (n < 0) then 
+      info = 10
+      call psb_errpush(info,name,i_err=(/2,0,0,0,0/))
+      goto 9999
+    endif
+    if (nz < 0) then 
+      info = 10
+      call psb_errpush(info,name,i_err=(/3,0,0,0,0/))
+      goto 9999
+    endif
+      
+    if (info == 0) call psb_realloc(nz,a%ia,info)
+    if (info == 0) call psb_realloc(nz,a%ja,info)
+    if (info == 0) call psb_realloc(nz,a%val,info)
+    if (info == 0) then 
+      call a%set_nrows(m)
+      call a%set_ncols(n)
+      call a%set_nzeros(0)
+      call a%set_bld()
+      call a%set_triangle(.false.)
+    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_coo_allocate_mnnz
+
+
+  subroutine  d_coo_allocate_mn(m,n,a) 
+    use psb_error_mod
+    use psb_realloc_mod
+    integer, intent(in) :: m,n
+    class(psbn_d_coo_sparse_mat), intent(inout) :: a
+    Integer :: err_act, info, nz
+    character(len=20)  :: name='allocate_mn'
+    logical, parameter :: debug=.false.
+
+    call psb_erractionsave(err_act)
+    info = 0
+    if (m < 0) then 
+      info = 10
+      call psb_errpush(info,name,i_err=(/1,0,0,0,0/))
+      goto 9999
+    endif
+    if (n < 0) then 
+      info = 10
+      call psb_errpush(info,name,i_err=(/2,0,0,0,0/))
+      goto 9999
+    endif
+
+    nz = max(7*m,7*n,1)
+      
+    if (info == 0) call psb_realloc(nz,a%ia,info)
+    if (info == 0) call psb_realloc(nz,a%ja,info)
+    if (info == 0) call psb_realloc(nz,a%val,info)
+    if (info == 0) then 
+      call a%set_nrows(m)
+      call a%set_ncols(n)
+      call a%set_nzeros(0)
+      call a%set_bld()
+      call a%set_triangle(.false.)
+    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_coo_allocate_mn
+
+
 end module psbn_d_base_mat_mod
 
 

base/newserial/psbn_mat_mod.f03

@@ -43,6 +43,12 @@ module psbn_d_mat_mod
     
   end type psbn_d_sparse_mat
 
+  private :: get_nrows, get_ncols, get_nzeros, get_size, &
+       & get_state, get_dupl, is_null, is_bld, is_upd, &
+       & is_asb, is_sorted, is_upper, is_lower, is_triangle, &
+       & is_unit, get_neigh, allocate_mn, allocate_mnnz, &
+       & reallocate_nz, free, d_csmv, d_csmm, d_cssv, d_cssm 
+
 contains 
 
   function get_dupl(a) result(res)
@@ -51,7 +57,7 @@ contains
     integer :: res
     
     if (allocated(a%a)) then 
-      res = a%a%get_dupl
+      res = a%a%get_dupl()
     else
       res = psbn_invalid_
     end if
@@ -304,48 +310,140 @@ contains
 
   end subroutine get_neigh
 
-  subroutine  allocate_mn(m,n,a) 
+  subroutine  allocate_mn(m,n,a,type,mold) 
     use psb_error_mod
+    use psb_string_mod
     integer, intent(in) :: m,n
     class(psbn_d_sparse_mat), intent(inout) :: a
+    character(len=*), intent(in), optional :: type
+    class(psbn_d_base_sparse_mat), intent(in), optional :: mold
 
-    Integer :: err_act
+    Integer :: err_act, info
     character(len=20)  :: name='allocate_mn'
+    character(len=8)   :: type_
     logical, parameter :: debug=.false.
 
 
     call psb_erractionsave(err_act)
-    ! This is the base version. If we get here
+    info = 0 
-    ! it means the derived class is incomplete,
+    if (allocated(a%a)) then 
-    ! so we throw an error.
+      call a%a%free()
-    call psb_errpush(700,name)
+      deallocate(a%a)
+    end if
+
+    if (present(mold)) then 
+      allocate(a%a, source=mold, stat=info)
+
+    else
+
+      if (present(type)) then 
+        type_ = psb_toupper(type)
+      else
+        type_ = 'COO'
+      end if
+
+      select case(type) 
+      case('COO')
+        allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
+! Add here a few other data structures inplemented by default.
+
+!!$      case('CSR') 
+!!$        allocate(psbn_d_csr_sparse_mat :: a%a, stat=info)
+
+      case default
+        allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
+      end select
+
+    end if
+
+    if (info /= 0) then 
+      info = 4010
+      goto 9999
+    end if
+    
+    call a%a%allocate(m,n)
           
-    if (err_act /= psb_act_ret_) then
+    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 allocate_mn
 
-  subroutine  allocate_mnnz(m,n,nz,a) 
+  subroutine  allocate_mnnz(m,n,nz,a,type,mold) 
     use psb_error_mod
+    use psb_string_mod
     integer, intent(in) :: m,n,nz
     class(psbn_d_sparse_mat), intent(inout) :: a
-    Integer :: err_act
+    character(len=*), intent(in), optional :: type
-    character(len=20)  :: name='allocate_mnz'
+    class(psbn_d_base_sparse_mat), intent(in), optional :: mold
+
+    Integer :: err_act, info
+    character(len=20)  :: name='allocate_mnnz'
+    character(len=8)   :: type_
     logical, parameter :: debug=.false.
 
+
     call psb_erractionsave(err_act)
-    ! This is the base version. If we get here
+    info = 0 
-    ! it means the derived class is incomplete,
+    if (allocated(a%a)) then 
-    ! so we throw an error.
+      call a%a%free()
-    call psb_errpush(700,name)
+      deallocate(a%a)
+    end if
+
+    if (present(mold)) then 
+      allocate(a%a, source=mold, stat=info)
+
+    else
+
+      if (present(type)) then 
+        type_ = psb_toupper(type)
+      else
+        type_ = 'COO'
+      end if
+
+      select case(type) 
+      case('COO')
+        allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
+! Add here a few other data structures inplemented by default.
+
+!!$      case('CSR') 
+!!$        allocate(psbn_d_csr_sparse_mat :: a%a, stat=info)
+
+      case default
+        allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
+      end select
+
+    end if
+
+    if (info /= 0) then 
+      info = 4010
+      goto 9999
+    end if
+    
+    call a%a%allocate(m,n,nz)
           
-    if (err_act /= psb_act_ret_) then
+    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 allocate_mnnz
 
   subroutine  reallocate_nz(nz,a) 
@@ -356,14 +454,25 @@ contains
     character(len=20)  :: name='reallocate_nz'
     logical, parameter :: debug=.false.
 
-    call psb_erractionsave(err_act)
+    if (.not.allocated(a%a)) then 
-    ! This is the base version. If we get here
+      info = 1121
-    ! it means the derived class is incomplete,
+      call psb_errpush(info,name)
-    ! so we throw an error.
+      goto 9999
-    call psb_errpush(700,name)
+    endif
-          
+
-    if (err_act /= psb_act_ret_) then
+    call a%a%reallocate(nz)
+
+    if (info /= 0) goto 9999
+
+    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
 
@@ -385,6 +494,16 @@ contains
 
     call a%a%free()
 
+    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 free