You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
95 lines
2.4 KiB
Fortran
95 lines
2.4 KiB
Fortran
20 years ago
|
! File: psb_dspfree.f90
|
||
|
|
!
|
||
|
|
! Subroutine: psb_dspfree
|
||
|
|
! Frees a sparse matrix structure.
|
||
|
|
!
|
||
|
|
! Parameters:
|
||
|
|
! a - type(<psb_dspmat_type>). The sparse matrix to be freed.
|
||
|
|
! desc_a - type(<psb_desc_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
|