@ -29,51 +29,10 @@
! ! $ POSSIBILITY OF SUCH DAMAGE .
! ! $
! ! $
Module psb_base _tools_mod
module psb_iv _tools_mod
use psb_const_mod
interface psb_cd_set_bld
subroutine psb_cd_set_bld ( desc , info )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc
integer :: info
end subroutine psb_cd_set_bld
end interface
interface psb_cd_set_ovl_bld
subroutine psb_cd_set_ovl_bld ( desc , info )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc
integer :: info
end subroutine psb_cd_set_ovl_bld
end interface
interface psb_cd_reinit
Subroutine psb_cd_reinit ( desc , info )
use psb_descriptor_type
Implicit None
! . . Array Arguments . .
Type ( psb_desc_type ) , Intent ( inout ) :: desc
integer , intent ( out ) :: info
end Subroutine psb_cd_reinit
end interface
interface psb_cdcpy
subroutine psb_cdcpy ( desc_in , desc_out , info )
use psb_descriptor_type
implicit none
! . . . . parameters . . .
type ( psb_desc_type ) , intent ( in ) :: desc_in
type ( psb_desc_type ) , intent ( out ) :: desc_out
integer , intent ( out ) :: info
end subroutine psb_cdcpy
end interface
interface psb_geall
subroutine psb_ialloc ( x , desc_a , info , n , lb )
use psb_descriptor_type
@ -107,17 +66,6 @@ Module psb_base_tools_mod
end subroutine psb_iasbv
end interface
interface psb_cdprt
subroutine psb_cdprt ( iout , desc_p , glob , short )
use psb_const_mod
use psb_descriptor_type
implicit none
type ( psb_desc_type ) , intent ( in ) :: desc_p
integer , intent ( in ) :: iout
logical , intent ( in ) , optional :: glob , short
end subroutine psb_cdprt
end interface
interface psb_gefree
subroutine psb_ifree ( x , desc_a , info )
@ -158,57 +106,6 @@ Module psb_base_tools_mod
end interface
interface psb_cdall
module procedure psb_cdall
end interface
interface psb_cdasb
module procedure psb_cdasb
end interface
interface psb_cdins
subroutine psb_cdinsrc ( nz , ia , ja , desc_a , info , ila , jla )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc_a
integer , intent ( in ) :: nz , ia ( : ) , ja ( : )
integer , intent ( out ) :: info
integer , optional , intent ( out ) :: ila ( : ) , jla ( : )
end subroutine psb_cdinsrc
subroutine psb_cdinsc ( nz , ja , desc , info , jla , mask )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc
integer , intent ( in ) :: nz , ja ( : )
integer , intent ( out ) :: info
integer , optional , intent ( out ) :: jla ( : )
logical , optional , target , intent ( in ) :: mask ( : )
end subroutine psb_cdinsc
end interface
interface psb_cdbldext
Subroutine psb_cd_lstext ( desc_a , in_list , desc_ov , info , mask , extype )
use psb_descriptor_type
Implicit None
Type ( psb_desc_type ) , Intent ( in ) , target :: desc_a
integer , intent ( in ) :: in_list ( : )
Type ( psb_desc_type ) , Intent ( out ) :: desc_ov
integer , intent ( out ) :: info
logical , intent ( in ) , optional , target :: mask ( : )
integer , intent ( in ) , optional :: extype
end Subroutine psb_cd_lstext
end interface
interface psb_cdren
subroutine psb_cdren ( trans , iperm , desc_a , info )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc_a
integer , intent ( inout ) :: iperm ( : )
character , intent ( in ) :: trans
integer , intent ( out ) :: info
end subroutine psb_cdren
end interface
interface psb_glob_to_loc
subroutine psb_glob_to_loc2 ( x , y , desc_a , info , iact , owned )
use psb_descriptor_type
@ -286,28 +183,6 @@ Module psb_base_tools_mod
end interface
interface psb_get_boundary
module procedure psb_get_boundary
end interface
interface psb_get_overlap
subroutine psb_get_ovrlap ( ovrel , desc , info )
use psb_descriptor_type
implicit none
integer , allocatable , intent ( out ) :: ovrel ( : )
type ( psb_desc_type ) , intent ( in ) :: desc
integer , intent ( out ) :: info
end subroutine psb_get_ovrlap
end interface
interface psb_icdasb
subroutine psb_icdasb ( desc , info , ext_hv )
use psb_descriptor_type
Type ( psb_desc_type ) , intent ( inout ) :: desc
integer , intent ( out ) :: info
logical , intent ( in ) , optional :: ext_hv
end subroutine psb_icdasb
end interface
interface psb_is_owned
module procedure psb_is_owned
@ -419,9 +294,164 @@ contains
res = ( lx > 0 )
end subroutine psb_local_index_v
end module psb_iv_tools_mod
module psb_cd_if_tools_mod
use psb_const_mod
interface psb_cd_set_bld
subroutine psb_cd_set_bld ( desc , info )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc
integer :: info
end subroutine psb_cd_set_bld
end interface
interface psb_cd_set_ovl_bld
subroutine psb_cd_set_ovl_bld ( desc , info )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc
integer :: info
end subroutine psb_cd_set_ovl_bld
end interface
interface psb_cd_reinit
Subroutine psb_cd_reinit ( desc , info )
use psb_descriptor_type
Implicit None
! . . Array Arguments . .
Type ( psb_desc_type ) , Intent ( inout ) :: desc
integer , intent ( out ) :: info
end Subroutine psb_cd_reinit
end interface
interface psb_cdcpy
subroutine psb_cdcpy ( desc_in , desc_out , info )
use psb_descriptor_type
implicit none
! . . . . parameters . . .
type ( psb_desc_type ) , intent ( in ) :: desc_in
type ( psb_desc_type ) , intent ( out ) :: desc_out
integer , intent ( out ) :: info
end subroutine psb_cdcpy
end interface
interface psb_cdprt
subroutine psb_cdprt ( iout , desc_p , glob , short )
use psb_const_mod
use psb_descriptor_type
implicit none
type ( psb_desc_type ) , intent ( in ) :: desc_p
integer , intent ( in ) :: iout
logical , intent ( in ) , optional :: glob , short
end subroutine psb_cdprt
end interface
interface psb_cdins
subroutine psb_cdinsrc ( nz , ia , ja , desc_a , info , ila , jla )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc_a
integer , intent ( in ) :: nz , ia ( : ) , ja ( : )
integer , intent ( out ) :: info
integer , optional , intent ( out ) :: ila ( : ) , jla ( : )
end subroutine psb_cdinsrc
subroutine psb_cdinsc ( nz , ja , desc , info , jla , mask )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc
integer , intent ( in ) :: nz , ja ( : )
integer , intent ( out ) :: info
integer , optional , intent ( out ) :: jla ( : )
logical , optional , target , intent ( in ) :: mask ( : )
end subroutine psb_cdinsc
end interface
interface psb_cdbldext
Subroutine psb_cd_lstext ( desc_a , in_list , desc_ov , info , mask , extype )
use psb_descriptor_type
Implicit None
Type ( psb_desc_type ) , Intent ( in ) , target :: desc_a
integer , intent ( in ) :: in_list ( : )
Type ( psb_desc_type ) , Intent ( out ) :: desc_ov
integer , intent ( out ) :: info
logical , intent ( in ) , optional , target :: mask ( : )
integer , intent ( in ) , optional :: extype
end Subroutine psb_cd_lstext
end interface
interface psb_cdren
subroutine psb_cdren ( trans , iperm , desc_a , info )
use psb_descriptor_type
type ( psb_desc_type ) , intent ( inout ) :: desc_a
integer , intent ( inout ) :: iperm ( : )
character , intent ( in ) :: trans
integer , intent ( out ) :: info
end subroutine psb_cdren
end interface
interface psb_get_overlap
subroutine psb_get_ovrlap ( ovrel , desc , info )
use psb_descriptor_type
implicit none
integer , allocatable , intent ( out ) :: ovrel ( : )
type ( psb_desc_type ) , intent ( in ) :: desc
integer , intent ( out ) :: info
end subroutine psb_get_ovrlap
end interface
interface psb_icdasb
subroutine psb_icdasb ( desc , info , ext_hv )
use psb_descriptor_type
Type ( psb_desc_type ) , intent ( inout ) :: desc
integer , intent ( out ) :: info
logical , intent ( in ) , optional :: ext_hv
end subroutine psb_icdasb
end interface
end module psb_cd_if_tools_mod
module psb_cd_tools_mod
use psb_const_mod
use psb_cd_if_tools_mod
interface psb_cdall
subroutine psb_cdall ( ictxt , desc , info , mg , ng , parts , vg , vl , flag , nl , repl , globalcheck )
use psb_descriptor_type
implicit None
include 'parts.fh'
Integer , intent ( in ) :: mg , ng , ictxt , vg ( : ) , vl ( : ) , nl
integer , intent ( in ) :: flag
logical , intent ( in ) :: repl , globalcheck
integer , intent ( out ) :: info
type ( psb_desc_type ) , intent ( out ) :: desc
optional :: mg , ng , parts , vg , vl , flag , nl , repl , globalcheck
end subroutine psb_cdall
end interface
interface psb_cdasb
module procedure psb_cdasb
end interface
interface psb_get_boundary
module procedure psb_get_boundary
end interface
contains
subroutine psb_get_boundary ( bndel , desc , info )
use psb_descriptor_type
use psi_mod
use psi_mod , only : psi_crea_bnd_elem
implicit none
integer , allocatable , intent ( out ) :: bndel ( : )
type ( psb_desc_type ) , intent ( in ) :: desc
@ -431,153 +461,161 @@ contains
end subroutine psb_get_boundary
subroutine psb_cda ll( ictxt , desc , info , mg , ng , parts , vg , vl , flag , nl , repl , globalcheck )
subroutine psb_cda sb( desc , info )
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit None
include 'parts.fh'
Integer , intent ( in ) :: mg , ng , ictxt , vg ( : ) , vl ( : ) , nl
integer , intent ( in ) :: flag
logical , intent ( in ) :: repl , globalcheck
integer , intent ( out ) :: info
type ( psb_desc_type ) , intent ( out ) :: desc
optional :: mg , ng , parts , vg , vl , flag , nl , repl , globalcheck
interface
subroutine psb_cdals ( m , n , parts , ictxt , desc , info )
use psb_descriptor_type
include 'parts.fh'
Integer , intent ( in ) :: m , n , ictxt
Type ( psb_desc_type ) , intent ( out ) :: desc
integer , intent ( out ) :: info
end subroutine psb_cdals
subroutine psb_cdalv ( v , ictxt , desc , info , flag )
use psb_descriptor_type
Integer , intent ( in ) :: ictxt , v ( : )
integer , intent ( in ) , optional :: flag
integer , intent ( out ) :: info
Type ( psb_desc_type ) , intent ( out ) :: desc
end subroutine psb_cdalv
subroutine psb_cd_inloc ( v , ictxt , desc , info , globalcheck )
use psb_descriptor_type
implicit None
Integer , intent ( in ) :: ictxt , v ( : )
integer , intent ( out ) :: info
type ( psb_desc_type ) , intent ( out ) :: desc
logical , intent ( in ) , optional :: globalcheck
end subroutine psb_cd_inloc
subroutine psb_cdrep ( m , ictxt , desc , info )
use psb_descriptor_type
Integer , intent ( in ) :: m , ictxt
Type ( psb_desc_type ) , intent ( out ) :: desc
integer , intent ( out ) :: info
end subroutine psb_cdrep
end interface
character ( len = 20 ) :: name
integer :: err_act , n_ , flag_ , i , me , np , nlp
integer , allocatable :: itmpsz ( : )
if ( psb_get_errstatus ( ) / = 0 ) return
info = 0
name = 'psb_cdall'
call psb_erractionsave ( err_act )
call psb_info ( ictxt , me , np )
if ( count ( ( / present ( vg ) , present ( vl ) , &
& present ( parts ) , present ( nl ) , present ( repl ) / ) ) / = 1 ) then
Type ( psb_desc_type ) , intent ( inout ) :: desc
integer , intent ( out ) :: info
call psb_icdasb ( desc , info , ext_hv = . false . )
end subroutine psb_cdasb
end module psb_cd_tools_mod
module psb_base_tools_mod
use psb_iv_tools_mod
use psb_cd_tools_mod
end module psb_base_tools_mod
subroutine psb_cdall ( ictxt , desc , info , mg , ng , parts , vg , vl , flag , nl , repl , globalcheck )
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit None
include 'parts.fh'
Integer , intent ( in ) :: mg , ng , ictxt , vg ( : ) , vl ( : ) , nl
integer , intent ( in ) :: flag
logical , intent ( in ) :: repl , globalcheck
integer , intent ( out ) :: info
type ( psb_desc_type ) , intent ( out ) :: desc
optional :: mg , ng , parts , vg , vl , flag , nl , repl , globalcheck
interface
subroutine psb_cdals ( m , n , parts , ictxt , desc , info )
use psb_descriptor_type
include 'parts.fh'
Integer , intent ( in ) :: m , n , ictxt
Type ( psb_desc_type ) , intent ( out ) :: desc
integer , intent ( out ) :: info
end subroutine psb_cdals
subroutine psb_cdalv ( v , ictxt , desc , info , flag )
use psb_descriptor_type
Integer , intent ( in ) :: ictxt , v ( : )
integer , intent ( in ) , optional :: flag
integer , intent ( out ) :: info
Type ( psb_desc_type ) , intent ( out ) :: desc
end subroutine psb_cdalv
subroutine psb_cd_inloc ( v , ictxt , desc , info , globalcheck )
use psb_descriptor_type
implicit None
Integer , intent ( in ) :: ictxt , v ( : )
integer , intent ( out ) :: info
type ( psb_desc_type ) , intent ( out ) :: desc
logical , intent ( in ) , optional :: globalcheck
end subroutine psb_cd_inloc
subroutine psb_cdrep ( m , ictxt , desc , info )
use psb_descriptor_type
Integer , intent ( in ) :: m , ictxt
Type ( psb_desc_type ) , intent ( out ) :: desc
integer , intent ( out ) :: info
end subroutine psb_cdrep
end interface
character ( len = 20 ) :: name
integer :: err_act , n_ , flag_ , i , me , np , nlp
integer , allocatable :: itmpsz ( : )
if ( psb_get_errstatus ( ) / = 0 ) return
info = 0
name = 'psb_cdall'
call psb_erractionsave ( err_act )
call psb_info ( ictxt , me , np )
if ( count ( ( / present ( vg ) , present ( vl ) , &
& present ( parts ) , present ( nl ) , present ( repl ) / ) ) / = 1 ) then
info = 581
call psb_errpush ( info , name , a_err = " vg, vl, parts, nl, repl" )
go to 999
endif
desc % base_desc = > null ( )
if ( present ( parts ) ) then
if ( . not . present ( mg ) ) then
info = 581
call psb_errpush ( info , name , a_err = " vg, vl, parts, nl, repl" )
call psb_errpush ( info , name )
go to 999
end if
if ( present ( ng ) ) then
n_ = ng
else
n_ = mg
endif
call psb_cdals ( mg , n_ , parts , ictxt , desc , info )
desc % base_desc = > null ( )
if ( present ( parts ) ) then
if ( . not . present ( mg ) ) then
info = 581
call psb_errpush ( info , name )
go to 999
end if
if ( present ( ng ) ) then
n_ = ng
else
n_ = mg
endif
call psb_cdals ( mg , n_ , parts , ictxt , desc , info )
else if ( present ( repl ) ) then
if ( . not . present ( mg ) ) then
info = 581
call psb_errpush ( info , name )
go to 999
end if
if ( . not . repl ) then
info = 581
call psb_errpush ( info , name )
go to 999
end if
call psb_cdrep ( mg , ictxt , desc , info )
else if ( present ( vg ) ) then
if ( present ( flag ) ) then
flag_ = flag
else
flag_ = 0
endif
call psb_cdalv ( vg , ictxt , desc , info , flag = flag_ )
else if ( present ( vl ) ) then
call psb_cd_inloc ( vl , ictxt , desc , info , globalcheck = globalcheck )
else if ( present ( nl ) ) then
allocate ( itmpsz ( 0 : np - 1 ) , stat = info )
if ( info / = 0 ) then
info = 4000
call psb_errpush ( info , name )
go to 999
endif
itmpsz = 0
itmpsz ( me ) = nl
call psb_sum ( ictxt , itmpsz )
nlp = 0
do i = 0 , me - 1
nlp = nlp + itmpsz ( i )
end do
call psb_cd_inloc ( ( / ( i , i = nlp + 1 , nlp + nl ) / ) , ictxt , desc , info , globalcheck = . false . )
else if ( present ( repl ) ) then
if ( . not . present ( mg ) ) then
info = 581
call psb_errpush ( info , name )
go to 999
end if
if ( . not . repl ) then
info = 581
call psb_errpush ( info , name )
go to 999
end if
call psb_cdrep ( mg , ictxt , desc , info )
else if ( present ( vg ) ) then
if ( present ( flag ) ) then
flag_ = flag
else
flag_ = 0
endif
call psb_cdalv ( vg , ictxt , desc , info , flag = flag_ )
if ( info / = 0 ) go to 999
else if ( present ( vl ) ) then
call psb_cd_inloc ( vl , ictxt , desc , info , globalcheck = globalcheck )
call psb_erractionrestore ( err_act )
return
else if ( present ( nl ) ) then
allocate ( itmpsz ( 0 : np - 1 ) , stat = info )
if ( info / = 0 ) then
info = 4000
call psb_errpush ( info , name )
go to 999
endif
999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( ictxt )
return
end if
return
itmpsz = 0
itmpsz ( me ) = nl
call psb_sum ( ictxt , itmpsz )
nlp = 0
do i = 0 , me - 1
nlp = nlp + itmpsz ( i )
end do
call psb_cd_inloc ( ( / ( i , i = nlp + 1 , nlp + nl ) / ) , ictxt , desc , info , globalcheck = . false . )
endif
end subroutine psb_cdall
if ( info / = 0 ) go to 999
subroutine psb_cdasb ( desc , info )
use psb_descriptor_type
call psb_erractionrestore ( err_act )
return
Type ( psb_desc_type ) , intent ( inout ) :: desc
integer , intent ( out ) :: info
999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( ictxt )
return
end if
return
call psb_icdasb ( desc , info , ext_hv = . false . )
end subroutine psb_cdasb
end module psb_base_tools_mod
end subroutine psb_cdall