@ -250,7 +250,7 @@ subroutine psb_casbv(x, desc_a, info)
end subroutine psb_casbv
end subroutine psb_casbv
subroutine psb_casb_vect ( x , desc_a , info , mold )
subroutine psb_casb_vect ( x , desc_a , info , mold , scratch )
use psb_base_mod , psb_protect_name = > psb_casb_vect
use psb_base_mod , psb_protect_name = > psb_casb_vect
implicit none
implicit none
@ -258,10 +258,12 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
type ( psb_c_vect_type ) , intent ( inout ) :: x
type ( psb_c_vect_type ) , intent ( inout ) :: x
integer , intent ( out ) :: info
integer , intent ( out ) :: info
class ( psb_c_base_vect_type ) , intent ( in ) , optional :: mold
class ( psb_c_base_vect_type ) , intent ( in ) , optional :: mold
logical , intent ( in ) , optional :: scratch
! local variables
! local variables
integer :: ictxt , np , me
integer :: ictxt , np , me
integer :: int_err ( 5 ) , i1sz , nrow , ncol , err_act
integer :: int_err ( 5 ) , i1sz , nrow , ncol , err_act
logical :: scratch_
integer :: debug_level , debug_unit
integer :: debug_level , debug_unit
character ( len = 20 ) :: name , ch_err
character ( len = 20 ) :: name , ch_err
@ -275,6 +277,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit ( )
debug_unit = psb_get_debug_unit ( )
debug_level = psb_get_debug_level ( )
debug_level = psb_get_debug_level ( )
scratch_ = . false .
if ( present ( scratch ) ) scratch_ = scratch
call psb_info ( ictxt , me , np )
call psb_info ( ictxt , me , np )
! . . . . verify blacs grid correctness . .
! . . . . verify blacs grid correctness . .
@ -293,6 +297,10 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
if ( debug_level > = psb_debug_ext_ ) &
if ( debug_level > = psb_debug_ext_ ) &
& write ( debug_unit , * ) me , ' ' , trim ( name ) , ': sizes: ' , nrow , ncol
& 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 )
call x % asb ( ncol , info )
! . . update halo elements . .
! . . update halo elements . .
call psb_halo ( x , desc_a , info )
call psb_halo ( x , desc_a , info )
@ -304,6 +312,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
if ( present ( mold ) ) then
if ( present ( mold ) ) then
call x % cnv ( mold )
call x % cnv ( mold )
end if
end if
end if
if ( debug_level > = psb_debug_ext_ ) &
if ( debug_level > = psb_debug_ext_ ) &
& write ( debug_unit , * ) me , ' ' , trim ( name ) , ': end'
& write ( debug_unit , * ) me , ' ' , trim ( name ) , ': end'
@ -321,7 +330,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
end subroutine psb_casb_vect
end subroutine psb_casb_vect
subroutine psb_casb_vect_r2 ( x , desc_a , info , mold )
subroutine psb_casb_vect_r2 ( x , desc_a , info , mold , scratch )
use psb_base_mod , psb_protect_name = > psb_casb_vect_r2
use psb_base_mod , psb_protect_name = > psb_casb_vect_r2
implicit none
implicit none
@ -329,10 +338,12 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
type ( psb_c_vect_type ) , intent ( inout ) :: x ( : )
type ( psb_c_vect_type ) , intent ( inout ) :: x ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
class ( psb_c_base_vect_type ) , intent ( in ) , optional :: mold
class ( psb_c_base_vect_type ) , intent ( in ) , optional :: mold
logical , intent ( in ) , optional :: scratch
! local variables
! local variables
integer :: ictxt , np , me , i , n
integer :: ictxt , np , me , i , n
integer :: int_err ( 5 ) , i1sz , nrow , ncol , err_act
integer :: int_err ( 5 ) , i1sz , nrow , ncol , err_act
logical :: scratch_
integer :: debug_level , debug_unit
integer :: debug_level , debug_unit
character ( len = 20 ) :: name , ch_err
character ( len = 20 ) :: name , ch_err
@ -346,6 +357,8 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit ( )
debug_unit = psb_get_debug_unit ( )
debug_level = psb_get_debug_level ( )
debug_level = psb_get_debug_level ( )
scratch_ = . false .
if ( present ( scratch ) ) scratch_ = scratch
call psb_info ( ictxt , me , np )
call psb_info ( ictxt , me , np )
! . . . . verify blacs grid correctness . .
! . . . . verify blacs grid correctness . .
@ -365,6 +378,14 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
if ( debug_level > = psb_debug_ext_ ) &
if ( debug_level > = psb_debug_ext_ ) &
& write ( debug_unit , * ) me , ' ' , trim ( name ) , ': sizes: ' , nrow , ncol
& 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
do i = 1 , n
call x ( i ) % asb ( ncol , info )
call x ( i ) % asb ( ncol , info )
if ( info / = 0 ) exit
if ( info / = 0 ) exit
@ -380,6 +401,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
call psb_errpush ( info , name , a_err = 'psb_halo' )
call psb_errpush ( info , name , a_err = 'psb_halo' )
go to 9999
go to 9999
end if
end if
end if
if ( debug_level > = psb_debug_ext_ ) &
if ( debug_level > = psb_debug_ext_ ) &
& write ( debug_unit , * ) me , ' ' , trim ( name ) , ': end'
& write ( debug_unit , * ) me , ' ' , trim ( name ) , ': end'