From 4745a96f43ad786f9a79f4013528418d2c3aa684 Mon Sep 17 00:00:00 2001 From: Alfredo Buttari Date: Thu, 6 Oct 2005 15:55:18 +0000 Subject: [PATCH] Added version for matrix freeing without descriptor --- src/tools/psb_dspfree.f90 | 78 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) diff --git a/src/tools/psb_dspfree.f90 b/src/tools/psb_dspfree.f90 index 44b51a09..188ce851 100644 --- a/src/tools/psb_dspfree.f90 +++ b/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