psblas3:

base/modules/psb_c_linmap_mod.f90
 base/modules/psb_d_linmap_mod.f90
 base/modules/psb_s_linmap_mod.f90
 base/modules/psb_z_linmap_mod.f90


Fix interface of clone.

base/modules/psb_c_linmap_mod.f90

@@ -216,18 +216,37 @@ contains
 
   subroutine  c_clone(map,mapout,info)
     use psb_desc_mod
+    use psb_error_mod
     implicit none 
     class(psb_clinmap_type), intent(inout) :: map
-    class(psb_clinmap_type), intent(inout) :: mapout
+    class(psb_base_linmap_type), intent(inout) :: mapout
     integer(psb_ipk_)     :: info 
     
-    call mapout%free(info)
+    integer(psb_ipk_) :: err_act
-    ! Base clone!    
+    integer(psb_ipk_) :: ierr(5)
-    if (info == 0) call &
+    character(len=20)  :: name='clone'
-         & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info)
+
-    if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info)
+    info = 0
-    if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info)
+    select type(mout => mapout)
-
+    class is (psb_clinmap_type)
+      call mout%free(info)
+      ! Base clone!    
+      if (info == 0) call &
+           & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info)
+      if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info)
+      if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
+    class default
+      info = psb_err_invalid_dynamic_type_
+      ierr(1) = 2
+      info = psb_err_missing_override_method_
+      call psb_errpush(info,name,i_err=ierr)
+      call psb_get_erraction(err_act)
+      if (err_act /= psb_act_ret_) then
+        call psb_error()
+      end if
+    end select
+
+      
   end subroutine c_clone
   
 

base/modules/psb_d_linmap_mod.f90

@@ -216,18 +216,37 @@ contains
 
   subroutine  d_clone(map,mapout,info)
     use psb_desc_mod
+    use psb_error_mod
     implicit none 
     class(psb_dlinmap_type), intent(inout) :: map
-    class(psb_dlinmap_type), intent(inout) :: mapout
+    class(psb_base_linmap_type), intent(inout) :: mapout
     integer(psb_ipk_)     :: info 
     
-    call mapout%free(info)
+    integer(psb_ipk_) :: err_act
-    ! Base clone!    
+    integer(psb_ipk_) :: ierr(5)
-    if (info == 0) call &
+    character(len=20)  :: name='clone'
-         & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info)
+
-    if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info)
+    info = 0
-    if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info)
+    select type(mout => mapout)
-
+    class is (psb_dlinmap_type)
+      call mout%free(info)
+      ! Base clone!    
+      if (info == 0) call &
+           & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info)
+      if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info)
+      if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
+    class default
+      info = psb_err_invalid_dynamic_type_
+      ierr(1) = 2
+      info = psb_err_missing_override_method_
+      call psb_errpush(info,name,i_err=ierr)
+      call psb_get_erraction(err_act)
+      if (err_act /= psb_act_ret_) then
+        call psb_error()
+      end if
+    end select
+
+      
   end subroutine d_clone
   
 

base/modules/psb_s_linmap_mod.f90

@@ -216,18 +216,37 @@ contains
 
   subroutine  s_clone(map,mapout,info)
     use psb_desc_mod
+    use psb_error_mod
     implicit none 
     class(psb_slinmap_type), intent(inout) :: map
-    class(psb_slinmap_type), intent(inout) :: mapout
+    class(psb_base_linmap_type), intent(inout) :: mapout
     integer(psb_ipk_)     :: info 
     
-    call mapout%free(info)
+    integer(psb_ipk_) :: err_act
-    ! Base clone!    
+    integer(psb_ipk_) :: ierr(5)
-    if (info == 0) call &
+    character(len=20)  :: name='clone'
-         & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info)
+
-    if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info)
+    info = 0
-    if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info)
+    select type(mout => mapout)
-
+    class is (psb_slinmap_type)
+      call mout%free(info)
+      ! Base clone!    
+      if (info == 0) call &
+           & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info)
+      if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info)
+      if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
+    class default
+      info = psb_err_invalid_dynamic_type_
+      ierr(1) = 2
+      info = psb_err_missing_override_method_
+      call psb_errpush(info,name,i_err=ierr)
+      call psb_get_erraction(err_act)
+      if (err_act /= psb_act_ret_) then
+        call psb_error()
+      end if
+    end select
+
+      
   end subroutine s_clone
   
 

base/modules/psb_z_linmap_mod.f90

@@ -216,18 +216,37 @@ contains
 
   subroutine  z_clone(map,mapout,info)
     use psb_desc_mod
+    use psb_error_mod
     implicit none 
     class(psb_zlinmap_type), intent(inout) :: map
-    class(psb_zlinmap_type), intent(inout) :: mapout
+    class(psb_base_linmap_type), intent(inout) :: mapout
     integer(psb_ipk_)     :: info 
     
-    call mapout%free(info)
+    integer(psb_ipk_) :: err_act
-    ! Base clone!    
+    integer(psb_ipk_) :: ierr(5)
-    if (info == 0) call &
+    character(len=20)  :: name='clone'
-         & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info)
+
-    if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info)
+    info = 0
-    if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info)
+    select type(mout => mapout)
-
+    class is (psb_zlinmap_type)
+      call mout%free(info)
+      ! Base clone!    
+      if (info == 0) call &
+           & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info)
+      if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info)
+      if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info)
+    class default
+      info = psb_err_invalid_dynamic_type_
+      ierr(1) = 2
+      info = psb_err_missing_override_method_
+      call psb_errpush(info,name,i_err=ierr)
+      call psb_get_erraction(err_act)
+      if (err_act /= psb_act_ret_) then
+        call psb_error()
+      end if
+    end select
+
+      
   end subroutine z_clone