fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

New ALLOCATE method for X_MAT

Browse Source
mat-allocate
Salvatore Filippone 4 years ago
parent ba35025f23
commit 027a14ae08
8 changed files with 196 additions and 32 deletions
Show Stats Download Patch File Download Diff File

14
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -128,6 +128,7 @@ module psb_c_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_c_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_c_free
procedure, pass(a) :: trim => psb_c_trim
procedure, pass(a) :: csput_a => psb_c_csput_a
@ -326,6 +327,7 @@ module psb_c_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_lc_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_lc_free
procedure, pass(a) :: trim => psb_lc_trim
procedure, pass(a) :: csput_a => psb_lc_csput_a
@ -604,12 +606,14 @@ module psb_c_mat_mod
end interface
interface
subroutine psb_c_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_cspmat_type
subroutine psb_c_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_c_base_sparse_mat
class(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_c_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_c_csall
end interface
@ -1384,12 +1388,14 @@ module psb_c_mat_mod
end interface
interface
subroutine psb_lc_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
subroutine psb_lc_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_lc_base_sparse_mat
class(psb_lcspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_lc_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_lc_csall
end interface

14
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -128,6 +128,7 @@ module psb_d_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_d_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_d_free
procedure, pass(a) :: trim => psb_d_trim
procedure, pass(a) :: csput_a => psb_d_csput_a
@ -326,6 +327,7 @@ module psb_d_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_ld_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_ld_free
procedure, pass(a) :: trim => psb_ld_trim
procedure, pass(a) :: csput_a => psb_ld_csput_a
@ -604,12 +606,14 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_dspmat_type
subroutine psb_d_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_d_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_d_csall
end interface
@ -1384,12 +1388,14 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_ld_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
subroutine psb_ld_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_ld_base_sparse_mat
class(psb_ldspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_ld_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_ld_csall
end interface

14
base/modules/serial/psb_s_mat_mod.F90
Unescape Escape View File

@ -128,6 +128,7 @@ module psb_s_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_s_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_s_free
procedure, pass(a) :: trim => psb_s_trim
procedure, pass(a) :: csput_a => psb_s_csput_a
@ -326,6 +327,7 @@ module psb_s_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_ls_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_ls_free
procedure, pass(a) :: trim => psb_ls_trim
procedure, pass(a) :: csput_a => psb_ls_csput_a
@ -604,12 +606,14 @@ module psb_s_mat_mod
end interface
interface
subroutine psb_s_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_sspmat_type
subroutine psb_s_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_s_base_sparse_mat
class(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_s_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_s_csall
end interface
@ -1384,12 +1388,14 @@ module psb_s_mat_mod
end interface
interface
subroutine psb_ls_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type
subroutine psb_ls_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_ls_base_sparse_mat
class(psb_lsspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_ls_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_ls_csall
end interface

14
base/modules/serial/psb_z_mat_mod.F90
Unescape Escape View File

@ -128,6 +128,7 @@ module psb_z_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_z_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_z_free
procedure, pass(a) :: trim => psb_z_trim
procedure, pass(a) :: csput_a => psb_z_csput_a
@ -326,6 +327,7 @@ module psb_z_mat_mod
! Memory/data management
procedure, pass(a) :: csall => psb_lz_csall
generic, public :: allocate => csall
procedure, pass(a) :: free => psb_lz_free
procedure, pass(a) :: trim => psb_lz_trim
procedure, pass(a) :: csput_a => psb_lz_csput_a
@ -604,12 +606,14 @@ module psb_z_mat_mod
end interface
interface
subroutine psb_z_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_zspmat_type
subroutine psb_z_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_z_base_sparse_mat
class(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_z_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_z_csall
end interface
@ -1384,12 +1388,14 @@ module psb_z_mat_mod
end interface
interface
subroutine psb_lz_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type
subroutine psb_lz_csall(nr,nc,a,info,nz,type,mold)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_lz_base_sparse_mat
class(psb_lzspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_lz_base_sparse_mat), optional, intent(in) :: mold
end subroutine psb_lz_csall
end interface

39
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -582,7 +582,7 @@ end subroutine psb_c_get_neigh
subroutine psb_c_csall(nr,nc,a,info,nz)
subroutine psb_c_csall(nr,nc,a,info,nz,type,mold)
use psb_c_mat_mod, psb_protect_name => psb_c_csall
use psb_c_base_mat_mod
use psb_error_mod
@ -591,6 +591,8 @@ subroutine psb_c_csall(nr,nc,a,info,nz)
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_c_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -601,7 +603,23 @@ subroutine psb_c_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_c_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_c_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_c_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_c_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_c_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)
@ -3381,7 +3399,7 @@ end subroutine psb_lc_get_neigh
subroutine psb_lc_csall(nr,nc,a,info,nz)
subroutine psb_lc_csall(nr,nc,a,info,nz,type,mold)
use psb_c_mat_mod, psb_protect_name => psb_lc_csall
use psb_c_base_mat_mod
use psb_error_mod
@ -3390,6 +3408,8 @@ subroutine psb_lc_csall(nr,nc,a,info,nz)
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_lc_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -3400,7 +3420,22 @@ subroutine psb_lc_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_lc_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_lc_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_lc_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_lc_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_lc_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)

39
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -582,7 +582,7 @@ end subroutine psb_d_get_neigh
subroutine psb_d_csall(nr,nc,a,info,nz)
subroutine psb_d_csall(nr,nc,a,info,nz,type,mold)
use psb_d_mat_mod, psb_protect_name => psb_d_csall
use psb_d_base_mat_mod
use psb_error_mod
@ -591,6 +591,8 @@ subroutine psb_d_csall(nr,nc,a,info,nz)
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_d_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -601,7 +603,23 @@ subroutine psb_d_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_d_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_d_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_d_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_d_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_d_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)
@ -3381,7 +3399,7 @@ end subroutine psb_ld_get_neigh
subroutine psb_ld_csall(nr,nc,a,info,nz)
subroutine psb_ld_csall(nr,nc,a,info,nz,type,mold)
use psb_d_mat_mod, psb_protect_name => psb_ld_csall
use psb_d_base_mat_mod
use psb_error_mod
@ -3390,6 +3408,8 @@ subroutine psb_ld_csall(nr,nc,a,info,nz)
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_ld_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -3400,7 +3420,22 @@ subroutine psb_ld_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_ld_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_ld_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_ld_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_ld_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_ld_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)

39
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -582,7 +582,7 @@ end subroutine psb_s_get_neigh
subroutine psb_s_csall(nr,nc,a,info,nz)
subroutine psb_s_csall(nr,nc,a,info,nz,type,mold)
use psb_s_mat_mod, psb_protect_name => psb_s_csall
use psb_s_base_mat_mod
use psb_error_mod
@ -591,6 +591,8 @@ subroutine psb_s_csall(nr,nc,a,info,nz)
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_s_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -601,7 +603,23 @@ subroutine psb_s_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_s_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_s_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_s_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_s_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_s_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)
@ -3381,7 +3399,7 @@ end subroutine psb_ls_get_neigh
subroutine psb_ls_csall(nr,nc,a,info,nz)
subroutine psb_ls_csall(nr,nc,a,info,nz,type,mold)
use psb_s_mat_mod, psb_protect_name => psb_ls_csall
use psb_s_base_mat_mod
use psb_error_mod
@ -3390,6 +3408,8 @@ subroutine psb_ls_csall(nr,nc,a,info,nz)
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_ls_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -3400,7 +3420,22 @@ subroutine psb_ls_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_ls_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_ls_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_ls_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_ls_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_ls_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)

