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

psblas3:

Browse Source 
Fixed TRANSP intent.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent d9b7abda2a
commit 61adee3c4c
16 changed files with 163 additions and 110 deletions
Show Stats Download Patch File Download Diff File

8
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -510,16 +510,16 @@ module psb_c_base_mat_mod
interface interface
subroutine psb_c_base_transp_2mat(a,b) subroutine psb_c_base_transp_2mat(a,b)
import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_ import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(out) :: a class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_c_base_transp_2mat end subroutine psb_c_base_transp_2mat
end interface end interface
interface interface
subroutine psb_c_base_transc_2mat(a,b) subroutine psb_c_base_transc_2mat(a,b)
import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_ import :: psb_c_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(out) :: a class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_c_base_transc_2mat end subroutine psb_c_base_transc_2mat
end interface end interface

8
base/modules/psb_c_mat_mod.f90
Unescape Escape View File

@ -547,8 +547,8 @@ module psb_c_mat_mod
interface interface
subroutine psb_c_transp_2mat(a,b) subroutine psb_c_transp_2mat(a,b)
import :: psb_cspmat_type import :: psb_cspmat_type
class(psb_cspmat_type), intent(out) :: a class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(in) :: b class(psb_cspmat_type), intent(out) :: b
end subroutine psb_c_transp_2mat end subroutine psb_c_transp_2mat
end interface end interface
@ -562,8 +562,8 @@ module psb_c_mat_mod
interface interface
subroutine psb_c_transc_2mat(a,b) subroutine psb_c_transc_2mat(a,b)
import :: psb_cspmat_type import :: psb_cspmat_type
class(psb_cspmat_type), intent(out) :: a class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(in) :: b class(psb_cspmat_type), intent(out) :: b
end subroutine psb_c_transc_2mat end subroutine psb_c_transc_2mat
end interface end interface

8
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -511,16 +511,16 @@ module psb_d_base_mat_mod
interface interface
subroutine psb_d_base_transp_2mat(a,b) subroutine psb_d_base_transp_2mat(a,b)
import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(out) :: a class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_d_base_transp_2mat end subroutine psb_d_base_transp_2mat
end interface end interface
interface interface
subroutine psb_d_base_transc_2mat(a,b) subroutine psb_d_base_transc_2mat(a,b)
import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ import :: psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(out) :: a class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_d_base_transc_2mat end subroutine psb_d_base_transc_2mat
end interface end interface

9
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -108,6 +108,7 @@ module psb_d_mat_mod
procedure, pass(a) :: d_cscnv_ip => psb_d_cscnv_ip procedure, pass(a) :: d_cscnv_ip => psb_d_cscnv_ip
procedure, pass(a) :: d_cscnv_base => psb_d_cscnv_base procedure, pass(a) :: d_cscnv_base => psb_d_cscnv_base
generic, public :: cscnv => d_cscnv, d_cscnv_ip, d_cscnv_base generic, public :: cscnv => d_cscnv, d_cscnv_ip, d_cscnv_base
procedure, pass(a) :: clone => psb_dspmat_type_clone
procedure, pass(a) :: reinit => psb_d_reinit procedure, pass(a) :: reinit => psb_d_reinit
procedure, pass(a) :: print_i => psb_d_sparse_print procedure, pass(a) :: print_i => psb_d_sparse_print
procedure, pass(a) :: print_n => psb_d_n_sparse_print procedure, pass(a) :: print_n => psb_d_n_sparse_print
@ -549,8 +550,8 @@ module psb_d_mat_mod
interface interface
subroutine psb_d_transp_2mat(a,b) subroutine psb_d_transp_2mat(a,b)
import :: psb_dspmat_type import :: psb_dspmat_type
class(psb_dspmat_type), intent(out) :: a class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(in) :: b class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transp_2mat end subroutine psb_d_transp_2mat
end interface end interface
@ -564,8 +565,8 @@ module psb_d_mat_mod
interface interface
subroutine psb_d_transc_2mat(a,b) subroutine psb_d_transc_2mat(a,b)
import :: psb_dspmat_type import :: psb_dspmat_type
class(psb_dspmat_type), intent(out) :: a class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(in) :: b class(psb_dspmat_type), intent(out) :: b
end subroutine psb_d_transc_2mat end subroutine psb_d_transc_2mat
end interface end interface

