fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
Alfredo Buttari
2005-09-12 17:10:01 +00:00
parent b20b2cacbb
commit 83db627d52
43 changed files with 433 additions and 337 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Make.inc
+2 -5
View File
@@ -1,4 +1,5 @@
.mod=.mod
.fh=.fh
.SUFFIXES: .f90 $(.mod)
@@ -41,11 +42,7 @@ RANLIB=ranlib
# Do not edit this #
##########################################################
LIBDIR = lib
PSBLASLIB = libpsblas.a
TOOLSLIB = libpsbtools.a
COMMLIB = libpsbcomm.a
METHDLIB = libpsbmethd.a
PRECLIB = libpsbprec.a
LIBNAME = libpsblas.a
TYPEMODS = psb_spmat_type$(.mod) psb_desc_type$(.mod) psb_prec_type$(.mod) psb_realloc_mod$(.mod)
CONSTMODS = psb_tools_const$(.mod)
Makefile
+4 -1
View File
@@ -3,11 +3,14 @@ include Make.inc
library:
( [ -d lib ] || mkdir lib)
(cd src; make lib)
@echo "====================================="
@echo "Compilation Succesfull."
@echo "You can now link to ./lib/libpsblas.a"
clean:
(cd src; make clean)
veryclean:
(cd src; make veryclean)
(cd lib; /bin/rm -f *.a *$(.mod) V*.inc *.pc *.pcl)
(cd lib; /bin/rm -f *.a *$(.mod) *$(.fh))
src/comm/Makefile
+5
View File
@@ -5,8 +5,11 @@ OBJS = psb_dgather.o psb_dhalo.o psb_dovrl.o \
MPFOBJS = psb_dscatter.o
INCDIRS = -I ../../lib -I .
LIBDIR = ../../lib
lib: mpfobjs $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MPFOBJS) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
mpfobjs:
@@ -15,3 +18,5 @@ mpfobjs:
clean:
/bin/rm -f $(MPFOBJS) $(OBJS)
veryclean: clean
src/internals/Makefile
+5
View File
@@ -9,8 +9,11 @@ COBJS = avltree.o
MPFOBJS = psi_dswapdata.o psi_dswaptran.o psi_iswapdata.o \
psi_iswaptran.o psi_extrct_dl.o psi_desc_index.o
INCDIRS = -I ../../lib -I .
LIBDIR = ../../lib
lib: mpfobjs $(FOBJS) $(COBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MPFOBJS) $(FOBJS) $(COBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
mpfobjs:
@@ -19,3 +22,5 @@ mpfobjs:
clean:
/bin/rm -f $(MPFOBJS) $(FOBJS) $(COBJS)
veryclean: clean
src/methd/Makefile
+8 -7
View File
@@ -1,18 +1,17 @@
include ../../Make.inc
LIBDIR=../../lib/
LIBNAME=$(LIBDIR)/$(F90LIB)
LIBDIR=../../lib
HERE=.
F90OBJS= f90_dcgstab.o f90_dcg.o f90_dcgs.o \
f90_dbicg.o f90_dcgstabl.o f90_zcgstab.o f90_dgmresr.o
OBJS= psb_dcgstab.o psb_dcg.o psb_dcgs.o \
psb_dbicg.o psb_dcgstabl.o psb_dgmresr.o
INCDIRS=-I. -I.. -I$(LIBDIR)
lib: $(F90OBJS)
ar -cur $(LIBNAME) $(F90OBJS)
ranlib $(LIBNAME)
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
#$(F90OBJS): $(MODS)
@@ -22,3 +21,5 @@ veryclean: clean
clean:
/bin/rm -f $(F90OBJS) $(LOCAL_MODS)
veryclean: clean
src/methd/psb_dbicg.f90
+1 -1
View File
@@ -95,7 +95,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
if (debug) write(*,*) 'psb_dbicg: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
src/methd/psb_dcg.f90
+2 -2
View File
@@ -88,7 +88,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
@@ -201,7 +201,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
!!$ CALL F90_PSHALO(Z,DECOMP_DATA)
Call psb_prcaply(prec,r,z,desc_a,info,work=aux)
rho_old = rho
rho = f90_psdot(r,z,desc_a,info)
rho = psb_dot(r,z,desc_a,info)
if (it==1) then
call psb_axpby(one,z,zero,p,desc_a,info)
src/methd/psb_dcgs.f90
+1 -1
View File
@@ -93,7 +93,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
Call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
If (debug) Write(*,*) 'psb_dcgs: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
src/methd/psb_dcgstab.f90
+10 -10
View File
@@ -71,7 +71,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Integer, Pointer :: iperm(:), ipnull(:), ipsave(:)
Real(Kind(1.d0)) ::rerr
Integer ::litmax, liter, naux, m, mglob, it,itrac,&
& nprows,npcols,me,mecol, n_row, n_col
& nprows,npcols,myrow,mycol, n_row, n_col
Character ::diagl, diagu
Logical, Parameter :: debug = .false.
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
@@ -92,11 +92,11 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_DCGSTAB',present(istop)
icontxt = desc_a%MATRIX_DATA(CTXT_)
CALL BLACS_GRIDINFO(icontxt,NPROWS,NPCOLS,ME,MECOL)
if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',nprows,npcols,me
icontxt = desc_a%matrix_data(psb_ctxt_)
CALL blacs_gridinfo(icontxt,nprows,npcols,myrow,mycol)
if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',nprows,npcols,myrow
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
@@ -222,7 +222,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
End If
If (rn0 == 0.d0 ) Then
If (itrac /= -1) Then
If (me == 0) Write(itrac,*) 'BiCGSTAB: ',itx,rn0
If (myrow == 0) Write(itrac,*) 'BiCGSTAB: ',itx,rn0
Endif
Exit restart
End If
@@ -231,13 +231,13 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
xni = psb_amax(x,desc_a,info)
rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bni,&
If (myrow == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bni,&
&xni,ani
Endif
Else If (listop == 2) Then
rerr = rni/bn2
If (itrac /= -1) Then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bn2
If (myrow == 0) Write(itrac,'(a,i4,3(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bn2
Endif
Endif
if (info /= 0) Then
@@ -313,7 +313,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
xni = psb_amax(x,desc_a,info)
rerr = rni/(ani*xni+bni)
If (itrac /= -1) Then
If (me == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bni,&
If (myrow == 0) Write(itrac,'(a,i4,5(2x,es10.4))') 'bicgstab: ',itx,rerr,rni,bni,&
&xni,ani
Endif
@@ -321,7 +321,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
rni = psb_nrm2(r,desc_a,info)
rerr = rni/bn2
If (itrac /= -1) Then
If (me == 0) Write(itrac,'(a,i4,3(2x,es10.4)))') 'bicgstab: ',itx,rerr,rni,bn2
If (myrow == 0) Write(itrac,'(a,i4,3(2x,es10.4)))') 'bicgstab: ',itx,rerr,rni,bn2
Endif
Endif
src/methd/psb_dcgstabl.f90
+1 -1
View File
@@ -103,7 +103,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
src/methd/psb_dgmresr.f90
+1 -1
View File
@@ -106,7 +106,7 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
If (debug) Write(0,*) 'psb_dgmres: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
src/modules/Makefile
+6
View File
@@ -10,13 +10,19 @@ MODULES = psb_realloc_mod.o psb_string_mod.o psb_spmat_type.o \
OBJS = error.o parts.o
INCDIRS = -I ../../lib
LIBDIR = ../../lib
psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o
lib: $(MODULES) $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
cp *$(.mod) ./psb_const.fh ../../lib
clean:
/bin/rm -f $(MODULES) $(OBJS) *$(.mod)
veryclean: clean
src/modules/psb_blacs_mod.f90
+2 -2
View File
@@ -1,4 +1,4 @@
module f90blacs
module psb_blacs_mod
interface gebs2d
module procedure igebs2ds, igebs2dv, igebs2dm,&
@@ -2732,4 +2732,4 @@ contains
end subroutine zgamn2dm
end module f90blacs
end module psb_blacs_mod
src/modules/psb_comm_mod.f90
+2 -2
View File
@@ -99,8 +99,8 @@ module psb_comm_mod
subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
& iiglobx, iilocx)
use psb_descriptor_type
real(kind(1.d0)), intent(in) :: locx(:,:)
real(kind(1.d0)), intent(out) :: globx(:,:)
real(kind(1.d0)), intent(in) :: locx(:)
real(kind(1.d0)), intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: iroot, iiglobx, iilocx
src/modules/psb_const.fh
+2 -1
View File
@@ -30,7 +30,7 @@
integer, parameter :: psb_n_dom_ovr_=1
integer, parameter :: psb_nnz_=1
integer, parameter :: psb_no_comm_=-1
integer, parameter :: ione=1, done=1.d0, izero=0, dzero=0.d0
integer, parameter :: ione=1, izero=0
integer, parameter :: itwo=2, ithree=3,mone=-1, psb_root_=0
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
integer, parameter :: psb_nzsizereq_=3
@@ -48,6 +48,7 @@
integer, parameter :: act_ret=0, act_abort=1, no_err=0
real(kind(1.d0)), parameter :: psb_colrow_=0.33, psb_percent_=0.7
real(kind(1.d0)), parameter :: dzero=0.d0, done=1.d0
character, parameter :: psb_all_='A', psb_topdef_=' '
character(len=5) :: psb_fidef_='CSR'
src/modules/psb_const_mod.f90
+3 -1
View File
@@ -1,3 +1,4 @@
module psb_const_mod
integer, parameter :: psb_nohalo_=0, psb_halo_=4
@@ -24,7 +25,7 @@ module psb_const_mod
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0, psb_n_dom_ovr_=1
integer, parameter :: psb_nnz_=1
integer, parameter :: psb_no_comm_=-1
integer, parameter :: ione=1, done=1.d0, izero=0, dzero=0.d0,mone=-1
integer, parameter :: ione=1,izero=0,mone=-1
integer, parameter :: itwo=2, ithree=3, psb_root_=0
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2, psb_nzsizereq_=3
integer, parameter :: psb_del_bnd_=6, psb_srtd_=7
@@ -40,6 +41,7 @@ module psb_const_mod
integer, parameter :: psb_dbleint_=2
real(kind(1.d0)), parameter :: psb_colrow_=0.33, psb_percent_=0.7
real(kind(1.d0)), parameter :: dzero=0.d0, done=1.d0
character, parameter :: psb_all_='A', psb_topdef_=' '
character(len=5) :: psb_fidef_='CSR'
src/modules/psb_prec_mod.f90
+12
View File
@@ -121,4 +121,16 @@ end interface
end subroutine psb_dprecaply1
end interface
interface psb_splu
subroutine psb_dsplu(a,l,u,d,info,blck)
use psb_spmat_type
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck
real(kind(1.d0)), intent(inout) :: d(:)
end subroutine psb_dsplu
end interface
end module psb_prec_mod
src/modules/psb_prec_type.f90
+1 -1
View File
@@ -12,7 +12,7 @@ module psb_prec_type
& asm_=3, ras_=5, ash_=4, rash_=6, ras2lv_=7, ras2lvm_=8,&
& lv2mras_=9, lv2smth_=10, lv2lsm_=11, sl2sm_=12, superlu_=13,&
& new_loc_smth_=14, new_glb_smth_=15, max_prec_=15
! Multilevel stuff.
! Multilevel stuff.
integer, parameter :: no_ml_=0, add_ml_prec_=1, mult_ml_prec_=2
integer, parameter :: new_ml_prec_=3, max_ml_=new_ml_prec_
integer, parameter :: pre_smooth_=1, post_smooth_=2, smooth_both_=3,&
src/modules/psb_tools_mod.f90
+1 -5
View File
@@ -8,7 +8,7 @@ Module psb_tools_mod
implicit none
integer, intent(in) :: m,n
real(kind(1.d0)), pointer :: x(:,:)
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer :: info
integer, optional, intent(in) :: js
end subroutine psb_dalloc
@@ -274,10 +274,6 @@ Module psb_tools_mod
Type(psb_desc_type), intent(out) :: desc_a
integer, intent(out) :: info
end subroutine psb_dscall
end interface
interface psb_scalv
subroutine psb_dscalv(m, v, icontxt, desc_a, info, flag)
use psb_descriptor_type
Integer, intent(in) :: m,icontxt, v(:)
src/prec/Makefile
+8 -9
View File
@@ -2,13 +2,11 @@ include ../../Make.inc
LIBDIR=../../lib/
LIBNAME=$(LIBDIR)/$(F90LIB)
HERE=.
MPFOBJS=dcslu.o psbdbldaggrmat.o
F90OBJS= dcsrsetup.o dcsrlu.o f90_psdprec.o \
dprecbld.o zprecbld.o gps.o psdprecfree.o dprecset.o \
psbdgenaggrmap.o $(MPFOBJS)
MPFOBJS=psb_dcslu.o psb_dbldaggrmat.o
F90OBJS= psb_dcsrsetup.o psb_dprec.o \
psb_dprecbld.o gps.o psb_dprecfree.o psb_dprecset.o \
psb_dgenaggrmap.o psb_dsplu.o $(MPFOBJS)
#dcoocp.o dcoocpadd.o dcoofact.o dcoolu.o dcooluadd.o\
COBJS=fort_slu_impl.o
@@ -17,10 +15,9 @@ INCDIRS=-I. -I.. -I$(LIBDIR)
OBJS=$(F90OBJS) $(COBJS)
lib: mpobjs $(OBJS)
ar -cur $(LIBNAME) $(OBJS)
ranlib $(LIBNAME)
$(AR) $(LIBDIR)/$(LIBNAME) $(MPFOBJS) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
#$(F90OBJS): $(MODS)
mpobjs:
(make $(MPFOBJS) F90="$(MPF90)" F90COPT="$(F90COPT)")
@@ -29,3 +26,5 @@ veryclean: clean
clean:
/bin/rm -f $(OBJS) $(LOCAL_MODS)
veryclean: clean
src/prec/psb_dbldaggrmat.f90
+29 -29
View File
@@ -9,7 +9,7 @@ subroutine psb_dbldaggrmat(a,desc_a,p,info)
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dbaseprec), intent(inout) :: p
type(psb_dbase_prec), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
@@ -85,7 +85,7 @@ contains
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,myprow,mypcol)
np = nprows*npcols
nglob = desc_a%matrix_data(m_)
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
@@ -113,7 +113,7 @@ contains
end if
call psb_spinfo(nztotreq,a,nzt,info)
call psb_spinfo(psb_nztotreq_,a,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spinfo')
@@ -126,7 +126,7 @@ contains
goto 9999
end if
b%infoa(upd_) = 6
b%infoa(psb_upd_) = 6
b%fida = 'COO'
b%m=a%m
b%k=a%k
@@ -138,7 +138,7 @@ contains
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(nztotreq,b,nzt,info)
call psb_spinfo(psb_nztotreq_,b,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
@@ -163,14 +163,14 @@ contains
goto 9999
end if
call psb_spinfo(nztotreq,b,nzl,info)
call psb_spinfo(psb_nztotreq_,b,nzl,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spinfo')
goto 9999
end if
nzl = nzl - jl
tmp%fida = 'COO'
tmp%infoa(nnz_) = nzl
tmp%infoa(psb_nnz_) = nzl
tmp%aspk => b%aspk(jl+1:jl+nzl)
tmp%ia1 => b%ia1(jl+1:jl+nzl)
tmp%ia2 => b%ia2(jl+1:jl+nzl)
@@ -179,8 +179,8 @@ contains
call psb_errpush(4010,name,a_err='psb_fixcoo')
goto 9999
end if
nzl = tmp%infoa(nnz_)
b%infoa(nnz_) = jl+nzl
nzl = tmp%infoa(psb_nnz_)
b%infoa(psb_nnz_) = jl+nzl
jl = jl + nzl
enddo
end if
@@ -192,7 +192,7 @@ contains
goto 9999
end if
irs = b%infoa(nnz_)
irs = b%infoa(psb_nnz_)
call psb_spreall(b,irs,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall')
@@ -235,7 +235,7 @@ contains
bg%m = ntaggr
bg%k = ntaggr
bg%infoa(nnz_) = nzbg
bg%infoa(psb_nnz_) = nzbg
bg%fida='COO'
bg%descra='G'
call psb_fixcoo(bg,info)
@@ -327,7 +327,7 @@ contains
np = nprows*npcols
nglob = desc_a%matrix_data(m_)
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
@@ -399,14 +399,14 @@ contains
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
end do
am4%infoa(nnz_) = ncol
am4%infoa(psb_nnz_) = ncol
else
do i=1,nrow
am4%aspk(i) = one
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
end do
am4%infoa(nnz_) = nrow
am4%infoa(psb_nnz_) = nrow
endif
am4%fida='COO'
am4%m=ncol
@@ -419,7 +419,7 @@ contains
if (test_dump) call &
& csprt(20+me,am4,head='% Operator Ptilde.',ivr=desc_a%loc_to_glob)
& psb_csprt(20+me,am4,head='% Operator Ptilde.',ivr=desc_a%loc_to_glob)
call psb_ipcoo2csr(am4,info)
@@ -465,7 +465,7 @@ contains
call dgamx2d(icontxt,'All',' ',1,1,anorm,1,itemp,jtemp,-1,-1,-1)
else
anorm = f90_psnrmi(am3,desc_a,info)
anorm = psb_nrmi(am3,desc_a,info)
endif
omega = 4.d0/(3.d0*anorm)
p%dprcparm(smooth_omega_) = omega
@@ -491,7 +491,7 @@ contains
end do
end do
else if (am3%fida=='COO') then
do j=1,am3%infoa(nnz_)
do j=1,am3%infoa(psb_nnz_)
if (am3%ia1(j) /= am3%ia2(j)) then
am3%aspk(j) = - omega*am3%aspk(j)
else
@@ -504,7 +504,7 @@ contains
goto 9999
end if
if (test_dump) call csprt(40+me,am3,head='% (I-wDA)',ivr=desc_a%loc_to_glob,&
if (test_dump) call psb_csprt(40+me,am3,head='% (I-wDA)',ivr=desc_a%loc_to_glob,&
& ivc=desc_a%loc_to_glob)
!
! Symbmm90 does the allocation for its result.
@@ -564,7 +564,7 @@ contains
if (p%iprcparm(smth_kind_) == smth_omg_) then
call psb_transp(am1,am2,fmt='COO')
nzl = am2%infoa(nnz_)
nzl = am2%infoa(psb_nnz_)
i=0
!
! Now we have to fix this. The only rows of B that are correct
@@ -579,7 +579,7 @@ contains
end if
end do
am2%infoa(nnz_) = i
am2%infoa(psb_nnz_) = i
call psb_ipcoo2csr(am2,info)
else
call psb_transp(am1,am2)
@@ -648,8 +648,8 @@ contains
call psb_spclone(b,bg,info)
if(info /= 0) goto 9999
nzbg = bg%infoa(nnz_)
nzl = bg%infoa(nnz_)
nzbg = bg%infoa(psb_nnz_)
nzl = bg%infoa(psb_nnz_)
allocate(ivall(ntaggr))
@@ -723,7 +723,7 @@ contains
p%av(ap_nd_)%ia2(k) = bg%ia2(i)
endif
enddo
p%av(ap_nd_)%infoa(nnz_) = k
p%av(ap_nd_)%infoa(psb_nnz_) = k
call psb_ipcoo2csr(p%av(ap_nd_),info)
if(info /= 0) then
@@ -741,7 +741,7 @@ contains
if (np>1) then
call psb_spinfo(nztotreq,am1,nzl,info)
call psb_spinfo(psb_nztotreq_,am1,nzl,info)
call psb_glob_to_loc(am1%ia1(1:nzl),p%desc_data,info,'I')
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc')
@@ -757,7 +757,7 @@ contains
goto 9999
end if
nzl = am2%infoa(nnz_)
nzl = am2%infoa(psb_nnz_)
call psb_glob_to_loc(am2%ia1(1:nzl),p%desc_data,info,'I')
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc')
@@ -776,7 +776,7 @@ contains
!
!
nzbr(:) = 0
nzbr(myprow+1) = b%infoa(nnz_)
nzbr(myprow+1) = b%infoa(psb_nnz_)
call psb_dscrep(ntaggr,icontxt,p%desc_data,info)
@@ -803,7 +803,7 @@ contains
bg%m = ntaggr
bg%k = ntaggr
bg%infoa(nnz_) = nzbg
bg%infoa(psb_nnz_) = nzbg
bg%fida='COO'
bg%descra='G'
call psb_fixcoo(bg,info)
@@ -845,7 +845,7 @@ contains
!
!
nzbr(:) = 0
nzbr(myprow+1) = b%infoa(nnz_)
nzbr(myprow+1) = b%infoa(psb_nnz_)
call psb_dscrep(ntaggr,icontxt,p%desc_data,info)
@@ -879,7 +879,7 @@ contains
bg%m = ntaggr
bg%k = ntaggr
bg%infoa(nnz_) = nzbg
bg%infoa(psb_nnz_) = nzbg
bg%fida='COO'
bg%descra='G'
call psb_fixcoo(bg,info)
src/prec/psb_dcslu.f90
+19 -7
View File
@@ -17,6 +17,7 @@
!*****************************************************************************
subroutine psb_dcslu(a,desc_a,p,upd,info)
use psb_serial_mod
use psb_const_mod
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
@@ -44,10 +45,21 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
external mpi_wtime
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, ione, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr
integer ::icontxt,nprow,npcol,me,mycol
character(len=20) :: name, ch_err
interface
subroutine psb_dsplu(a,l,u,d,info,blck)
use psb_spmat_type
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck
real(kind(1.d0)), intent(inout) :: d(:)
end subroutine psb_dsplu
end interface
info=0
name='psb_dcslu'
call psb_erractionsave(err_act)
@@ -109,7 +121,7 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
call psb_nullify_sp(p%av(k))
end do
nrow_a = desc_a%matrix_data(psb_n_row_)
call psb_spinfo(nztotreq,a,nztota,info)
call psb_spinfo(psb_nztotreq_,a,nztota,info)
if(info/=0) then
info=4010
ch_err='psb_spinfo'
@@ -157,8 +169,8 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
! Here we allocate a full copy to hold local A and received BLK
!
call psb_spinfo(nztotreq,a,nztota,info)
call psb_spinfo(nztotreq,blck,nztotb,info)
call psb_spinfo(psb_nztotreq_,a,nztota,info)
call psb_spinfo(psb_nztotreq_,blck,nztotb,info)
call psb_spall(atmp,nztota+nztotb,info)
if(info/=0) then
info=4011
@@ -199,7 +211,7 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spfree(atmp,info)
if(info/=0) then
info=4010
@@ -309,7 +321,7 @@ contains
atmp%descra = 'GUN'
! This is the renumbering coherent with global indices..
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
!
! Remember: we have switched IA1=COLS and IA2=ROWS
! Now identify the set of distinct local column indices
@@ -457,7 +469,7 @@ contains
itmp(1:8) = 0
! write(0,*) me,' Renumbering: Calling Metis'
! call blacs_barrier(icontxt,'All')
ione = 1
! write(0,*) size(p%av(u_pr_)%pl),size(p%av(l_pr_)%pr)
call gps_reduction(atmp%m,atmp%ia2,atmp%ia1,p%perm,p%invperm,info)
if(info/=0) then
src/prec/psb_dcsrsetup.f90
+4 -4
View File
@@ -74,7 +74,7 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
goto 9999
end if
blk%fida = 'COO'
blk%infoa(nnz_) = 0
blk%infoa(psb_nnz_) = 0
If (upd == 'F') Then
call psb_dsccpy(desc_p,desc_data,info)
@@ -115,7 +115,7 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
goto 9999
end if
blk%fida='COO'
blk%infoa(nnz_)=0
blk%infoa(psb_nnz_)=0
if (debug) write(0,*) 'Calling desccpy'
if (upd == 'F') then
call psb_dsccpy(desc_p,desc_data,info)
@@ -166,7 +166,7 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
n_row = desc_p%matrix_data(psb_n_row_)
t2 = mpi_wtime()
if (debug) write(0,*) 'Before dcsrovr ',blk%fida,blk%m,nnz_,blk%infoa(nnz_)
if (debug) write(0,*) 'Before dcsrovr ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovrb, 0, "st OVR" )
!!$ blk%m = n_row-nrow_a
!!$ blk%k = n_row
@@ -187,7 +187,7 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
goto 9999
end if
if (debug) write(0,*) 'After psb_dcsrovr ',blk%fida,blk%m,nnz_,blk%infoa(nnz_)
if (debug) write(0,*) 'After psb_dcsrovr ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovre, 0, "ed OVR" )
t3 = mpi_wtime()
src/prec/psb_dgenaggrmap.f90
+1 -1
View File
@@ -1,7 +1,7 @@
subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_spmat_type
use psb_serial_mod
use psb_desc_type
use psb_descriptor_type
use psb_error_mod
implicit none
integer, intent(in) :: aggr_type
src/prec/psb_dprec.f90
+19 -19
View File
@@ -18,7 +18,7 @@ subroutine psb_dprecaply(prec,x,y,desc_data,info,trans, work)
! Local variables
character ::trans_
real(kind(1.d0)), pointer :: work_(:)
integer :: icontxt,nprow,npcol,me,mycol,err_act
integer :: icontxt,nprow,npcol,me,mycol,err_act, int_err(5)
logical,parameter :: debug=.false., debugprt=.false.
real(kind(1.d0)), parameter :: one=1.d0, zero=0.d0
external mpi_wtime
@@ -101,7 +101,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
integer, intent(out) :: info
! Local variables
integer :: n_row,n_col
integer :: n_row,n_col, int_err(5)
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act
@@ -127,7 +127,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
case default
info=40
int_err(1)=6
ch_err(2)=trans
ch_err(2:2)=trans
goto 9999
end select
@@ -164,7 +164,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
call psb_bjacaply(prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then
info=4010
ch_err=psb_bjacaply
ch_err='psb_bjacaply'
goto 9999
end if
@@ -199,14 +199,14 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
tx(1:desc_data%matrix_data(psb_n_row_)) = x(1:desc_data%matrix_data(psb_n_row_))
tx(desc_data%matrix_data(psb_n_row_)+1:isz) = zero
if (prec%iprcparm(restr_)==halo_) then
if (prec%iprcparm(restr_)==psb_halo_) then
call psb_halo(tx,prec%desc_data,info,work=aux)
if(info /=0) then
info=4010
ch_err='psb_halo'
goto 9999
end if
else if (prec%iprcparm(restr_) /= none_) then
else if (prec%iprcparm(restr_) /= psb_none_) then
write(0,*) 'Problem in PRCAPLY: Unknown value for restriction ',&
&prec%iprcparm(restr_)
end if
@@ -233,11 +233,11 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
select case (prec%iprcparm(prol_))
case(none_)
case(psb_none_)
! Would work anyway, but since it's supposed to do nothing...
! call f90_psovrl(ty,prec%desc_data,update_type=prec%a_restrict)
case(sum_,avg_)
case(psb_sum_,psb_avg_)
call psb_ovrl(ty,prec%desc_data,info,&
& update_type=prec%iprcparm(prol_),work=aux)
if(info /=0) then
@@ -284,7 +284,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
return
9999 continue
call psb_errpush(info,name,i_err=int_err=a_err=ch_err)
call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error()
@@ -324,7 +324,7 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
real(kind(1.d0)), parameter :: one=1.d0, zero=0.d0
@@ -374,18 +374,18 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
case('N','n')
call psb_spsm(one,prec%av(l_pr_),x,zero,ww,desc_data,info,&
& trans='N',unit=diagl,choice=none_,work=aux)
& trans='N',unit=diagl,choice=psb_none_,work=aux)
ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row)
call psb_spsm(one,prec%av(u_pr_),ww,beta,y,desc_data,info,&
& trans='N',unit=diagu,choice=none_, work=aux)
& trans='N',unit=diagu,choice=psb_none_, work=aux)
if(info /=0) goto 9999
case('T','t','C','c')
call psb_spsm(one,prec%av(u_pr_),x,zero,ww,desc_data,info,&
& trans=trans,unit=diagu,choice=none_, work=aux)
& trans=trans,unit=diagu,choice=psb_none_, work=aux)
ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row)
call psb_spsm(one,prec%av(l_pr_),ww,beta,y,desc_data,info,&
& trans=trans,unit=diagl,choice=none_,work=aux)
& trans=trans,unit=diagl,choice=psb_none_,work=aux)
if(info /=0) goto 9999
end select
@@ -440,11 +440,11 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
if(info /=0) goto 9999
call psb_spsm(one,prec%av(l_pr_),ty,zero,ww,&
& prec%desc_data,info,&
& trans='N',unit='U',choice=none_,work=aux)
& trans='N',unit='U',choice=psb_none_,work=aux)
ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row)
call psb_spsm(one,prec%av(u_pr_),ww,zero,tx,&
& prec%desc_data,info,&
& trans='N',unit='U',choice=none_,work=aux)
& trans='N',unit='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999
end do
@@ -535,7 +535,7 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
real(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
& x2l(:),b2l(:),tz(:),tty(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical, parameter :: debug=.false., debugprt=.false.
@@ -862,7 +862,7 @@ subroutine psb_dprec1(prec,x,desc_data,info,trans)
use psb_error_mod
implicit none
type(pab_desc_type),intent(in) :: desc_data
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:)
integer, intent(out) :: info
@@ -873,7 +873,7 @@ subroutine psb_dprec1(prec,x,desc_data,info,trans)
! Local variables
character :: trans_
integer :: icontxt,nprow,npcol,me,mycol,i, isz, err_act
integer :: icontxt,nprow,npcol,me,mycol,i, isz, err_act, int_err(5)
real(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err
name='psb_dprec1'
src/prec/psb_dprecbld.f90
+34 -18
View File
@@ -4,9 +4,9 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
Use psb_spmat_type
use psb_descriptor_type
use psb_prec_type
use psb_comm_mod
use psb_const_mod
use psb_psblas_mod
Use psb_prec_mod
use psb_error_mod
Implicit None
@@ -37,10 +37,10 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(CTXT_)
icontxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(m_)
mglob = desc_a%matrix_data(psb_m_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
@@ -69,7 +69,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
call psb_nullify_desc(p%baseprecv(1)%desc_data)
select case(p%baseprecv(1)%iprcparm(p_type_))
case (NOPREC_)
case (noprec_)
! Do nothing.
@@ -126,7 +126,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
if (debug) then
allocate(gd(mglob))
call psb_dgatherm(gd, p%baseprecv(1)%d, desc_a, info, iroot=iroot)
call psb_dgather(gd, p%baseprecv(1)%d, desc_a, info, iroot=iroot)
if(info /= 0) then
info=4010
ch_err='psb_dgatherm'
@@ -150,9 +150,9 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
call psb_check_def(p%baseprecv(1)%iprcparm(n_ovr_),'overlap',&
& 0,is_legal_n_ovr)
call psb_check_def(p%baseprecv(1)%iprcparm(restr_),'restriction',&
& halo_,is_legal_restrict)
& psb_halo_,is_legal_restrict)
call psb_check_def(p%baseprecv(1)%iprcparm(prol_),'prolongator',&
& none_,is_legal_prolong)
& psb_none_,is_legal_prolong)
if ((p%baseprecv(1)%iprcparm(iren_)<0).or.(p%baseprecv(1)%iprcparm(iren_)>2)) then
write(0,*) 'Bad PREC%IRENUM value, defaulting to 0', &
@@ -271,6 +271,22 @@ subroutine psb_splu_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_csrsetup
Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_dcsrsetup
end interface
info=0
name='psb_splu_bld'
call psb_erractionsave(err_act)
@@ -295,7 +311,7 @@ subroutine psb_splu_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nza = atmp%infoa(nnz_)
nza = atmp%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done csdp',info,nza,atmp%m,atmp%k
call blacs_barrier(icontxt,'All')
@@ -309,7 +325,7 @@ subroutine psb_splu_bld(a,desc_a,p,info)
goto 9999
end if
nzb = blck%infoa(nnz_)
nzb = blck%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done csrsetup',info,nzb,blck%fida
call blacs_barrier(icontxt,'All')
@@ -334,17 +350,17 @@ subroutine psb_splu_bld(a,desc_a,p,info)
atmp%ia1(nza+j) = blck%ia1(j)
atmp%ia2(nza+j) = blck%ia2(j)
end do
atmp%infoa(nnz_) = nza+nzb
atmp%infoa(psb_nnz_) = nza+nzb
atmp%m = atmp%m + blck%m
atmp%k = max(a%k,blck%k)
else
atmp%infoa(nnz_) = nza
atmp%infoa(psb_nnz_) = nza
atmp%m = a%m
atmp%k = a%k
endif
i=0
do j=1, atmp%infoa(nnz_)
do j=1, atmp%infoa(psb_nnz_)
if (atmp%ia2(j) <= atmp%m) then
i = i + 1
atmp%aspk(i) = atmp%aspk(j)
@@ -352,7 +368,7 @@ subroutine psb_splu_bld(a,desc_a,p,info)
atmp%ia2(i) = atmp%ia2(j)
endif
enddo
atmp%infoa(nnz_) = i
atmp%infoa(psb_nnz_) = i
call psb_ipcoo2csr(atmp,info)
@@ -362,7 +378,7 @@ subroutine psb_splu_bld(a,desc_a,p,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_spinfo(nztotreq,atmp,nzt,info)
call psb_spinfo(psb_nztotreq_,atmp,nzt,info)
if(info /= 0) then
info=4010
ch_err='psb_spinfo'
@@ -471,7 +487,7 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
end if
nrg = p%av(ac_)%m
call psb_spinfo(nztotreq,p%av(ac_),nzg,info)
call psb_spinfo(psb_nztotreq_,p%av(ac_),nzg,info)
call psb_ipcoo2csr(p%av(ac_),info)
if(info /= 0) then
info=4011
@@ -502,7 +518,7 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
goto 9999
end if
k=0
do i=1,p%av(ac_)%infoa(nnz_)
do i=1,p%av(ac_)%infoa(psb_nnz_)
if (p%av(ac_)%ia2(i) <= p%av(ac_)%m) then
k = k + 1
p%av(ac_)%aspk(k) = p%av(ac_)%aspk(i)
@@ -510,9 +526,9 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
p%av(ac_)%ia2(k) = p%av(ac_)%ia2(i)
end if
end do
p%av(ac_)%infoa(nnz_) = k
p%av(ac_)%infoa(psb_nnz_) = k
call psb_ipcoo2csr(p%av(ac_),info)
call psb_spinfo(nztotreq,p%av(ac_),nzg,info)
call psb_spinfo(psb_nztotreq_,p%av(ac_),nzg,info)
call fort_slu_factor(nrg,nzg,&
& p%av(ac_)%aspk,p%av(ac_)%ia2,p%av(ac_)%ia1,p%iprcparm(slu_ptr_),info)
if(info /= 0) then
src/prec/psb_dprecset.f90
+8 -8
View File
@@ -39,8 +39,8 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
case ('NONE','NOPREC')
p%baseprecv(1)%iprcparm(p_type_) = noprec_
p%baseprecv(1)%iprcparm(f_type_) = f_none_
p%baseprecv(1)%iprcparm(restr_) = none_
p%baseprecv(1)%iprcparm(prol_) = none_
p%baseprecv(1)%iprcparm(restr_) = psb_none_
p%baseprecv(1)%iprcparm(prol_) = psb_none_
p%baseprecv(1)%iprcparm(iren_) = 0
p%baseprecv(1)%iprcparm(n_ovr_) = 0
p%baseprecv(1)%iprcparm(jac_sweeps_) = 1
@@ -48,8 +48,8 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
case ('DIAG','DIAGSC')
p%baseprecv(1)%iprcparm(p_type_) = diagsc_
p%baseprecv(1)%iprcparm(f_type_) = f_none_
p%baseprecv(1)%iprcparm(restr_) = none_
p%baseprecv(1)%iprcparm(prol_) = none_
p%baseprecv(1)%iprcparm(restr_) = psb_none_
p%baseprecv(1)%iprcparm(prol_) = psb_none_
p%baseprecv(1)%iprcparm(iren_) = 0
p%baseprecv(1)%iprcparm(n_ovr_) = 0
p%baseprecv(1)%iprcparm(jac_sweeps_) = 1
@@ -57,8 +57,8 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
case ('BJA','ILU')
p%baseprecv(1)%iprcparm(p_type_) = bja_
p%baseprecv(1)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(1)%iprcparm(restr_) = none_
p%baseprecv(1)%iprcparm(prol_) = none_
p%baseprecv(1)%iprcparm(restr_) = psb_none_
p%baseprecv(1)%iprcparm(prol_) = psb_none_
p%baseprecv(1)%iprcparm(iren_) = 0
p%baseprecv(1)%iprcparm(n_ovr_) = 0
p%baseprecv(1)%iprcparm(ilu_fill_in_) = 0
@@ -68,8 +68,8 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
! Defaults first
p%baseprecv(1)%iprcparm(p_type_) = asm_
p%baseprecv(1)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(1)%iprcparm(restr_) = halo_
p%baseprecv(1)%iprcparm(prol_) = none_
p%baseprecv(1)%iprcparm(restr_) = psb_halo_
p%baseprecv(1)%iprcparm(prol_) = psb_none_
p%baseprecv(1)%iprcparm(iren_) = 0
p%baseprecv(1)%iprcparm(n_ovr_) = 1
p%baseprecv(1)%iprcparm(ilu_fill_in_) = 0
src/prec/psb_dsplu.f90
+5 -5
View File
@@ -5,7 +5,7 @@ subroutine psb_dsplu(a,l,u,d,info,blck)
! into L/D/U.
!
!
use psb_spmat_type
use psb_serial_mod
use psb_tools_mod
use psb_error_mod
@@ -22,7 +22,7 @@ subroutine psb_dsplu(a,l,u,d,info,blck)
integer :: i, j, jj, k, kk, l1, l2, ll, low1, low2,m,ma,err_act
real(kind(1.d0)), parameter :: epstol=1.d-12
type(d_spmat), pointer :: blck_
type(psb_dspmat_type), pointer :: blck_
character(len=20) :: name, ch_err
name='psb_dcsrlu'
info = 0
@@ -104,7 +104,7 @@ contains
real(kind(1.d0)), parameter :: epstol=1.d-12
integer, parameter :: nrb=16
logical,parameter :: debug=.false.
type(d_spmat) :: trw
type(psb_dspmat_type) :: trw
character(len=20) :: name, ch_err
name='psb_dspluint'
@@ -170,7 +170,7 @@ contains
end if
do
if (ktrw > trw%infoa(nnz_)) exit
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
! write(0,*)'KKKKK',k
@@ -311,7 +311,7 @@ contains
end if
do
if (ktrw > trw%infoa(nnz_)) exit
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
! write(0,*)'KKKKK',k
src/psblas/Makefile
+6 -7
View File
@@ -1,21 +1,18 @@
include ../../Make.inc
#FCOPT=-O2
F90_PSDOBJS= psb_ddot.o psb_damax.o psb_dasum.o psb_daxpby.o\
OBJS= psb_ddot.o psb_damax.o psb_dasum.o psb_daxpby.o\
psb_dnrm2.o psb_dnrmi.o psb_dspmm.o psb_dspsm.o\
LIBDIR=../../lib
HERE=.
LIBNAME=$(LIBDIR)/$(F90LIB)
INCDIRS=-I. -I.. -I$(LIBDIR)
lib: $(F90_PSDOBJS)
(cd INTERNALS; make lib LIBDIR=../$(LIBDIR) LIBNAME=$(LIBNAME))
ar -cur $(LIBNAME) $(F90_PSDOBJS)
ranlib $(LIBNAME)
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
#$(F90_PSDOBJS): $(MODS)
@@ -24,3 +21,5 @@ veryclean: clean
clean:
/bin/rm -f $(F90_PSDOBJS) $(LOCAL_MODS)
veryclean: clean
src/psblas/psb_daxpby.f90
+16 -16
View File
@@ -32,8 +32,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
real(kind(1.D0)), intent(inout) :: y(:,:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err
@@ -41,10 +41,10 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@@ -87,11 +87,11 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
goto 9999
end if
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
! check vector correctness
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -106,7 +106,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
end if
if ((in.ne.0)) then
if(desc_data(psb_n_row_).gt.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
call daxpby(desc_a%matrix_data(psb_n_col_),in,&
& alpha,x(iix,jjx),size(x,1),beta,&
& y(iiy,jjy),size(y,1),info)
@@ -156,18 +156,18 @@ subroutine psb_psdaxpbyv(alpha, x, beta,y,desc_a,info)
real(kind(1.D0)), intent(inout) :: y(:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err
name='psb_daxpby'
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@@ -182,11 +182,11 @@ subroutine psb_psdaxpbyv(alpha, x, beta,y,desc_a,info)
ix = ione
iy = ione
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
! check vector correctness
call psb_chkvect(m,ione,size(x),ix,ione,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y),iy,ione,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ione,size(x),ix,ione,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ione,size(y),iy,ione,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -199,7 +199,7 @@ subroutine psb_psdaxpbyv(alpha, x, beta,y,desc_a,info)
end if
if ((in.ne.0)) then
if(desc_data(psb_n_row_).gt.0) then
if(desc_a%matrix_data(psb_n_row_).gt.0) then
call daxpby(desc_a%matrix_data(psb_n_col_),ione,&
& alpha,x,size(x),beta,&
& y,size(y),info)
src/psblas/psb_dnrm2.f90
+36 -36
View File
@@ -25,9 +25,9 @@ function psb_dnrm2(x, desc_a, info, jx)
real(kind(1.D0)) :: psb_dnrm2
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim
real(kind(1.d0)) :: nrm2
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
real(kind(1.d0)),pointer :: tmpx(:)
external dcombnrm2
character(len=20) :: name, ch_err
@@ -36,10 +36,10 @@ function psb_dnrm2(x, desc_a, info, jx)
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -58,9 +58,9 @@ function psb_dnrm2(x, desc_a, info, jx)
ijx = 1
endif
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -79,21 +79,21 @@ function psb_dnrm2(x, desc_a, info, jx)
nrm2 = dnrm2( ndim, x(iix,jjx), ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
id = desc_a%ovrlap_elem(i+n_dom_ovr_)
id = desc_a%ovrlap_elem(i+psb_n_dom_ovr_)
dd = dble(id-1)/dble(id)
nrm2 = nrm2 * sqrt(&
& one - dd * ( &
& x(desc_a%ovrlap_elem(i+ovrlp_elem_), jjx) &
& done - dd * ( &
& x(desc_a%ovrlap_elem(i+psb_ovrlp_elem_), jjx) &
& / nrm2 &
& ) ** 2 &
& )
i = i+2
end do
else
nrm2 = zero
nrm2 = dzero
end if
else
nrm2 = zero
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
@@ -136,9 +136,9 @@ function psb_dnrm2v(x, desc_a, info)
real(kind(1.D0)) :: psb_dnrm2v
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim
real(kind(1.d0)) :: nrm2
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
real(kind(1.d0)),pointer :: tmpx(:)
external dcombnrm2
character(len=20) :: name, ch_err
@@ -147,10 +147,10 @@ function psb_dnrm2v(x, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -165,9 +165,9 @@ function psb_dnrm2v(x, desc_a, info)
ix = 1
jx=1
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
call psb_chkvect(m,1,size(x),ix,jx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -186,21 +186,21 @@ function psb_dnrm2v(x, desc_a, info)
nrm2 = dnrm2( ndim, x, ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
id = desc_a%ovrlap_elem(i+n_dom_ovr_)
id = desc_a%ovrlap_elem(i+psb_n_dom_ovr_)
dd = dble(id-1)/dble(id)
nrm2 = nrm2 * sqrt(&
& one - dd * ( &
& x(desc_a%ovrlap_elem(i+ovrlp_elem_)) &
& done - dd * ( &
& x(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) &
& / nrm2 &
& ) ** 2 &
& )
i = i+2
end do
else
nrm2 = zero
nrm2 = dzero
end if
else
nrm2 = zero
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
@@ -245,9 +245,9 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, temp(2), ndim
real(kind(1.d0)) :: nrm2
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
real(kind(1.d0)),pointer :: tmpx(:)
external dcombnrm2
character(len=20) :: name, ch_err
@@ -256,10 +256,10 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -273,9 +273,9 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
ix = 1
jx = 1
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
call psb_chkvect(m,1,size(x),ix,jx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -294,21 +294,21 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
nrm2 = dnrm2( ndim, x, ione )
i=1
do while (desc_a%ovrlap_elem(i) .ne. -1)
id = desc_a%ovrlap_elem(i+n_dom_ovr_)
id = desc_a%ovrlap_elem(i+psb_n_dom_ovr_)
dd = dble(id-1)/dble(id)
nrm2 = nrm2 * sqrt(&
& one - dd * ( &
& x(desc_a%ovrlap_elem(i+ovrlp_elem_)) &
& done - dd * ( &
& x(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) &
& / nrm2 &
& ) ** 2 &
& )
i = i+2
end do
else
nrm2 = zero
nrm2 = dzero
end if
else
nrm2 = zero
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
src/psblas/psb_dnrmi.f90
+9 -8
View File
@@ -19,21 +19,22 @@ function psb_dnrmi(a,desc_a,info)
type(psb_dspmat_type), intent(in) :: a
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)) :: psb_dnrmi
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iia, jja, ia, ja, temp(2)
real(kind(1.d0)) :: nrmi
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iia, jja, ia, ja, temp(2), mdim, ndim, m
real(kind(1.d0)) :: nrmi, dcsnmi
character(len=20) :: name, ch_err
name='psb_dnrmi'
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -47,8 +48,8 @@ function psb_dnrmi(a,desc_a,info)
ia = 1
ja = 1
m = desc_a%matrix_data(m_)
n = desc_a%matrix_data(n_)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
if(info.ne.0) then
@@ -85,7 +86,7 @@ function psb_dnrmi(a,desc_a,info)
nrmi = 0.d0
end if
psb_nrmi = nrmi
psb_dnrmi = nrmi
call psb_erractionrestore(err_act)
return
src/psblas/psb_dspmm.f90
+79 -75
View File
@@ -50,7 +50,7 @@
subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
& trans, k, jx, jy, work, doswap)
use psb_dspmat_type
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
@@ -58,31 +58,34 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
implicit none
real(kind(1.D0)), intent(in) :: alpha, beta
real(kind(1.d0)), intent(inout) :: x(:,:)
real(kind(1.d0)), intent(inout) :: y(:,:)
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
character, intent(in), optional :: trans
integer, intent(in), optional :: k, jx, jy,doswap
real(kind(1.D0)), intent(in) :: alpha, beta
real(kind(1.d0)), intent(inout), target :: x(:,:)
real(kind(1.d0)), intent(inout), target :: y(:,:)
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), optional, pointer :: work(:)
character, intent(in), optional :: trans
integer, intent(in), optional :: k, jx, jy,doswap
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:)
real(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:)
character :: itrans
character(len=20) :: name, ch_err
name='psb_dspmm'
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -112,9 +115,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(doswap)) then
doswap_ = doswap
idoswap = doswap
else
doswap_ = 1
idoswap = 1
endif
if (present(k)) then
@@ -140,8 +143,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_data(m_)
n = desc_data(n_)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
lldx = size(x,1)
@@ -193,8 +196,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -209,12 +212,12 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
if(doswap_.lt.0) x(nrow:ncol,1:ik)=0.d0
if(idoswap.lt.0) x(nrow:ncol,1:ik)=0.d0
ib1=min(nb,ik)
xp => x(iix:lldx,jjx:jjx+ib1-1)
if(doswap_.gt.0)&
& call psi_swapdata(ior(SWAP_SEND,SWAP_RECV),&
if(idoswap.gt.0)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,dzero,xp,desc_a,iwork,info)
!!$ & call PSI_dSwapData(ior(SWAP_SEND,SWAP_RECV),ib1,&
!!$ & dzero,x(iix,jjx),lldx,desc_a%matrix_data,&
@@ -225,29 +228,29 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
ib=ib1
ib1 = max(0,min(nb,(ik)-(i-1+ib)))
xp => x(iix:lldx,jjx+i+ib-1:jjx+i+ib+ib1-2)
if((ib1.gt.0).and.(doswap_.gt.0))&
& call psi_swapdata(SWAP_SEND_,ib1,&
if((ib1.gt.0).and.(idoswap.gt.0))&
& call psi_swapdata(psb_swap_send_,ib1,&
& dzero,xp,desc_a,iwork,info)
!!$ & call PSI_dSwapData(SWAP_SEND,ib1,&
!!$ & dzero,x(iix,jjx+i+ib-1),lldx,desc_a%matrix_data,&
!!$ & desc_a%halo_index,iwork,liwork,info)
if(info.ne.0) exit blk
! local Matrix-vector product
call dcsmm(itran,nrow,ib,ncol,alpha,a%pr,a%fida,&
call dcsmm(itrans,nrow,ib,ncol,alpha,a%pr,a%fida,&
& a%descra,a%aspk,a%ia1,a%ia2,a%infoa,a%pl,&
& x(iix,jjx+i-1),lldx,beta,y(iiy,jjy+i-1),lldy,&
& iwork,liwork,info)
if(info.ne.0) exit blk
if((ib1.gt.0).and.(doswap_.gt.0))&
& call psi_swapdata(SWAP_SEND_,ib1,&
if((ib1.gt.0).and.(idoswap.gt.0))&
& call psi_swapdata(psb_swap_send_,ib1,&
& dzero,xp,desc_a,iwork,info)
!!$ & call PSI_dSwapData(SWAP_RECV,ib1,&
!!$ & dzero,x(iix,jjx+i+ib-1),lldx,desc_a%matrix_data,&
!!$ & desc_a%halo_index,iwork,liwork,info)
if(info.ne.0) exit blk
end do
end do blk
if(info.ne.0) then
info = 4011
@@ -264,15 +267,15 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
if(desc_as%ovrlap_elem(1).ne.-1) then
if(desc_a%ovrlap_elem(1).ne.-1) then
info = 3070
call psb_errpush(info,name)
goto 9999
end if
! checking for vectors correctness
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -287,10 +290,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
if(doswap_.lt.0) y(nrow:ncol,1:ik)=0.d0
if(idoswap.lt.0) y(nrow:ncol,1:ik)=0.d0
! local Matrix-vector product
call dcsmm(itran,ncol,ik,nrow,alpha,a%pr,a%fida,&
call dcsmm(itrans,ncol,ik,nrow,alpha,a%pr,a%fida,&
& a%descra,a%aspk,a%ia1,a%ia2,a%infoa,a%pl,&
& x(iix,jjx),lldx,beta,y(iiy,jjy),lldy,&
& iwork,liwork,info)
@@ -302,8 +305,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
end if
yp => y(iiy:lldy,jjy:jjy+ik-1)
if(doswap_.gt.0)&
& call psi_swaptran(ior(SWAP_SEND,SWAP_RECV),&
if(idoswap.gt.0)&
& call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& ik,done,yp,desc_a,iwork,info)
!!$ & call PSI_dSwapTran(ior(SWAP_SEND,SWAP_RECV),&
!!$ & ik,done,y(iiy,jjy),lldy,desc_a%matrix_data,&
@@ -360,7 +363,7 @@ end subroutine psb_dspmm
subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
& trans, work, doswap)
use psb_dspmat_type
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
@@ -368,31 +371,34 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
implicit none
real(kind(1.D0)), intent(in) :: alpha, beta
real(kind(1.d0)), intent(inout) :: x(:)
real(kind(1.d0)), intent(inout) :: y(:)
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
character, intent(in), optional :: trans
integer, intent(in), optional :: doswap
real(kind(1.D0)), intent(in) :: alpha, beta
real(kind(1.d0)), intent(inout), target :: x(:)
real(kind(1.d0)), intent(inout), target :: y(:)
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), optional, pointer :: work(:)
character, intent(in), optional :: trans
integer, intent(in), optional :: doswap
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
& i, ib, ib1
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:)
real(kind(1.d0)),pointer :: tmpx(:), iwork(:), xp(:), yp(:)
character :: itrans
character(len=20) :: name, ch_err
name='psb_dspmv'
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -413,9 +419,9 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
ik = 1
if (present(doswap)) then
doswap_ = doswap
idoswap = doswap
else
doswap_ = 1
idoswap = 1
endif
if (present(trans)) then
@@ -434,8 +440,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_data(m_)
n = desc_data(n_)
m = desc_a%matrix_data(psb_m_)
n = desc_a%matrix_data(psb_n_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
lldx = size(x,1)
@@ -486,8 +492,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
end if
! checking for vectors correctness
call psb_chkvect(n,ik,size(x),ix,jx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(n,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -502,23 +508,21 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
if(doswap_.lt.0) then
x(nrow:ncol,1:ik)=0.d0
if(idoswap.lt.0) then
x(nrow:ncol)=0.d0
else
call psi_swapdata(ior(SWAP_SEND,SWAP_RECV),&
& dzero,xp,desc_a,iwork,info)
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& dzero,x,desc_a,iwork,info)
!!$ call PSI_dSwapData(ior(SWAP_SEND,SWAP_RECV),1,&
!!$ & dzero,x(iix,jjx),lldx,desc_a%matrix_data,&
!!$ & desc_a%halo_index,iwork,liwork,info)
end if
! local Matrix-vector product
call dcsmm(itran,nrow,ib,ncol,alpha,a%pr,a%fida,&
call dcsmm(itrans,nrow,ib,ncol,alpha,a%pr,a%fida,&
& a%descra,a%aspk,a%ia1,a%ia2,a%infoa,a%pl,&
& xp(iix),lldx,beta,yp(iiy),lldy,&
& x(iix),lldx,beta,y(iiy),lldy,&
& iwork,liwork,info)
if(info.ne.0) exit blk
if(info.ne.0) then
info = 4011
@@ -535,15 +539,15 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
if(desc_as%ovrlap_elem(1).ne.-1) then
if(desc_a%ovrlap_elem(1).ne.-1) then
info = 3070
call psb_errpush(info,name)
goto 9999
end if
! checking for vectors correctness
call psb_chkvect(m,ik,size(x),ix,jx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y),iy,jy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(n,ik,size(y),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect'
@@ -561,10 +565,10 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
xp => x(iix:lldx)
yp => x(iiy:lldy)
if(doswap_.lt.0) y(nrow:ncol,1:ik)=0.d0
if(idoswap.lt.0) y(nrow:ncol)=0.d0
! local Matrix-vector product
call dcsmm(itran,ncol,ik,nrow,alpha,a%pr,a%fida,&
call dcsmm(itrans,ncol,ik,nrow,alpha,a%pr,a%fida,&
& a%descra,a%aspk,a%ia1,a%ia2,a%infoa,a%pl,&
& x(iix),lldx,beta,y(iiy),lldy,&
& iwork,liwork,info)
@@ -575,8 +579,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
if(doswap_.gt.0)&
$ call psi_swaptran(ior(SWAP_SEND,SWAP_RECV),&
if(idoswap.gt.0)&
& call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& done,yp,desc_a,iwork,info)
!!$ & call PSI_dSwapTran(ior(SWAP_SEND,SWAP_RECV),&
!!$ & ik,done,y(iiy,jjy),lldy,desc_a%matrix_data,&
src/psblas/psb_dspsm.f90
+58 -50
View File
@@ -44,7 +44,7 @@
subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, d, k, jx, jy, work)
use psb_dspmat_type
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
@@ -53,33 +53,37 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
implicit none
real(kind(1.D0)), intent(in) :: alpha, beta
real(kind(1.d0)), intent(in) :: x(:,:)
real(kind(1.d0)), intent(inout) :: y(:,:)
real(kind(1.d0)), intent(in), target :: x(:,:)
real(kind(1.d0)), intent(inout), target :: y(:,:)
type (psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: d(:)
real(kind(1.d0)), intent(inout), optional :: work(:)
real(kind(1.d0)), intent(in), optional, target :: d(:)
real(kind(1.d0)), optional, pointer :: work(:)
character, intent(in), optional :: trans, unitd
integer, intent(in), optional :: choice
integer, intent(in), optional :: k, jx, jy
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:)
real(kind(1.d0)),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
character :: itrans
character(len=20) :: name, ch_err
name='psb_dspsm'
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -119,7 +123,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
if (present(choice)) then
lchoice = choice
else
lchoice = AVG_
lchoice = psb_avg_
endif
if (present(unitd)) then
@@ -144,7 +148,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
lldx = size(x,1)
@@ -194,8 +198,8 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
! checking for matrix correctness
call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja)
! checking for vectors correctness
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'
@@ -233,7 +237,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
! update overlap elements
if(lchoice.gt.0) then
yp => y(iiy:lldy,jjy:jjy+ik-1)
call psi_swapdata(ior(SWAP_SEND,SWAP_RECV),ik,&
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),ik,&
& done,yp,desc_a,iwork,info)
!!$ call PSI_dSwapData(ior(SWAP_SEND,SWAP_RECV),ik,&
!!$ & done,y,lldy,desc_a%matrix_data,desc_a%ovrlap_index,&
@@ -242,26 +246,26 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
i=0
! switch on update type
select case (lchoice)
case(SQUARE_ROOT_)
case(psb_square_root_)
do while(desc_a%ovrlap_elem(i).ne.-ione)
y(desc_a%ovrlap_elem(i+ovrlp_elem_),:) =&
& y(desc_a%ovrlap_elem(i+ovrlp_elem_),:)/&
& sqrt(real(desc_a%ovrlap_elem(i+n_dom_ovr_)))
y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_),:) =&
& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_),:)/&
& sqrt(real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_)))
i = i+2
end do
case(AVG_)
case(psb_avg_)
do while(desc_a%ovrlap_elem(i).ne.-ione)
y(desc_a%ovrlap_elem(i+ovrlp_elem_),:) =&
& y(desc_a%ovrlap_elem(i+ovrlp_elem_),:)/&
& real(desc_a%ovrlap_elem(i+n_dom_ovr_))
y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_),:) =&
& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_),:)/&
& real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_))
i = i+2
end do
case(SUM_)
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = 70
int_err=(/10,lchoice/)
int_err=(/10,lchoice,0,0,0/)
call psb_errpush(info,name,i_err=int_err)
goto 9999
end select
@@ -316,7 +320,7 @@ end subroutine psb_dspsm
!
subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, d, work)
use psb_dspmat_type
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
@@ -324,32 +328,36 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
real(kind(1.D0)), intent(in) :: alpha, beta
real(kind(1.d0)), intent(in) :: x(:)
real(kind(1.d0)), intent(inout) :: y(:)
real(kind(1.d0)), intent(in), target :: x(:)
real(kind(1.d0)), intent(inout), target :: y(:)
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: d(:)
real(kind(1.d0)), intent(inout), optional :: work(:)
real(kind(1.d0)), intent(in), optional, target :: d(:)
real(kind(1.d0)), optional, pointer :: work(:)
character, intent(in), optional :: trans, unitd
integer, intent(in), optional :: choice
! locals
integer :: int_err(5), icontxt, nprow, npcol, me, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
character :: lunitd
integer, parameter :: nb=4
real(kind(1.d0)),pointer :: tmpx(:), xp(:), yp(:)
real(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:), id(:)
character :: itrans
character(len=20) :: name, ch_err
name='psb_dspsv'
info=0
call psb_erractionsave(err_act)
icontxt=desc_data(psb_ctxt_)
icontxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@@ -371,7 +379,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
if (present(choice)) then
lchoice = choice
else
lchoice = AVG_
lchoice = psb_avg_
endif
if (present(unitd)) then
@@ -396,7 +404,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
itrans = 'N'
endif
m = desc_data(m_)
m = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
lldx = size(x)
@@ -446,8 +454,8 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
! checking for matrix correctness
call psb_chkmat(m,m,ia,ja,desc_a%matrix_data,info,iia,jja)
! checking for vectors correctness
call psb_chkvect(m,ik,size(x),ix,ijx,desc_data%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,ijy,desc_data%matrix_data,info,iiy,jjy)
call psb_chkvect(m,ik,size(x),ix,ijx,desc_a%matrix_data,info,iix,jjx)
call psb_chkvect(m,ik,size(y),iy,ijy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then
info=4010
ch_err='psb_chkvect/mat'
@@ -485,7 +493,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
! update overlap elements
if(lchoice.gt.0) then
yp => y(iiy:lldy)
call psi_swapdata(ior(SWAP_SEND,SWAP_RECV),&
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& done,yp,desc_a,iwork,info)
!!$ call PSI_dSwapData(ior(SWAP_SEND,SWAP_RECV),ik,&
!!$ & done,y,lldy,desc_a%matrix_data,desc_a%ovrlap_index,&
@@ -494,26 +502,26 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
i=0
! switch on update type
select case (lchoice)
case(SQUARE_ROOT_)
case(psb_square_root_)
do while(desc_a%ovrlap_elem(i).ne.-ione)
y(desc_a%ovrlap_elem(i+ovrlp_elem_)) =&
& y(desc_a%ovrlap_elem(i+ovrlp_elem_))/&
& sqrt(real(desc_a%ovrlap_elem(i+n_dom_ovr_)))
y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) =&
& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_))/&
& sqrt(real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_)))
i = i+2
end do
case(AVG_)
case(psb_avg_)
do while(desc_a%ovrlap_elem(i).ne.-ione)
y(desc_a%ovrlap_elem(i+ovrlp_elem_)) =&
& y(desc_a%ovrlap_elem(i+ovrlp_elem_))/&
& real(desc_a%ovrlap_elem(i+n_dom_ovr_))
y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_)) =&
& y(desc_a%ovrlap_elem(i+psb_ovrlp_elem_))/&
& real(desc_a%ovrlap_elem(i+psb_n_dom_ovr_))
i = i+2
end do
case(SUM_)
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = 70
int_err=(/10,lchoice/)
int_err=(/10,lchoice,0,0,0/)
call psb_errpush(info,name,i_err=int_err)
goto 9999
end select
src/serial/Makefile
+12
View File
@@ -10,8 +10,11 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsdp.o psb_dcsmm.o psb_dcsmv.o \
INCDIRS = -I ../../lib -I .
LIBDIR = ../../lib
lib: auxd cood csrd jadd f77d dpd lib1
$(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
lib1: $(FOBJS)
@@ -43,3 +46,12 @@ clean:
(cd jad; make clean)
(cd dp; make clean)
(cd f77; make clean)
veryclean:
/bin/rm -f $(FOBJS)
(cd aux; make veryclean)
(cd coo; make veryclean)
(cd csr; make veryclean)
(cd jad; make veryclean)
(cd dp; make veryclean)
(cd f77; make veryclean)
src/serial/aux/Makefile
+4 -2
View File
@@ -12,9 +12,8 @@ OBJS=$(FOBJS)
#
# Where the library should go, and how it is called.
# Note that we are regenerating most of libsparker.a on the fly.
#LIBDIR=../../../LIB
LIBDIR=../../../lib
#LIBNAME=libsparker.a
LIBFILE=$(LIBDIR)/$(LIBNAME)
INCDIRS=-I. -I$(LIBDIR)
#
@@ -24,8 +23,11 @@ INCDIRS=-I. -I$(LIBDIR)
default: lib
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean:
/bin/rm -f $(OBJS)
veryclean: clean
src/serial/coo/Makefile
+3 -1
View File
@@ -13,7 +13,7 @@ OBJS=$(FOBJS)
#
# Where the library should go, and how it is called.
# Note that we are regenerating most of libsparker.a on the fly.
#LIBDIR=../../LIB
LIBDIR=../../../lib
#LIBNAME=libsparker.a
LIBFILE=$(LIBDIR)/$(LIBNAME)
SPARKERDIR=..
@@ -27,6 +27,8 @@ INCDIRS=-I. -I$(SPARKERDIR) -I$(LIBDIR)
default: lib
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean: cleanobjs
src/serial/csr/Makefile
+2
View File
@@ -25,6 +25,8 @@ INCDIRS=-I. -I$(LIBDIR)
default: lib
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean: cleanobjs
src/serial/dp/Makefile
+2
View File
@@ -29,6 +29,8 @@ INCDIRS=-I. -I$(LIBDIR)
lib: $(FOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean: cleanobjs
src/serial/f77/Makefile
+2
View File
@@ -28,6 +28,8 @@ INCDIRS=-I. -I$(LIBDIR)
default: lib
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean: cleanobjs
src/serial/jad/Makefile
+2
View File
@@ -23,6 +23,8 @@ INCDIRS=-I. -I$(LIBDIR)
default: lib
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean: cleanobjs
src/tools/Makefile
+5
View File
@@ -12,8 +12,11 @@ FOBJS = psb_dallc.o psb_dasb.o psb_dcsrp.o psb_descprt.o \
MPFOBJS = psb_descasb.o psb_dcsrovr.o
INCDIRS = -I ../../lib -I .
LIBDIR = ../../lib
lib: mpfobjs $(FOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MPFOBJS) $(FOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
mpfobjs:
@@ -22,3 +25,5 @@ mpfobjs:
clean:
/bin/rm -f $(MPFOBJS) $(FOBJS)
veryclean: clean
src/tools/psb_dallc.f90
+1 -1
View File
@@ -22,7 +22,7 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js)
!....parameters...
integer, intent(in) :: m,n
real(kind(1.d0)), pointer :: x(:,:)
type(psb_desc_type), intent(inout) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
integer :: info
integer, optional, intent(in) :: js