From 6faed403eee8fa47934233aaf6e8ec475c259271 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 22 Apr 2018 15:39:10 +0100 Subject: [PATCH] Added I to L conversion because of GNU PR52162. --- base/modules/serial/psb_c_mat_mod.F90 | 36 +++++++++++++++++++++------ base/modules/serial/psb_d_mat_mod.F90 | 36 +++++++++++++++++++++------ base/modules/serial/psb_s_mat_mod.F90 | 36 +++++++++++++++++++++------ base/modules/serial/psb_z_mat_mod.F90 | 36 +++++++++++++++++++++------ 4 files changed, 112 insertions(+), 32 deletions(-) diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index 578cbd9f..426fe4a3 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -1314,16 +1314,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + info = psb_success_ + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if call a%csget(imin,imax,nz,lia,lja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_c_lcsgetptn @@ -1343,16 +1353,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if + call a%csget(imin,imax,nz,lia,lja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_c_lcsgetrow #endif diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index d484b634..264a868f 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -1314,16 +1314,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + info = psb_success_ + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if call a%csget(imin,imax,nz,lia,lja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_d_lcsgetptn @@ -1343,16 +1353,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if + call a%csget(imin,imax,nz,lia,lja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_d_lcsgetrow #endif diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index 1bcc8a53..791d6fbb 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -1314,16 +1314,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + info = psb_success_ + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if call a%csget(imin,imax,nz,lia,lja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_s_lcsgetptn @@ -1343,16 +1353,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if + call a%csget(imin,imax,nz,lia,lja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_s_lcsgetrow #endif diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index 7bcf71c7..e13e1498 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -1314,16 +1314,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + info = psb_success_ + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if call a%csget(imin,imax,nz,lia,lja,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_z_lcsgetptn @@ -1343,16 +1353,26 @@ contains ! Local integer(psb_ipk_), allocatable :: lia(:), lja(:) + ! + ! Note: in principle we could use reallocate on assignment, + ! but GCC bug 52162 forces us to take defensive programming. + ! if (allocated(ia)) then - lia = ia + call psb_realloc(size(ia),lia,info) + if (info == psb_success_) lia(:) = ia(:) end if if (allocated(ja)) then - lja = ja + call psb_realloc(size(ja),lja,info) + if (info == psb_success_) lja(:) = ja(:) end if + call a%csget(imin,imax,nz,lia,lja,val,info,& & jmin,jmax,iren,append,nzin,rscale,cscale) - ia = lia - ja = lja + + call psb_ensure_size(size(lia),ia,info) + if (info == psb_success_) ia(:) = lia(:) + call psb_ensure_size(size(lja),ja,info) + if (info == psb_success_) ja(:) = lja(:) end subroutine psb_z_lcsgetrow #endif