psblas3:

added someitems about SPCNV.

base/newserial/Makefile

@@ -1,7 +1,7 @@
 include ../../Make.inc
 
 MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o  psbn_mat_mod.o\
-	psbn_d_csr_mat_mod.o  psbn_d_csr_impl.o
+	 psbn_mat_impl.o psbn_d_csr_mat_mod.o  psbn_d_csr_impl.o
 
 
 LIBMOD=
@@ -20,7 +20,7 @@ psbn_mat_mod.o:	psbn_base_mat_mod.o
 psbn_coo_mat.o psbn_csr_mat.o:	psbn_d_base_mat_mod.o
 
 psbn_d_csr_impl.o: psbn_d_csr_mat_mod.o
-psbn_d_mat_impl.o: psbn_d_base_mat_mod.o
+psbn_mat_impl.o: psbn_mat_mod.o
 
 clean:
 	/bin/rm -f $(MODULES) $(OBJS) $(MPFOBJS) *$(.mod)

base/newserial/README

@@ -28,78 +28,78 @@ Design principles for this directory.
    OUTER object which is what the rest of the library sees, as
    follows: 
      
-  type :: psbn_d_sparse_mat
+   type :: psbn_d_sparse_mat
 
-    class(psbn_d_base_sparse_mat), allocatable  :: a 
+     class(psbn_d_base_sparse_mat), allocatable  :: a 
     
-  end type psbn_d_sparse_mat
+   end type psbn_d_sparse_mat
-  type(psbn_d_sparse_mat) :: a
+   type(psbn_d_sparse_mat) :: a
 
-  In this way we can have an outer object whose type is stable
+   In this way we can have an outer object whose type is stable
-  both statically (at compile time) and at runtime, while at runtime
+   both statically (at compile time) and at runtime, while at runtime
-  the type of the inner object switches from COO to CSR to whatever as
+   the type of the inner object switches from COO to CSR to whatever as
-  needed. All of the methods are simply thrown onto the corresponding
+   needed. All of the methods are simply thrown onto the corresponding
-  methods of the (allocatable, polymorphic) component A%A as needed
+   methods of the (allocatable, polymorphic) component A%A as needed
-  (provided the component is allocated, that is).
+   (provided the component is allocated, that is).
-  This is what is called a STATE design pattern (different from the
+   This is what is called a STATE design pattern (different from the
-  internal state we discussed above).
+   internal state we discussed above).
 
-  As an example, consider the allocate/build/assembly cycle: 
+   As an example, consider the allocate/build/assembly cycle: 
-  the outer code would do the following: 
+   the outer code would do the following: 
-  1.  Allocate(psbn_d_coo_sparse_mat ::  a%a) 
+   1.  Allocate(psbn_d_coo_sparse_mat ::  a%a) 
 
-  2. During the build loop a call to A%CSINS() gets translated into
+   2. During the build loop a call to A%CSINS() gets translated into
-     CALL A%A%CSINS()
+      CALL A%A%CSINS()
     
-  3. At assembly time the code would do the following
+   3. At assembly time the code would do the following
-     subroutine psb_spasb(a,....)
+      subroutine psb_spasb(a,....)
-     type(psbn_d_sparse_mat), intent(inout)  :: a
+      type(psbn_d_sparse_mat), intent(inout)  :: a 
 
-     class(psbn_d_base_sparse_mat), allocatable :: temp
+      class(psbn_d_base_sparse_mat), allocatable :: temp
 
-     select case (TYPE)
+      select case (TYPE)
-     case('CSR')
+      case('CSR')
-        allocate(psbn_d_csr_sparse_mat :: temp, stat=info)
+         allocate(psbn_d_csr_sparse_mat :: temp, stat=info)
-     end select				 
+      end select				 
-     call temp%from_coo(a%a)
+      call temp%from_coo(a%a)
-     call a%a%free()
+      call a%a%free()
-     call move_alloc(temp,a%a)
+      call move_alloc(temp,a%a)
       
 
-  4. Note in the above that to_coo, from_coo are defined so that every
+   4. Note in the above that to_coo, from_coo are defined so that every
-     conceivable  storage representation provides just 2 conversion
+      conceivable  storage representation provides just 2 conversion
-     routines, avoiding quadratic explosion. But since all have to
+      routines, avoiding quadratic explosion. But since all have to
-     provide them, the to_coo/from_coo is defined in d_base_mat_mod
+      provide them, the to_coo/from_coo is defined in d_base_mat_mod
-     together with d_coo_sparse_mat, which enjoys the "eldest child"
+      together with d_coo_sparse_mat, which enjoys the "eldest child"
-     status with respect to all the other types derived from
+      status with respect to all the other types derived from
-     d_base_sparse_mat (its "siblings"). 
+      d_base_sparse_mat (its "siblings"). 
 
