psblas3:

base/modules/psb_d_tools_mod.f90
 base/modules/psb_d_vect_mod.f90
 base/tools/psb_dasb.f90

Defined new ASB(,,scratch=.true.)

base/modules/psb_d_tools_mod.f90

@@ -79,21 +79,23 @@ Module psb_d_tools_mod
       real(psb_dpk_), allocatable, intent(inout) :: x(:)
       integer, intent(out)            ::  info
     end subroutine psb_dasbv
-    subroutine psb_dasb_vect(x, desc_a, info,mold)
+    subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
       use psb_descriptor_type, only : psb_desc_type, psb_dpk_
       use psb_d_vect_mod
       type(psb_desc_type), intent(in)      :: desc_a
       type(psb_d_vect_type), intent(inout) :: x
       integer, intent(out)                 :: info
       class(psb_d_base_vect_type), intent(in), optional :: mold
+      logical, intent(in), optional        :: scratch
     end subroutine psb_dasb_vect
-    subroutine psb_dasb_vect_r2(x, desc_a, info,mold)
+    subroutine psb_dasb_vect_r2(x, desc_a, info,mold, scratch)
       use psb_descriptor_type, only : psb_desc_type, psb_dpk_
       use psb_d_vect_mod
       type(psb_desc_type), intent(in)      :: desc_a
       type(psb_d_vect_type), intent(inout) :: x(:)
       integer, intent(out)                 :: info
       class(psb_d_base_vect_type), intent(in), optional :: mold
+      logical, intent(in), optional        :: scratch
     end subroutine psb_dasb_vect_r2
   end interface
 

base/tools/psb_dasb.f90

@@ -250,7 +250,7 @@ subroutine psb_dasbv(x, desc_a, info)
 
 end subroutine psb_dasbv
 
-subroutine psb_dasb_vect(x, desc_a, info, mold)
+subroutine psb_dasb_vect(x, desc_a, info, mold,  scratch)
   use psb_base_mod, psb_protect_name => psb_dasb_vect
   implicit none
 
@@ -258,10 +258,12 @@ subroutine psb_dasb_vect(x, desc_a, info, mold)
   type(psb_d_vect_type), intent(inout) ::  x
   integer, intent(out)             ::  info
   class(psb_d_base_vect_type), intent(in), optional :: mold
+  logical, intent(in), optional    :: scratch
 
   ! local variables
   integer :: ictxt,np,me
   integer :: int_err(5), i1sz,nrow,ncol, err_act
+  logical :: scratch_
   integer              :: debug_level, debug_unit
   character(len=20)    :: name,ch_err
 
@@ -275,6 +277,8 @@ subroutine psb_dasb_vect(x, desc_a, info, mold)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+  scratch_ = .false.
+  if (present(scratch)) scratch_ = scratch
   call psb_info(ictxt, me, np)
 
   !     ....verify blacs grid correctness..
@@ -293,6 +297,10 @@ subroutine psb_dasb_vect(x, desc_a, info, mold)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
 
+  if (scratch_) then 
+    call x%free(info)
+    call x%bld(ncol,mold=mold)
+  else
     call x%asb(ncol,info)
     ! ..update halo elements..
     call psb_halo(x,desc_a,info)
@@ -306,7 +314,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold)
     end if
     if (debug_level >= psb_debug_ext_) &
          & write(debug_unit,*) me,' ',trim(name),': end'
-
+  endif
   call psb_erractionrestore(err_act)
   return
 
@@ -321,7 +329,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold)
 end subroutine psb_dasb_vect
 
 
-subroutine psb_dasb_vect_r2(x, desc_a, info, mold)
+subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
   use psb_base_mod, psb_protect_name => psb_dasb_vect_r2
   implicit none
 
@@ -329,10 +337,12 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold)
   type(psb_d_vect_type), intent(inout) ::  x(:)
   integer, intent(out)        ::  info
   class(psb_d_base_vect_type), intent(in), optional :: mold
+  logical, intent(in), optional    :: scratch
 
   ! local variables
   integer :: ictxt,np,me, i, n 
   integer :: int_err(5), i1sz,nrow,ncol, err_act
+  logical :: scratch_
   integer              :: debug_level, debug_unit
   character(len=20)    :: name,ch_err
 
@@ -345,6 +355,8 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold)
   ictxt       = desc_a%get_context()
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
+  scratch_ = .false.
+  if (present(scratch)) scratch_ = scratch
 
   call psb_info(ictxt, me, np)
 
@@ -365,6 +377,13 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
 
+  if (scratch_) then 
+    do i=1,n
+      call x(i)%free(info)
+      call x(i)%bld(ncol,mold=mold)
+    end do
+
+  else
     do i=1, n
       call x(i)%asb(ncol,info)
       if (info /= 0) exit
@@ -380,6 +399,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold)
       call psb_errpush(info,name,a_err='psb_halo')
       goto 9999
     end if
+  end if
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': end'