39
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -582,7 +582,7 @@ end subroutine psb_z_get_neigh
subroutine psb_z_csall(nr,nc,a,info,nz)
subroutine psb_z_csall(nr,nc,a,info,nz,type,mold)
use psb_z_mat_mod, psb_protect_name => psb_z_csall
use psb_z_base_mat_mod
use psb_error_mod
@ -591,6 +591,8 @@ subroutine psb_z_csall(nr,nc,a,info,nz)
integer(psb_ipk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_z_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -601,7 +603,23 @@ subroutine psb_z_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_z_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_z_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_z_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_z_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_z_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)
@ -3381,7 +3399,7 @@ end subroutine psb_lz_get_neigh
subroutine psb_lz_csall(nr,nc,a,info,nz)
subroutine psb_lz_csall(nr,nc,a,info,nz,type,mold)
use psb_z_mat_mod, psb_protect_name => psb_lz_csall
use psb_z_base_mat_mod
use psb_error_mod
@ -3390,6 +3408,8 @@ subroutine psb_lz_csall(nr,nc,a,info,nz)
integer(psb_lpk_), intent(in) :: nr,nc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: nz
character(len=*), intent(in), optional :: type
class(psb_lz_base_sparse_mat), optional, intent(in) :: mold
integer(psb_ipk_) :: err_act
character(len=20) :: name='csall'
@ -3400,7 +3420,22 @@ subroutine psb_lz_csall(nr,nc,a,info,nz)
call a%free()
info = psb_success_
if (present(mold)) then
allocate(a%a, stat=info, mold=mold)
else if (present(type)) then
select case (type)
case('CSR')
allocate(psb_lz_csr_sparse_mat :: a%a, stat=info)
case('COO')
allocate(psb_lz_coo_sparse_mat :: a%a, stat=info)
case('CSC')
allocate(psb_lz_csc_sparse_mat :: a%a, stat=info)
case default
allocate(psb_lz_coo_sparse_mat :: a%a, stat=info)
end select
else
allocate(psb_lz_coo_sparse_mat :: a%a, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info, name)

Write Preview
Loading…
Cancel
Save