8
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -511,16 +511,16 @@ module psb_s_base_mat_mod
interface interface
subroutine psb_s_base_transp_2mat(a,b) subroutine psb_s_base_transp_2mat(a,b)
import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_ import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(out) :: a class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_s_base_transp_2mat end subroutine psb_s_base_transp_2mat
end interface end interface
interface interface
subroutine psb_s_base_transc_2mat(a,b) subroutine psb_s_base_transc_2mat(a,b)
import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_ import :: psb_s_base_sparse_mat, psb_base_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(out) :: a class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_s_base_transc_2mat end subroutine psb_s_base_transc_2mat
end interface end interface

8
base/modules/psb_s_mat_mod.f90
Unescape Escape View File

@ -550,8 +550,8 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_transp_2mat(a,b) subroutine psb_s_transp_2mat(a,b)
import :: psb_sspmat_type import :: psb_sspmat_type
class(psb_sspmat_type), intent(out) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(in) :: b class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transp_2mat end subroutine psb_s_transp_2mat
end interface end interface
@ -565,8 +565,8 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_transc_2mat(a,b) subroutine psb_s_transc_2mat(a,b)
import :: psb_sspmat_type import :: psb_sspmat_type
class(psb_sspmat_type), intent(out) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(in) :: b class(psb_sspmat_type), intent(out) :: b
end subroutine psb_s_transc_2mat end subroutine psb_s_transc_2mat
end interface end interface

8
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -512,16 +512,16 @@ module psb_z_base_mat_mod
interface interface
subroutine psb_z_base_transp_2mat(a,b) subroutine psb_z_base_transp_2mat(a,b)
import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(out) :: a class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_z_base_transp_2mat end subroutine psb_z_base_transp_2mat
end interface end interface
interface interface
subroutine psb_z_base_transc_2mat(a,b) subroutine psb_z_base_transc_2mat(a,b)
import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_ import :: psb_z_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(out) :: a class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
end subroutine psb_z_base_transc_2mat end subroutine psb_z_base_transc_2mat
end interface end interface

8
base/modules/psb_z_mat_mod.f90
Unescape Escape View File

@ -547,8 +547,8 @@ module psb_z_mat_mod
interface interface
subroutine psb_z_transp_2mat(a,b) subroutine psb_z_transp_2mat(a,b)
import :: psb_zspmat_type import :: psb_zspmat_type
class(psb_zspmat_type), intent(out) :: a class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(in) :: b class(psb_zspmat_type), intent(out) :: b
end subroutine psb_z_transp_2mat end subroutine psb_z_transp_2mat
end interface end interface
@ -562,8 +562,8 @@ module psb_z_mat_mod
interface interface
subroutine psb_z_transc_2mat(a,b) subroutine psb_z_transc_2mat(a,b)
import :: psb_zspmat_type import :: psb_zspmat_type
class(psb_zspmat_type), intent(out) :: a class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(in) :: b class(psb_zspmat_type), intent(out) :: b
end subroutine psb_z_transc_2mat end subroutine psb_z_transc_2mat
end interface end interface

16
base/serial/impl/psb_c_base_mat_impl.f90
Unescape Escape View File

