psblas: fix initialization of blk%pl|pr in sphalo, was giving a

segfault on SP
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 4da8e537af
commit 1aa0b01613

@ -18,7 +18,7 @@ CINCLUDES=-I.
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG). FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG).
lib: mpfobjs $(MODULES) $(OBJS) lib: mpfobjs $(MODULES) $(OBJS) $(LIBMOD)
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME) $(RANLIB) $(LIBDIR)/$(LIBNAME)
/bin/cp -p $(LIBMOD) $(LIBDIR) /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_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_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_gps_mod.o: psb_realloc_mod.o
psb_base_mod.o: $(MODULES) mpfobjs $(LIBMOD): $(MODULES:.o:$(.mod))
mpfobjs: mpfobjs:

@ -405,8 +405,8 @@ contains
call psb_nullify_sp(a) call psb_nullify_sp(a)
call psb_sp_reall(a,nnz,info) call psb_sp_reall(a,nnz,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set INFOA fields ! set INFOA fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -439,8 +439,8 @@ contains
a%k=max(0,k) a%k=max(0,k)
call psb_sp_reall(a,nnz,info) call psb_sp_reall(a,nnz,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set INFOA fields ! set INFOA fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -473,8 +473,8 @@ contains
a%k=max(0,k) a%k=max(0,k)
call psb_sp_reall(a,nnz,info) call psb_sp_reall(a,nnz,info)
if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr) if (debug) write(0,*) 'Check in ALLOCATE ',info,allocated(a%pl),allocated(a%pr)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set infoa fields ! set infoa fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -500,8 +500,8 @@ contains
call psb_nullify_sp(a) call psb_nullify_sp(a)
call psb_sp_reall(a, ni1,ni2,nd,info) call psb_sp_reall(a, ni1,ni2,nd,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set INFOA fields ! set INFOA fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -950,8 +950,8 @@ contains
if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k
call psb_sp_reall(a,nnz,info) call psb_sp_reall(a,nnz,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set INFOA fields ! set INFOA fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -984,8 +984,8 @@ contains
a%k=max(0,k) a%k=max(0,k)
call psb_sp_reall(a,nnz,info) call psb_sp_reall(a,nnz,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set INFOA fields ! set INFOA fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -1018,8 +1018,8 @@ contains
a%k=max(0,k) a%k=max(0,k)
call psb_sp_reall(a,nnz,info) call psb_sp_reall(a,nnz,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set infoa fields ! set infoa fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'
@ -1046,8 +1046,8 @@ contains
call psb_nullify_sp(a) call psb_nullify_sp(a)
call psb_sp_reall(a, ni1,ni2,nd,info) call psb_sp_reall(a, ni1,ni2,nd,info)
a%pl(1)=0 a%pl(:)=0
a%pr(1)=0 a%pr(:)=0
! set INFOA fields ! set INFOA fields
a%fida = 'COO' a%fida = 'COO'
a%descra = 'GUN' a%descra = 'GUN'

@ -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,& call psb_sp_getrow(irw,a,nz,b%ia1,b%ia2,b%aspk,info,iren=iren,&
& lrw=lrw_,append=append_,nzin=nzb) & lrw=lrw_,append=append_,nzin=nzb)
if (.not.allocated(b%pl)) then if (info == 0) call psb_ensure_size(1,b%pl,info)
allocate(b%pl(1),stat=info) if (info == 0) call psb_ensure_size(1,b%pr,info)
b%pl = 0 if (info /= 0) return
endif b%pl = 0
if (.not.allocated(b%pr)) then b%pr = 0
allocate(b%pr(1),stat=info)
b%pr = 0
endif
b%infoa(psb_nnz_) = nzb+nz b%infoa(psb_nnz_) = nzb+nz
b%m = b%m+lrw_-irw+1 b%m = b%m+lrw_-irw+1
b%k = max(b%k,a%k) b%k = max(b%k,a%k)

@ -81,6 +81,7 @@ contains
if (idx<0) then if (idx<0) then
write(0,*) ' spgtrow Error : idx no good ',idx write(0,*) ' spgtrow Error : idx no good ',idx
info = 2
return return
end if end if
nr = lrw - irw + 1 nr = lrw - irw + 1
@ -157,6 +158,7 @@ contains
endif endif
if (idx<0) then if (idx<0) then
write(debug_unit,*) ' spgtrow Error : idx no good ',idx write(debug_unit,*) ' spgtrow Error : idx no good ',idx
info = 2
return return
end if end if
@ -582,6 +584,7 @@ contains
if (idx<0) then if (idx<0) then
write(debug_unit,*) trim(name),& write(debug_unit,*) trim(name),&
&' Error : idx no good ',idx &' Error : idx no good ',idx
info = 2
return return
end if end if

@ -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,& call psb_sp_getrow(irw,a,nz,b%ia1,b%ia2,b%aspk,info,iren=iren,&
& lrw=lrw_,append=append_,nzin=nzb) & lrw=lrw_,append=append_,nzin=nzb)
if (.not.allocated(b%pl)) then if (info == 0) call psb_ensure_size(1,b%pl,info)
allocate(b%pl(1),stat=info) if (info == 0) call psb_ensure_size(1,b%pr,info)
b%pl = 0 if (info /= 0) return
endif b%pl = 0
if (.not.allocated(b%pr)) then b%pr = 0
allocate(b%pr(1),stat=info)
b%pr = 0
endif
b%infoa(psb_nnz_) = nzb+nz b%infoa(psb_nnz_) = nzb+nz
b%m = b%m+lrw_-irw+1 b%m = b%m+lrw_-irw+1
b%k = max(b%k,a%k) b%k = max(b%k,a%k)

@ -351,7 +351,16 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
blk%fida = 'COO' blk%fida = 'COO'
blk%infoa(psb_nnz_) = l1 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_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

@ -350,7 +350,16 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
blk%fida = 'COO' blk%fida = 'COO'
blk%infoa(psb_nnz_) = l1 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_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

Loading…
Cancel
Save