-  5. How does a user add a new storage format? Very simple. After
+   5. How does a user add a new storage format? Very simple. After
-     deriving the class and implementing all the necessary methods,
+      deriving the class and implementing all the necessary methods,
-     the user declares in the program a dummy variable of the new
+      the user declares in the program a dummy variable of the new
-     inner type 
+      inner type 
 
-     type(X_YYY_sparse_mat) :: reftype
+      type(X_YYY_sparse_mat) :: reftype
 
 
-     then calls 
+      then calls 
-       call psb_spasb(a,....,mold=reftype)
+        call psb_spasb(a,....,mold=reftype)
 
-     In psb_spasb we have
+      In psb_spasb we have
-     class(psbn_d_base_sparse_mat), intent(in), optional :: mold
+      class(psbn_d_base_sparse_mat), intent(in), optional :: mold
 
-     if (present(mold)) then 
+      if (present(mold)) then 
         allocate(temp,source=mold,stat=info)
-     end select				 
+      end select				 
-     call temp%from_coo(a%a)
+      call temp%from_coo(a%a)
-     call a%a%free()
+      call a%a%free()
-     call move_alloc(temp,a%a)
+      call move_alloc(temp,a%a)
   
-     AND IT'S DONE! Nothing else in the library requires the explicit
+      AND IT'S DONE! Nothing else in the library requires the explicit
-     knowledge of type of  MOLD. 
+      knowledge of type of  MOLD. 
 
-     User exercise: start by adding CSR in this way. 
+      User exercise: start by adding CSR in this way. 
-     (waiting for a couple of bug fixes from NAG to actually test this.)
+      (waiting for a couple of bug fixes from NAG to actually test this.)
 
     
   

base/newserial/psbn_d_base_mat_mod.f03

@@ -1,4 +1,3 @@
-
 module psbn_d_base_mat_mod
 
   use psbn_base_mat_mod
@@ -14,10 +13,11 @@ module psbn_d_base_mat_mod
     procedure, pass(a) :: csins
     procedure, pass(a) :: to_coo
     procedure, pass(a) :: from_coo
-
+    procedure, pass(a) :: to_fmt
+    procedure, pass(a) :: from_fmt
   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
+       & csins, to_coo, from_coo, to_fmt, from_fmt
   
   
   type, extends(psbn_d_base_sparse_mat) :: psbn_d_coo_sparse_mat
@@ -38,10 +38,12 @@ module psbn_d_base_mat_mod
     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)  :: 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)  :: to_fmt   => d_coo_to_fmt
-    procedure, pass(a)  :: free => d_coo_free
+    procedure, pass(a)  :: from_fmt => d_coo_from_fmt
+    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, &
@@ -81,6 +83,26 @@ module psbn_d_base_mat_mod
     end subroutine d_coo_from_coo_impl
   end interface
 
+  interface 
+    subroutine d_coo_to_fmt_impl(a,b,info) 
+      use psb_const_mod
+      import psbn_d_coo_sparse_mat, psbn_d_base_sparse_mat
+      class(psbn_d_coo_sparse_mat), intent(in)   :: a
+      class(psbn_d_base_sparse_mat), intent(out) :: b
+      integer, intent(out)                       :: info
+    end subroutine d_coo_to_fmt_impl
+  end interface
+  
+  interface 
+    subroutine d_coo_from_fmt_impl(a,b,info) 
+      use psb_const_mod
+      import psbn_d_coo_sparse_mat, psbn_d_base_sparse_mat
+      class(psbn_d_coo_sparse_mat), intent(inout) :: a
+      class(psbn_d_base_sparse_mat), intent(in)   :: b
+      integer, intent(out)                        :: info
+    end subroutine d_coo_from_fmt_impl
+  end interface
+  
   interface 
     subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) 
       use psb_const_mod
@@ -164,29 +186,48 @@ contains
     
   end subroutine to_coo
   
-
+  subroutine from_coo(a,b,info) 
-  subroutine d_fix_coo(a,info,idir) 
     use psb_error_mod
