From d4d408f9502465e564a0486c2c186ce253a09ca2 Mon Sep 17 00:00:00 2001
From: Salvatore Filippone <salvatore.filippone@cranfield.ac.uk>
Date: Wed, 5 Jan 2011 15:36:49 +0000
Subject: [PATCH] psblas3:  base/serial/impl/psb_c_csc_impl.f90 
 base/serial/impl/psb_c_csr_impl.f90  base/serial/impl/psb_d_csc_impl.f90 
 base/serial/impl/psb_d_csr_impl.f90  base/serial/impl/psb_s_csc_impl.f90 
 base/serial/impl/psb_s_csr_impl.f90  base/serial/impl/psb_z_csc_impl.f90 
 base/serial/impl/psb_z_csr_impl.f90  base/tools/psb_linmap.f90

Workaround allocate-on-assignment problems.
---
 base/serial/impl/psb_c_csc_impl.f90 | 19 ++++++++++---------
 base/serial/impl/psb_c_csr_impl.f90 | 21 ++++++++++++---------
 base/serial/impl/psb_d_csc_impl.f90 | 19 ++++++++++---------
 base/serial/impl/psb_d_csr_impl.f90 |  7 ++++---
 base/serial/impl/psb_s_csc_impl.f90 | 19 ++++++++++---------
 base/serial/impl/psb_s_csr_impl.f90 | 15 +++++++++------
 base/serial/impl/psb_z_csc_impl.f90 | 19 ++++++++++---------
 base/serial/impl/psb_z_csr_impl.f90 | 21 ++++++++++++---------
 base/tools/psb_linmap.f90           | 16 ++++++++--------
 9 files changed, 85 insertions(+), 71 deletions(-)

diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90
index 326d6318..257aaadc 100644
--- a/base/serial/impl/psb_c_csc_impl.f90
+++ b/base/serial/impl/psb_c_csc_impl.f90
@@ -2519,9 +2519,9 @@ subroutine psb_c_cp_csc_to_fmt(a,b,info)
 
   type is (psb_c_csc_sparse_mat) 
     call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)
-    b%icp = a%icp
-    b%ia  = a%ia
-    b%val = a%val
+    call psb_safe_cpy( a%icp, b%icp , info)
+    call psb_safe_cpy( a%ia , b%ia  , info)
+    call psb_safe_cpy( a%val, b%val , info)
 
   class default
     call a%cp_to_coo(tmp,info)
@@ -2599,9 +2599,9 @@ subroutine psb_c_cp_csc_from_fmt(a,b,info)
 
   type is (psb_c_csc_sparse_mat) 
     call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
-    a%icp = b%icp
-    a%ia  = b%ia
-    a%val = b%val
+    call psb_safe_cpy( b%icp, a%icp , info)
+    call psb_safe_cpy( b%ia , a%ia  , info)
+    call psb_safe_cpy( b%val, a%val , info)
 
   class default
     call b%cp_to_coo(tmp,info)
@@ -2961,6 +2961,7 @@ end subroutine psb_c_csc_print
 
 subroutine psb_c_csc_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_cp_from
   implicit none 
 
@@ -2978,9 +2979,9 @@ subroutine psb_c_csc_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
-  a%icp = b%icp 
-  a%ia  = b%ia
-  a%val = b%val 
+  call psb_safe_cpy( b%icp, a%icp , info)
+  call psb_safe_cpy( b%ia , a%ia  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90
index 53b6381f..3e83f3fa 100644
--- a/base/serial/impl/psb_c_csr_impl.f90
+++ b/base/serial/impl/psb_c_csr_impl.f90
@@ -2657,6 +2657,7 @@ end subroutine psb_c_mv_csr_to_fmt
 subroutine psb_c_cp_csr_to_fmt(a,b,info) 
   use psb_const_mod
   use psb_c_base_mat_mod
+  use psb_realloc_mod
   use psb_c_csr_mat_mod, psb_protect_name => psb_c_cp_csr_to_fmt
   implicit none 
 
@@ -2681,9 +2682,9 @@ subroutine psb_c_cp_csr_to_fmt(a,b,info)
 
   type is (psb_c_csr_sparse_mat) 
     call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)
-    b%irp = a%irp
-    b%ja  = a%ja
-    b%val = a%val
+    call psb_safe_cpy( a%irp, b%irp , info)
+    call psb_safe_cpy( a%ja , b%ja  , info)
+    call psb_safe_cpy( a%val, b%val , info)
 
   class default
     call a%cp_to_coo(tmp,info)
