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

psblas3:

Browse Source 
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.
psblas3-type-indexed
Salvatore Filippone 14 years ago
parent 724b09620c
commit d4d408f950
9 changed files with 85 additions and 71 deletions
Show Stats Download Patch File Download Diff File

19
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -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)

21
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -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)

19
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -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)

7
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -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)

19
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -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)

15
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -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)

19
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -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)

21
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -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)

16
base/tools/psb_linmap.f90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save