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

segfault on SP

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: 

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'

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)
+  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
-  endif
-  if (.not.allocated(b%pr)) then 
-    allocate(b%pr(1),stat=info)
   b%pr = 0
-  endif
   b%infoa(psb_nnz_) = nzb+nz
   b%m = b%m+lrw_-irw+1
   b%k = max(b%k,a%k)

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
 

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)
+  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
-  endif
-  if (.not.allocated(b%pr)) then 
-    allocate(b%pr(1),stat=info)
   b%pr = 0
-  endif
   b%infoa(psb_nnz_) = nzb+nz
   b%m = b%m+lrw_-irw+1
   b%k = max(b%k,a%k)

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),&

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),&