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

in the future? Probably.

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.

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

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
 
 

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
 

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

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

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

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

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 

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

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

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

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

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