From 9b586cf1e29c80f87c0711a1559c895af19db0bf Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 10 Mar 2006 12:28:55 +0000 Subject: [PATCH] Fixed ambiguity in spfree vs sp_free (serial version). To be refined in the future? Probably. --- src/modules/psb_prec_type.f90 | 2 +- src/modules/psb_spmat_type.f90 | 78 ++++++++++++--------- src/modules/psb_tools_mod.f90 | 5 -- src/prec/psb_dbldaggrmat.f90 | 38 +++++----- src/prec/psb_dilu_bld.f90 | 8 +-- src/prec/psb_dilu_fct.f90 | 8 +-- src/prec/psb_dslu_bld.f90 | 6 +- src/prec/psb_dumf_bld.f90 | 6 +- src/serial/psb_dtransp.f90 | 2 +- src/tools/psb_cdovrbld.f90 | 6 +- src/tools/psb_dspasb.f90 | 21 +----- src/tools/psb_dspfree.f90 | 124 +++------------------------------ src/tools/psb_dsphalo.f90 | 6 +- test/Fileread/mat_dist.f90 | 8 +-- 14 files changed, 102 insertions(+), 216 deletions(-) diff --git a/src/modules/psb_prec_type.f90 b/src/modules/psb_prec_type.f90 index 1f9ff203..7ffe7c56 100644 --- a/src/modules/psb_prec_type.f90 +++ b/src/modules/psb_prec_type.f90 @@ -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. diff --git a/src/modules/psb_spmat_type.f90 b/src/modules/psb_spmat_type.f90 index 0f22e875..dfe97206 100644 --- a/src/modules/psb_spmat_type.f90 +++ b/src/modules/psb_spmat_type.f90 @@ -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 - -! !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 diff --git a/src/modules/psb_tools_mod.f90 b/src/modules/psb_tools_mod.f90 index 95e6ed7b..46414898 100644 --- a/src/modules/psb_tools_mod.f90 +++ b/src/modules/psb_tools_mod.f90 @@ -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 diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index 1ff997a8..4237c5c0 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -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 diff --git a/src/prec/psb_dilu_bld.f90 b/src/prec/psb_dilu_bld.f90 index 07865c55..f543f4dd 100644 --- a/src/prec/psb_dilu_bld.f90 +++ b/src/prec/psb_dilu_bld.f90 @@ -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 diff --git a/src/prec/psb_dilu_fct.f90 b/src/prec/psb_dilu_fct.f90 index 70345765..8c1ba772 100644 --- a/src/prec/psb_dilu_fct.f90 +++ b/src/prec/psb_dilu_fct.f90 @@ -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 diff --git a/src/prec/psb_dslu_bld.f90 b/src/prec/psb_dslu_bld.f90 index ddd8dc5c..d8492e68 100644 --- a/src/prec/psb_dslu_bld.f90 +++ b/src/prec/psb_dslu_bld.f90 @@ -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 diff --git a/src/prec/psb_dumf_bld.f90 b/src/prec/psb_dumf_bld.f90 index 05d819df..bbe524e1 100644 --- a/src/prec/psb_dumf_bld.f90 +++ b/src/prec/psb_dumf_bld.f90 @@ -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 diff --git a/src/serial/psb_dtransp.f90 b/src/serial/psb_dtransp.f90 index 9231200c..f89d5050 100644 --- a/src/serial/psb_dtransp.f90 +++ b/src/serial/psb_dtransp.f90 @@ -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 diff --git a/src/tools/psb_cdovrbld.f90 b/src/tools/psb_cdovrbld.f90 index 6f19aa70..8940a907 100644 --- a/src/tools/psb_cdovrbld.f90 +++ b/src/tools/psb_cdovrbld.f90 @@ -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 diff --git a/src/tools/psb_dspasb.f90 b/src/tools/psb_dspasb.f90 index 8962a476..a83c35f5 100644 --- a/src/tools/psb_dspasb.f90 +++ b/src/tools/psb_dspasb.f90 @@ -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 diff --git a/src/tools/psb_dspfree.f90 b/src/tools/psb_dspfree.f90 index 3c05539a..dc24c066 100644 --- a/src/tools/psb_dspfree.f90 +++ b/src/tools/psb_dspfree.f90 @@ -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 diff --git a/src/tools/psb_dsphalo.f90 b/src/tools/psb_dsphalo.f90 index 7b0e4fa8..6c53d7b0 100644 --- a/src/tools/psb_dsphalo.f90 +++ b/src/tools/psb_dsphalo.f90 @@ -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 diff --git a/test/Fileread/mat_dist.f90 b/test/Fileread/mat_dist.f90 index 41e4689b..7fcbc5f3 100644 --- a/test/Fileread/mat_dist.f90 +++ b/test/Fileread/mat_dist.f90 @@ -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