diff --git a/base/modules/Makefile b/base/modules/Makefile index 5ca562f1..94492927 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -18,7 +18,7 @@ CINCLUDES=-I. FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG). -lib: mpfobjs $(MODULES) $(OBJS) +lib: mpfobjs $(MODULES) $(OBJS) $(LIBMOD) $(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) /bin/cp -p $(LIBMOD) $(LIBDIR) @@ -36,8 +36,7 @@ psb_sort_mod.o: psb_error_mod.o psb_realloc_mod.o psb_methd_mod.o: psb_serial_mod.o psb_desc_type.o psb_prec_type.o psb_tools_mod.o: psb_spmat_type.o psb_desc_type.o psi_mod.o psb_gps_mod.o psb_gps_mod.o: psb_realloc_mod.o -psb_base_mod.o: $(MODULES) mpfobjs - +$(LIBMOD): $(MODULES:.o:$(.mod)) mpfobjs: diff --git a/base/modules/psb_spmat_type.f90 b/base/modules/psb_spmat_type.f90 index 081ffa66..44b07f21 100644 --- a/base/modules/psb_spmat_type.f90 +++ b/base/modules/psb_spmat_type.f90 @@ -405,8 +405,8 @@ contains call psb_nullify_sp(a) call psb_sp_reall(a,nnz,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set INFOA fields a%fida = 'COO' a%descra = 'GUN' @@ -439,8 +439,8 @@ contains a%k=max(0,k) call psb_sp_reall(a,nnz,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set INFOA fields a%fida = 'COO' a%descra = 'GUN' @@ -473,8 +473,8 @@ contains a%k=max(0,k) call psb_sp_reall(a,nnz,info) if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set infoa fields a%fida = 'COO' a%descra = 'GUN' @@ -500,8 +500,8 @@ contains call psb_nullify_sp(a) call psb_sp_reall(a, ni1,ni2,nd,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set INFOA fields a%fida = 'COO' a%descra = 'GUN' @@ -950,8 +950,8 @@ contains if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k call psb_sp_reall(a,nnz,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set INFOA fields a%fida = 'COO' a%descra = 'GUN' @@ -984,8 +984,8 @@ contains a%k=max(0,k) call psb_sp_reall(a,nnz,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set INFOA fields a%fida = 'COO' a%descra = 'GUN' @@ -1018,8 +1018,8 @@ contains a%k=max(0,k) call psb_sp_reall(a,nnz,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set infoa fields a%fida = 'COO' a%descra = 'GUN' @@ -1046,8 +1046,8 @@ contains call psb_nullify_sp(a) call psb_sp_reall(a, ni1,ni2,nd,info) - a%pl(1)=0 - a%pr(1)=0 + a%pl(:)=0 + a%pr(:)=0 ! set INFOA fields a%fida = 'COO' a%descra = 'GUN' diff --git a/base/serial/psb_dspgtblk.f90 b/base/serial/psb_dspgtblk.f90 index afc74e5d..c0f06332 100644 --- a/base/serial/psb_dspgtblk.f90 +++ b/base/serial/psb_dspgtblk.f90 @@ -98,14 +98,11 @@ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt) call psb_sp_getrow(irw,a,nz,b%ia1,b%ia2,b%aspk,info,iren=iren,& & lrw=lrw_,append=append_,nzin=nzb) - if (.not.allocated(b%pl)) then - allocate(b%pl(1),stat=info) - b%pl = 0 - endif - if (.not.allocated(b%pr)) then - allocate(b%pr(1),stat=info) - b%pr = 0 - endif + if (info == 0) call psb_ensure_size(1,b%pl,info) + if (info == 0) call psb_ensure_size(1,b%pr,info) + if (info /= 0) return + b%pl = 0 + b%pr = 0 b%infoa(psb_nnz_) = nzb+nz b%m = b%m+lrw_-irw+1 b%k = max(b%k,a%k) diff --git a/base/serial/psb_getrow_mod.f90 b/base/serial/psb_getrow_mod.f90 index 110f71ee..92daa7c2 100644 --- a/base/serial/psb_getrow_mod.f90 +++ b/base/serial/psb_getrow_mod.f90 @@ -81,6 +81,7 @@ contains if (idx<0) then write(0,*) ' spgtrow Error : idx no good ',idx + info = 2 return end if nr = lrw - irw + 1 @@ -157,6 +158,7 @@ contains endif if (idx<0) then write(debug_unit,*) ' spgtrow Error : idx no good ',idx + info = 2 return end if @@ -582,6 +584,7 @@ contains if (idx<0) then write(debug_unit,*) trim(name),& &' Error : idx no good ',idx + info = 2 return end if diff --git a/base/serial/psb_zspgtblk.f90 b/base/serial/psb_zspgtblk.f90 index aa1b4f3d..50c8e11d 100644 --- a/base/serial/psb_zspgtblk.f90 +++ b/base/serial/psb_zspgtblk.f90 @@ -98,14 +98,11 @@ subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt) call psb_sp_getrow(irw,a,nz,b%ia1,b%ia2,b%aspk,info,iren=iren,& & lrw=lrw_,append=append_,nzin=nzb) - if (.not.allocated(b%pl)) then - allocate(b%pl(1),stat=info) - b%pl = 0 - endif - if (.not.allocated(b%pr)) then - allocate(b%pr(1),stat=info) - b%pr = 0 - endif + if (info == 0) call psb_ensure_size(1,b%pl,info) + if (info == 0) call psb_ensure_size(1,b%pr,info) + if (info /= 0) return + b%pl = 0 + b%pr = 0 b%infoa(psb_nnz_) = nzb+nz b%m = b%m+lrw_-irw+1 b%k = max(b%k,a%k) diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index f2d89976..f31e890c 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -351,7 +351,16 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& blk%fida = 'COO' blk%infoa(psb_nnz_) = l1 - + call psb_ensure_size(1,blk%pl,info) + if (info == 0) call psb_ensure_size(1,blk%pr,info) + if (info /= 0) then + info=4010 + ch_err='psb_ensure_size' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + blk%pl = 0 + blk%pr = 0 if (debug_level >= psb_debug_outer_)& & write(debug_unit,*) me,' ',trim(name),& diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index bf9770af..be52c264 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -350,7 +350,16 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& blk%fida = 'COO' blk%infoa(psb_nnz_) = l1 - + call psb_ensure_size(1,blk%pl,info) + if (info == 0) call psb_ensure_size(1,blk%pr,info) + if (info /= 0) then + info=4010 + ch_err='psb_ensure_size' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + blk%pl = 0 + blk%pr = 0 if (debug_level >= psb_debug_outer_)& & write(debug_unit,*) me,' ',trim(name),&