fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed ambiguity in spfree vs sp_free (serial version). To be refined

Browse Source 
in the future? Probably.
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 97af703116
commit 9b586cf1e2
14 changed files with 102 additions and 216 deletions
Show Stats Download Patch File Download Diff File

2
src/modules/psb_prec_type.f90
Unescape Escape View File

@ -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.

54
src/modules/psb_spmat_type.f90
Unescape Escape View File

@ -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,7 +54,7 @@ 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
@ -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
@ -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
! !locals
! logical, parameter :: debug=.false.
! INFO = 0
! deallocate(a%aspk,a%ia1,a%ia2,a%pr,a%pl,STAT=INFO)
! call psb_nullify_sp(a)
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.
! Return
info = 0
! 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

5
src/modules/psb_tools_mod.f90
Unescape Escape View File

@ -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

38
src/prec/psb_dbldaggrmat.f90
Unescape Escape View File

@ -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

8
src/prec/psb_dilu_bld.f90
Unescape Escape View File

@ -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

8
src/prec/psb_dilu_fct.f90
Unescape Escape View File

@ -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

6
src/prec/psb_dslu_bld.f90
Unescape Escape View File

@ -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

6
src/prec/psb_dumf_bld.f90
Unescape Escape View File

@ -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

2
src/serial/psb_dtransp.f90
Unescape Escape View File

@ -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

6
src/tools/psb_cdovrbld.f90
Unescape Escape View File

@ -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

21
src/tools/psb_dspasb.f90
Unescape Escape View File

@ -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

124
src/tools/psb_dspfree.f90
Unescape Escape View File

@ -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

6
src/tools/psb_dsphalo.f90
Unescape Escape View File

@ -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

8
test/Fileread/mat_dist.f90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save