@ -34,7 +34,7 @@ Module psb_c_tools_mod
interface psb_geall
subroutine psb_calloc ( x , desc_a , info , n , lb )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
implicit none
complex ( psb_spk_ ) , allocatable , intent ( out ) :: x ( : , : )
type ( psb_desc_type ) , intent ( in ) :: desc_a
@ -42,7 +42,7 @@ Module psb_c_tools_mod
integer , optional , intent ( in ) :: n , lb
end subroutine psb_calloc
subroutine psb_callocv ( x , desc_a , info , n )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
complex ( psb_spk_ ) , allocatable , intent ( out ) :: x ( : )
type ( psb_desc_type ) , intent ( in ) :: desc_a
integer , intent ( out ) :: info
@ -53,13 +53,13 @@ Module psb_c_tools_mod
interface psb_geasb
subroutine psb_casb ( x , desc_a , info )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
type ( psb_desc_type ) , intent ( in ) :: desc_a
complex ( psb_spk_ ) , allocatable , intent ( inout ) :: x ( : , : )
integer , intent ( out ) :: info
end subroutine psb_casb
subroutine psb_casbv ( x , desc_a , info )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
type ( psb_desc_type ) , intent ( in ) :: desc_a
complex ( psb_spk_ ) , allocatable , intent ( inout ) :: x ( : )
integer , intent ( out ) :: info
@ -69,7 +69,7 @@ Module psb_c_tools_mod
interface psb_sphalo
Subroutine psb_csphalo ( a , desc_a , blk , info , rowcnv , colcnv , &
& rowscale , colscale , outfmt , data )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
Type ( psb_c_sparse_mat ) , Intent ( in ) :: a
Type ( psb_c_sparse_mat ) , Intent ( inout ) :: blk
@ -83,13 +83,13 @@ Module psb_c_tools_mod
interface psb_gefree
subroutine psb_cfree ( x , desc_a , info )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
complex ( psb_spk_ ) , allocatable , intent ( inout ) :: x ( : , : )
type ( psb_desc_type ) , intent ( in ) :: desc_a
integer , intent ( out ) :: info
end subroutine psb_cfree
subroutine psb_cfreev ( x , desc_a , info )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
complex ( psb_spk_ ) , allocatable , intent ( inout ) :: x ( : )
type ( psb_desc_type ) , intent ( in ) :: desc_a
integer , intent ( out ) :: info
@ -99,7 +99,7 @@ Module psb_c_tools_mod
interface psb_geins
subroutine psb_cinsi ( m , irw , val , x , desc_a , info , dupl )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
integer , intent ( in ) :: m
type ( psb_desc_type ) , intent ( in ) :: desc_a
complex ( psb_spk_ ) , intent ( inout ) :: x ( : , : )
@ -109,7 +109,7 @@ Module psb_c_tools_mod
integer , optional , intent ( in ) :: dupl
end subroutine psb_cinsi
subroutine psb_cinsvi ( m , irw , val , x , desc_a , info , dupl )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
integer , intent ( in ) :: m
type ( psb_desc_type ) , intent ( in ) :: desc_a
complex ( psb_spk_ ) , intent ( inout ) :: x ( : )
@ -123,7 +123,7 @@ Module psb_c_tools_mod
interface psb_cdbldext
Subroutine psb_ccdbldext ( a , desc_a , novr , desc_ov , info , extype )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
integer , intent ( in ) :: novr
Type ( psb_c_sparse_mat ) , Intent ( in ) :: a
@ -136,7 +136,7 @@ Module psb_c_tools_mod
interface psb_spall
subroutine psb_cspalloc ( a , desc_a , info , nnz )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
type ( psb_desc_type ) , intent ( inout ) :: desc_a
type ( psb_c_sparse_mat ) , intent ( out ) :: a
@ -147,7 +147,7 @@ Module psb_c_tools_mod
interface psb_spasb
subroutine psb_cspasb ( a , desc_a , info , afmt , upd , dupl , mold )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat , psb_c_base_sparse_mat
type ( psb_c_sparse_mat ) , intent ( inout ) :: a
type ( psb_desc_type ) , intent ( in ) :: desc_a
@ -160,7 +160,7 @@ Module psb_c_tools_mod
interface psb_spfree
subroutine psb_cspfree ( a , desc_a , info )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
type ( psb_desc_type ) , intent ( in ) :: desc_a
type ( psb_c_sparse_mat ) , intent ( inout ) :: a
@ -171,7 +171,7 @@ Module psb_c_tools_mod
interface psb_spins
subroutine psb_cspins ( nz , ia , ja , val , a , desc_a , info , rebuild )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
type ( psb_desc_type ) , intent ( inout ) :: desc_a
type ( psb_c_sparse_mat ) , intent ( inout ) :: a
@ -181,7 +181,7 @@ Module psb_c_tools_mod
logical , intent ( in ) , optional :: rebuild
end subroutine psb_cspins
subroutine psb_cspins_2desc ( nz , ia , ja , val , a , desc_ar , desc_ac , info )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
type ( psb_desc_type ) , intent ( in ) :: desc_ar
type ( psb_desc_type ) , intent ( inout ) :: desc_ac
@ -195,7 +195,7 @@ Module psb_c_tools_mod
interface psb_sprn
subroutine psb_csprn ( a , desc_a , info , clear )
use psb_descriptor_type
use psb_descriptor_type , only : psb_desc_type , psb_spk_ , psb_dpk_
use psb_mat_mod , only : psb_c_sparse_mat
type ( psb_desc_type ) , intent ( in ) :: desc_a
type ( psb_c_sparse_mat ) , intent ( inout ) :: a
@ -204,90 +204,90 @@ Module psb_c_tools_mod
end subroutine psb_csprn
end interface
interface psb_linmap_init
module procedure psb_clinmap_init
end interface
interface psb_linmap_ins
module procedure psb_clinmap_ins
end interface
interface psb_linmap_asb
module procedure psb_clinmap_asb
end interface
contains
subroutine psb_clinmap_init ( a_map , cd_xt , descin , descout )
use psb_base_tools_mod
use psb_c_mat_mod
use psb_descriptor_type
use psb_serial_mod
use psb_penv_mod
use psb_error_mod
implicit none
type ( psb_c_sparse_mat ) , intent ( out ) :: a_map
type ( psb_desc_type ) , intent ( out ) :: cd_xt
type ( psb_desc_type ) , intent ( in ) :: descin , descout
integer :: nrow_in , nrow_out , ncol_in , info , ictxt
ictxt = psb_cd_get_context ( descin )
call psb_cdcpy ( descin , cd_xt , info )
if ( info == 0 ) call psb_cd_reinit ( cd_xt , info )
if ( info / = 0 ) then
write ( 0 , * ) 'Error on reinitialising the extension map'
call psb_error ( ictxt )
call psb_abort ( ictxt )
stop
end if
nrow_in = psb_cd_get_local_rows ( cd_xt )
ncol_in = psb_cd_get_local_cols ( cd_xt )
nrow_out = psb_cd_get_local_rows ( descout )
call a_map % csall ( nrow_out , ncol_in , info )
end subroutine psb_clinmap_init
subroutine psb_clinmap_ins ( nz , ir , ic , val , a_map , cd_xt , descin , descout )
use psb_base_tools_mod
use psb_c_mat_mod
use psb_descriptor_type
implicit none
integer , intent ( in ) :: nz
integer , intent ( in ) :: ir ( : ) , ic ( : )
complex ( psb_spk_ ) , intent ( in ) :: val ( : )
type ( psb_c_sparse_mat ) , intent ( inout ) :: a_map
type ( psb_desc_type ) , intent ( inout ) :: cd_xt
type ( psb_desc_type ) , intent ( in ) :: descin , descout
integer :: info
call psb_spins ( nz , ir , ic , val , a_map , descout , cd_xt , info )
end subroutine psb_clinmap_ins
subroutine psb_clinmap_asb ( a_map , cd_xt , descin , descout , afmt )
use psb_base_tools_mod
use psb_c_mat_mod
use psb_descriptor_type
use psb_serial_mod
implicit none
type ( psb_c_sparse_mat ) , intent ( inout ) :: a_map
type ( psb_desc_type ) , intent ( inout ) :: cd_xt
type ( psb_desc_type ) , intent ( in ) :: descin , descout
character ( len = * ) , optional , intent ( in ) :: afmt
integer :: nrow_in , nrow_out , ncol_in , info , ictxt
ictxt = psb_cd_get_context ( descin )
call psb_cdasb ( cd_xt , info )
call a_map % set_ncols ( psb_cd_get_local_cols ( cd_xt ) )
call a_map % cscnv ( info , type = afmt )
end subroutine psb_clinmap_asb
! ! $
! ! $ interface psb_linmap_init
! ! $ module procedure psb_clinmap_init
! ! $ end interface
! ! $
! ! $ interface psb_linmap_ins
! ! $ module procedure psb_clinmap_ins
! ! $ end interface
! ! $
! ! $ interface psb_linmap_asb
! ! $ module procedure psb_clinmap_asb
! ! $ end interface
! ! $
! ! $ contains
! ! $ subroutine psb_clinmap_init ( a_map , cd_xt , descin , descout )
! ! $ use psb_base_tools_mod
! ! $ use psb_c_mat_mod
! ! $ use psb_descriptor_type
! ! $ use psb_serial_mod
! ! $ use psb_penv_mod
! ! $ use psb_error_mod
! ! $ implicit none
! ! $ type ( psb_c_sparse_mat ) , intent ( out ) :: a_map
! ! $ type ( psb_desc_type ) , intent ( out ) :: cd_xt
! ! $ type ( psb_desc_type ) , intent ( in ) :: descin , descout
! ! $
! ! $ integer :: nrow_in , nrow_out , ncol_in , info , ictxt
! ! $
! ! $ ictxt = psb_cd_get_context ( descin )
! ! $
! ! $ call psb_cdcpy ( descin , cd_xt , info )
! ! $ if ( info == 0 ) call psb_cd_reinit ( cd_xt , info )
! ! $ if ( info / = 0 ) then
! ! $ write ( 0 , * ) 'Error on reinitialising the extension map'
! ! $ call psb_error ( ictxt )
! ! $ call psb_abort ( ictxt )
! ! $ stop
! ! $ end if
! ! $
! ! $ nrow_in = psb_cd_get_local_rows ( cd_xt )
! ! $ ncol_in = psb_cd_get_local_cols ( cd_xt )
! ! $ nrow_out = psb_cd_get_local_rows ( descout )
! ! $
! ! $ call a_map % csall ( nrow_out , ncol_in , info )
! ! $
! ! $ end subroutine psb_clinmap_init
! ! $
! ! $ subroutine psb_clinmap_ins ( nz , ir , ic , val , a_map , cd_xt , descin , descout )
! ! $ use psb_base_tools_mod
! ! $ use psb_c_mat_mod
! ! $ use psb_descriptor_type
! ! $ implicit none
! ! $ integer , intent ( in ) :: nz
! ! $ integer , intent ( in ) :: ir ( : ) , ic ( : )
! ! $ complex ( psb_spk_ ) , intent ( in ) :: val ( : )
! ! $ type ( psb_c_sparse_mat ) , intent ( inout ) :: a_map
! ! $ type ( psb_desc_type ) , intent ( inout ) :: cd_xt
! ! $ type ( psb_desc_type ) , intent ( in ) :: descin , descout
! ! $ integer :: info
! ! $
! ! $ call psb_spins ( nz , ir , ic , val , a_map , descout , cd_xt , info )
! ! $
! ! $ end subroutine psb_clinmap_ins
! ! $
! ! $ subroutine psb_clinmap_asb ( a_map , cd_xt , descin , descout , afmt )
! ! $ use psb_base_tools_mod
! ! $ use psb_c_mat_mod
! ! $ use psb_descriptor_type
! ! $ use psb_serial_mod
! ! $ implicit none
! ! $ type ( psb_c_sparse_mat ) , intent ( inout ) :: a_map
! ! $ type ( psb_desc_type ) , intent ( inout ) :: cd_xt
! ! $ type ( psb_desc_type ) , intent ( in ) :: descin , descout
! ! $ character ( len = * ) , optional , intent ( in ) :: afmt
! ! $
! ! $ integer :: nrow_in , nrow_out , ncol_in , info , ictxt
! ! $
! ! $ ictxt = psb_cd_get_context ( descin )
! ! $
! ! $ call psb_cdasb ( cd_xt , info )
! ! $ call a_map % set_ncols ( psb_cd_get_local_cols ( cd_xt ) )
! ! $ call a_map % cscnv ( info , type = afmt )
! ! $
! ! $ end subroutine psb_clinmap_asb
end module psb_c_tools_mod