@@ -2736,6 +2737,7 @@ end subroutine psb_c_mv_csr_from_fmt
 subroutine psb_c_cp_csr_from_fmt(a,b,info) 
   use psb_const_mod
   use psb_c_base_mat_mod
+  use psb_realloc_mod
   use psb_c_csr_mat_mod, psb_protect_name => psb_c_cp_csr_from_fmt
   implicit none 
 
@@ -2759,9 +2761,9 @@ subroutine psb_c_cp_csr_from_fmt(a,b,info)
 
   type is (psb_c_csr_sparse_mat) 
     call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
-    a%irp = b%irp
-    a%ja  = b%ja
-    a%val = b%val
+    call psb_safe_cpy( b%irp, a%irp , info)
+    call psb_safe_cpy( b%ja , a%ja  , info)
+    call psb_safe_cpy( b%val, a%val , info)
 
   class default
     call b%cp_to_coo(tmp,info)
@@ -2772,6 +2774,7 @@ end subroutine psb_c_cp_csr_from_fmt
 
 subroutine psb_c_csr_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_cp_from
   implicit none 
 
@@ -2789,9 +2792,9 @@ subroutine psb_c_csr_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat)
-  a%irp = b%irp 
-  a%ja  = b%ja
-  a%val = b%val 
+  call psb_safe_cpy( b%irp, a%irp , info)
+  call psb_safe_cpy( b%ja , a%ja  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90
index 9456db1b..5160da37 100644
--- a/base/serial/impl/psb_d_csc_impl.f90
+++ b/base/serial/impl/psb_d_csc_impl.f90
@@ -2391,9 +2391,9 @@ subroutine psb_d_cp_csc_to_fmt(a,b,info)
 
   type is (psb_d_csc_sparse_mat) 
     call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat)
-    b%icp = a%icp
-    b%ia  = a%ia
-    b%val = a%val
+    call psb_safe_cpy( a%icp, b%icp , info)
+    call psb_safe_cpy( a%ia , b%ia  , info)
+    call psb_safe_cpy( a%val, b%val , info)
 
   class default
     call a%cp_to_coo(tmp,info)
@@ -2471,9 +2471,9 @@ subroutine psb_d_cp_csc_from_fmt(a,b,info)
 
   type is (psb_d_csc_sparse_mat) 
     call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat)
-    a%icp = b%icp
-    a%ia  = b%ia
-    a%val = b%val
+    call psb_safe_cpy( b%icp, a%icp , info)
+    call psb_safe_cpy( b%ia , a%ia  , info)
+    call psb_safe_cpy( b%val, a%val , info)
 
   class default
     call b%cp_to_coo(tmp,info)
@@ -2834,6 +2834,7 @@ end subroutine psb_d_csc_print
 
 subroutine psb_d_csc_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_cp_from
   implicit none 
 
@@ -2851,9 +2852,9 @@ subroutine psb_d_csc_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat)
-  a%icp = b%icp 
-  a%ia  = b%ia
-  a%val = b%val 
+  call psb_safe_cpy( b%icp, a%icp , info)
+  call psb_safe_cpy( b%ia , a%ia  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90
index b779f5b0..c5460342 100644
--- a/base/serial/impl/psb_d_csr_impl.f90
+++ b/base/serial/impl/psb_d_csr_impl.f90
@@ -2822,6 +2822,7 @@ end subroutine psb_d_cp_csr_from_fmt
 
 subroutine psb_d_csr_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_cp_from
   implicit none 
 
@@ -2839,9 +2840,9 @@ subroutine psb_d_csr_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat)
-  a%irp = b%irp 
-  a%ja  = b%ja
-  a%val = b%val 
+  call psb_safe_cpy( b%irp, a%irp , info)
+  call psb_safe_cpy( b%ja , a%ja  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90
index 964a17d5..7f8aa640 100644
--- a/base/serial/impl/psb_s_csc_impl.f90
+++ b/base/serial/impl/psb_s_csc_impl.f90
@@ -2156,9 +2156,9 @@ subroutine psb_s_cp_csc_to_fmt(a,b,info)
 
   type is (psb_s_csc_sparse_mat) 
     call b%psb_s_base_sparse_mat%cp_from(a%psb_s_base_sparse_mat)
-    b%icp = a%icp
-    b%ia  = a%ia
-    b%val = a%val
+    call psb_safe_cpy( a%icp, b%icp , info)
+    call psb_safe_cpy( a%ia , b%ia  , info)
+    call psb_safe_cpy( a%val, b%val , info)
 
   class default
     call a%cp_to_coo(tmp,info)
@@ -2236,9 +2236,9 @@ subroutine psb_s_cp_csc_from_fmt(a,b,info)
 
   type is (psb_s_csc_sparse_mat) 
     call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat)
