mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 20:32:12 +00:00
psblas3:
base/modules/psb_c_base_mat_mod.f03 base/modules/psb_d_base_mat_mod.f03 base/modules/psb_s_base_mat_mod.f03 base/modules/psb_z_base_mat_mod.f03 base/serial/f03/psb_d_csc_impl.f03 Fixes for compilation with GNU 4.5.0 (fortran-dev branch). Added transpose to S/C/Z.
This commit is contained in:
Salvatore Filippone
@@ -36,6 +36,11 @@ module psb_c_base_mat_mod
|
||||
generic, public :: cp_from => c_base_cp_from
|
||||
procedure, pass(a) :: c_base_mv_from
|
||||
generic, public :: mv_from => c_base_mv_from
|
||||
|
||||
procedure, pass(a) :: base_transp_1mat => c_base_transp_1mat
|
||||
procedure, pass(a) :: base_transp_2mat => c_base_transp_2mat
|
||||
procedure, pass(a) :: base_transc_1mat => c_base_transc_1mat
|
||||
procedure, pass(a) :: base_transc_2mat => c_base_transc_2mat
|
||||
end type psb_c_base_sparse_mat
|
||||
|
||||
private :: c_base_csmv, c_base_csmm, c_base_cssv, c_base_cssm,&
|
||||
@@ -88,7 +93,9 @@ module psb_c_base_mat_mod
|
||||
generic, public :: cp_from => c_coo_cp_from
|
||||
procedure, pass(a) :: c_coo_mv_from
|
||||
generic, public :: mv_from => c_coo_mv_from
|
||||
|
||||
procedure, pass(a) :: base_transp_1mat => c_coo_transp_1mat
|
||||
procedure, pass(a) :: base_transc_1mat => c_coo_transc_1mat
|
||||
|
||||
end type psb_c_coo_sparse_mat
|
||||
|
||||
private :: c_coo_get_nzeros, c_coo_set_nzeros, c_coo_get_diag, &
|
||||
@@ -99,7 +106,8 @@ module psb_c_base_mat_mod
|
||||
& c_cp_coo_to_fmt, c_cp_coo_from_fmt, &
|
||||
& c_coo_scals, c_coo_scal, c_coo_csgetrow, c_coo_sizeof, &
|
||||
& c_coo_csgetptn, c_coo_get_nz_row, c_coo_reinit,&
|
||||
& c_coo_cp_from, c_coo_mv_from
|
||||
& c_coo_cp_from, c_coo_mv_from, &
|
||||
& c_coo_transp_1mat, c_coo_transc_1mat
|
||||
|
||||
|
||||
interface
|
||||
@@ -779,6 +787,186 @@ contains
|
||||
end subroutine csclip
|
||||
|
||||
|
||||
!
|
||||
! Here we go.
|
||||
!
|
||||
subroutine c_coo_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: a
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
integer :: info
|
||||
|
||||
call a%psb_c_base_sparse_mat%psb_base_sparse_mat%transp()
|
||||
call move_alloc(a%ia,itemp)
|
||||
call move_alloc(a%ja,a%ia)
|
||||
call move_alloc(itemp,a%ja)
|
||||
|
||||
call a%fix(info)
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_coo_transp_1mat
|
||||
|
||||
subroutine c_coo_transc_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: a
|
||||
|
||||
call a%transp()
|
||||
a%val(:) = conjg(a%val)
|
||||
|
||||
end subroutine c_coo_transc_1mat
|
||||
|
||||
subroutine c_base_transp_2mat(a,b)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_base_sparse_mat), intent(out) :: a
|
||||
class(psb_base_sparse_mat), intent(in) :: b
|
||||
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer err_act, info
|
||||
character(len=*), parameter :: name='c_base_transp'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = 0
|
||||
select type(b)
|
||||
class is (psb_c_base_sparse_mat)
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transp()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
class default
|
||||
info = 700
|
||||
end select
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,name,a_err=b%get_fmt())
|
||||
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 c_base_transp_2mat
|
||||
|
||||
subroutine c_base_transc_2mat(a,b)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_base_sparse_mat), intent(out) :: a
|
||||
class(psb_base_sparse_mat), intent(in) :: b
|
||||
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer err_act, info
|
||||
character(len=*), parameter :: name='c_base_transc'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
info = 0
|
||||
select type(b)
|
||||
class is (psb_c_base_sparse_mat)
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transc()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
class default
|
||||
info = 700
|
||||
end select
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,name,a_err=b%get_fmt())
|
||||
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 c_base_transc_2mat
|
||||
|
||||
subroutine c_base_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer :: err_act, info
|
||||
character(len=*), parameter :: name='c_base_transp'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transp()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = 700
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
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 c_base_transp_1mat
|
||||
|
||||
subroutine c_base_transc_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer :: err_act, info
|
||||
character(len=*), parameter :: name='c_base_transc'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transc()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = 700
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
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 c_base_transc_1mat
|
||||
|
||||
|
||||
|
||||
|
||||
!====================================
|
||||
!
|
||||
|
||||
@@ -790,34 +790,6 @@ contains
|
||||
!
|
||||
! Here we go.
|
||||
!
|
||||
!!$ subroutine d_coo_transp_2mat(a,b)
|
||||
!!$ use psb_error_mod
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_d_coo_sparse_mat), intent(out) :: a
|
||||
!!$ type(psb_d_coo_sparse_mat), intent(in) :: b
|
||||
!!$
|
||||
!!$ call a%psb_d_base_sparse_mat%psb_base_sparse_mat%transp(b%psb_d_base_sparse_mat%psb_base_sparse_mat)
|
||||
!!$ a%ia = b%ja
|
||||
!!$ a%ja = b%ia
|
||||
!!$ a%val = b%val
|
||||
!!$
|
||||
!!$ call a%fix()
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$ end subroutine d_coo_transp_2mat
|
||||
!!$
|
||||
!!$ subroutine d_coo_transc_2mat(a,b)
|
||||
!!$ use psb_error_mod
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_d_coo_sparse_mat), intent(out) :: a
|
||||
!!$ class(psb_d_coo_sparse_mat), intent(in) :: b
|
||||
!!$
|
||||
!!$ call a%transp(b)
|
||||
!!$ end subroutine d_coo_transc_2mat
|
||||
!!$
|
||||
subroutine d_coo_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
@@ -36,6 +36,11 @@ module psb_s_base_mat_mod
|
||||
generic, public :: cp_from => s_base_cp_from
|
||||
procedure, pass(a) :: s_base_mv_from
|
||||
generic, public :: mv_from => s_base_mv_from
|
||||
|
||||
procedure, pass(a) :: base_transp_1mat => s_base_transp_1mat
|
||||
procedure, pass(a) :: base_transp_2mat => s_base_transp_2mat
|
||||
procedure, pass(a) :: base_transc_1mat => s_base_transc_1mat
|
||||
procedure, pass(a) :: base_transc_2mat => s_base_transc_2mat
|
||||
end type psb_s_base_sparse_mat
|
||||
|
||||
private :: s_base_csmv, s_base_csmm, s_base_cssv, s_base_cssm,&
|
||||
@@ -88,6 +93,8 @@ module psb_s_base_mat_mod
|
||||
generic, public :: cp_from => s_coo_cp_from
|
||||
procedure, pass(a) :: s_coo_mv_from
|
||||
generic, public :: mv_from => s_coo_mv_from
|
||||
procedure, pass(a) :: base_transp_1mat => s_coo_transp_1mat
|
||||
procedure, pass(a) :: base_transc_1mat => s_coo_transc_1mat
|
||||
|
||||
end type psb_s_coo_sparse_mat
|
||||
|
||||
@@ -99,7 +106,9 @@ module psb_s_base_mat_mod
|
||||
& s_cp_coo_to_fmt, s_cp_coo_from_fmt, &
|
||||
& s_coo_scals, s_coo_scal, s_coo_csgetrow, s_coo_sizeof, &
|
||||
& s_coo_csgetptn, s_coo_get_nz_row, s_coo_reinit,&
|
||||
& s_coo_cp_from, s_coo_mv_from
|
||||
& s_coo_cp_from, s_coo_mv_from, &
|
||||
& s_coo_transp_1mat, s_coo_transc_1mat
|
||||
|
||||
|
||||
|
||||
interface
|
||||
@@ -778,6 +787,127 @@ contains
|
||||
|
||||
end subroutine csclip
|
||||
|
||||
subroutine s_coo_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_s_coo_sparse_mat), intent(inout) :: a
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
integer :: info
|
||||
|
||||
call a%psb_s_base_sparse_mat%psb_base_sparse_mat%transp()
|
||||
call move_alloc(a%ia,itemp)
|
||||
call move_alloc(a%ja,a%ia)
|
||||
call move_alloc(itemp,a%ja)
|
||||
|
||||
call a%fix(info)
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_coo_transp_1mat
|
||||
|
||||
subroutine s_coo_transc_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_s_coo_sparse_mat), intent(inout) :: a
|
||||
|
||||
call a%transp()
|
||||
end subroutine s_coo_transc_1mat
|
||||
|
||||
subroutine s_base_transp_2mat(a,b)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_s_base_sparse_mat), intent(out) :: a
|
||||
class(psb_base_sparse_mat), intent(in) :: b
|
||||
|
||||
type(psb_s_coo_sparse_mat) :: tmp
|
||||
integer err_act, info
|
||||
character(len=*), parameter :: name='s_base_transp'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = 0
|
||||
select type(b)
|
||||
class is (psb_s_base_sparse_mat)
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transp()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
class default
|
||||
info = 700
|
||||
end select
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,name,a_err=b%get_fmt())
|
||||
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 s_base_transp_2mat
|
||||
|
||||
subroutine s_base_transc_2mat(a,b)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_s_base_sparse_mat), intent(out) :: a
|
||||
class(psb_base_sparse_mat), intent(in) :: b
|
||||
|
||||
call a%transp(b)
|
||||
end subroutine s_base_transc_2mat
|
||||
|
||||
subroutine s_base_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
type(psb_s_coo_sparse_mat) :: tmp
|
||||
integer :: err_act, info
|
||||
character(len=*), parameter :: name='s_base_transp'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transp()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = 700
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
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 s_base_transp_1mat
|
||||
|
||||
subroutine s_base_transc_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
call a%transp()
|
||||
end subroutine s_base_transc_1mat
|
||||
|
||||
|
||||
|
||||
|
||||
!====================================
|
||||
|
||||
@@ -36,6 +36,11 @@ module psb_z_base_mat_mod
|
||||
generic, public :: cp_from => z_base_cp_from
|
||||
procedure, pass(a) :: z_base_mv_from
|
||||
generic, public :: mv_from => z_base_mv_from
|
||||
|
||||
procedure, pass(a) :: base_transp_1mat => z_base_transp_1mat
|
||||
procedure, pass(a) :: base_transp_2mat => z_base_transp_2mat
|
||||
procedure, pass(a) :: base_transc_1mat => z_base_transc_1mat
|
||||
procedure, pass(a) :: base_transc_2mat => z_base_transc_2mat
|
||||
end type psb_z_base_sparse_mat
|
||||
|
||||
private :: z_base_csmv, z_base_csmm, z_base_cssv, z_base_cssm,&
|
||||
@@ -88,6 +93,8 @@ module psb_z_base_mat_mod
|
||||
generic, public :: cp_from => z_coo_cp_from
|
||||
procedure, pass(a) :: z_coo_mv_from
|
||||
generic, public :: mv_from => z_coo_mv_from
|
||||
procedure, pass(a) :: base_transp_1mat => z_coo_transp_1mat
|
||||
procedure, pass(a) :: base_transc_1mat => z_coo_transc_1mat
|
||||
|
||||
end type psb_z_coo_sparse_mat
|
||||
|
||||
@@ -99,7 +106,8 @@ module psb_z_base_mat_mod
|
||||
& z_cp_coo_to_fmt, z_cp_coo_from_fmt, &
|
||||
& z_coo_scals, z_coo_scal, z_coo_csgetrow, z_coo_sizeof, &
|
||||
& z_coo_csgetptn, z_coo_get_nz_row, z_coo_reinit,&
|
||||
& z_coo_cp_from, z_coo_mv_from
|
||||
& z_coo_cp_from, z_coo_mv_from, &
|
||||
& z_coo_transp_1mat, z_coo_transc_1mat
|
||||
|
||||
|
||||
interface
|
||||
@@ -779,6 +787,187 @@ contains
|
||||
end subroutine csclip
|
||||
|
||||
|
||||
!
|
||||
! Here we go.
|
||||
!
|
||||
subroutine z_coo_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_z_coo_sparse_mat), intent(inout) :: a
|
||||
|
||||
integer, allocatable :: itemp(:)
|
||||
integer :: info
|
||||
|
||||
call a%psb_z_base_sparse_mat%psb_base_sparse_mat%transp()
|
||||
call move_alloc(a%ia,itemp)
|
||||
call move_alloc(a%ja,a%ia)
|
||||
call move_alloc(itemp,a%ja)
|
||||
|
||||
call a%fix(info)
|
||||
|
||||
return
|
||||
|
||||
end subroutine z_coo_transp_1mat
|
||||
|
||||
subroutine z_coo_transc_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_z_coo_sparse_mat), intent(inout) :: a
|
||||
|
||||
call a%transp()
|
||||
a%val(:) = conjg(a%val)
|
||||
|
||||
end subroutine z_coo_transc_1mat
|
||||
|
||||
subroutine z_base_transp_2mat(a,b)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_z_base_sparse_mat), intent(out) :: a
|
||||
class(psb_base_sparse_mat), intent(in) :: b
|
||||
|
||||
type(psb_z_coo_sparse_mat) :: tmp
|
||||
integer err_act, info
|
||||
character(len=*), parameter :: name='z_base_transp'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = 0
|
||||
select type(b)
|
||||
class is (psb_z_base_sparse_mat)
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transp()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
class default
|
||||
info = 700
|
||||
end select
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,name,a_err=b%get_fmt())
|
||||
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 z_base_transp_2mat
|
||||
|
||||
subroutine z_base_transc_2mat(a,b)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_z_base_sparse_mat), intent(out) :: a
|
||||
class(psb_base_sparse_mat), intent(in) :: b
|
||||
|
||||
type(psb_z_coo_sparse_mat) :: tmp
|
||||
integer err_act, info
|
||||
character(len=*), parameter :: name='z_base_transc'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
info = 0
|
||||
select type(b)
|
||||
class is (psb_z_base_sparse_mat)
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transc()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
class default
|
||||
info = 700
|
||||
end select
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,name,a_err=b%get_fmt())
|
||||
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 z_base_transc_2mat
|
||||
|
||||
subroutine z_base_transp_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
type(psb_z_coo_sparse_mat) :: tmp
|
||||
integer :: err_act, info
|
||||
character(len=*), parameter :: name='z_base_transp'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transp()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = 700
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
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 z_base_transp_1mat
|
||||
|
||||
subroutine z_base_transc_1mat(a)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: a
|
||||
|
||||
type(psb_z_coo_sparse_mat) :: tmp
|
||||
integer :: err_act, info
|
||||
character(len=*), parameter :: name='z_base_transc'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == 0) call tmp%transc()
|
||||
if (info == 0) call a%mv_from_coo(tmp,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = 700
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
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 z_base_transc_1mat
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!====================================
|
||||
!
|
||||
|
||||
@@ -1929,7 +1929,10 @@ subroutine d_cp_csc_to_fmt_impl(a,b,info)
|
||||
call a%cp_to_coo(b,info)
|
||||
|
||||
type is (psb_d_csc_sparse_mat)
|
||||
b = a
|
||||
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
|
||||
|
||||
class default
|
||||
call tmp%cp_from_fmt(a,info)
|
||||
|
||||
Reference in New Issue
Block a user