@ -473,8 +473,8 @@ subroutine psb_c_base_transp_2mat(a,b)
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_c_base_sparse_mat), intent(out) :: a class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_c_coo_sparse_mat) :: tmp type(psb_c_coo_sparse_mat) :: tmp
integer err_act, info integer err_act, info
@ -485,9 +485,9 @@ subroutine psb_c_base_transp_2mat(a,b)
info = psb_success_ info = psb_success_
select type(b) select type(b)
class is (psb_c_base_sparse_mat) class is (psb_c_base_sparse_mat)
call b%cp_to_coo(tmp,info) call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transp() if (info == psb_success_) call tmp%transp()
if (info == psb_success_) call a%mv_from_coo(tmp,info) if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
end select end select
@ -511,8 +511,8 @@ subroutine psb_c_base_transc_2mat(a,b)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_transc_2mat use psb_c_base_mat_mod, psb_protect_name => psb_c_base_transc_2mat
implicit none implicit none
class(psb_c_base_sparse_mat), intent(out) :: a class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_c_coo_sparse_mat) :: tmp type(psb_c_coo_sparse_mat) :: tmp
integer err_act, info integer err_act, info
@ -523,9 +523,9 @@ subroutine psb_c_base_transc_2mat(a,b)
info = psb_success_ info = psb_success_
select type(b) select type(b)
class is (psb_c_base_sparse_mat) class is (psb_c_base_sparse_mat)
call b%cp_to_coo(tmp,info) call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transc() if (info == psb_success_) call tmp%transc()
if (info == psb_success_) call a%mv_from_coo(tmp,info) if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
end select end select

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

@ -1589,8 +1589,8 @@ subroutine psb_c_transp_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_c_mat_mod, psb_protect_name => psb_c_transp_2mat use psb_c_mat_mod, psb_protect_name => psb_c_transp_2mat
implicit none implicit none
class(psb_cspmat_type), intent(out) :: a class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(in) :: b class(psb_cspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transp' character(len=20) :: name='transp'
@ -1598,22 +1598,22 @@ subroutine psb_c_transp_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transp(b%a) call a%a%transp_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1670,8 +1670,8 @@ subroutine psb_c_transc_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_c_mat_mod, psb_protect_name => psb_c_transc_2mat use psb_c_mat_mod, psb_protect_name => psb_c_transc_2mat
implicit none implicit none
class(psb_cspmat_type), intent(out) :: a class(psb_cspmat_type), intent(in) :: a
class(psb_cspmat_type), intent(in) :: b class(psb_cspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transc' character(len=20) :: name='transc'
@ -1679,22 +1679,22 @@ subroutine psb_c_transc_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transc(b%a) call a%a%transc_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

40
base/serial/impl/psb_d_base_mat_impl.f90
Unescape Escape View File

@ -473,8 +473,8 @@ subroutine psb_d_base_transp_2mat(a,b)
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_d_base_sparse_mat), intent(out) :: a class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_d_coo_sparse_mat) :: tmp type(psb_d_coo_sparse_mat) :: tmp
integer err_act, info integer err_act, info
@ -485,9 +485,9 @@ subroutine psb_d_base_transp_2mat(a,b)
info = psb_success_ info = psb_success_
select type(b) select type(b)
class is (psb_d_base_sparse_mat) class is (psb_d_base_sparse_mat)
call b%cp_to_coo(tmp,info) call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transp() if (info == psb_success_) call tmp%transp()
if (info == psb_success_) call a%mv_from_coo(tmp,info) if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
end select end select
@ -511,10 +511,36 @@ subroutine psb_d_base_transc_2mat(a,b)
use psb_d_base_mat_mod, psb_protect_name => psb_d_base_transc_2mat use psb_d_base_mat_mod, psb_protect_name => psb_d_base_transc_2mat
implicit none implicit none
class(psb_d_base_sparse_mat), intent(out) :: a class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_d_coo_sparse_mat) :: tmp
integer err_act, info
character(len=*), parameter :: name='d_base_transc'
call a%transp(b) call psb_erractionsave(err_act)
info = psb_success_
select type(b)
class is (psb_d_base_sparse_mat)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transc()
if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default
info = psb_err_invalid_dynamic_type_
end select
if (info /= psb_success_) then
call psb_errpush(info,name,a_err=b%get_fmt(),i_err=(/1,0,0,0,0/))
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_d_base_transc_2mat end subroutine psb_d_base_transc_2mat
subroutine psb_d_base_transp_1mat(a) subroutine psb_d_base_transp_1mat(a)

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