-    a%icp = b%icp
-    a%ia  = b%ia
-    a%val = b%val
+    call psb_safe_cpy( b%icp, a%icp , info)
+    call psb_safe_cpy( b%ia , a%ia  , info)
+    call psb_safe_cpy( b%val, a%val , info)
 
   class default
     call b%cp_to_coo(tmp,info)
@@ -2598,6 +2598,7 @@ end subroutine psb_s_csc_print
 
 subroutine psb_s_csc_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_cp_from
   implicit none 
 
@@ -2615,9 +2616,9 @@ subroutine psb_s_csc_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat)
-  a%icp = b%icp 
-  a%ia  = b%ia
-  a%val = b%val 
+  call psb_safe_cpy( b%icp, a%icp , info)
+  call psb_safe_cpy( b%ia , a%ia  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90
index f2e743ea..422c9d03 100644
--- a/base/serial/impl/psb_s_csr_impl.f90
+++ b/base/serial/impl/psb_s_csr_impl.f90
@@ -2464,6 +2464,7 @@ end subroutine psb_s_mv_csr_to_fmt
 subroutine psb_s_cp_csr_to_fmt(a,b,info) 
   use psb_const_mod
   use psb_s_base_mat_mod
+  use psb_realloc_mod
   use psb_s_csr_mat_mod, psb_protect_name => psb_s_cp_csr_to_fmt
   implicit none 
 
@@ -2488,9 +2489,9 @@ subroutine psb_s_cp_csr_to_fmt(a,b,info)
 
   type is (psb_s_csr_sparse_mat) 
     call b%psb_s_base_sparse_mat%cp_from(a%psb_s_base_sparse_mat)
-    b%irp = a%irp
-    b%ja  = a%ja
-    b%val = a%val
+    call psb_safe_cpy( a%irp, b%irp , info)
+    call psb_safe_cpy( a%ja , b%ja  , info)
+    call psb_safe_cpy( a%val, b%val , info)
 
   class default
     call a%cp_to_coo(tmp,info)
@@ -2580,6 +2581,7 @@ end subroutine psb_s_cp_csr_from_fmt
 
 subroutine psb_s_csr_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_cp_from
   implicit none 
 
@@ -2597,9 +2599,10 @@ subroutine psb_s_csr_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat)
-  a%irp = b%irp 
-  a%ja  = b%ja
-  a%val = b%val 
+  call psb_safe_cpy( b%irp, a%irp , info)
+  call psb_safe_cpy( b%ja , a%ja  , info)
+  call psb_safe_cpy( b%val, a%val , info)
+
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90
index 4c84098c..d0c7ad66 100644
--- a/base/serial/impl/psb_z_csc_impl.f90
+++ b/base/serial/impl/psb_z_csc_impl.f90
@@ -2523,9 +2523,9 @@ subroutine psb_z_cp_csc_to_fmt(a,b,info)
     b%ia  = a%ia
     b%val = a%val
 
-  class default
-    call a%cp_to_coo(tmp,info)
-    if (info == psb_success_) call b%mv_from_coo(tmp,info)
+    call psb_safe_cpy( a%icp, b%icp , info)
+    call psb_safe_cpy( a%ia , b%ia  , info)
+    call psb_safe_cpy( a%val, b%val , info)
   end select
 
 end subroutine psb_z_cp_csc_to_fmt
@@ -2599,9 +2599,9 @@ subroutine psb_z_cp_csc_from_fmt(a,b,info)
 
   type is (psb_z_csc_sparse_mat) 
     call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat)
-    a%icp = b%icp
-    a%ia  = b%ia
-    a%val = b%val
+    call psb_safe_cpy( b%icp, a%icp , info)
+    call psb_safe_cpy( b%ia , a%ia  , info)
+    call psb_safe_cpy( b%val, a%val , info)
 
   class default
     call b%cp_to_coo(tmp,info)
@@ -2961,6 +2961,7 @@ end subroutine psb_z_csc_print
 
 subroutine psb_z_csc_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_cp_from
   implicit none 
 
