psblas3:

base/serial/f77/smmp.f
 base/serial/impl/psb_c_mat_impl.F90
 base/serial/impl/psb_d_mat_impl.F90
 base/serial/impl/psb_s_mat_impl.F90
 base/serial/impl/psb_z_mat_impl.F90
 base/serial/psb_cnumbmm.f90
 base/serial/psb_csymbmm.f90
 base/serial/psb_dnumbmm.f90
 base/serial/psb_dsymbmm.f90
 base/serial/psb_snumbmm.f90
 base/serial/psb_ssymbmm.f90
 base/serial/psb_znumbmm.f90
 base/serial/psb_zsymbmm.f90

Fixed usage of move_alloc with polymorphic arguments.

base/serial/impl/psb_c_mat_impl.F90

@@ -867,7 +867,7 @@ subroutine psb_c_csgetblk(imin,imax,a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csget'
   logical, parameter :: debug=.false.
-  type(psb_c_coo_sparse_mat), allocatable  :: acoo
+  class(psb_c_base_sparse_mat), allocatable  :: acoo
 
 
   info = psb_success_
@@ -878,12 +878,21 @@ subroutine psb_c_csgetblk(imin,imax,a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
+  allocate(psb_c_coo_sparse_mat :: acoo,stat=info)    
 
-  if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,&
-       & jmin,jmax,iren,append,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_c_coo_sparse_mat)
+      call a%a%csget(imin,imax,acoo,info,&
+           & jmin,jmax,iren,append,rscale,cscale)
+      class default
+        ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
 
   call psb_erractionrestore(err_act)
@@ -920,7 +929,7 @@ subroutine psb_c_csclip(a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csclip'
   logical, parameter :: debug=.false.
-  type(psb_c_coo_sparse_mat), allocatable  :: acoo
+  class(psb_c_base_sparse_mat), allocatable  :: acoo
 
   info = psb_success_
   call psb_erractionsave(err_act)
@@ -930,11 +939,22 @@ subroutine psb_c_csclip(a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
-  if (info == psb_success_) call a%a%csclip(acoo,info,&
-       & imin,imax,jmin,jmax,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  allocate(psb_c_coo_sparse_mat :: acoo,stat=info)    
+  
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_c_coo_sparse_mat)
+      call a%a%csclip(acoo,info,&
+           & imin,imax,jmin,jmax,rscale,cscale)
+    class default
+      ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+ 
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
   
   call psb_erractionrestore(err_act)

base/serial/impl/psb_d_mat_impl.F90

@@ -867,7 +867,7 @@ subroutine psb_d_csgetblk(imin,imax,a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csget'
   logical, parameter :: debug=.false.
-  type(psb_d_coo_sparse_mat), allocatable  :: acoo
+  class(psb_d_base_sparse_mat), allocatable  :: acoo
 
 
   info = psb_success_
@@ -878,12 +878,21 @@ subroutine psb_d_csgetblk(imin,imax,a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
+  allocate(psb_d_coo_sparse_mat :: acoo,stat=info)    
 
-  if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,&
-       & jmin,jmax,iren,append,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_d_coo_sparse_mat)
+      call a%a%csget(imin,imax,acoo,info,&
+           & jmin,jmax,iren,append,rscale,cscale)
+      class default
+        ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
 
   call psb_erractionrestore(err_act)
@@ -920,7 +929,7 @@ subroutine psb_d_csclip(a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csclip'
   logical, parameter :: debug=.false.
-  type(psb_d_coo_sparse_mat), allocatable  :: acoo
+  class(psb_d_base_sparse_mat), allocatable  :: acoo
 
   info = psb_success_
   call psb_erractionsave(err_act)
@@ -930,11 +939,22 @@ subroutine psb_d_csclip(a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
-  if (info == psb_success_) call a%a%csclip(acoo,info,&
-       & imin,imax,jmin,jmax,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  allocate(psb_d_coo_sparse_mat :: acoo,stat=info)    
+  
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_d_coo_sparse_mat)
+      call a%a%csclip(acoo,info,&
+           & imin,imax,jmin,jmax,rscale,cscale)
+    class default
+      ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+ 
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
   
   call psb_erractionrestore(err_act)

base/serial/impl/psb_s_mat_impl.F90

@@ -867,7 +867,7 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csget'
   logical, parameter :: debug=.false.
-  type(psb_s_coo_sparse_mat), allocatable  :: acoo
+  class(psb_s_base_sparse_mat), allocatable  :: acoo
 
 
   info = psb_success_
@@ -878,12 +878,21 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
+  allocate(psb_s_coo_sparse_mat :: acoo,stat=info)    
 
-  if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,&
-       & jmin,jmax,iren,append,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_s_coo_sparse_mat)
+      call a%a%csget(imin,imax,acoo,info,&
+           & jmin,jmax,iren,append,rscale,cscale)
+      class default
+        ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
 
   call psb_erractionrestore(err_act)
@@ -920,7 +929,7 @@ subroutine psb_s_csclip(a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csclip'
   logical, parameter :: debug=.false.
-  type(psb_s_coo_sparse_mat), allocatable  :: acoo
+  class(psb_s_base_sparse_mat), allocatable  :: acoo
 
   info = psb_success_
   call psb_erractionsave(err_act)
@@ -930,11 +939,22 @@ subroutine psb_s_csclip(a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
-  if (info == psb_success_) call a%a%csclip(acoo,info,&
-       & imin,imax,jmin,jmax,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  allocate(psb_s_coo_sparse_mat :: acoo,stat=info)    
+  
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_s_coo_sparse_mat)
+      call a%a%csclip(acoo,info,&
+           & imin,imax,jmin,jmax,rscale,cscale)
+    class default
+      ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+ 
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
   
   call psb_erractionrestore(err_act)

base/serial/impl/psb_z_mat_impl.F90

@@ -867,7 +867,7 @@ subroutine psb_z_csgetblk(imin,imax,a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csget'
   logical, parameter :: debug=.false.
-  type(psb_z_coo_sparse_mat), allocatable  :: acoo
+  class(psb_z_base_sparse_mat), allocatable  :: acoo
 
 
   info = psb_success_
@@ -878,12 +878,21 @@ subroutine psb_z_csgetblk(imin,imax,a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
+  allocate(psb_z_coo_sparse_mat :: acoo,stat=info)    
 
-  if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,&
-       & jmin,jmax,iren,append,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_z_coo_sparse_mat)
+      call a%a%csget(imin,imax,acoo,info,&
+           & jmin,jmax,iren,append,rscale,cscale)
+      class default
+        ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
 
   call psb_erractionrestore(err_act)
@@ -920,7 +929,7 @@ subroutine psb_z_csclip(a,b,info,&
   Integer :: err_act
   character(len=20)  :: name='csclip'
   logical, parameter :: debug=.false.
-  type(psb_z_coo_sparse_mat), allocatable  :: acoo
+  class(psb_z_base_sparse_mat), allocatable  :: acoo
 
   info = psb_success_
   call psb_erractionsave(err_act)
@@ -930,11 +939,22 @@ subroutine psb_z_csclip(a,b,info,&
     goto 9999
   endif
 
-  allocate(acoo,stat=info)    
-  if (info == psb_success_) call a%a%csclip(acoo,info,&
-       & imin,imax,jmin,jmax,rscale,cscale)
-!!$  if (info == psb_success_) call move_alloc(acoo,b%a)
-  if (info == psb_success_) call b%mv_from(acoo)
+  allocate(psb_z_coo_sparse_mat :: acoo,stat=info)    
+  
+  if (info == psb_success_) then 
+    select type (acoo)
+    type is (psb_z_coo_sparse_mat)
+      call a%a%csclip(acoo,info,&
+           & imin,imax,jmin,jmax,rscale,cscale)
+    class default
+      ! This is impossible
+      info = psb_err_internal_error_
+    end select
+  else
+    info = psb_err_alloc_dealloc_
+  end if
+ 
+  if (info == psb_success_) call move_alloc(acoo,b%a)
   if (info /= psb_success_) goto 9999 
   
   call psb_erractionrestore(err_act)