From 83db627d526eb2d6e87538da0cc50bf6bd6a93b2 Mon Sep 17 00:00:00 2001 From: Alfredo Buttari Date: Mon, 12 Sep 2005 17:10:01 +0000 Subject: [PATCH] *** empty log message *** --- Make.inc | 7 +- Makefile | 5 +- src/comm/Makefile | 5 ++ src/internals/Makefile | 5 ++ src/methd/Makefile | 15 ++-- src/methd/psb_dbicg.f90 | 2 +- src/methd/psb_dcg.f90 | 4 +- src/methd/psb_dcgs.f90 | 2 +- src/methd/psb_dcgstab.f90 | 20 ++--- src/methd/psb_dcgstabl.f90 | 2 +- src/methd/psb_dgmresr.f90 | 2 +- src/modules/Makefile | 6 ++ src/modules/psb_blacs_mod.f90 | 4 +- src/modules/psb_comm_mod.f90 | 4 +- src/modules/psb_const.fh | 3 +- src/modules/psb_const_mod.f90 | 4 +- src/modules/psb_prec_mod.f90 | 12 +++ src/modules/psb_prec_type.f90 | 2 +- src/modules/psb_tools_mod.f90 | 6 +- src/prec/Makefile | 17 ++-- src/prec/psb_dbldaggrmat.f90 | 58 ++++++------- src/prec/psb_dcslu.f90 | 26 ++++-- src/prec/psb_dcsrsetup.f90 | 8 +- src/prec/psb_dgenaggrmap.f90 | 2 +- src/prec/psb_dprec.f90 | 38 ++++----- src/prec/psb_dprecbld.f90 | 52 ++++++++---- src/prec/psb_dprecset.f90 | 16 ++-- src/prec/psb_dsplu.f90 | 10 +-- src/psblas/Makefile | 13 ++- src/psblas/psb_daxpby.f90 | 32 +++---- src/psblas/psb_dnrm2.f90 | 72 ++++++++-------- src/psblas/psb_dnrmi.f90 | 17 ++-- src/psblas/psb_dspmm.f90 | 154 +++++++++++++++++----------------- src/psblas/psb_dspsm.f90 | 108 +++++++++++++----------- src/serial/Makefile | 12 +++ src/serial/aux/Makefile | 6 +- src/serial/coo/Makefile | 4 +- src/serial/csr/Makefile | 2 + src/serial/dp/Makefile | 2 + src/serial/f77/Makefile | 2 + src/serial/jad/Makefile | 2 + src/tools/Makefile | 5 ++ src/tools/psb_dallc.f90 | 2 +- 43 files changed, 433 insertions(+), 337 deletions(-) diff --git a/Make.inc b/Make.inc index 3ed867b0..3c9db7cf 100644 --- a/Make.inc +++ b/Make.inc @@ -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) diff --git a/Makefile b/Makefile index c176825f..3d8bc806 100644 --- a/Makefile +++ b/Makefile @@ -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)) diff --git a/src/comm/Makefile b/src/comm/Makefile index 4781eaf1..9fde8262 100644 --- a/src/comm/Makefile +++ b/src/comm/Makefile @@ -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 diff --git a/src/internals/Makefile b/src/internals/Makefile index c7716ea7..d1bb5e62 100644 --- a/src/internals/Makefile +++ b/src/internals/Makefile @@ -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 diff --git a/src/methd/Makefile b/src/methd/Makefile index 3cec4fe7..846da9f6 100644 --- a/src/methd/Makefile +++ b/src/methd/Makefile @@ -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 diff --git a/src/methd/psb_dbicg.f90 b/src/methd/psb_dbicg.f90 index 53b53bbe..2ca7b9f9 100644 --- a/src/methd/psb_dbicg.f90 +++ b/src/methd/psb_dbicg.f90 @@ -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_) diff --git a/src/methd/psb_dcg.f90 b/src/methd/psb_dcg.f90 index b06f8cb1..1f710608 100644 --- a/src/methd/psb_dcg.f90 +++ b/src/methd/psb_dcg.f90 @@ -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) diff --git a/src/methd/psb_dcgs.f90 b/src/methd/psb_dcgs.f90 index e972616e..6ed6b73f 100644 --- a/src/methd/psb_dcgs.f90 +++ b/src/methd/psb_dcgs.f90 @@ -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_) diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 9c7e1221..a5301909 100644 --- a/src/methd/psb_dcgstab.f90 +++ b/src/methd/psb_dcgstab.f90 @@ -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 diff --git a/src/methd/psb_dcgstabl.f90 b/src/methd/psb_dcgstabl.f90 index 3f50c4b8..69e10d25 100644 --- a/src/methd/psb_dcgstabl.f90 +++ b/src/methd/psb_dcgstabl.f90 @@ -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_) diff --git a/src/methd/psb_dgmresr.f90 b/src/methd/psb_dgmresr.f90 index 06b5512a..f20e4223 100644 --- a/src/methd/psb_dgmresr.f90 +++ b/src/methd/psb_dgmresr.f90 @@ -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_) diff --git a/src/modules/Makefile b/src/modules/Makefile index a8626a2f..229823bb 100644 --- a/src/modules/Makefile +++ b/src/modules/Makefile @@ -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 + diff --git a/src/modules/psb_blacs_mod.f90 b/src/modules/psb_blacs_mod.f90 index 8c50bb03..8d08e463 100644 --- a/src/modules/psb_blacs_mod.f90 +++ b/src/modules/psb_blacs_mod.f90 @@ -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 diff --git a/src/modules/psb_comm_mod.f90 b/src/modules/psb_comm_mod.f90 index d2742f61..963e4424 100644 --- a/src/modules/psb_comm_mod.f90 +++ b/src/modules/psb_comm_mod.f90 @@ -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 diff --git a/src/modules/psb_const.fh b/src/modules/psb_const.fh index 64cffec7..60179f89 100644 --- a/src/modules/psb_const.fh +++ b/src/modules/psb_const.fh @@ -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' diff --git a/src/modules/psb_const_mod.f90 b/src/modules/psb_const_mod.f90 index 725880fc..c81f26c1 100644 --- a/src/modules/psb_const_mod.f90 +++ b/src/modules/psb_const_mod.f90 @@ -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' diff --git a/src/modules/psb_prec_mod.f90 b/src/modules/psb_prec_mod.f90 index 59913868..e710d9fd 100644 --- a/src/modules/psb_prec_mod.f90 +++ b/src/modules/psb_prec_mod.f90 @@ -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 diff --git a/src/modules/psb_prec_type.f90 b/src/modules/psb_prec_type.f90 index cdc98812..947165da 100644 --- a/src/modules/psb_prec_type.f90 +++ b/src/modules/psb_prec_type.f90 @@ -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,& diff --git a/src/modules/psb_tools_mod.f90 b/src/modules/psb_tools_mod.f90 index 97ff1099..7fff4178 100644 --- a/src/modules/psb_tools_mod.f90 +++ b/src/modules/psb_tools_mod.f90 @@ -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(:) diff --git a/src/prec/Makefile b/src/prec/Makefile index 9a3836a2..f22ba3f8 100644 --- a/src/prec/Makefile +++ b/src/prec/Makefile @@ -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 diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index 679c95e7..c6fbc108 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -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) diff --git a/src/prec/psb_dcslu.f90 b/src/prec/psb_dcslu.f90 index db9d7271..d05a62bf 100644 --- a/src/prec/psb_dcslu.f90 +++ b/src/prec/psb_dcslu.f90 @@ -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 diff --git a/src/prec/psb_dcsrsetup.f90 b/src/prec/psb_dcsrsetup.f90 index be15193a..75c12701 100644 --- a/src/prec/psb_dcsrsetup.f90 +++ b/src/prec/psb_dcsrsetup.f90 @@ -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() diff --git a/src/prec/psb_dgenaggrmap.f90 b/src/prec/psb_dgenaggrmap.f90 index fd1a8757..f9ea91b4 100644 --- a/src/prec/psb_dgenaggrmap.f90 +++ b/src/prec/psb_dgenaggrmap.f90 @@ -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 diff --git a/src/prec/psb_dprec.f90 b/src/prec/psb_dprec.f90 index abc51c9d..87430217 100644 --- a/src/prec/psb_dprec.f90 +++ b/src/prec/psb_dprec.f90 @@ -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' diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index 581dbee1..5c68b3b1 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -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 diff --git a/src/prec/psb_dprecset.f90 b/src/prec/psb_dprecset.f90 index fa934ef4..82ae13d0 100644 --- a/src/prec/psb_dprecset.f90 +++ b/src/prec/psb_dprecset.f90 @@ -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 diff --git a/src/prec/psb_dsplu.f90 b/src/prec/psb_dsplu.f90 index 561d7ca7..c6aca639 100644 --- a/src/prec/psb_dsplu.f90 +++ b/src/prec/psb_dsplu.f90 @@ -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 diff --git a/src/psblas/Makefile b/src/psblas/Makefile index 57781188..c28234a6 100644 --- a/src/psblas/Makefile +++ b/src/psblas/Makefile @@ -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 diff --git a/src/psblas/psb_daxpby.f90 b/src/psblas/psb_daxpby.f90 index 3eeba1bf..0e6860fa 100644 --- a/src/psblas/psb_daxpby.f90 +++ b/src/psblas/psb_daxpby.f90 @@ -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) diff --git a/src/psblas/psb_dnrm2.f90 b/src/psblas/psb_dnrm2.f90 index 63a23a87..acb7f177 100644 --- a/src/psblas/psb_dnrm2.f90 +++ b/src/psblas/psb_dnrm2.f90 @@ -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) diff --git a/src/psblas/psb_dnrmi.f90 b/src/psblas/psb_dnrmi.f90 index 0881c23f..f235c20a 100644 --- a/src/psblas/psb_dnrmi.f90 +++ b/src/psblas/psb_dnrmi.f90 @@ -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 diff --git a/src/psblas/psb_dspmm.f90 b/src/psblas/psb_dspmm.f90 index 3f3e75a8..4f7a8faa 100644 --- a/src/psblas/psb_dspmm.f90 +++ b/src/psblas/psb_dspmm.f90 @@ -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,& diff --git a/src/psblas/psb_dspsm.f90 b/src/psblas/psb_dspsm.f90 index c379efee..e2f52947 100644 --- a/src/psblas/psb_dspsm.f90 +++ b/src/psblas/psb_dspsm.f90 @@ -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 diff --git a/src/serial/Makefile b/src/serial/Makefile index cda79acc..64de2266 100644 --- a/src/serial/Makefile +++ b/src/serial/Makefile @@ -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) diff --git a/src/serial/aux/Makefile b/src/serial/aux/Makefile index 38e3f4c5..d1b327e4 100644 --- a/src/serial/aux/Makefile +++ b/src/serial/aux/Makefile @@ -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 diff --git a/src/serial/coo/Makefile b/src/serial/coo/Makefile index 8b48ce82..0e4aaeca 100644 --- a/src/serial/coo/Makefile +++ b/src/serial/coo/Makefile @@ -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 diff --git a/src/serial/csr/Makefile b/src/serial/csr/Makefile index 232d90f5..76984b94 100644 --- a/src/serial/csr/Makefile +++ b/src/serial/csr/Makefile @@ -25,6 +25,8 @@ INCDIRS=-I. -I$(LIBDIR) default: lib lib: $(OBJS) + $(AR) $(LIBDIR)/$(LIBNAME) $(OBJS) + $(RANLIB) $(LIBDIR)/$(LIBNAME) clean: cleanobjs diff --git a/src/serial/dp/Makefile b/src/serial/dp/Makefile index ac7e1b3f..4c3af854 100644 --- a/src/serial/dp/Makefile +++ b/src/serial/dp/Makefile @@ -29,6 +29,8 @@ INCDIRS=-I. -I$(LIBDIR) lib: $(FOBJS) + $(AR) $(LIBDIR)/$(LIBNAME) $(OBJS) + $(RANLIB) $(LIBDIR)/$(LIBNAME) clean: cleanobjs diff --git a/src/serial/f77/Makefile b/src/serial/f77/Makefile index 581cae9f..d64a2b14 100644 --- a/src/serial/f77/Makefile +++ b/src/serial/f77/Makefile @@ -28,6 +28,8 @@ INCDIRS=-I. -I$(LIBDIR) default: lib lib: $(OBJS) + $(AR) $(LIBDIR)/$(LIBNAME) $(OBJS) + $(RANLIB) $(LIBDIR)/$(LIBNAME) clean: cleanobjs diff --git a/src/serial/jad/Makefile b/src/serial/jad/Makefile index e4996024..2b15d4d8 100644 --- a/src/serial/jad/Makefile +++ b/src/serial/jad/Makefile @@ -23,6 +23,8 @@ INCDIRS=-I. -I$(LIBDIR) default: lib lib: $(OBJS) + $(AR) $(LIBDIR)/$(LIBNAME) $(OBJS) + $(RANLIB) $(LIBDIR)/$(LIBNAME) clean: cleanobjs diff --git a/src/tools/Makefile b/src/tools/Makefile index 004c4e6c..c40cf877 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -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 diff --git a/src/tools/psb_dallc.f90 b/src/tools/psb_dallc.f90 index 37de12d4..1d6cdaec 100644 --- a/src/tools/psb_dallc.f90 +++ b/src/tools/psb_dallc.f90 @@ -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