! 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 integer,parameter :: ione=1 character(len=20) :: name, ch_err 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 !!$ 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