! File: psb_dspfree.f90 ! ! Subroutine: psb_dspfree ! Frees a sparse matrix structure. ! ! Parameters: ! a - type(). The sparse matrix to be freed. ! desc_a - type(). The communication descriptor. ! info - integer. Eventually returns an error code. ! subroutine psb_dspfree(a, desc_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_desc_type), intent(in) :: desc_a 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 character(len=20) :: name, ch_err if(psb_get_errstatus().ne.0) return info=0 name = 'psb_dspfree' call psb_erractionsave(err_act) if (.not.associated(desc_a%matrix_data)) then info=295 call psb_errpush(info,name) return else icontxt=desc_a%matrix_data(psb_ctxt_) end if !...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(icontxt) return end if 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 character(len=20) :: name, ch_err if(psb_get_errstatus().ne.0) return 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).and.(associated(a%pr))) 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).and.(associated(a%pl))) 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).and.(associated(a%ia2))) 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).and.(associated(a%ia1))) 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).and.(associated(a%aspk))) 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