psblas2-dev:

base/internals/psi_dswapdata.F90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_zspmm.f90
 base/tools/psb_cd_inloc.f90
 base/tools/psb_cdals.f90
 base/tools/psb_cdalv.f90


Merged fixes from ulbe testing.

base/internals/psi_dswapdata.F90

@@ -187,6 +187,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
        & albf,do_send,do_recv
   logical, parameter :: usersend=.false.
 
+  real(psb_dpk_), allocatable, target  :: buffer(:)
   real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
 #ifdef HAVE_VOLATILE
   volatile :: sndbuf, rcvbuf
@@ -267,7 +268,10 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
     rcvbuf => work(totsnd_+1:totsnd_+totrcv_)
     albf=.false.
   else
-    allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info)
+    allocate(buffer(totsnd_+totrcv_), stat=info)
+    sndbuf => buffer(1:totsnd_)
+    rcvbuf => buffer(totsnd_+1:totsnd_+totrcv_)
+
     if(info /= 0) then
       call psb_errpush(4000,name)
       goto 9999
@@ -503,11 +507,12 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
     call psb_errpush(4000,name)
     goto 9999
   end if
-  if(albf) deallocate(sndbuf,rcvbuf,stat=info)
+
-  if(info /= 0) then
+!!$  if(albf) deallocate(sndbuf,rcvbuf,stat=info)
-    call psb_errpush(4000,name)
+!!$  if(info /= 0) then
-    goto 9999
+!!$    call psb_errpush(4000,name)
-  end if
+!!$    goto 9999
+!!$  end if
 
   call psb_erractionrestore(err_act)
   return

base/psblas/psb_dspmm.f90

@@ -94,7 +94,7 @@ subroutine  psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
        & i, ib, ib1, ip, idx
   integer, parameter       :: nb=4
   real(psb_dpk_), pointer     :: xp(:,:), yp(:,:), iwork(:)
-  real(psb_dpk_), allocatable :: xvsave(:,:)
+  real(psb_dpk_), allocatable  :: xvsave(:,:)
   character                :: trans_
   character(len=20)        :: name, ch_err
   logical                  :: aliw, doswap_
@@ -256,7 +256,7 @@ subroutine  psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
         if(info /= 0) exit blk
 
         if((ib1 > 0).and.(doswap_))&
-             & call psi_swapdata(psb_swap_send_,ib1,&
+             & call psi_swapdata(psb_swap_recv_,ib1,&
              & dzero,xp,desc_a,iwork,info)
 
         if(info /= 0) exit blk
@@ -339,7 +339,15 @@ subroutine  psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
 
   end if
 
-  if (aliw) deallocate(iwork)
+  if (aliw) deallocate(iwork,stat=info)
+  if (debug_level >= psb_debug_comp_) &
+       & write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info
+  if(info /= 0) then
+    info = 4010
+    ch_err='Deallocate iwork'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
   nullify(iwork)
 
   call psb_erractionrestore(err_act)

base/psblas/psb_zspmm.f90

@@ -256,7 +256,7 @@ subroutine  psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
         if(info /= 0) exit blk
 
         if((ib1 > 0).and.(doswap_))&
-             & call psi_swapdata(psb_swap_send_,ib1,&
+             & call psi_swapdata(psb_swap_recv_,ib1,&
              & zzero,xp,desc_a,iwork,info)
 
         if(info /= 0) exit blk
@@ -340,7 +340,15 @@ subroutine  psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
 
   end if
 
-  if (aliw) deallocate(iwork)
+  if (aliw) deallocate(iwork,stat=info)
+  if (debug_level >= psb_debug_comp_) &
+       & write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info
+  if(info /= 0) then
+    info = 4010
+    ch_err='Deallocate iwork'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
   nullify(iwork)
 
   call psb_erractionrestore(err_act)

base/tools/psb_cd_inloc.f90

@@ -170,10 +170,12 @@ subroutine psb_cd_inloc(v, ictxt, desc, info)
   if (psb_cd_choose_large_state(ictxt,m)) then 
     allocate(desc%matrix_data(psb_mdata_size_),&
          &temp_ovrlap(m),stat=info)
+    desc%matrix_data(:) = 0
     desc%matrix_data(psb_desc_size_) = psb_desc_large_
   else
     allocate(desc%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
          &temp_ovrlap(m),stat=info)
+    desc%matrix_data(:) = 0
     desc%matrix_data(psb_desc_size_) = psb_desc_normal_
   end if
   if (info /= 0) then     

base/tools/psb_cdals.f90

@@ -130,10 +130,12 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
   if (psb_cd_choose_large_state(ictxt,m)) then 
     allocate(desc%matrix_data(psb_mdata_size_),&
          & temp_ovrlap(m),prc_v(np),stat=info)
+    desc%matrix_data(:) = 0
     desc%matrix_data(psb_desc_size_) = psb_desc_large_
   else
     allocate(desc%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
          & temp_ovrlap(m),prc_v(np),stat=info)
+    desc%matrix_data(:) = 0
     desc%matrix_data(psb_desc_size_) = psb_desc_normal_
   end if
   if (info /= 0) then     

base/tools/psb_cdalv.f90

@@ -141,10 +141,12 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
   if (psb_cd_choose_large_state(ictxt,m)) then 
     allocate(desc%matrix_data(psb_mdata_size_),&
          &temp_ovrlap(m),stat=info)
+    desc%matrix_data(:) = 0
     desc%matrix_data(psb_desc_size_) = psb_desc_large_
   else
     allocate(desc%glob_to_loc(m),desc%matrix_data(psb_mdata_size_),&
          &temp_ovrlap(m),stat=info)
+    desc%matrix_data(:) = 0
     desc%matrix_data(psb_desc_size_) = psb_desc_normal_
   end if
   if (info /= 0) then     
@@ -153,7 +155,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
     call psb_errpush(info,name,i_err=int_err,a_err='integer')
     goto 9999
   endif
-
   desc%matrix_data(psb_m_)        = m
   desc%matrix_data(psb_n_)        = n
   ! This has to be set BEFORE any call to SET_BLD