@@ -2978,9 +2979,9 @@ subroutine psb_z_csc_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat)
-  a%icp = b%icp 
-  a%ia  = b%ia
-  a%val = b%val 
+  call psb_safe_cpy( b%icp, a%icp , info)
+  call psb_safe_cpy( b%ia , a%ia  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90
index bb8f66f2..39b32d81 100644
--- a/base/serial/impl/psb_z_csr_impl.f90
+++ b/base/serial/impl/psb_z_csr_impl.f90
@@ -2656,6 +2656,7 @@ end subroutine psb_z_mv_csr_to_fmt
 subroutine psb_z_cp_csr_to_fmt(a,b,info) 
   use psb_const_mod
   use psb_z_base_mat_mod
+  use psb_realloc_mod
   use psb_z_csr_mat_mod, psb_protect_name => psb_z_cp_csr_to_fmt
   implicit none 
 
@@ -2680,9 +2681,9 @@ subroutine psb_z_cp_csr_to_fmt(a,b,info)
 
   type is (psb_z_csr_sparse_mat) 
     call b%psb_z_base_sparse_mat%cp_from(a%psb_z_base_sparse_mat)
-    b%irp = a%irp
-    b%ja  = a%ja
-    b%val = a%val
+    call psb_safe_cpy( a%irp, b%irp , info)
+    call psb_safe_cpy( a%ja , b%ja  , info)
+    call psb_safe_cpy( a%val, b%val , info)
 
   class default
     call a%cp_to_coo(tmp,info)
@@ -2735,6 +2736,7 @@ end subroutine psb_z_mv_csr_from_fmt
 subroutine psb_z_cp_csr_from_fmt(a,b,info) 
   use psb_const_mod
   use psb_z_base_mat_mod
+  use psb_realloc_mod
   use psb_z_csr_mat_mod, psb_protect_name => psb_z_cp_csr_from_fmt
   implicit none 
 
@@ -2758,9 +2760,9 @@ subroutine psb_z_cp_csr_from_fmt(a,b,info)
 
   type is (psb_z_csr_sparse_mat) 
     call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat)
-    a%irp = b%irp
-    a%ja  = b%ja
-    a%val = b%val
+    call psb_safe_cpy( b%irp, a%irp , info)
+    call psb_safe_cpy( b%ja , a%ja  , info)
+    call psb_safe_cpy( b%val, a%val , info)
 
   class default
     call b%cp_to_coo(tmp,info)
@@ -2771,6 +2773,7 @@ end subroutine psb_z_cp_csr_from_fmt
 
 subroutine psb_z_csr_cp_from(a,b)
   use psb_error_mod
+  use psb_realloc_mod
   use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_cp_from
   implicit none 
 
@@ -2788,9 +2791,9 @@ subroutine psb_z_csr_cp_from(a,b)
 
   call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
   call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat)
-  a%irp = b%irp 
-  a%ja  = b%ja
-  a%val = b%val 
+  call psb_safe_cpy( b%irp, a%irp , info)
+  call psb_safe_cpy( b%ja , a%ja  , info)
+  call psb_safe_cpy( b%val, a%val , info)
 
   if (info /= psb_success_) goto 9999
   call psb_erractionrestore(err_act)
diff --git a/base/tools/psb_linmap.f90 b/base/tools/psb_linmap.f90
index 153ad947..34fef5c0 100644
--- a/base/tools/psb_linmap.f90
+++ b/base/tools/psb_linmap.f90
@@ -65,8 +65,8 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
         allocate(this%iaggr(size(iaggr)),&
              & this%naggr(size(naggr)), stat=info) 
         if (info == psb_success_) then 
-          this%iaggr = iaggr
-          this%naggr = naggr
+          this%iaggr(:) = iaggr(:)
+          this%naggr(:) = naggr(:)
         end if
       end if
     else
@@ -143,8 +143,8 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
         allocate(this%iaggr(size(iaggr)),&
              & this%naggr(size(naggr)), stat=info) 
         if (info == psb_success_) then 
-          this%iaggr = iaggr
-          this%naggr = naggr
+          this%iaggr(:) = iaggr(:)
+          this%naggr(:) = naggr(:)
         end if
       end if
     else
@@ -225,8 +225,8 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
         allocate(this%iaggr(size(iaggr)),&
              & this%naggr(size(naggr)), stat=info) 
         if (info == psb_success_) then 
-          this%iaggr = iaggr
-          this%naggr = naggr
+          this%iaggr(:) = iaggr(:)
+          this%naggr(:) = naggr(:)
         end if
       end if
     else
@@ -303,8 +303,8 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
         allocate(this%iaggr(size(iaggr)),&
              & this%naggr(size(naggr)), stat=info) 
         if (info == psb_success_) then 
-          this%iaggr = iaggr
-          this%naggr = naggr
+          this%iaggr(:) = iaggr(:)
+          this%naggr(:) = naggr(:)
         end if
       end if
     else