@ -1588,8 +1588,8 @@ subroutine psb_d_transp_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_d_mat_mod, psb_protect_name => psb_d_transp_2mat use psb_d_mat_mod, psb_protect_name => psb_d_transp_2mat
implicit none implicit none
class(psb_dspmat_type), intent(out) :: a class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(in) :: b class(psb_dspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transp' character(len=20) :: name='transp'
@ -1597,22 +1597,22 @@ subroutine psb_d_transp_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transp(b%a) call a%a%transp_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1669,8 +1669,8 @@ subroutine psb_d_transc_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_d_mat_mod, psb_protect_name => psb_d_transc_2mat use psb_d_mat_mod, psb_protect_name => psb_d_transc_2mat
implicit none implicit none
class(psb_dspmat_type), intent(out) :: a class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(in) :: b class(psb_dspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transc' character(len=20) :: name='transc'
@ -1678,22 +1678,22 @@ subroutine psb_d_transc_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transc(b%a) call a%a%transc_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

40
base/serial/impl/psb_s_base_mat_impl.f90
Unescape Escape View File

@ -473,8 +473,8 @@ subroutine psb_s_base_transp_2mat(a,b)
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_s_base_sparse_mat), intent(out) :: a class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_s_coo_sparse_mat) :: tmp type(psb_s_coo_sparse_mat) :: tmp
integer err_act, info integer err_act, info
@ -485,9 +485,9 @@ subroutine psb_s_base_transp_2mat(a,b)
info = psb_success_ info = psb_success_
select type(b) select type(b)
class is (psb_s_base_sparse_mat) class is (psb_s_base_sparse_mat)
call b%cp_to_coo(tmp,info) call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transp() if (info == psb_success_) call tmp%transp()
if (info == psb_success_) call a%mv_from_coo(tmp,info) if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
end select end select
@ -511,10 +511,36 @@ subroutine psb_s_base_transc_2mat(a,b)
use psb_s_base_mat_mod, psb_protect_name => psb_s_base_transc_2mat use psb_s_base_mat_mod, psb_protect_name => psb_s_base_transc_2mat
implicit none implicit none
class(psb_s_base_sparse_mat), intent(out) :: a class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_s_coo_sparse_mat) :: tmp
integer err_act, info
character(len=*), parameter :: name='s_base_transc'
call a%transp(b) call psb_erractionsave(err_act)
info = psb_success_
select type(b)
class is (psb_s_base_sparse_mat)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transc()
if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default
info = psb_err_invalid_dynamic_type_
end select
if (info /= psb_success_) then
call psb_errpush(info,name,a_err=b%get_fmt(),i_err=(/1,0,0,0,0/))
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine psb_s_base_transc_2mat end subroutine psb_s_base_transc_2mat
subroutine psb_s_base_transp_1mat(a) subroutine psb_s_base_transp_1mat(a)

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

