mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 04:12:09 +00:00
Fixed ambiguity in spfree vs sp_free (serial version). To be refined
in the future? Probably.
This commit is contained in:
Salvatore Filippone
@@ -436,7 +436,7 @@ contains
|
||||
|
||||
if (associated(p%av)) then
|
||||
do i=1,size(p%av)
|
||||
call psb_spfree(p%av(i),info)
|
||||
call psb_sp_free(p%av(i),info)
|
||||
if (info /= 0) then
|
||||
! Actually, we don't care here about this.
|
||||
! Just let it go.
|
||||
|
||||
@@ -37,8 +37,8 @@ module psb_spmat_type
|
||||
use psb_error_mod
|
||||
use psb_realloc_mod
|
||||
use psb_const_mod
|
||||
! Typedef: psb_dspmat_type
|
||||
! Contains a sparse matrix
|
||||
! Typedef: psb_dspmat_type
|
||||
! Contains a sparse matrix
|
||||
type psb_dspmat_type
|
||||
! Rows & columns
|
||||
integer :: m, k
|
||||
@@ -54,8 +54,8 @@ module psb_spmat_type
|
||||
integer, pointer :: ia1(:)=>null(), ia2(:)=>null()
|
||||
! Permutations matrix
|
||||
integer, pointer :: pl(:)=>null(), pr(:)=>null()
|
||||
end type psb_dspmat_type
|
||||
|
||||
end type psb_dspmat_type
|
||||
|
||||
interface psb_nullify_sp
|
||||
module procedure psb_nullify_dsp
|
||||
end interface
|
||||
@@ -76,9 +76,9 @@ module psb_spmat_type
|
||||
module procedure psb_dspallocate, psb_dspall3, psb_dspallmk, psb_dspallmknz
|
||||
end interface
|
||||
|
||||
! interface psb_spfree
|
||||
! module procedure psb_dspfree
|
||||
! end interface
|
||||
interface psb_sp_free
|
||||
module procedure psb_dsp_free
|
||||
end interface
|
||||
|
||||
interface psb_sp_reinit
|
||||
module procedure psb_dspreinit
|
||||
@@ -89,7 +89,7 @@ contains
|
||||
subroutine psb_nullify_dsp(mat)
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout) :: mat
|
||||
|
||||
|
||||
nullify(mat%aspk,mat%ia1,mat%ia2,mat%pl,mat%pr)
|
||||
mat%m=0
|
||||
mat%k=0
|
||||
@@ -147,7 +147,7 @@ contains
|
||||
Subroutine psb_dspallmk(m,k,a,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
|
||||
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
Integer, intent(in) :: m,k
|
||||
Integer, intent(out) :: info
|
||||
@@ -177,7 +177,7 @@ contains
|
||||
Subroutine psb_dspallmknz(m,k,a, nnz,info)
|
||||
implicit none
|
||||
!....parameters...
|
||||
|
||||
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(in) :: m,k,nnz
|
||||
integer, intent(out) :: info
|
||||
@@ -206,7 +206,7 @@ contains
|
||||
|
||||
end subroutine psb_dspallmknz
|
||||
|
||||
|
||||
|
||||
subroutine psb_dspall3(a, ni1,ni2,nd,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
@@ -218,9 +218,9 @@ contains
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
|
||||
|
||||
call psb_sp_reall(a, ni1,ni2,nd,info)
|
||||
|
||||
|
||||
a%pl(1)=0
|
||||
a%pr(1)=0
|
||||
! set INFOA fields
|
||||
@@ -279,7 +279,7 @@ contains
|
||||
if (info /= 0) return
|
||||
call psb_realloc(max(1,a%k),a%pr,info)
|
||||
if (info /= 0) return
|
||||
|
||||
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspreallocate
|
||||
@@ -305,12 +305,12 @@ contains
|
||||
if (info /= 0) return
|
||||
call psb_realloc(max(1,a%k),a%pr,info)
|
||||
if (info /= 0) return
|
||||
|
||||
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspreall3
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine psb_dspclone(a, b,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
@@ -345,7 +345,7 @@ contains
|
||||
b%descra = a%descra
|
||||
b%m = a%m
|
||||
b%k = a%k
|
||||
|
||||
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspclone
|
||||
@@ -402,24 +402,34 @@ contains
|
||||
End Subroutine psb_dsp_transfer
|
||||
|
||||
|
||||
! subroutine psb_dspfree(a,info)
|
||||
! implicit none
|
||||
! !....Parameters...
|
||||
! Type(psb_dspmat_type), intent(inout) :: A
|
||||
! Integer, intent(out) :: info
|
||||
subroutine psb_dsp_free(a,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
Integer, intent(out) :: info
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
! !locals
|
||||
! logical, parameter :: debug=.false.
|
||||
info = 0
|
||||
|
||||
! INFO = 0
|
||||
|
||||
! deallocate(a%aspk,a%ia1,a%ia2,a%pr,a%pl,STAT=INFO)
|
||||
|
||||
! call psb_nullify_sp(a)
|
||||
|
||||
! Return
|
||||
|
||||
! End Subroutine psb_dspfree
|
||||
if (associated(a%aspk)) then
|
||||
deallocate(a%aspk,STAT=INFO)
|
||||
endif
|
||||
if ((info == 0) .and. associated(a%ia1)) then
|
||||
deallocate(a%ia1,STAT=INFO)
|
||||
endif
|
||||
if ((info == 0) .and. associated(a%ia2)) then
|
||||
deallocate(a%ia2,STAT=INFO)
|
||||
endif
|
||||
if ((info == 0) .and. associated(a%pr)) then
|
||||
deallocate(a%pr,STAT=INFO)
|
||||
endif
|
||||
if ((info == 0) .and. associated(a%pl)) then
|
||||
deallocate(a%pl,STAT=INFO)
|
||||
endif
|
||||
call psb_nullify_sp(a)
|
||||
Return
|
||||
End Subroutine psb_dsp_free
|
||||
|
||||
|
||||
end module psb_spmat_type
|
||||
|
||||
@@ -417,11 +417,6 @@ Module psb_tools_mod
|
||||
type(psb_dspmat_type), intent(inout) ::a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspfree
|
||||
subroutine psb_dspfrees(a,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) ::a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspfrees
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
@@ -282,9 +282,9 @@ contains
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_spfree(b,info)
|
||||
call psb_sp_free(b,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='spfree')
|
||||
call psb_errpush(4010,name,a_err='sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -296,9 +296,9 @@ contains
|
||||
call psb_errpush(4010,name,a_err='spclone')
|
||||
goto 9999
|
||||
end if
|
||||
call psb_spfree(b,info)
|
||||
call psb_sp_free(b,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='spfree')
|
||||
call psb_errpush(4010,name,a_err='sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -570,9 +570,9 @@ contains
|
||||
call psb_numbmm(am3,am4,am1)
|
||||
|
||||
|
||||
call psb_spfree(am4,info)
|
||||
call psb_sp_free(am4,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='spfree')
|
||||
call psb_errpush(4010,name,a_err='sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -594,9 +594,9 @@ contains
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_spfree(am4,info)
|
||||
call psb_sp_free(am4,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_spfree')
|
||||
call psb_errpush(4010,name,a_err='psb_sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -651,9 +651,9 @@ contains
|
||||
call psb_errpush(4010,name,a_err='psb_rwextd')
|
||||
goto 9999
|
||||
end if
|
||||
call psb_spfree(am4,info)
|
||||
call psb_sp_free(am4,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_spfree')
|
||||
call psb_errpush(4010,name,a_err='psb_sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -670,9 +670,9 @@ contains
|
||||
call psb_numbmm(am2,am3,b)
|
||||
|
||||
!!$ if (aggr_dump) call csprt(50+me,am1,head='% Operator PTrans.')
|
||||
call psb_spfree(am3,info)
|
||||
call psb_sp_free(am3,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_spfree')
|
||||
call psb_errpush(4010,name,a_err='psb_sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -757,9 +757,9 @@ contains
|
||||
bg%fida='COO'
|
||||
bg%descra='G'
|
||||
|
||||
call psb_spfree(b,info)
|
||||
call psb_sp_free(b,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_spfree')
|
||||
call psb_errpush(4010,name,a_err='psb_sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -867,7 +867,7 @@ contains
|
||||
bg%descra='G'
|
||||
call psb_fixcoo(bg,info)
|
||||
if(info /= 0) goto 9999
|
||||
call psb_spfree(b,info)
|
||||
call psb_sp_free(b,info)
|
||||
if(info /= 0) goto 9999
|
||||
if (me==0) then
|
||||
if (test_dump) call psb_csprt(80+me,bg,head='% Smoothed aggregate AC.')
|
||||
@@ -893,9 +893,9 @@ contains
|
||||
end if
|
||||
call psb_cddec(naggr,icontxt,desc_p,info)
|
||||
|
||||
call psb_spfree(b,info)
|
||||
call psb_sp_free(b,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='spfree')
|
||||
call psb_errpush(4010,name,a_err='sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -946,9 +946,9 @@ contains
|
||||
call psb_errpush(4010,name,a_err='psb_fixcoo')
|
||||
goto 9999
|
||||
end if
|
||||
call psb_spfree(b,info)
|
||||
call psb_sp_free(b,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_spfree')
|
||||
call psb_errpush(4010,name,a_err='psb_sp_free')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
@@ -277,10 +277,10 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_spfree(atmp,info)
|
||||
call psb_sp_free(atmp,info)
|
||||
if(info/=0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
@@ -339,10 +339,10 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
|
||||
! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5
|
||||
! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5
|
||||
|
||||
call psb_spfree(blck,info)
|
||||
call psb_sp_free(blck,info)
|
||||
if(info/=0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -108,10 +108,10 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
|
||||
if (present(blck)) then
|
||||
blck_ => null()
|
||||
else
|
||||
call psb_spfree(blck_,info)
|
||||
call psb_sp_free(blck_,info)
|
||||
if(info.ne.0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
@@ -454,10 +454,10 @@ contains
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call psb_spfree(trw,info)
|
||||
call psb_sp_free(trw,info)
|
||||
if(info.ne.0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -189,11 +189,11 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
|
||||
call blacs_barrier(icontxt,'All')
|
||||
endif
|
||||
|
||||
call psb_spfree(blck,info)
|
||||
call psb_spfree(atmp,info)
|
||||
call psb_sp_free(blck,info)
|
||||
call psb_sp_free(atmp,info)
|
||||
if(info /= 0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -189,11 +189,11 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
|
||||
write(0,*) me, 'UMFBLD: Done umf_Factor',info,p%iprcparm(umf_numptr_)
|
||||
call blacs_barrier(icontxt,'All')
|
||||
endif
|
||||
call psb_spfree(blck,info)
|
||||
call psb_spfree(atmp,info)
|
||||
call psb_sp_free(blck,info)
|
||||
call psb_sp_free(atmp,info)
|
||||
if(info /= 0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -55,7 +55,7 @@ subroutine psb_dtransp(a,b,c,fmt)
|
||||
else
|
||||
fmt_='CSR'
|
||||
endif
|
||||
if (associated(b%aspk)) call psb_spfree(b,info)
|
||||
if (associated(b%aspk)) call psb_sp_free(b,info)
|
||||
call psb_sp_clone(a,b,info)
|
||||
|
||||
if (b%fida=='CSR') then
|
||||
|
||||
@@ -52,7 +52,7 @@ Subroutine psb_cdovrbld(n_ovr,desc_p,desc_a,a,&
|
||||
use psb_serial_mod
|
||||
Use psi_mod
|
||||
use psb_realloc_mod
|
||||
use psb_tools_mod, only : psb_cdprt, psb_spfree
|
||||
use psb_tools_mod, only : psb_cdprt
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
Implicit None
|
||||
@@ -668,10 +668,10 @@ Subroutine psb_cdovrbld(n_ovr,desc_p,desc_a,a,&
|
||||
Deallocate(works,workr,t_halo_in,t_halo_out,work,&
|
||||
& length_dl,dep_list,tmp_ovr_idx,tmp_halo,&
|
||||
& brvindx,rvsz,sdsz,bsdindx,temp,stat=info)
|
||||
call psb_spfree(blk,info)
|
||||
call psb_sp_free(blk,info)
|
||||
if (info.ne.0) then
|
||||
info=4010
|
||||
ch_err='spfree'
|
||||
ch_err='sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -61,21 +61,6 @@ subroutine psb_dspasb(a,desc_a, info, afmt, up, dup)
|
||||
end subroutine psb_cest
|
||||
end interface
|
||||
|
||||
interface psb_spfree
|
||||
subroutine psb_dspfree(a, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) ::a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspfree
|
||||
subroutine psb_dspfrees(a,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) ::a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspfrees
|
||||
end interface
|
||||
|
||||
!...Parameters....
|
||||
type(psb_dspmat_type), intent (inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
@@ -241,7 +226,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, up, dup)
|
||||
close(iout)
|
||||
endif
|
||||
|
||||
call psb_spfree(atemp,info)
|
||||
call psb_sp_free(atemp,info)
|
||||
|
||||
|
||||
else if (spstate == psb_spmat_upd_) then
|
||||
@@ -273,10 +258,10 @@ subroutine psb_dspasb(a,desc_a, info, afmt, up, dup)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_spfree(atemp,info)
|
||||
call psb_sp_free(atemp,info)
|
||||
if (info /= no_err) then
|
||||
info = 4010
|
||||
ch_err='spfree'
|
||||
ch_err='sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
+10
-114
@@ -64,50 +64,21 @@ subroutine psb_dspfree(a, desc_a,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (.not.associated(desc_a%matrix_data)) then
|
||||
info=295
|
||||
call psb_errpush(info,name)
|
||||
return
|
||||
info=295
|
||||
call psb_errpush(info,name)
|
||||
return
|
||||
else
|
||||
icontxt=desc_a%matrix_data(psb_ctxt_)
|
||||
icontxt=desc_a%matrix_data(psb_ctxt_)
|
||||
end if
|
||||
|
||||
!...deallocate a....
|
||||
call psb_sp_free(a,info)
|
||||
|
||||
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
|
||||
info=2045
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -116,8 +87,8 @@ subroutine psb_dspfree(a, desc_a,info)
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.act_abort) then
|
||||
call psb_error(icontxt)
|
||||
return
|
||||
call psb_error(icontxt)
|
||||
return
|
||||
end if
|
||||
return
|
||||
|
||||
@@ -125,78 +96,3 @@ 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
|
||||
|
||||
@@ -51,7 +51,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
|
||||
use psb_descriptor_type
|
||||
Use psb_prec_type
|
||||
use psb_realloc_mod
|
||||
use psb_tools_mod, only : psb_glob_to_loc, psb_loc_to_glob, psb_spfree
|
||||
use psb_tools_mod, only : psb_glob_to_loc, psb_loc_to_glob
|
||||
use psb_error_mod
|
||||
|
||||
Implicit None
|
||||
@@ -331,10 +331,10 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
|
||||
|
||||
Deallocate(sdid,brvindx,rvid,bsdindx,rvsz,sdsz,stat=info)
|
||||
|
||||
call psb_spfree(tmp,info)
|
||||
call psb_sp_free(tmp,info)
|
||||
if (info /= 0) then
|
||||
info=4010
|
||||
ch_err='psb_spfree'
|
||||
ch_err='psb_sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
@@ -470,10 +470,10 @@ contains
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_spfree(blck,info)
|
||||
call psb_sp_free(blck,info)
|
||||
if(info/=0)then
|
||||
info=4010
|
||||
ch_err='spfree'
|
||||
ch_err='sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
@@ -823,10 +823,10 @@ contains
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_spfree(blck,info)
|
||||
call psb_sp_free(blck,info)
|
||||
if(info/=0)then
|
||||
info=4010
|
||||
ch_err='spfree'
|
||||
ch_err='sp_free'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
Reference in New Issue
Block a user