diff --git a/src/modules/psb_serial_mod.f90 b/src/modules/psb_serial_mod.f90 index 70472440..ead82596 100644 --- a/src/modules/psb_serial_mod.f90 +++ b/src/modules/psb_serial_mod.f90 @@ -310,21 +310,23 @@ module psb_serial_mod end interface interface psb_coins - subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) + subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild) use psb_spmat_type integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:),gtl(:) real(kind(1.d0)), intent(in) :: val(:) type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, optional, intent(in) :: rebuild end subroutine psb_dcoins - subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) + subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild) use psb_spmat_type integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: ia(:),ja(:),gtl(:) complex(kind(1.d0)), intent(in) :: val(:) type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, optional, intent(in) :: rebuild end subroutine psb_zcoins end interface diff --git a/src/modules/psb_spmat_type.f90 b/src/modules/psb_spmat_type.f90 index f573d7d5..4b0f7725 100644 --- a/src/modules/psb_spmat_type.f90 +++ b/src/modules/psb_spmat_type.f90 @@ -173,7 +173,7 @@ contains ! right after allocate, with spins doing the right thing. ! hopefully :-) - case(psb_spmat_upd_) + case( psb_spmat_upd_) case default info=591 diff --git a/src/modules/psb_tools_mod.f90 b/src/modules/psb_tools_mod.f90 index 36138a31..7b8c77aa 100644 --- a/src/modules/psb_tools_mod.f90 +++ b/src/modules/psb_tools_mod.f90 @@ -535,7 +535,7 @@ Module psb_tools_mod interface psb_spins - subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) + subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js,rebuild) use psb_descriptor_type use psb_spmat_type type(psb_desc_type), intent(inout) :: desc_a @@ -544,6 +544,7 @@ Module psb_tools_mod real(kind(1.d0)), intent(in) :: val(:) integer, intent(out) :: info integer, intent(in), optional :: is,js + logical, intent(in), optional :: rebuild end subroutine psb_dspins subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) use psb_descriptor_type diff --git a/src/serial/Makefile b/src/serial/Makefile index 74f912e3..d8151009 100644 --- a/src/serial/Makefile +++ b/src/serial/Makefile @@ -14,7 +14,6 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsdp.o psb_dcsmm.o psb_dcsmv.o \ psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspinfo.o psb_zspscal.o\ psb_getifield.o psb_setifield.o psb_update_mod.o - INCDIRS = -I ../../lib -I . LIBDIR = ../../lib diff --git a/src/serial/dp/dcocr.f b/src/serial/dp/dcocr.f index 63b60bd7..c72662dd 100644 --- a/src/serial/dp/dcocr.f +++ b/src/serial/dp/dcocr.f @@ -94,18 +94,18 @@ C ELSE IF (LARN.LT.NNZ) THEN IERROR = 60 INT_VAL(1) = 18 - INT_VAL(2) = NNZ+2 - INT_VAL(3) = LAUX + INT_VAL(2) = NNZ + INT_VAL(3) = LARN ELSE IF (LIAN1.LT.NNZ) THEN IERROR = 60 INT_VAL(1) = 19 - INT_VAL(2) = NNZ+2 - INT_VAL(3) = LAUX + INT_VAL(2) = NNZ + INT_VAL(3) = LIAN1 ELSE IF (LIAN2.LT.M+1) THEN IERROR = 60 INT_VAL(1) = 20 - INT_VAL(2) = NNZ+2 - INT_VAL(3) = LAUX + INT_VAL(2) = M+1 + INT_VAL(3) = LIAN2 ENDIF C diff --git a/src/serial/f77/Makefile b/src/serial/f77/Makefile index ba897019..2374337e 100644 --- a/src/serial/f77/Makefile +++ b/src/serial/f77/Makefile @@ -3,7 +3,7 @@ include ../../../Make.inc # # The object files # -FOBJS = daxpby.o dcsmm.o dcsnmi.o dcsrp.o dcssm.o \ +FOBJS = daxpby.o dcsmm.o dcsnmi.o dcsrp.o dcssm.o \ dgelp.o dlpupd.o dswmm.o dswprt.o \ dswsm.o smmp.o dcsrws.o \ zcsnmi.o zaxpby.o zcsmm.o zcssm.o zswmm.o zswsm.o\ diff --git a/src/serial/psb_dcoins.f90 b/src/serial/psb_dcoins.f90 index 164537df..562d5a5c 100644 --- a/src/serial/psb_dcoins.f90 +++ b/src/serial/psb_dcoins.f90 @@ -31,7 +31,7 @@ ! File: psbdcoins.f90 ! Subroutine: ! Parameters: -subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) +subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild) use psb_spmat_type use psb_const_mod @@ -47,6 +47,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) real(kind(1.d0)), intent(in) :: val(:) type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, intent(in), optional :: rebuild character(len=5) :: ufida integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,& @@ -87,11 +88,11 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) goto 9999 end if -!!$ if (present(rebuild)) then -!!$ rebuild_ = rebuild -!!$ else + if (present(rebuild)) then + rebuild_ = rebuild + else rebuild_ = .false. -!!$ end if + end if call touppers(a%fida,ufida) ng = size(gtl) @@ -178,12 +179,16 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) & imin,imax,jmin,jmax,nzl,info) if (info > 0) then if (rebuild_) then - write(0,*) 'COINS: Going through rebuild_ fingers crossed!' + if (debug) write(0,*)& + & 'COINS: Going through rebuild_ fingers crossed!' irst = info call psb_nullify_sp(tmp) tmp%fida='COO' call psb_csdp(a,tmp,info) - call psb_setifield(psb_spmat_bld_,psb_state_,tmp,info) + call psb_sp_setifld(psb_spmat_bld_,psb_state_,tmp,info) + if (debug) then + write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst + endif call psb_sp_transfer(tmp,a,info) call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_spinfo(psb_nzsizereq_,a,isza,info) @@ -194,6 +199,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) goto 9999 endif + if (debug) write(0,*)& + & 'COINS: Reinserting',a%fida,nza,isza if ((nza+nz)>isza) then call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info) if(info /= izero) then @@ -206,6 +213,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) if (irst <= nz) then call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),& & nza,a%ia1,a%ia2,a%aspk,gtl,ng,imin,imax,jmin,jmax,info) + call psb_sp_setifld(nza,psb_del_bnd_,a,info) + call psb_sp_setifld(nza,psb_nnz_,a,info) end if else @@ -292,7 +301,6 @@ contains real(kind(1.d0)), intent(in) :: val(*) real(kind(1.d0)), intent(inout) :: aspk(*) integer, intent(out) :: info - integer :: i,ir,ic info = 0 diff --git a/src/serial/psb_zcoins.f90 b/src/serial/psb_zcoins.f90 index 0f38cead..86943164 100644 --- a/src/serial/psb_zcoins.f90 +++ b/src/serial/psb_zcoins.f90 @@ -31,7 +31,7 @@ ! File: psbzcoins.f90 ! Subroutine: ! Parameters: -subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) +subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild) use psb_spmat_type use psb_const_mod @@ -47,6 +47,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) complex(kind(1.d0)), intent(in) :: val(:) type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, optional, intent(in) :: rebuild character(len=5) :: ufida integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,& @@ -87,11 +88,11 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) goto 9999 end if -!!$ if (present(rebuild)) then -!!$ rebuild_ = rebuild -!!$ else + if (present(rebuild)) then + rebuild_ = rebuild + else rebuild_ = .false. -!!$ end if + end if call touppers(a%fida,ufida) ng = size(gtl) @@ -178,12 +179,16 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) & imin,imax,jmin,jmax,nzl,info) if (info > 0) then if (rebuild_) then - write(0,*) 'COINS: Going through rebuild_ fingers crossed!' + if (debug) write(0,*)& + & 'COINS: Going through rebuild_ fingers crossed!' irst = info call psb_nullify_sp(tmp) tmp%fida='COO' call psb_csdp(a,tmp,info) - call psb_setifield(psb_spmat_bld_,psb_state_,tmp,info) + call psb_sp_setifld(psb_spmat_bld_,psb_state_,tmp,info) + if (debug) then + write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst + endif call psb_sp_transfer(tmp,a,info) call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_spinfo(psb_nzsizereq_,a,isza,info) @@ -194,6 +199,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) goto 9999 endif + if (debug) write(0,*)& + & 'COINS: Reinserting',a%fida,nza,isza if ((nza+nz)>isza) then call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info) if(info /= izero) then @@ -206,6 +213,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) if (irst <= nz) then call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),& & nza,a%ia1,a%ia2,a%aspk,gtl,ng,imin,imax,jmin,jmax,info) + call psb_sp_setifld(nza,psb_del_bnd_,a,info) + call psb_sp_setifld(nza,psb_nnz_,a,info) end if else diff --git a/src/tools/psb_cdins.f90 b/src/tools/psb_cdins.f90 index 82206272..e0354915 100644 --- a/src/tools/psb_cdins.f90 +++ b/src/tools/psb_cdins.f90 @@ -51,7 +51,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js) !....PARAMETERS... Type(psb_desc_type), intent(inout) :: desc_a - Integer, intent(in) :: nz,IA(:),JA(:) + Integer, intent(in) :: nz,ia(:),ja(:) integer, intent(out) :: info integer, intent(in), optional :: is,js diff --git a/src/tools/psb_dspalloc.f90 b/src/tools/psb_dspalloc.f90 index 364cd314..d8fe928d 100644 --- a/src/tools/psb_dspalloc.f90 +++ b/src/tools/psb_dspalloc.f90 @@ -69,7 +69,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) name = 'psb_dspalloc' icontxt = desc_a%matrix_data(psb_ctxt_) - dectype=desc_a%matrix_data(psb_dec_type_) + dectype = desc_a%matrix_data(psb_dec_type_) call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol) ! ....verify blacs grid correctness.. if (nprow.eq.-1) then @@ -133,7 +133,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) if (debug) write(0,*) 'spall: ', & &desc_a%matrix_data(psb_dec_type_),psb_desc_bld_ -!!$ desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_ + return call psb_erractionrestore(err_act) diff --git a/src/tools/psb_dspins.f90 b/src/tools/psb_dspins.f90 index c8794b92..c30f80b3 100644 --- a/src/tools/psb_dspins.f90 +++ b/src/tools/psb_dspins.f90 @@ -44,7 +44,7 @@ ! is - integer(optional). The row offset. ! js - integer(optional). The column offset. ! -subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) +subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js,rebuild) use psb_descriptor_type use psb_spmat_type @@ -60,7 +60,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) real(kind(1.d0)), intent(in) :: val(:) integer, intent(out) :: info integer, intent(in), optional :: is,js - + logical, intent(in), optional :: rebuild !locals..... integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,& @@ -70,6 +70,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) integer :: nprow,npcol, myrow ,mycol, iflag, isize, irlc logical, parameter :: debug=.false. integer, parameter :: relocsz=200 + logical :: rebuild_ interface psb_cdins subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js) @@ -127,6 +128,11 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) goto 9999 end if + if (present(rebuild)) then + rebuild_ = rebuild + else + rebuild_ = .false. + endif spstate = a%infoa(psb_state_) if (psb_is_bld_dec(dectype)) then @@ -156,7 +162,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) else if (psb_is_asb_dec(dectype)) then nrow = desc_a%matrix_data(psb_n_row_) ncol = desc_a%matrix_data(psb_n_col_) - call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,info) + call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,& + & info,rebuild=rebuild_) if (info /= 0) then info=4010 ch_err='psb_coins' diff --git a/src/tools/psb_dsprn.f90 b/src/tools/psb_dsprn.f90 index 02d986dd..b6f363e4 100644 --- a/src/tools/psb_dsprn.f90 +++ b/src/tools/psb_dsprn.f90 @@ -53,6 +53,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear) integer, intent(out) :: info logical, intent(in), optional :: clear + !locals Integer :: icontxt Integer :: nprow,npcol,myrow,mycol,err,err_act diff --git a/src/tools/psb_zspalloc.f90 b/src/tools/psb_zspalloc.f90 index 33e8955d..fd9311a2 100644 --- a/src/tools/psb_zspalloc.f90 +++ b/src/tools/psb_zspalloc.f90 @@ -133,7 +133,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) if (debug) write(0,*) 'spall: ', & &desc_a%matrix_data(psb_dec_type_),psb_desc_bld_ -!!$ desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_ + return call psb_erractionrestore(err_act) diff --git a/src/tools/psb_zspins.f90 b/src/tools/psb_zspins.f90 index 088bf133..fe0b2583 100644 --- a/src/tools/psb_zspins.f90 +++ b/src/tools/psb_zspins.f90 @@ -44,7 +44,7 @@ ! is - integer(optional). The row offset. ! js - integer(optional). The column offset. ! -subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) +subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js,rebuild) use psb_descriptor_type use psb_spmat_type @@ -60,7 +60,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) complex(kind(1.d0)), intent(in) :: val(:) integer, intent(out) :: info integer, intent(in), optional :: is,js - + logical, intent(in), optional :: rebuild !locals..... integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,& @@ -70,6 +70,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) integer :: nprow,npcol, myrow ,mycol, iflag, isize, irlc logical, parameter :: debug=.false. integer, parameter :: relocsz=200 + logical :: rebuild_ interface psb_cdins subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js) @@ -127,6 +128,11 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) goto 9999 end if + if (present(rebuild)) then + rebuild_ = rebuild + else + rebuild_ = .false. + endif spstate = a%infoa(psb_state_) if (psb_is_bld_dec(dectype)) then @@ -156,7 +162,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) else if (psb_is_asb_dec(dectype)) then nrow = desc_a%matrix_data(psb_n_row_) ncol = desc_a%matrix_data(psb_n_col_) - call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,info) + call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,& + & info,rebuild=rebuild_) if (info /= 0) then info=4010 ch_err='psb_coins'