psblas3:
base/serial/f03/Makefile base/serial/f03/psb_base_mat_impl.f90 base/serial/f03/psb_c_base_mat_impl.f90 base/serial/f03/psb_c_coo_impl.f90 base/serial/f03/psb_c_csc_impl.f90 base/serial/f03/psb_c_csr_impl.f90 base/serial/f03/psb_c_mat_impl.F90 base/serial/f03/psb_d_base_mat_impl.f90 base/serial/f03/psb_d_coo_impl.f90 base/serial/f03/psb_d_csc_impl.f90 base/serial/f03/psb_d_csr_impl.f90 base/serial/f03/psb_d_mat_impl.F90 base/serial/f03/psb_s_base_mat_impl.f90 base/serial/f03/psb_s_coo_impl.f90 base/serial/f03/psb_s_csc_impl.f90 base/serial/f03/psb_s_csr_impl.f90 base/serial/f03/psb_s_mat_impl.F90 base/serial/f03/psb_z_base_mat_impl.f90 base/serial/f03/psb_z_coo_impl.f90 base/serial/f03/psb_z_csc_impl.f90 base/serial/f03/psb_z_csr_impl.f90 base/serial/f03/psb_z_mat_impl.F90 Change name of f03 subdir, step 1psblas3-type-indexed
Salvatore Filippone
14 years ago
parent
5b24b3695c
commit
45414785de
@ -1,44 +0,0 @@
|
||||
include ../../../Make.inc
|
||||
|
||||
#
|
||||
# The object files
|
||||
#
|
||||
BOBJS=psb_base_mat_impl.o psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o
|
||||
SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o
|
||||
DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o
|
||||
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o
|
||||
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o
|
||||
|
||||
OBJS=$(BOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS)
|
||||
|
||||
#
|
||||
# Where the library should go, and how it is called.
|
||||
# Note that we are regenerating most of libsparker.a on the fly.
|
||||
SPARKERDIR=..
|
||||
LIBDIR=../..
|
||||
MODDIR=../../modules
|
||||
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG)$(MODDIR) $(FMFLAG)$(SPARKERDIR) $(FMFLAG).
|
||||
#LIBNAME=libsparker.a
|
||||
LIBFILE=$(LIBDIR)/$(LIBNAME)
|
||||
|
||||
#
|
||||
# No change should be needed below
|
||||
#
|
||||
|
||||
|
||||
default: lib
|
||||
|
||||
lib: $(OBJS)
|
||||
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(LIBDIR)/$(LIBNAME)
|
||||
|
||||
# A bit excessive, but safe
|
||||
$(OBJS): $(MODDIR)/psb_sparse_mod.o
|
||||
|
||||
clean: cleanobjs
|
||||
|
||||
veryclean: cleanobjs
|
||||
|
||||
cleanobjs:
|
||||
/bin/rm -f $(OBJS)
|
||||
|
||||
@ -1,337 +0,0 @@
|
||||
function psb_base_get_nz_row(idx,a) result(res)
|
||||
use psb_error_mod
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_get_nz_row
|
||||
implicit none
|
||||
integer, intent(in) :: idx
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='base_get_nz_row'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
res = -1
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end function psb_base_get_nz_row
|
||||
|
||||
function psb_base_get_nzeros(a) result(res)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_get_nzeros
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='base_get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
res = -1
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end function psb_base_get_nzeros
|
||||
|
||||
function psb_base_get_size(a) result(res)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_get_size
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
integer :: res
|
||||
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='get_size'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
res = -1
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end function psb_base_get_size
|
||||
|
||||
subroutine psb_base_reinit(a,clear)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_reinit
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
logical, intent(in), optional :: clear
|
||||
|
||||
Integer :: err_act, info
|
||||
character(len=20) :: name='reinit'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
info = psb_err_missing_override_method_
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_reinit
|
||||
|
||||
subroutine psb_base_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_sparse_print
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: iout
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
integer, intent(in), optional :: iv(:)
|
||||
integer, intent(in), optional :: eirs,eics
|
||||
character(len=*), optional :: head
|
||||
integer, intent(in), optional :: ivr(:), ivc(:)
|
||||
|
||||
Integer :: err_act, info
|
||||
character(len=20) :: name='sparse_print'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
info = psb_err_missing_override_method_
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_sparse_print
|
||||
|
||||
subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_csgetptn
|
||||
implicit none
|
||||
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: imin,imax
|
||||
integer, intent(out) :: nz
|
||||
integer, allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer,intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer, intent(in), optional :: iren(:)
|
||||
integer, intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='csget'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_csgetptn
|
||||
|
||||
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_get_neigh
|
||||
use psb_error_mod
|
||||
use psb_realloc_mod
|
||||
use psb_sort_mod
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(in) :: a
|
||||
integer, intent(in) :: idx
|
||||
integer, intent(out) :: n
|
||||
integer, allocatable, intent(out) :: neigh(:)
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: lev
|
||||
|
||||
integer :: lev_, i, nl, ifl,ill,&
|
||||
& n1, err_act, nn, nidx,ntl,ma
|
||||
integer, allocatable :: ia(:), ja(:)
|
||||
character(len=20) :: name='get_neigh'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if(present(lev)) then
|
||||
lev_ = lev
|
||||
else
|
||||
lev_=1
|
||||
end if
|
||||
! Turns out we can write get_neigh at this
|
||||
! level
|
||||
n = 0
|
||||
ma = a%get_nrows()
|
||||
call a%csget(idx,idx,n,ia,ja,info)
|
||||
if (info == psb_success_) call psb_realloc(n,neigh,info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
end if
|
||||
neigh(1:n) = ja(1:n)
|
||||
ifl = 1
|
||||
ill = n
|
||||
do nl = 2, lev_
|
||||
n1 = ill - ifl + 1
|
||||
call psb_ensure_size(ill+n1*n1,neigh,info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
end if
|
||||
ntl = 0
|
||||
do i=ifl,ill
|
||||
nidx=neigh(i)
|
||||
if ((nidx /= idx).and.(nidx > 0).and.(nidx <= ma)) then
|
||||
call a%csget(nidx,nidx,nn,ia,ja,info)
|
||||
if (info == psb_success_) call psb_ensure_size(ill+ntl+nn,neigh,info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
end if
|
||||
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
|
||||
ntl = ntl+nn
|
||||
end if
|
||||
end do
|
||||
call psb_msort_unique(neigh(ill+1:ill+ntl),nn)
|
||||
ifl = ill + 1
|
||||
ill = ill + nn
|
||||
end do
|
||||
call psb_msort_unique(neigh(1:ill),nn,dir=psb_sort_up_)
|
||||
n = nn
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_get_neigh
|
||||
|
||||
subroutine psb_base_allocate_mnnz(m,n,a,nz)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_allocate_mnnz
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
integer, intent(in) :: m,n
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
integer, intent(in), optional :: nz
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='allocate_mnz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_allocate_mnnz
|
||||
|
||||
subroutine psb_base_reallocate_nz(nz,a)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_reallocate_nz
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
integer, intent(in) :: nz
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_reallocate_nz
|
||||
|
||||
subroutine psb_base_free(a)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_free
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='free'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_free
|
||||
|
||||
subroutine psb_base_trim(a)
|
||||
use psb_base_mat_mod, psb_protect_name => psb_base_trim
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_base_sparse_mat), intent(inout) :: a
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='trim'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
! This is the base version. If we get here
|
||||
! it means the derived class is incomplete,
|
||||
! so we throw an error.
|
||||
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
|
||||
|
||||
if (err_act /= psb_act_ret_) then
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psb_base_trim
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue