Added version for matrix freeing without descriptor

src/tools/psb_dspfree.f90

@@ -92,3 +92,81 @@ subroutine psb_dspfree(a, desc_a,info)
   return
 
 end subroutine psb_dspfree
+
+
+
+subroutine psb_dspfrees(a, info)
+  !...free sparse matrix structure...
+  use psb_descriptor_type
+  use psb_spmat_type
+  use psb_serial_mod
+  use psb_const_mod
+  use psb_error_mod
+  implicit none
+
+  !....parameters...
+  type(psb_dspmat_type), intent(inout)       ::a
+  integer, intent(out)        :: info
+  !...locals....
+  integer             :: int_err(5)
+  integer             :: temp(1)
+  real(kind(1.d0))    :: real_err(5)
+  integer             :: icontxt,nprow,npcol,me,mypcol,err, err_act
+  integer,parameter   :: ione=1
+  character(len=20)   :: name, ch_err
+
+  info=0
+  name = 'psb_dspfrees'
+  call psb_erractionsave(err_act)
+
+  !...deallocate a....
+
+  if ((info.eq.0).and.(.not.associated(a%pr))) info=2951
+  if (info.eq.0) then
+     !deallocate pr field
+     deallocate(a%pr,stat=info)
+     if (info.ne.0) info=2045
+  end if
+  if ((info.eq.0).and.(.not.associated(a%pl))) info=2952
+  !deallocate pl  field
+  if (info.eq.0) then 
+     deallocate(a%pl,stat=info)
+     if (info.ne.0) info=2046
+  end if
+  if ((info.eq.0).and.(.not.associated(a%ia2))) info=2953
+  if (info.eq.0) then
+     !deallocate ia2 field
+     deallocate(a%ia2,stat=info)
+     if (info.ne.0) info=2047
+  end if
+  if ((info.eq.0).and.(.not.associated(a%ia1))) info=2954
+  if (info.eq.0) then
+     !deallocate ia1  field
+     deallocate(a%ia1,stat=info)
+     if (info.ne.0) info=2048
+  endif
+  if ((info.eq.0).and.(.not.associated(a%aspk))) info=2955
+  if (info.eq.0) then
+     !deallocate aspk field
+     deallocate(a%aspk,stat=info)
+     if (info.ne.0) info=2049
+  endif
+  if (info.eq.0) call psb_nullify_sp(a)
+
+  if(info.ne.0) then
+     call psb_errpush(info,name)
+     goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act.eq.act_abort) then
+     call psb_error()
+     return
+  end if
+  return
+
+end subroutine psb_dspfrees