psblas3:
base/modules/Makefile base/modules/psb_base_mat_mod.f03 base/modules/psb_d_base_mat_mod.f03 base/modules/psb_d_csr_mat_mod.f03 base/modules/psb_mat_mod.f03 base/modules/psbn_base_mat_mod.f03 base/modules/psbn_d_base_mat_mod.f03 base/modules/psbn_d_csr_mat_mod.f03 base/modules/psbn_mat_impl.f03 base/modules/psbn_mat_mod.f03 test/pargen/Makefile test/pargen/psb_d_csc_impl.f03 test/pargen/psb_d_csc_mat_mod.f03 test/pargen/psbn_d_csc_impl.f03 test/pargen/psbn_d_csc_mat_mod.f03 test/serial/Makefile test/serial/psb_d_cxx_impl.f03 test/serial/psb_d_cxx_mat_mod.f03 test/serial/psbn_d_cxx_impl.f03 test/serial/psbn_d_cxx_mat_mod.f03 Switchover to psb_completed.psblas3-type-indexed
Salvatore Filippone
16 years ago
parent
5a6b34de32
commit
6824977d63
@ -1,245 +0,0 @@
|
||||
subroutine psb_d_csall(nr,nc,a,info,nz)
|
||||
use psb_d_base_mat_mod
|
||||
use psb_realloc_mod
|
||||
use psb_sort_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_csall
|
||||
implicit none
|
||||
type(psb_d_sparse_mat), intent(out) :: a
|
||||
integer, intent(in) :: nr,nc
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: nz
|
||||
|
||||
|
||||
info = 0
|
||||
call a%allocate(nr,nc,nz)
|
||||
call a%set_bld()
|
||||
return
|
||||
|
||||
end subroutine psb_d_csall
|
||||
|
||||
|
||||
subroutine psb_d_csput(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
|
||||
use psb_d_base_mat_mod
|
||||
use psb_error_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_csput
|
||||
implicit none
|
||||
type(psb_d_sparse_mat), intent(inout) :: a
|
||||
real(psb_dpk_), intent(in) :: val(:)
|
||||
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: gtl(:)
|
||||
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='psb_csput'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.a%is_bld()) then
|
||||
info = 1121
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
call a%a%csput(nz,val,ia,ja,imin,imax,jmin,jmax,info,gtl)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine psb_d_csput
|
||||
|
||||
|
||||
|
||||
subroutine psb_d_spcnv(a,b,info,type,mold,upd,dupl)
|
||||
use psb_error_mod
|
||||
use psb_string_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_spcnv
|
||||
implicit none
|
||||
type(psb_d_sparse_mat), intent(in) :: a
|
||||
type(psb_d_sparse_mat), intent(out) :: b
|
||||
integer, intent(out) :: info
|
||||
integer,optional, intent(in) :: dupl, upd
|
||||
character(len=*), optional, intent(in) :: type
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: mold
|
||||
|
||||
|
||||
class(psb_d_base_sparse_mat), allocatable :: altmp
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='psb_cscnv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (a%is_null()) then
|
||||
info = 1121
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(dupl)) then
|
||||
call b%set_dupl(dupl)
|
||||
else if (a%is_bld()) then
|
||||
! Does this make sense at all?? Who knows..
|
||||
call b%set_dupl(psb_dupl_def_)
|
||||
end if
|
||||
|
||||
if (count( (/present(mold),present(type) /)) > 1) then
|
||||
info = 583
|
||||
call psb_errpush(info,name,a_err='TYPE, MOLD')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (present(mold)) then
|
||||
|
||||
allocate(altmp, source=mold,stat=info)
|
||||
|
||||
else if (present(type)) then
|
||||
|
||||
select case (psb_toupper(type))
|
||||
case ('CSR')
|
||||
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
|
||||
case ('COO')
|
||||
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
|
||||
case default
|
||||
info = 136
|
||||
call psb_errpush(info,name,a_err=type)
|
||||
goto 9999
|
||||
end select
|
||||
else
|
||||
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
|
||||
end if
|
||||
|
||||
if (info /= 0) then
|
||||
info = 4000
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call altmp%cp_from_fmt(a%a, info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = 4010
|
||||
call psb_errpush(info,name,a_err="mv_from")
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call move_alloc(altmp,b%a)
|
||||
call b%set_asb()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine psb_d_spcnv
|
||||
|
||||
subroutine psb_d_spcnv_ip(a,info,type,mold,dupl)
|
||||
use psb_error_mod
|
||||
use psb_string_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_spcnv_ip
|
||||
implicit none
|
||||
|
||||
type(psb_d_sparse_mat), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
integer,optional, intent(in) :: dupl
|
||||
character(len=*), optional, intent(in) :: type
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: mold
|
||||
|
||||
|
||||
class(psb_d_base_sparse_mat), allocatable :: altmp
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='psb_cscnv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (a%is_null()) then
|
||||
info = 1121
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(dupl)) then
|
||||
call a%set_dupl(dupl)
|
||||
else if (a%is_bld()) then
|
||||
call a%set_dupl(psb_dupl_def_)
|
||||
end if
|
||||
|
||||
if (count( (/present(mold),present(type) /)) > 1) then
|
||||
info = 583
|
||||
call psb_errpush(info,name,a_err='TYPE, MOLD')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (present(mold)) then
|
||||
|
||||
allocate(altmp, source=mold,stat=info)
|
||||
|
||||
else if (present(type)) then
|
||||
|
||||
select case (psb_toupper(type))
|
||||
case ('CSR')
|
||||
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
|
||||
case ('COO')
|
||||
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
|
||||
case default
|
||||
info = 136
|
||||
call psb_errpush(info,name,a_err=type)
|
||||
goto 9999
|
||||
end select
|
||||
else
|
||||
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
|
||||
end if
|
||||
|
||||
|
||||
if (info /= 0) then
|
||||
info = 4000
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(altmp)) then
|
||||
call altmp%mv_from_fmt(a%a, info)
|
||||
else
|
||||
write(0,*) 'Unallocated altmp??'
|
||||
info = -1
|
||||
end if
|
||||
if (info /= 0) then
|
||||
info = 4010
|
||||
call psb_errpush(info,name,a_err="mv_from")
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call move_alloc(altmp,a%a)
|
||||
call a%set_asb()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine psb_d_spcnv_ip
|
||||
Loading…
Reference in New Issue