-    use psb_const_mod
+    use psb_realloc_mod
-    class(psbn_d_coo_sparse_mat), intent(inout) :: a
+    class(psbn_d_base_sparse_mat), intent(inout) :: a
-    integer, intent(out)                :: info
+    class(psbn_d_coo_sparse_mat), intent(in) :: b
-    integer, intent(in), optional :: idir
+    integer, intent(out)            :: info
+    
     Integer :: err_act
-    character(len=20)  :: name='fix_coo'
+    character(len=20)  :: name='from_coo'
     logical, parameter :: debug=.false.
     
     call psb_erractionsave(err_act)
-    info = 0
+    ! This is the base version. If we get here
-    call d_fix_coo_impl(a,info,idir)
+    ! it means the derived class is incomplete,
-
+    ! so we throw an error.
-    if (info /= 0) goto 9999
+    info = 700
+    call psb_errpush(info,name)
     
-    call psb_erractionrestore(err_act)
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
     return
     
-9999 continue
+  end subroutine from_coo
-    call psb_erractionrestore(err_act)
+  
+  
+  subroutine to_fmt(a,b,info) 
+    use psb_error_mod
+    use psb_realloc_mod
+    class(psbn_d_base_sparse_mat), intent(in) :: a
+    class(psbn_d_base_sparse_mat), intent(out) :: b
+    integer, intent(out)            :: info
     
+    Integer :: err_act
+    character(len=20)  :: name='to_fmt'
+    logical, parameter :: debug=.false.
+    
+    call psb_erractionsave(err_act)
+    ! This is the base version. If we get here
+    ! it means the derived class is incomplete,
+    ! so we throw an error.
+    info = 700
     call psb_errpush(info,name)
     
     if (err_act /= psb_act_ret_) then
@@ -194,18 +235,17 @@ contains
     end if
     return
     
+  end subroutine to_fmt
   
-  end subroutine d_fix_coo
+  subroutine from_fmt(a,b,info) 
-  
-  subroutine from_coo(a,b,info) 
     use psb_error_mod
     use psb_realloc_mod
     class(psbn_d_base_sparse_mat), intent(inout) :: a
-    class(psbn_d_coo_sparse_mat), intent(in) :: b
+    class(psbn_d_base_sparse_mat), intent(in) :: b
     integer, intent(out)            :: info
     
     Integer :: err_act
-    character(len=20)  :: name='from_coo'
+    character(len=20)  :: name='from_fmt'
     logical, parameter :: debug=.false.
     
     call psb_erractionsave(err_act)
@@ -220,10 +260,43 @@ contains
     end if
     return
     
-  end subroutine from_coo
+  end subroutine from_fmt
   
   
   
+  subroutine d_fix_coo(a,info,idir) 
+    use psb_error_mod
+    use psb_const_mod
+    class(psbn_d_coo_sparse_mat), intent(inout) :: a
+    integer, intent(out)                :: info
+    integer, intent(in), optional :: idir
+    Integer :: err_act
+    character(len=20)  :: name='fix_coo'
+    logical, parameter :: debug=.false.
+    
+    call psb_erractionsave(err_act)
+    info = 0
+    call d_fix_coo_impl(a,info,idir)
+    
+    if (info /= 0) goto 9999
+    
+    call psb_erractionrestore(err_act)
+    return
+    
+9999 continue
+    call psb_erractionrestore(err_act)
+    
+    call psb_errpush(info,name)
+    
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+    return
+    
+    
+  end subroutine d_fix_coo
+  
+  
   subroutine csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) 
     use psb_error_mod
     use psb_realloc_mod
@@ -420,6 +493,68 @@ contains
     
   end subroutine d_coo_from_coo
   
+  subroutine d_coo_to_fmt(a,b,info) 
+    use psb_error_mod
+    use psb_realloc_mod
+    class(psbn_d_coo_sparse_mat), intent(in) :: a
+    class(psbn_d_base_sparse_mat), intent(out) :: b
+    integer, intent(out)            :: info
+    
+    Integer :: err_act
+    character(len=20)  :: name='to_coo'
+    logical, parameter :: debug=.false.
+    
+    call psb_erractionsave(err_act)
+    info = 0
+    call d_coo_to_fmt_impl(a,b,info)
+    if (info /= 0) goto 9999
+    
+    call psb_erractionrestore(err_act)
+    return
+    
+9999 continue
+    call psb_erractionrestore(err_act)
+    
+    call psb_errpush(info,name)
+    
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+    return
+    
+  end subroutine d_coo_to_fmt
+  
+  subroutine d_coo_from_fmt(a,b,info) 
+    use psb_error_mod
+    use psb_realloc_mod
+    class(psbn_d_coo_sparse_mat), intent(inout) :: a
+    class(psbn_d_base_sparse_mat), intent(in) :: b
+    integer, intent(out)            :: info
+    
+    Integer :: err_act
+    character(len=20)  :: name='from_coo'
+    logical, parameter :: debug=.false.
+    
+    call psb_erractionsave(err_act)
+    info = 0
+    call d_coo_from_fmt_impl(a,b,info)
+    if (info /= 0) goto 9999
+    
+    call psb_erractionrestore(err_act)
+    return
+    
+9999 continue
+    call psb_erractionrestore(err_act)
+    
+    call psb_errpush(info,name)
+    
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+    return
+    
+  end subroutine d_coo_from_fmt
+  
   subroutine  d_coo_reallocate_nz(nz,a) 
     use psb_error_mod
     use psb_realloc_mod

