From dbea2f11a585c1652cbe3a0b586f0aacec7cef03 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 7 Jun 2010 20:44:29 +0000 Subject: [PATCH] psblas3: base/serial/f03/psb_c_coo_impl.f03 base/serial/f03/psb_d_coo_impl.f03 base/serial/f03/psb_s_coo_impl.f03 base/serial/f03/psb_z_coo_impl.f03 Fixed stupid out.-of-bounfd bug in coo_to|from_coo --- base/serial/f03/psb_c_coo_impl.f03 | 25 ++++++++++++++----------- base/serial/f03/psb_d_coo_impl.f03 | 24 +++++++++++++----------- base/serial/f03/psb_s_coo_impl.f03 | 24 +++++++++++++----------- base/serial/f03/psb_z_coo_impl.f03 | 24 +++++++++++++----------- 4 files changed, 53 insertions(+), 44 deletions(-) diff --git a/base/serial/f03/psb_c_coo_impl.f03 b/base/serial/f03/psb_c_coo_impl.f03 index 390c86a4..97f0f98d 100644 --- a/base/serial/f03/psb_c_coo_impl.f03 +++ b/base/serial/f03/psb_c_coo_impl.f03 @@ -2528,7 +2528,7 @@ subroutine psb_c_cp_coo_to_coo(a,b,info) class(psb_c_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info - Integer :: err_act + Integer :: err_act, nz character(len=20) :: name='to_coo' logical, parameter :: debug=.false. @@ -2537,12 +2537,14 @@ subroutine psb_c_cp_coo_to_coo(a,b,info) info = psb_success_ call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat) - call b%set_nzeros(a%get_nzeros()) - call b%reallocate(a%get_nzeros()) - b%ia(:) = a%ia(:) - b%ja(:) = a%ja(:) - b%val(:) = a%val(:) + nz = a%get_nzeros() + call b%set_nzeros(nz) + call b%reallocate(nz) + + b%ia(1:nz) = a%ia(1:nz) + b%ja(1:nz) = a%ja(1:nz) + b%val(1:nz) = a%val(1:nz) call b%fix(info) @@ -2580,12 +2582,13 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat) - call a%set_nzeros(b%get_nzeros()) - call a%reallocate(b%get_nzeros()) + nz = b%get_nzeros() + call a%set_nzeros(nz) + call a%reallocate(nz) - a%ia(:) = b%ia(:) - a%ja(:) = b%ja(:) - a%val(:) = b%val(:) + a%ia(1:nz) = b%ia(1:nz) + a%ja(1:nz) = b%ja(1:nz) + a%val(1:nz) = b%val(1:nz) call a%fix(info) diff --git a/base/serial/f03/psb_d_coo_impl.f03 b/base/serial/f03/psb_d_coo_impl.f03 index 88509e65..ee78dfa4 100644 --- a/base/serial/f03/psb_d_coo_impl.f03 +++ b/base/serial/f03/psb_d_coo_impl.f03 @@ -2328,7 +2328,7 @@ subroutine psb_d_cp_coo_to_coo(a,b,info) class(psb_d_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info - Integer :: err_act + Integer :: err_act, nz character(len=20) :: name='to_coo' logical, parameter :: debug=.false. @@ -2337,12 +2337,13 @@ subroutine psb_d_cp_coo_to_coo(a,b,info) info = psb_success_ call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat) - call b%set_nzeros(a%get_nzeros()) - call b%reallocate(a%get_nzeros()) + nz = a%get_nzeros() + call b%set_nzeros(nz) + call b%reallocate(nz) - b%ia(:) = a%ia(:) - b%ja(:) = a%ja(:) - b%val(:) = a%val(:) + b%ia(1:nz) = a%ia(1:nz) + b%ja(1:nz) = a%ja(1:nz) + b%val(1:nz) = a%val(1:nz) call b%fix(info) @@ -2380,12 +2381,13 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) - call a%set_nzeros(b%get_nzeros()) - call a%reallocate(b%get_nzeros()) + nz = b%get_nzeros() + call a%set_nzeros(nz) + call a%reallocate(nz) - a%ia(:) = b%ia(:) - a%ja(:) = b%ja(:) - a%val(:) = b%val(:) + a%ia(1:nz) = b%ia(1:nz) + a%ja(1:nz) = b%ja(1:nz) + a%val(1:nz) = b%val(1:nz) call a%fix(info) diff --git a/base/serial/f03/psb_s_coo_impl.f03 b/base/serial/f03/psb_s_coo_impl.f03 index 86e617e4..62b79667 100644 --- a/base/serial/f03/psb_s_coo_impl.f03 +++ b/base/serial/f03/psb_s_coo_impl.f03 @@ -2328,7 +2328,7 @@ subroutine psb_s_cp_coo_to_coo(a,b,info) class(psb_s_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info - Integer :: err_act + Integer :: err_act, nz character(len=20) :: name='to_coo' logical, parameter :: debug=.false. @@ -2337,12 +2337,13 @@ subroutine psb_s_cp_coo_to_coo(a,b,info) info = psb_success_ call b%psb_s_base_sparse_mat%cp_from(a%psb_s_base_sparse_mat) - call b%set_nzeros(a%get_nzeros()) - call b%reallocate(a%get_nzeros()) + nz = a%get_nzeros() + call b%set_nzeros(nz) + call b%reallocate(nz) - b%ia(:) = a%ia(:) - b%ja(:) = a%ja(:) - b%val(:) = a%val(:) + b%ia(1:nz) = a%ia(1:nz) + b%ja(1:nz) = a%ja(1:nz) + b%val(1:nz) = a%val(1:nz) call b%fix(info) @@ -2380,12 +2381,13 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat) - call a%set_nzeros(b%get_nzeros()) - call a%reallocate(b%get_nzeros()) + nz = b%get_nzeros() + call a%set_nzeros(nz) + call a%reallocate(nz) - a%ia(:) = b%ia(:) - a%ja(:) = b%ja(:) - a%val(:) = b%val(:) + a%ia(1:nz) = b%ia(1:nz) + a%ja(1:nz) = b%ja(1:nz) + a%val(1:nz) = b%val(1:nz) call a%fix(info) diff --git a/base/serial/f03/psb_z_coo_impl.f03 b/base/serial/f03/psb_z_coo_impl.f03 index 1ff1314e..cceeaf7d 100644 --- a/base/serial/f03/psb_z_coo_impl.f03 +++ b/base/serial/f03/psb_z_coo_impl.f03 @@ -2528,7 +2528,7 @@ subroutine psb_z_cp_coo_to_coo(a,b,info) class(psb_z_coo_sparse_mat), intent(inout) :: b integer, intent(out) :: info - Integer :: err_act + Integer :: err_act, nz character(len=20) :: name='to_coo' logical, parameter :: debug=.false. @@ -2537,12 +2537,13 @@ subroutine psb_z_cp_coo_to_coo(a,b,info) info = psb_success_ call b%psb_z_base_sparse_mat%cp_from(a%psb_z_base_sparse_mat) - call b%set_nzeros(a%get_nzeros()) - call b%reallocate(a%get_nzeros()) + nz = a%get_nzeros() + call b%set_nzeros(nz) + call b%reallocate(nz) - b%ia(:) = a%ia(:) - b%ja(:) = a%ja(:) - b%val(:) = a%val(:) + b%ia(1:nz) = a%ia(1:nz) + b%ja(1:nz) = a%ja(1:nz) + b%val(1:nz) = a%val(1:nz) call b%fix(info) @@ -2580,12 +2581,13 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat) - call a%set_nzeros(b%get_nzeros()) - call a%reallocate(b%get_nzeros()) + nz = b%get_nzeros() + call a%set_nzeros(nz) + call a%reallocate(nz) - a%ia(:) = b%ia(:) - a%ja(:) = b%ja(:) - a%val(:) = b%val(:) + a%ia(1:nz) = b%ia(1:nz) + a%ja(1:nz) = b%ja(1:nz) + a%val(1:nz) = b%val(1:nz) call a%fix(info)