fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 03:42:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_desc_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/serial/impl/psb_c_base_mat_impl.F90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_s_base_mat_impl.F90
 base/serial/impl/psb_z_base_mat_impl.F90

Fix clone  to avoid INTENT(OUT),ALLOCATABLE and use intent(inout)
This commit is contained in:
Salvatore Filippone
2013-04-05 14:32:22 +00:00
parent 1f5b66fc82
commit 2dbd56b775
9 changed files with 97 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_c_base_mat_mod.f90
+2 -4
View File
@@ -432,8 +432,8 @@ module psb_c_base_mat_mod
subroutine psb_c_base_clone(a,b, info)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_long_int_k_
implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_clone
end interface
@@ -1585,8 +1585,6 @@ module psb_c_base_mat_mod
contains
subroutine c_base_mv_from(a,b)
implicit none
base/modules/psb_d_base_mat_mod.f90
+2 -4
View File
@@ -432,8 +432,8 @@ module psb_d_base_mat_mod
subroutine psb_d_base_clone(a,b, info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_long_int_k_
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_clone
end interface
@@ -1585,8 +1585,6 @@ module psb_d_base_mat_mod
contains
subroutine d_base_mv_from(a,b)
implicit none
base/modules/psb_desc_mod.f90
+37 -26
View File
@@ -908,9 +908,9 @@ contains
implicit none
!....parameters...
class(psb_desc_type), intent(inout), target :: desc
class(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), intent(out) :: info
class(psb_desc_type), intent(inout), target :: desc
class(psb_desc_type), intent(inout) :: desc_out
integer(psb_ipk_), intent(out) :: info
!locals
integer(psb_ipk_) :: np,me,ictxt, err_act
integer(psb_ipk_) :: debug_level, debug_unit
@@ -924,31 +924,42 @@ contains
call psb_erractionsave(err_act)
name = 'psb_cdcpy'
ictxt = desc%get_context()
if (desc%is_valid()) then
ictxt = desc%get_context()
! check on blacs grid
call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Entered'
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
! check on blacs grid
call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': Entered'
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
desc_out%base_desc => desc%base_desc
if (info == psb_success_) call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%ovrlap_index,&
& desc_out%ovrlap_index,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info)
if (info == psb_success_) call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info)
if ((info == psb_success_).and.(allocated(desc%indxmap))) &
& call desc%indxmap%clone(desc_out%indxmap,info)
desc_out%base_desc => desc%base_desc
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%ovrlap_index,&
& desc_out%ovrlap_index,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info)
if ((info == psb_success_).and.(allocated(desc%indxmap))) &
& call desc%indxmap%clone(desc_out%indxmap,info)
else
call desc_out%free(info)
end if
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name)
base/modules/psb_s_base_mat_mod.f90
+2 -4
View File
@@ -432,8 +432,8 @@ module psb_s_base_mat_mod
subroutine psb_s_base_clone(a,b, info)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_long_int_k_
implicit none
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_clone
end interface
@@ -1585,8 +1585,6 @@ module psb_s_base_mat_mod
contains
subroutine s_base_mv_from(a,b)
implicit none
base/modules/psb_z_base_mat_mod.f90
+2 -4
View File
@@ -432,8 +432,8 @@ module psb_z_base_mat_mod
subroutine psb_z_base_clone(a,b, info)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_long_int_k_
implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(out) :: b
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_clone
end interface
@@ -1585,8 +1585,6 @@ module psb_z_base_mat_mod
contains
subroutine z_base_mv_from(a,b)
implicit none
base/serial/impl/psb_c_base_mat_impl.F90
+13 -2
View File
@@ -555,10 +555,21 @@ subroutine psb_c_base_clone(a,b,info)
use psb_error_mod
implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
end if
if (info /= 0) then
info = psb_err_alloc_dealloc_
return
end if
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
base/serial/impl/psb_d_base_mat_impl.F90
+13 -2
View File
@@ -555,10 +555,21 @@ subroutine psb_d_base_clone(a,b,info)
use psb_error_mod
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
end if
if (info /= 0) then
info = psb_err_alloc_dealloc_
return
end if
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
base/serial/impl/psb_s_base_mat_impl.F90
+13 -2
View File
@@ -555,10 +555,21 @@ subroutine psb_s_base_clone(a,b,info)
use psb_error_mod
implicit none
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
end if
if (info /= 0) then
info = psb_err_alloc_dealloc_
return
end if
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_
base/serial/impl/psb_z_base_mat_impl.F90
+13 -2
View File
@@ -555,10 +555,21 @@ subroutine psb_z_base_clone(a,b,info)
use psb_error_mod
implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(out) :: b
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
if (allocated(b)) then
call b%free()
deallocate(b, stat=info)
end if
if (info /= 0) then
info = psb_err_alloc_dealloc_
return
end if
! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_