base/newserial/psbn_d_coo_impl.f03

@@ -1615,6 +1615,78 @@ subroutine d_coo_from_coo_impl(a,b,info)
 end subroutine d_coo_from_coo_impl
 
 
+subroutine d_coo_to_fmt_impl(a,b,info) 
+  use psb_error_mod
+  use psb_realloc_mod
+  use psbn_d_base_mat_mod, psb_protect_name => d_coo_to_fmt_impl
+  class(psbn_d_coo_sparse_mat), intent(in) :: a
+  class(psbn_d_base_sparse_mat), intent(out) :: b
+  integer, intent(out)            :: info
+
+  Integer :: err_act
+  character(len=20)  :: name='to_coo'
+  logical, parameter :: debug=.false.
+
+
+  call psb_erractionsave(err_act)
+  info = 0
+
+  call b%from_coo(a,info)
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  call psb_errpush(info,name)
+
+  if (err_act /= psb_act_ret_) then
+    call psb_error()
+  end if
+  return
+
+end subroutine d_coo_to_fmt_impl
+  
+subroutine d_coo_from_fmt_impl(a,b,info) 
+  use psb_error_mod
+  use psb_realloc_mod
+  use psbn_d_base_mat_mod, psb_protect_name => d_coo_from_fmt_impl
+  class(psbn_d_coo_sparse_mat), intent(inout) :: a
+  class(psbn_d_base_sparse_mat), intent(in) :: b
+  integer, intent(out)            :: info
+
+  Integer :: err_act
+  character(len=20)  :: name='from_coo'
+  logical, parameter :: debug=.false.
+  integer :: m,n,nz
+
+
+  call psb_erractionsave(err_act)
+  info = 0
+
+  call b%to_coo(a,info)
+
+  if (info /= 0) goto 9999
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  call psb_errpush(info,name)
+
+  if (err_act /= psb_act_ret_) then
+    call psb_error()
+  end if
+  return
+
+end subroutine d_coo_from_fmt_impl
+
+
 subroutine d_fix_coo_impl(a,info,idir) 
   use psb_const_mod
   use psb_error_mod

base/newserial/psbn_mat_mod.f03

@@ -49,6 +49,30 @@ module psbn_d_mat_mod
        & is_unit, get_neigh, allocate_mn, allocate_mnnz, &
        & reallocate_nz, free, d_csmv, d_csmm, d_cssv, d_cssm 
 
+
+  interface psbn_spcnv
+    subroutine psbn_d_spcnv(a,b,info,type,mold,upd,dupl)
+      use psbn_d_base_mat_mod
+      import psbn_d_sparse_mat
+      type(psbn_d_sparse_mat), intent(in)    :: a
+      type(psbn_d_sparse_mat), intent(out)   :: b
+      integer, intent(out)                   :: info
+      integer,optional, intent(in)           :: dupl, upd
+      character(len=*), optional, intent(in) :: type
+      class(psbn_d_base_sparse_mat), intent(in), optional :: mold
+      
+    end subroutine psbn_d_spcnv
+    subroutine psbn_d_spcnv_ip(a,info,type,mold,dupl)
+      use psbn_d_base_mat_mod
+      import psbn_d_sparse_mat
+      type(psbn_d_sparse_mat), intent(inout)  :: a
+      integer, intent(out)                    :: info
+      integer,optional, intent(in)            :: dupl
+      character(len=*), optional, intent(in)  :: type
+      class(psbn_d_base_sparse_mat), intent(in), optional :: mold
+    end subroutine psbn_d_spcnv_ip
+  end interface
+
 contains 
 
   function get_dupl(a) result(res)