@ -1587,8 +1587,8 @@ subroutine psb_s_transp_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_s_mat_mod, psb_protect_name => psb_s_transp_2mat use psb_s_mat_mod, psb_protect_name => psb_s_transp_2mat
implicit none implicit none
class(psb_sspmat_type), intent(out) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(in) :: b class(psb_sspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transp' character(len=20) :: name='transp'
@ -1596,22 +1596,22 @@ subroutine psb_s_transp_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transp(b%a) call a%a%transp_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1668,8 +1668,8 @@ subroutine psb_s_transc_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_s_mat_mod, psb_protect_name => psb_s_transc_2mat use psb_s_mat_mod, psb_protect_name => psb_s_transc_2mat
implicit none implicit none
class(psb_sspmat_type), intent(out) :: a class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(in) :: b class(psb_sspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transc' character(len=20) :: name='transc'
@ -1677,22 +1677,22 @@ subroutine psb_s_transc_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transc(b%a) call a%a%transc_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

16
base/serial/impl/psb_z_base_mat_impl.f90
Unescape Escape View File

@ -474,8 +474,8 @@ subroutine psb_z_base_transp_2mat(a,b)
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psb_z_base_sparse_mat), intent(out) :: a class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_z_coo_sparse_mat) :: tmp type(psb_z_coo_sparse_mat) :: tmp
integer err_act, info integer err_act, info
@ -486,9 +486,9 @@ subroutine psb_z_base_transp_2mat(a,b)
info = psb_success_ info = psb_success_
select type(b) select type(b)
class is (psb_z_base_sparse_mat) class is (psb_z_base_sparse_mat)
call b%cp_to_coo(tmp,info) call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transp() if (info == psb_success_) call tmp%transp()
if (info == psb_success_) call a%mv_from_coo(tmp,info) if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
end select end select
@ -512,8 +512,8 @@ subroutine psb_z_base_transc_2mat(a,b)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_transc_2mat use psb_z_base_mat_mod, psb_protect_name => psb_z_base_transc_2mat
implicit none implicit none
class(psb_z_base_sparse_mat), intent(out) :: a class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(in) :: b class(psb_base_sparse_mat), intent(out) :: b
type(psb_z_coo_sparse_mat) :: tmp type(psb_z_coo_sparse_mat) :: tmp
integer err_act, info integer err_act, info
character(len=*), parameter :: name='z_base_transc' character(len=*), parameter :: name='z_base_transc'
@ -523,9 +523,9 @@ subroutine psb_z_base_transc_2mat(a,b)
info = psb_success_ info = psb_success_
select type(b) select type(b)
class is (psb_z_base_sparse_mat) class is (psb_z_base_sparse_mat)
call b%cp_to_coo(tmp,info) call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%transc() if (info == psb_success_) call tmp%transc()
if (info == psb_success_) call a%mv_from_coo(tmp,info) if (info == psb_success_) call b%mv_from_coo(tmp,info)
class default class default
info = psb_err_invalid_dynamic_type_ info = psb_err_invalid_dynamic_type_
end select end select

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

@ -1587,8 +1587,8 @@ subroutine psb_z_transp_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_z_mat_mod, psb_protect_name => psb_z_transp_2mat use psb_z_mat_mod, psb_protect_name => psb_z_transp_2mat
implicit none implicit none
class(psb_zspmat_type), intent(out) :: a class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(in) :: b class(psb_zspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transp' character(len=20) :: name='transp'
@ -1596,22 +1596,22 @@ subroutine psb_z_transp_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transp(b%a) call a%a%transp_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1668,8 +1668,8 @@ subroutine psb_z_transc_2mat(a,b)
use psb_string_mod use psb_string_mod
use psb_z_mat_mod, psb_protect_name => psb_z_transc_2mat use psb_z_mat_mod, psb_protect_name => psb_z_transc_2mat
implicit none implicit none
class(psb_zspmat_type), intent(out) :: a class(psb_zspmat_type), intent(in) :: a
class(psb_zspmat_type), intent(in) :: b class(psb_zspmat_type), intent(out) :: b
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='transc' character(len=20) :: name='transc'
@ -1677,22 +1677,22 @@ subroutine psb_z_transc_2mat(a,b)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (b%is_null()) then if (a%is_null()) then
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(a%a,mold=b%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else #else
call b%a%mold(a%a,info) call a%a%mold(b%a,info)
#endif #endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
end if end if
call a%a%transc(b%a) call a%a%transc_2mat(b%a)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

Write Preview
Loading…
Cancel
Save