mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-18 20:02:27 +00:00
Initial revision
This commit is contained in:
Salvatore Filippone
@@ -0,0 +1,22 @@
|
||||
include ../../Make.inc
|
||||
|
||||
MODULES = psb_realloc_mod.o psb_string_mod.o psb_spmat_type.o \
|
||||
psb_desc_type.o \
|
||||
psb_blacs_mod.o psb_serial_mod.o psb_tools_mod.o \
|
||||
psb_prec_type.o psb_error_mod.o psb_prec_mod.o \
|
||||
psb_methd_mod.o psb_const_mod.o \
|
||||
psb_comm_mod.o psb_psblas_mod.o psi_mod.o
|
||||
|
||||
OBJS = error.o parts.o
|
||||
|
||||
INCDIRS = ../../lib
|
||||
|
||||
psb_realloc_mod.o : psb_error_mod.o
|
||||
psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o
|
||||
|
||||
lib: $(MODULES) $(OBJS)
|
||||
cp *$(.mod) ./psb_const.fh ../../lib
|
||||
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(MODULES) $(OBJS) *$(.mod)
|
||||
@@ -0,0 +1,3 @@
|
||||
1- psb_methd_mod: sistemare tutto
|
||||
2- psb_prec_mod : sistemare tutto
|
||||
3- psb_prec_type: sistemare tutto
|
||||
@@ -0,0 +1,130 @@
|
||||
!
|
||||
! Wrapper subroutines to provide error tools to F77 and C code
|
||||
!
|
||||
|
||||
subroutine FCpsb_errcomm(icontxt, err)
|
||||
use psb_error_mod
|
||||
integer, intent(in) :: icontxt
|
||||
integer, intent(inout):: err
|
||||
|
||||
call psb_errcomm(icontxt, err)
|
||||
|
||||
end subroutine FCpsb_errcomm
|
||||
|
||||
subroutine FCpsb_errpush(err_c, r_name, i_err)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: err_c
|
||||
character(len=20), intent(in) :: r_name
|
||||
integer :: i_err(5)
|
||||
|
||||
call psb_errpush(err_c, r_name, i_err)
|
||||
|
||||
end subroutine FCpsb_errpush
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_serror()
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
call psb_error()
|
||||
|
||||
end subroutine FCpsb_serror
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_perror(icontxt)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: icontxt
|
||||
|
||||
call psb_error(icontxt)
|
||||
|
||||
end subroutine FCpsb_perror
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_get_errstatus(s)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(out) :: s
|
||||
|
||||
call psb_get_errstatus(s)
|
||||
|
||||
end subroutine FCpsb_get_errstatus
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_get_errverbosity(v)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(out) :: v
|
||||
|
||||
call psb_get_errverbosity(v)
|
||||
|
||||
end subroutine FCpsb_get_errverbosity
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_set_errverbosity(v)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(inout) :: v
|
||||
|
||||
call psb_set_errverbosity(v)
|
||||
|
||||
end subroutine FCpsb_set_errverbosity
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_erractionsave(err_act)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(out) :: err_act
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
end subroutine FCpsb_erractionsave
|
||||
|
||||
|
||||
subroutine FCpsb_get_erraction(err_act)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
integer, intent(out) :: err_act
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
end subroutine FCpsb_get_erraction
|
||||
|
||||
|
||||
|
||||
subroutine FCpsb_erractionrestore(err_act)
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: err_act
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
end subroutine FCpsb_erractionrestore
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,8 @@
|
||||
module psb_parts_mod
|
||||
interface
|
||||
subroutine psb_parts(glob_index,nrow,np,pv,nv)
|
||||
integer, intent (in) :: glob_index,np,nrow
|
||||
integer, intent (out) :: nv, pv(*)
|
||||
end subroutine psb_parts
|
||||
end interface
|
||||
end module psb_parts_mod
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,110 @@
|
||||
module psb_comm_mod
|
||||
|
||||
interface psb_ovrl
|
||||
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(inout), optional :: work(:)
|
||||
logical, intent(in), optional :: choice
|
||||
integer, intent(in), optional :: update_type,jx,ik
|
||||
end subroutine psb_dovrlm
|
||||
subroutine psb_dovrlv(x,desc_a,info,work,choice,update_type)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(inout), optional :: work(:)
|
||||
logical, intent(in), optional :: choice
|
||||
integer, intent(in), optional :: update_type
|
||||
end subroutine psb_dovrlv
|
||||
end interface
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(in), optional :: alpha
|
||||
real(kind(1.d0)), intent(inout), optional :: work(:)
|
||||
integer, intent(in), optional :: mode,jx,ik
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_dhalom
|
||||
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(in), optional :: alpha
|
||||
real(kind(1.d0)), intent(inout), optional :: work(:)
|
||||
integer, intent(in), optional :: mode
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_dhalov
|
||||
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
use psb_descriptor_type
|
||||
integer, intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(in), optional :: alpha
|
||||
integer, intent(inout), optional :: work(:)
|
||||
integer, intent(in), optional :: mode,jx,ik
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_ihalom
|
||||
subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
|
||||
use psb_descriptor_type
|
||||
integer, intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(in), optional :: alpha
|
||||
integer, intent(inout), optional :: work(:)
|
||||
integer, intent(in), optional :: mode
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_ihalov
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_dscatter
|
||||
subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
|
||||
& iiglobx, ijglobx, iilocx,ijlocx,ik)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(out) :: locx(:,:)
|
||||
real(kind(1.d0)), intent(in) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iroot,iiglobx,&
|
||||
& ijglobx,iilocx,ijlocx,ik
|
||||
end subroutine psb_dscatterm
|
||||
subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(out) :: locx(:)
|
||||
real(kind(1.d0)), intent(in) :: globx(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iroot
|
||||
end subroutine psb_dscatterv
|
||||
end interface
|
||||
|
||||
interface psb_dgather
|
||||
subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
|
||||
& iiglobx, ijglobx, iilocx,ijlocx,ik)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(in) :: locx(:,:)
|
||||
real(kind(1.d0)), intent(out) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iroot, iiglobx, ijglobx, iilocx, ijlocx, ik
|
||||
end subroutine psb_dgatherm
|
||||
subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
|
||||
& iiglobx, iilocx)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(in) :: locx(:,:)
|
||||
real(kind(1.d0)), intent(out) :: globx(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iroot, iiglobx, iilocx
|
||||
end subroutine psb_dgatherv
|
||||
end interface
|
||||
|
||||
end module psb_comm_mod
|
||||
@@ -0,0 +1,38 @@
|
||||
integer, parameter :: psb_nohalo_=0, psb_halo_=4
|
||||
integer, parameter :: psb_none_=0,psb_sum_=1
|
||||
integer, parameter :: psb_avg_=2,psb_square_root_=3
|
||||
integer, parameter :: psb_swap_send_=1,psb_swap_recv_=2
|
||||
integer, parameter :: psb_swap_sync_=4,psb_swap_mpi_=8
|
||||
integer, parameter :: psb_deadlock_check_=0
|
||||
integer, parameter :: psb_local_mtrx_check_=1
|
||||
integer, parameter :: psb_local_comm_check_=2
|
||||
integer, parameter :: psb_consistency_check_=3
|
||||
integer, parameter :: psb_global_check_=4
|
||||
integer, parameter :: psb_order_communication_=5
|
||||
integer, parameter :: psb_change_represent_=6
|
||||
integer, parameter :: psb_loc_to_glob_check_=7
|
||||
integer, parameter :: psb_convert_halo_=1
|
||||
integer, parameter :: psb_convert_ovrlap_=2
|
||||
integer, parameter :: psb_act_ret_=0
|
||||
integer, parameter :: psb_act_abort_=1, no_err_=0
|
||||
integer, parameter :: psb_dec_type_=1,psb_m_=2,psb_n_=3
|
||||
integer, parameter :: psb_n_row_=4,psb_n_col_=5,psb_ctxt_=6
|
||||
integer, parameter :: psb_loc_to_glob_=7
|
||||
integer, parameter :: psb_mpi_c_=9,psb_mdata_size_=10
|
||||
integer, parameter :: psb_desc_asb_=3099
|
||||
integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
|
||||
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
|
||||
integer, parameter :: psb_desc_upd_asb_=psb_desc_upd_+1
|
||||
integer, parameter :: psb_upd_glb_=998,psb_upd_loc_=997
|
||||
integer, parameter :: psb_proc_id_=0,psb_n_elem_recv_=1
|
||||
integer, parameter :: psb_elem_recv_=2,psb_n_elem_send_=2
|
||||
integer, parameter :: psb_elem_send_=3,psb_n_ovrlp_elem_=1
|
||||
integer, parameter :: psb_ovrlp_elem_to_=2,psb_ovrlp_elem_=0
|
||||
integer, parameter :: psb_nnz_=1, psb_n_dom_ovr_=1
|
||||
integer, parameter :: psb_no_comm_=-1, psb_nzsizereq_=3
|
||||
integer, parameter :: ione=1, done=1.d0,izero=0, dzero=0.d0
|
||||
integer, parameter :: itwo=2, ithree=3,root=0, act_abort=1
|
||||
integer, parameter :: psb_nztotreq_=1,psb_nzrowreq_=2
|
||||
character, parameter :: psb_all_='A',psb_topdef_=' '
|
||||
|
||||
|
||||
@@ -0,0 +1,36 @@
|
||||
module psb_const_mod
|
||||
|
||||
integer, parameter :: psb_nohalo_=0, psb_halo_=4
|
||||
integer, parameter :: psb_none_=0, psb_sum_=1
|
||||
integer, parameter :: psb_avg_=2, psb_square_root_=3
|
||||
integer, parameter :: psb_swap_send_=1, psb_swap_recv_=2
|
||||
integer, parameter :: psb_swap_sync_=4, psb_swap_mpi_=8
|
||||
integer, parameter :: psb_deadlock_check_=0, psb_local_mtrx_check_=1
|
||||
integer, parameter :: psb_local_comm_check_=2, psb_consistency_check_=3
|
||||
integer, parameter :: psb_global_check_=4, psb_order_communication_=5
|
||||
integer, parameter :: psb_change_represent_=6, psb_loc_to_glob_check_=7
|
||||
integer, parameter :: psb_convert_halo_=1, psb_convert_ovrlap_=2
|
||||
integer, parameter :: psb_act_ret_=0, psb_act_abort_=1, no_err_=0
|
||||
integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
|
||||
integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6
|
||||
integer, parameter :: psb_loc_to_glob_=7, psb_mpi_c_=9,psb_mdata_size_=10
|
||||
integer, parameter :: psb_desc_asb_=3099, psb_desc_bld_=psb_desc_asb_+1
|
||||
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1, psb_desc_upd_asb_=psb_desc_upd_+1
|
||||
integer, parameter :: psb_upd_glb_=998, psb_upd_loc_=997
|
||||
integer, parameter :: psb_proc_id_=0, psb_n_elem_recv_=1
|
||||
integer, parameter :: psb_elem_recv_=2, psb_n_elem_send_=2
|
||||
integer, parameter :: psb_elem_send_=3, psb_n_ovrlp_elem_=1
|
||||
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0, psb_n_dom_ovr_=1
|
||||
integer, parameter :: psb_nnz_=1
|
||||
integer, parameter :: psb_no_comm_=-1
|
||||
integer, parameter :: ione=1, done=1.d0, izero=0, dzero=0.d0
|
||||
integer, parameter :: itwo=2, ithree=3, root=0
|
||||
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2, psb_nzsizereq_=3
|
||||
|
||||
real(kind(1.d0)), parameter :: psb_colrow_=0.33
|
||||
|
||||
character, parameter :: psb_all_='A', psb_topdef_=' '
|
||||
|
||||
|
||||
|
||||
end module psb_const_mod
|
||||
@@ -0,0 +1,82 @@
|
||||
!
|
||||
! Module to define desc_a,
|
||||
! structure for coomunications.
|
||||
!
|
||||
! Typedef: psb_desc_type
|
||||
! Defines a communication descriptor
|
||||
|
||||
|
||||
module psb_descriptor_type
|
||||
use psb_const_mod
|
||||
|
||||
! desc_type contains data for communications.
|
||||
type psb_desc_type
|
||||
! contain decomposition informations
|
||||
integer, pointer :: matrix_data(:)=>null()
|
||||
! contain index of halo elements to send/receive
|
||||
integer, pointer :: halo_index(:)=>null()
|
||||
! contain indices of boundary elements
|
||||
integer, pointer :: bnd_elem(:)=>null()
|
||||
! contain index of overlap elements to send/receive
|
||||
integer, pointer :: ovrlap_elem(:)=>null()
|
||||
! contain for each local overlap element, the number of times
|
||||
! that is duplicated
|
||||
integer, pointer :: ovrlap_index(:)=>null()
|
||||
! contain for each local element the corresponding global index
|
||||
integer, pointer :: loc_to_glob(:)=>null()
|
||||
! contain for each global element the corresponding local index,
|
||||
! if exist.
|
||||
integer, pointer :: glob_to_loc (:)=>null()
|
||||
! local renumbering induced by sparse matrix storage.
|
||||
integer, pointer :: lprm(:)=>null()
|
||||
! index space in case it is not just the contiguous range 1:n
|
||||
integer, pointer :: idx_space(:)=>null()
|
||||
end type psb_desc_type
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_nullify_desc(desc)
|
||||
type(psb_desc_type), intent(inout) :: desc
|
||||
|
||||
nullify(desc%matrix_data,desc%loc_to_glob,desc%glob_to_loc,&
|
||||
&desc%halo_index,desc%bnd_elem,desc%ovrlap_elem,&
|
||||
&desc%ovrlap_index, desc%lprm, desc%idx_space)
|
||||
|
||||
end subroutine psb_nullify_desc
|
||||
|
||||
logical function psb_is_ok_dec(dectype)
|
||||
integer :: dectype
|
||||
|
||||
psb_is_ok_dec = ((dectype == desc_asb).or.(dectype == desc_bld).or.&
|
||||
&(dectype == desc_upd).or.(dectype== desc_upd_asb))
|
||||
|
||||
end function psb_is_ok_dec
|
||||
|
||||
logical function psb_is_bld_dec(dectype)
|
||||
integer :: dectype
|
||||
|
||||
psb_is_bld_dec = (dectype == desc_bld)
|
||||
end function psb_is_bld_dec
|
||||
|
||||
logical function psb_is_upd_dec(dectype)
|
||||
integer :: dectype
|
||||
|
||||
psb_is_upd_dec = (dectype == desc_upd)
|
||||
|
||||
end function psb_is_upd_dec
|
||||
|
||||
logical function psb_is_asb_upd_dec(dectype)
|
||||
integer :: dectype
|
||||
|
||||
psb_is_asb_upd_dec = (dectype == desc_upd_asb)
|
||||
|
||||
end function psb_is_asb_upd_dec
|
||||
|
||||
logical function psb_is_asb_dec(dectype)
|
||||
integer :: dectype
|
||||
|
||||
psb_is_asb_dec = (dectype == desc_asb)
|
||||
|
||||
end function psb_is_asb_dec
|
||||
|
||||
end module psb_descriptor_type
|
||||
@@ -0,0 +1,428 @@
|
||||
module psb_error_mod
|
||||
|
||||
public psb_errpush, psb_error, psb_get_errstatus,&
|
||||
& psb_get_errverbosity, psb_set_errverbosity,psb_errcomm, &
|
||||
& psb_erractionsave, psb_erractionrestore, act_ret, act_abort, &
|
||||
& no_err, psb_get_erraction, psb_set_erraction
|
||||
|
||||
interface psb_error
|
||||
module procedure psb_serror
|
||||
module procedure psb_perror
|
||||
end interface
|
||||
|
||||
integer, parameter :: act_ret=0, act_abort=1, no_err=0
|
||||
|
||||
private
|
||||
|
||||
type psb_errstack_node
|
||||
|
||||
integer :: err_code=0 ! the error code
|
||||
character(len=20) :: routine='' ! the name of the routine generating the error
|
||||
integer,dimension(5) :: i_err_data=0 ! array of integer data to complete the error msg
|
||||
! real(kind(1.d0))(dim=10) :: r_err_data=0.d0 ! array of real data to complete the error msg
|
||||
! complex(dim=10) :: c_err_data=0.c0 ! array of complex data to complete the error msg
|
||||
character(len=20) :: a_err_data='' ! array of character data to complete the error msg
|
||||
type(psb_errstack_node), pointer :: next ! pointer to the next element in the stack
|
||||
|
||||
end type psb_errstack_node
|
||||
|
||||
|
||||
type psb_errstack
|
||||
|
||||
type(psb_errstack_node), pointer :: top => null() ! pointer to the top element of the stack
|
||||
integer :: n_elems=0 ! number of entries in the stack
|
||||
|
||||
end type psb_errstack
|
||||
|
||||
|
||||
type(psb_errstack) :: error_stack ! the PSBLAS-2.0 error stack
|
||||
integer :: error_status=0 ! the error status (maybe not here)
|
||||
integer :: verbosity_level=1 ! the verbosity level (maybe not here)
|
||||
integer :: err_action=1
|
||||
|
||||
contains
|
||||
|
||||
|
||||
! saves action to support error traceback
|
||||
! also changes error action to "return"
|
||||
subroutine psb_erractionsave(err_act)
|
||||
integer, intent(out) :: err_act
|
||||
err_act=err_action
|
||||
err_action=act_ret
|
||||
end subroutine psb_erractionsave
|
||||
|
||||
|
||||
! return the action to take upon error occurrence
|
||||
subroutine psb_get_erraction(err_act)
|
||||
integer, intent(out) :: err_act
|
||||
err_act=err_action
|
||||
end subroutine psb_get_erraction
|
||||
|
||||
! sets the action to take upon error occurrence
|
||||
subroutine psb_set_erraction(err_act)
|
||||
integer, intent(in) :: err_act
|
||||
err_action=err_act
|
||||
end subroutine psb_set_erraction
|
||||
|
||||
|
||||
! restores error action previously saved with psb_erractionsave
|
||||
subroutine psb_erractionrestore(err_act)
|
||||
integer, intent(in) :: err_act
|
||||
err_action=err_act
|
||||
end subroutine psb_erractionrestore
|
||||
|
||||
|
||||
! checks wether an error has occurred on one of the porecesses in the execution pool
|
||||
subroutine psb_errcomm(icontxt, err)
|
||||
integer, intent(in) :: icontxt
|
||||
integer, intent(inout):: err
|
||||
integer :: temp(2)
|
||||
integer, parameter :: ione=1
|
||||
|
||||
call igamx2d(icontxt, 'A', ' ', ione, ione, err, ione,&
|
||||
&temp ,temp,-ione ,-ione,-ione)
|
||||
end subroutine psb_errcomm
|
||||
|
||||
|
||||
|
||||
! sets verbosity of the error message
|
||||
subroutine psb_set_errverbosity(v)
|
||||
integer, intent(in) :: v
|
||||
verbosity_level=v
|
||||
end subroutine psb_set_errverbosity
|
||||
|
||||
|
||||
|
||||
! returns verbosity of the error message
|
||||
subroutine psb_get_errverbosity(v)
|
||||
integer, intent(out) :: v
|
||||
v=verbosity_level
|
||||
end subroutine psb_get_errverbosity
|
||||
|
||||
|
||||
|
||||
! checks the status of the error condition
|
||||
subroutine psb_get_errstatus(s)
|
||||
integer, intent(out) :: s
|
||||
s=error_status
|
||||
end subroutine psb_get_errstatus
|
||||
|
||||
|
||||
|
||||
! pushes an error on the error stack
|
||||
subroutine psb_errpush(err_c, r_name, i_err, a_err)
|
||||
|
||||
integer, intent(in) :: err_c
|
||||
character(len=20), intent(in) :: r_name
|
||||
character(len=20), optional :: a_err
|
||||
integer, optional :: i_err(5)
|
||||
|
||||
type(psb_errstack_node), pointer :: new_node
|
||||
|
||||
|
||||
allocate(new_node)
|
||||
|
||||
new_node%err_code = err_c
|
||||
new_node%routine = r_name
|
||||
if(present(i_err)) new_node%i_err_data = i_err
|
||||
if(present(a_err)) new_node%a_err_data = a_err
|
||||
new_node%next => error_stack%top
|
||||
error_stack%top => new_node
|
||||
error_stack%n_elems = error_stack%n_elems+1
|
||||
if(error_status.eq.0) error_status=1
|
||||
nullify(new_node)
|
||||
|
||||
end subroutine psb_errpush
|
||||
|
||||
|
||||
! pops an error from the error stack
|
||||
subroutine psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
|
||||
integer, intent(out) :: err_c
|
||||
character(len=20), intent(out) :: r_name, a_e_d
|
||||
integer, intent(out) :: i_e_d(5)
|
||||
|
||||
type(psb_errstack_node), pointer :: old_node
|
||||
|
||||
err_c = error_stack%top%err_code
|
||||
r_name = error_stack%top%routine
|
||||
i_e_d = error_stack%top%i_err_data
|
||||
a_e_d = error_stack%top%a_err_data
|
||||
|
||||
old_node => error_stack%top
|
||||
error_stack%top => old_node%next
|
||||
error_stack%n_elems = error_stack%n_elems - 1
|
||||
if(error_stack%n_elems.eq.0) error_status=0
|
||||
|
||||
deallocate(old_node)
|
||||
|
||||
end subroutine psb_errpop
|
||||
|
||||
|
||||
|
||||
! handles the occurence of an error in a parallel routine
|
||||
subroutine psb_perror(icontxt)
|
||||
|
||||
integer, intent(in) :: icontxt
|
||||
integer :: err_c
|
||||
character(len=20) :: r_name, a_e_d
|
||||
integer :: i_e_d(5)
|
||||
integer :: nprow, npcol, me, mypcol, temp(2)
|
||||
integer, parameter :: ione=1, izero=0
|
||||
|
||||
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
|
||||
|
||||
if(error_status.gt.0) then
|
||||
if(verbosity_level.gt.1) then
|
||||
|
||||
do while (error_stack%n_elems.gt.izero)
|
||||
write(0,'(50("="))')
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
|
||||
! write(0,'(50("="))')
|
||||
end do
|
||||
call blacs_abort(icontxt,-1)
|
||||
else
|
||||
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
|
||||
do while (error_stack%n_elems.gt.0)
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
end do
|
||||
call blacs_abort(icontxt,-1)
|
||||
end if
|
||||
end if
|
||||
|
||||
if(error_status.gt.izero) then
|
||||
call blacs_abort(icontxt,err_c)
|
||||
end if
|
||||
|
||||
|
||||
end subroutine psb_perror
|
||||
|
||||
|
||||
! handles the occurence of an error in a serial routine
|
||||
subroutine psb_serror()
|
||||
|
||||
integer :: err_c
|
||||
character(len=20) :: r_name, a_e_d
|
||||
integer :: i_e_d(5)
|
||||
integer :: nprow, npcol, me, mypcol, temp(2)
|
||||
integer, parameter :: ione=1, izero=0
|
||||
|
||||
if(error_status.gt.0) then
|
||||
if(verbosity_level.gt.1) then
|
||||
|
||||
do while (error_stack%n_elems.gt.izero)
|
||||
write(0,'(50("="))')
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
|
||||
! write(0,'(50("="))')
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
|
||||
do while (error_stack%n_elems.gt.0)
|
||||
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine psb_serror
|
||||
|
||||
|
||||
! prints the error msg associated to a specific error code
|
||||
subroutine psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
|
||||
|
||||
integer, intent(in) :: err_c
|
||||
character(len=20), intent(in) :: r_name, a_e_d
|
||||
integer, intent(in) :: i_e_d(5)
|
||||
integer, optional :: me
|
||||
|
||||
if(present(me)) then
|
||||
write(0,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name
|
||||
else
|
||||
write(0,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name
|
||||
end if
|
||||
|
||||
|
||||
select case (err_c)
|
||||
case(:0)
|
||||
write (0,'("error on calling sperror. err_c must be greater than 0")')
|
||||
case(2)
|
||||
write (0,'("pivot too small")')
|
||||
case(3)
|
||||
write (0,'("Invalid number of ovr:",i0)')i_e_d(1)
|
||||
case(5)
|
||||
write (0,'("Invalid input")')
|
||||
|
||||
case(10)
|
||||
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
|
||||
case(20)
|
||||
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
case(30)
|
||||
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
|
||||
write (0,'("current value is ",i0)')i_e_d(2)
|
||||
case(35)
|
||||
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
|
||||
write (0,'("Current value is ",i0)')i_e_d(2)
|
||||
case(40)
|
||||
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
|
||||
write (0,'("current value is ",a)')a_e_d(2:2)
|
||||
case(50)
|
||||
write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(2)
|
||||
write (0,'("current values are ",i0," < ",i0)') i_e_d(3),i_e_d(4)
|
||||
case(60)
|
||||
write (0,'("input argument n. ",i0," must be equal or greater than ",i0)')i_e_d(1),i_e_d(2)
|
||||
write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
|
||||
case(70)
|
||||
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2)
|
||||
write (0,'("current value is ",a)')a_e_d
|
||||
case(71)
|
||||
write (0,'("Impossible error in ASB: nrow>ncol,")')
|
||||
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
|
||||
! ... csr format error ...
|
||||
case(80)
|
||||
write (0,'("input argument ia2(1) is less than 0")')
|
||||
write (0,'("current value is ",i0)')i_e_d(1)
|
||||
! ... csr format error ...
|
||||
case(90)
|
||||
write (0,'("indices in ia2 array are not in increasing order")')
|
||||
case(91)
|
||||
write (0,'("indices in ia1 array are not in increasing order")')
|
||||
! ... csr format error ...
|
||||
case(100)
|
||||
write (0,'("indices in ia1 array are not within problem dimension")')
|
||||
write (0,'("problem dimension is ",i0)')i_e_d(1)
|
||||
case(110)
|
||||
write (0,'("invalid combination of input arguments")')
|
||||
case(115)
|
||||
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1)
|
||||
write (0,'("Current value is ",i0)')i_e_d(2)
|
||||
case(120)
|
||||
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
|
||||
write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
|
||||
! ... coo format error ...
|
||||
case(130)
|
||||
write (0,'("there are duplicated elements in coo format")')
|
||||
write (0,'("please set repflag flag to 2 or 3")')
|
||||
case(134)
|
||||
write (0,'("Invalid input format ",a3)')a_e_d(1:3)
|
||||
case(135)
|
||||
write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3)
|
||||
case(136)
|
||||
write (0,'("Format ",a3," is unknown")')a_e_d(1:3)
|
||||
case(140)
|
||||
write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2)
|
||||
case(150)
|
||||
write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1)
|
||||
case(290)
|
||||
write (0,'("Is not possible to call this routine without calling before psdalloc on the same matrix")')
|
||||
case(295)
|
||||
write (0,'("Is not possible to call this routine without calling before psdspalloc on the same matrix")')
|
||||
case(300)
|
||||
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
|
||||
& i_e_d(1),i_e_d(4),i_e_d(3)
|
||||
write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
|
||||
case(400)
|
||||
write (0,'("MPI error:",i0)')i_e_d(1)
|
||||
case(550)
|
||||
write (0,'("Parameter n. ",i0," must be equal on all BLACS processes. ",i0)')i_e_d(1)
|
||||
case(570)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
|
||||
write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4)
|
||||
write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
|
||||
case(575)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
|
||||
write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
|
||||
case(580)
|
||||
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1)
|
||||
write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
|
||||
case(600)
|
||||
write (0,'("Sparse Matrix and decsriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
|
||||
case (1122)
|
||||
write (0,'("Invalid state for DESC_A")')
|
||||
case (1123)
|
||||
write (0,'("Invalid combined state for A and DESC_A")')
|
||||
case(1124:1999)
|
||||
write (0,'("computational error. code: ",i0)')err_c
|
||||
case(2010)
|
||||
write (0,'("BLACS error. Number of processes=-1")')
|
||||
case(2025)
|
||||
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
|
||||
case(2030)
|
||||
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
|
||||
case(2231)
|
||||
write (0,'("Invalid input state for matrix.")')
|
||||
case(2232)
|
||||
write (0,'("Input state for matrix is not adequate for regeneration.")')
|
||||
case (2233:2999)
|
||||
write(0,'("resource error. code: ",i0)')err_c
|
||||
case(3000:3009)
|
||||
write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3)
|
||||
case(3010)
|
||||
write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
|
||||
case(3015)
|
||||
write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3)
|
||||
case(3020)
|
||||
write (0,'("Case trans = C is not yet implemented.")')
|
||||
case(3021)
|
||||
write (0,'("Case trans /= N is not yet implemented.")')
|
||||
case(3022)
|
||||
write (0,'("Only unit diagonal so far for triangular matrices. ")')
|
||||
case(3023)
|
||||
write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
|
||||
case(3024)
|
||||
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
|
||||
case(3030)
|
||||
write (0,'("Case ja/=ix or ia/=iy is not yet implemented.")')
|
||||
case(3040)
|
||||
write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
|
||||
case(3050)
|
||||
write (0,'("Case ix /= iy is not yet implemented.")')
|
||||
case(3060)
|
||||
write (0,'("Case ix /= 1 is not yet implemented.")')
|
||||
case(3070)
|
||||
write (0,'("This operation is only implemented with no overlap.")')
|
||||
case(3080)
|
||||
write (0,'("Decompostion type ",i0," not yet supported.")')i_e_d(1)
|
||||
case(3090)
|
||||
write (0,'("Insert matrix mode not yet implemented.")')
|
||||
case(3100)
|
||||
write (0,'("Error on index. Element has not been inserted")')
|
||||
write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
|
||||
case(3110)
|
||||
write (0,'("Before you call this routine, you must assembly sparse matrix")')
|
||||
case(3111:3999)
|
||||
write(0,'("miscellaneus error. code: ",i0)')err_c
|
||||
case(4000)
|
||||
write(0,'("Allocation/deallocation error")')
|
||||
case(4010)
|
||||
write (0,'("Error from call to subroutine ",a)')a_e_d
|
||||
case(4011)
|
||||
write (0,'("Error from call to a subroutine ")')
|
||||
case(4012)
|
||||
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
|
||||
case (5001)
|
||||
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
|
||||
case (5002)
|
||||
write (0,'("Invalid PREC: ",i0)')i_e_d(1)
|
||||
case (5003)
|
||||
write (0,'("Invalid PREC: ",a3)')a_e_d(1:3)
|
||||
case default
|
||||
write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name
|
||||
write(0,'(5(i0,2x))') i_e_d
|
||||
write(0,'(a)') a_e_d
|
||||
|
||||
end select
|
||||
|
||||
end subroutine psb_errmsg
|
||||
|
||||
|
||||
|
||||
end module psb_error_mod
|
||||
@@ -0,0 +1,123 @@
|
||||
Module psb_methd_mod
|
||||
|
||||
interface psb_cg
|
||||
subroutine psb_dcg(a,prec,b,x,eps,&
|
||||
& desc_a,info,itmax,iter,err,itrace,istop)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), intent(in) :: b(:)
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
real(kind(1.d0)), intent(in) :: eps
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: itmax, itrace,istop
|
||||
integer, optional, intent(out) :: iter
|
||||
real(kind(1.d0)), optional, intent(out) :: err
|
||||
end subroutine psb_dcg
|
||||
end interface
|
||||
|
||||
interface spb_bicg
|
||||
subroutine psb_dbicg(a,prec,b,x,eps,&
|
||||
& desc_a,info,itmax,iter,err,itrace,istop)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), intent(in) :: b(:)
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
real(kind(1.d0)), intent(in) :: eps
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: itmax, itrace,istop
|
||||
integer, optional, intent(out) :: iter
|
||||
real(kind(1.d0)), optional, intent(out) :: err
|
||||
end subroutine psb_dbicg
|
||||
end interface
|
||||
|
||||
interface ppsb_bicgstab
|
||||
subroutine psb_dcgstab(a,prec,b,x,eps,&
|
||||
& desc_a,info,itmax,iter,err,itrace,istop)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), intent(in) :: b(:)
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
real(kind(1.d0)), intent(in) :: eps
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: itmax, itrace,istop
|
||||
integer, optional, intent(out) :: iter
|
||||
real(kind(1.d0)), optional, intent(out) :: err
|
||||
end subroutine psb_dcgstab
|
||||
end interface
|
||||
|
||||
interface psb_bicgstabl
|
||||
Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
|
||||
&itmax,iter,err, itrace,irst,istop)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
Use psb_prec_type
|
||||
!!$ parameters
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in) :: desc_a
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
Real(Kind(1.d0)), Intent(in) :: b(:)
|
||||
Real(Kind(1.d0)), Intent(inout) :: x(:)
|
||||
Real(Kind(1.d0)), Intent(in) :: eps
|
||||
integer, intent(out) :: info
|
||||
Integer, Optional, Intent(in) :: itmax, itrace, irst,istop
|
||||
Integer, Optional, Intent(out) :: iter
|
||||
Real(Kind(1.d0)), Optional, Intent(out) :: err
|
||||
end subroutine psb_dcgstabl
|
||||
end interface
|
||||
|
||||
interface psb_rgmres
|
||||
Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
|
||||
&itmax,iter,err,itrace,irst,istop)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
Use psb_prec_type
|
||||
!!$ parameters
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in) :: desc_a
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
Real(Kind(1.d0)), Intent(in) :: b(:)
|
||||
Real(Kind(1.d0)), Intent(inout) :: x(:)
|
||||
Real(Kind(1.d0)), Intent(in) :: eps
|
||||
integer, intent(out) :: info
|
||||
Integer, Optional, Intent(in) :: itmax, itrace, irst,istop
|
||||
Integer, Optional, Intent(out) :: iter
|
||||
Real(Kind(1.d0)), Optional, Intent(out) :: err
|
||||
end subroutine psb_dgmresr
|
||||
end interface
|
||||
|
||||
interface psb_cgs
|
||||
subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
|
||||
&itmax,iter,err,itrace,istop)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
!!$ parameters
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
real(kind(1.d0)), intent(in) :: b(:)
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
real(kind(1.d0)), intent(in) :: eps
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: itmax, itrace,istop
|
||||
integer, optional, intent(out) :: iter
|
||||
real(kind(1.d0)), optional, intent(out) :: err
|
||||
end subroutine psb_dcgs
|
||||
end interface
|
||||
|
||||
end module psb_methd_mod
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,124 @@
|
||||
|
||||
module psb_prec_mod
|
||||
use psb_prec_type
|
||||
|
||||
interface psb_bldaggrmat
|
||||
subroutine psb_dbldaggrmat(a,desc_a,p,info)
|
||||
use psb_prec_type
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dbase_prec), intent(inout) :: p
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dbldaggrmat
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_genaggrmap
|
||||
subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
|
||||
use psb_spmat_type
|
||||
use psb_descriptor_type
|
||||
implicit none
|
||||
integer, intent(in) :: aggr_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, pointer :: ilaggr(:),nlaggr(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dgenaggrmap
|
||||
end interface
|
||||
|
||||
interface psb_precbld
|
||||
subroutine psb_dprecbld(a,prec,desc_a,ierr,upd)
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
implicit none
|
||||
integer, intent(out) :: ierr
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_dprec_type), intent(inout) :: prec
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
character, intent(in),optional :: upd
|
||||
end subroutine psb_dprecbld
|
||||
end interface
|
||||
|
||||
interface psb_precset
|
||||
subroutine psb_dprecset(prec,ptype,iv,rs,rv,ierr)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
implicit none
|
||||
type(psb_dprec_type), intent(inout) :: prec
|
||||
character(len=10), intent(in) :: ptype
|
||||
integer, optional, intent(in) :: iv(:)
|
||||
real(kind(1.d0)), optional, intent(in) :: rs
|
||||
real(kind(1.d0)), optional, intent(in) :: rv(:)
|
||||
integer, optional, intent(out) :: ierr
|
||||
end subroutine psb_dprecset
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_precfree
|
||||
subroutine psb_dprecfree(p,info)
|
||||
use psb_descriptor_type
|
||||
use psb_serial_mod
|
||||
use psb_const_mod
|
||||
use psb_prec_type
|
||||
type(psb_dprec_type), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dprecfree
|
||||
end interface
|
||||
|
||||
interface psb_cslu
|
||||
subroutine psb_dcslu(a,desc_data,p,upd,info)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(psb_dbase_prec), intent(inout) :: p
|
||||
character, intent(in) :: upd
|
||||
end subroutine psb_dcslu
|
||||
end interface
|
||||
|
||||
interface psb_csrsetup
|
||||
Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
|
||||
use psb_serial_mod
|
||||
Use psb_descriptor_type
|
||||
Use psb_prec_type
|
||||
integer, intent(in) :: ptype,novr
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_dspmat_type), Intent(inout) :: blk
|
||||
Type(psb_desc_type), Intent(inout) :: desc_p
|
||||
Type(psb_desc_type), Intent(in) :: desc_data
|
||||
Character, Intent(in) :: upd
|
||||
integer, intent(out) :: info
|
||||
character(len=5), optional :: outfmt
|
||||
end Subroutine psb_dcsrsetup
|
||||
end interface
|
||||
|
||||
interface psb_prcaply
|
||||
subroutine psb_dprecaply(prec,x,y,desc_data,info,trans,work)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
real(kind(0.d0)),intent(inout) :: x(:), y(:)
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
real(kind(0.d0)),intent(inout), optional, target :: work(:)
|
||||
end subroutine psb_dprecaply
|
||||
subroutine psb_dprecaply1(prec,x,desc_data,info,trans)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_prec_type
|
||||
type(psb_desc_type),intent(in) :: desc_data
|
||||
type(psb_dprec_type), intent(in) :: prec
|
||||
real(kind(0.d0)),intent(inout) :: x(:)
|
||||
integer, intent(out) :: info
|
||||
character(len=1), optional :: trans
|
||||
end subroutine psb_dprecaply1
|
||||
end interface
|
||||
|
||||
end module psb_prec_mod
|
||||
@@ -0,0 +1,373 @@
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!! Module to define PREC_DATA, !!
|
||||
!! structure for preconditioning. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
module psb_prec_type
|
||||
|
||||
use psb_spmat_type
|
||||
use psb_descriptor_type
|
||||
|
||||
integer, parameter :: min_prec_=0, noprec_=0, diagsc_=1, bja_=2,&
|
||||
& asm_=3, ras_=5, ash_=4, rash_=6, ras2lv_=7, ras2lvm_=8,&
|
||||
& lv2mras_=9, lv2smth_=10, lv2lsm_=11, sl2sm_=12, superlu_=13,&
|
||||
& new_loc_smth_=14, new_glb_smth_=15, max_prec_=15
|
||||
! Multilevel stuff.
|
||||
integer, parameter :: no_ml_=0, add_ml_prec_=1, mult_ml_prec_=2
|
||||
integer, parameter :: new_ml_prec_=3, max_ml_=new_ml_prec_
|
||||
integer, parameter :: pre_smooth_=1, post_smooth_=2, smooth_both_=3,&
|
||||
& max_smooth_=smooth_both_
|
||||
integer, parameter :: loc_aggr_=0, glb_aggr_=1, new_loc_aggr_=2
|
||||
integer, parameter :: new_glb_aggr_=3, max_aggr_=new_glb_aggr_
|
||||
integer, parameter :: no_smth_=0, smth_omg_=1, smth_biz_=2
|
||||
integer, parameter :: lib_choice_=0, user_choice_=1
|
||||
integer, parameter :: mat_distr_=0, mat_repl_=1
|
||||
! Entries in iprcparm: preconditioner type, factorization type,
|
||||
! prolongation type, restriction type, renumbering algorithm,
|
||||
! number of overlap layers, pointer to SuperLU factors,
|
||||
! levels of fill in for ILU(N),
|
||||
integer, parameter :: p_type_=1, f_type_=2, restr_=3, prol_=4
|
||||
integer, parameter :: iren_=5, n_ovr_=6, slu_ptr_=7
|
||||
integer, parameter :: ilu_fill_in_=8, jac_sweeps_=9, ml_type_=10
|
||||
integer, parameter :: smth_pos_=11, aggr_alg_=12, smth_kind_=13
|
||||
integer, parameter :: om_choice_=14, glb_smth_=15, coarse_mat_=16
|
||||
integer, parameter :: ifpsz=20
|
||||
! Entries in dprcparm: ILU(E) epsilon, smoother omega
|
||||
integer, parameter :: fact_eps_=1, smooth_omega_=2
|
||||
integer, parameter :: dfpsz=4
|
||||
! Factorization types: none, ILU(N), ILU(E), SuperLU
|
||||
integer, parameter :: f_none_=0,f_ilu_n_=1, f_ilu_e_=2,f_slu_=3
|
||||
! Fields for sparse matrices ensembles:
|
||||
integer, parameter :: l_pr_=1, u_pr_=2, bp_ilu_avsz=2
|
||||
integer, parameter :: ap_nd_=3, ac_=4, sm_pr_t_=5, sm_pr_=6
|
||||
integer, parameter :: smth_avsz=6
|
||||
|
||||
|
||||
type psb_dbase_prec
|
||||
|
||||
type(psb_dspmat_type), pointer :: av(:) => null()
|
||||
real(kind(1.d0)), pointer :: d(:) => null()
|
||||
type(psb_desc_type), pointer :: desc_data => null()
|
||||
integer, pointer :: iprcparm(:) => null()
|
||||
real(kind(1.d0)), pointer :: dprcparm(:) => null()
|
||||
integer, pointer :: perm(:) => null(), invperm(:) => null()
|
||||
integer, pointer :: mlia(:) => null(), nlaggr(:) => null()
|
||||
type(psb_dspmat_type), pointer :: aorig => null()
|
||||
real(kind(1.d0)), pointer :: dorig(:) => null()
|
||||
|
||||
end type psb_dbase_prec
|
||||
|
||||
type psb_dprec_type
|
||||
type(psb_dbase_prec), pointer :: baseprecv(:) => null()
|
||||
! contain type of preconditioning to be performed
|
||||
integer :: prec, base_prec
|
||||
end type psb_dprec_type
|
||||
|
||||
|
||||
character(len=15), parameter, private :: &
|
||||
& smooth_names(1:2)=(/'Pre-smoothing ','Post-smoothing'/)
|
||||
character(len=15), parameter, private :: &
|
||||
& smooth_kinds(0:2)=(/'No smoother ','Omega smoother',&
|
||||
& 'Bizr. smoother'/)
|
||||
character(len=15), parameter, private :: &
|
||||
& matrix_names(0:1)=(/'Distributed ','Replicated '/)
|
||||
character(len=18), parameter, private :: &
|
||||
& aggr_names(0:3)=(/'Local aggregation ','Global aggregation',&
|
||||
& 'New local aggr. ','New global aggr. '/)
|
||||
character(len=6), parameter, private :: &
|
||||
& restrict_names(0:4)=(/'None ',' ',' ',' ','Halo '/)
|
||||
character(len=12), parameter, private :: &
|
||||
& prolong_names(0:3)=(/'None ','Sum ','Average ','Square root'/)
|
||||
character(len=15), parameter, private :: &
|
||||
& ml_names(0:3)=(/'None ','Additive ','Multiplicative',&
|
||||
& 'New ML '/)
|
||||
character(len=15), parameter, private :: &
|
||||
& fact_names(0:3)=(/'None ','ILU(n) ',&
|
||||
& 'ILU(eps) ','Sparse LU '/)
|
||||
|
||||
interface psb_base_precfree
|
||||
module procedure psb_dbase_precfree
|
||||
end interface
|
||||
interface psb_check_def
|
||||
module procedure psb_icheck_def, psb_dcheck_def
|
||||
end interface
|
||||
|
||||
interface psb_prec_descr
|
||||
module procedure psb_file_prec_descr
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_file_prec_descr(iout,p)
|
||||
integer, intent(in) :: iout
|
||||
type(psb_dprec_type), intent(in) :: p
|
||||
|
||||
write(iout,*) 'Preconditioner description'
|
||||
if (associated(p%baseprecv)) then
|
||||
if (size(p%baseprecv)>=1) then
|
||||
write(iout,*) 'Base preconditioner'
|
||||
select case(p%baseprecv(1)%iprcparm(p_type_))
|
||||
case(noprec_)
|
||||
write(iout,*) 'No preconditioning'
|
||||
case(diagsc_)
|
||||
write(iout,*) 'Diagonal scaling'
|
||||
case(bja_)
|
||||
write(iout,*) 'Block Jacobi with: ',&
|
||||
& fact_names(p%baseprecv(1)%iprcparm(f_type_))
|
||||
case(asm_,ras_,ash_,rash_)
|
||||
write(iout,*) 'Additive Schwarz with: ',&
|
||||
& fact_names(p%baseprecv(1)%iprcparm(f_type_))
|
||||
write(iout,*) 'Overlap:',&
|
||||
& p%baseprecv(1)%iprcparm(n_ovr_)
|
||||
write(iout,*) 'Restriction: ',&
|
||||
& restrict_names(p%baseprecv(1)%iprcparm(restr_))
|
||||
write(iout,*) 'Prolongation: ',&
|
||||
& prolong_names(p%baseprecv(1)%iprcparm(prol_))
|
||||
end select
|
||||
end if
|
||||
if (size(p%baseprecv)>=2) then
|
||||
if (.not.associated(p%baseprecv(2)%iprcparm)) then
|
||||
write(iout,*) 'Inconsistent MLPREC part!'
|
||||
return
|
||||
endif
|
||||
write(iout,*) 'Multilevel: ',ml_names(p%baseprecv(2)%iprcparm(ml_type_))
|
||||
if (p%baseprecv(2)%iprcparm(ml_type_)>no_ml_) then
|
||||
write(iout,*) 'Multilevel aggregation: ', &
|
||||
& aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_))
|
||||
write(iout,*) 'Smoother: ', &
|
||||
& smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_))
|
||||
write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_)
|
||||
write(iout,*) 'Smoothing position: ',&
|
||||
& smooth_names(p%baseprecv(2)%iprcparm(smth_pos_))
|
||||
write(iout,*) 'Coarse matrix: ',&
|
||||
& matrix_names(p%baseprecv(2)%iprcparm(coarse_mat_))
|
||||
write(iout,*) 'Factorization type: ',&
|
||||
& fact_names(p%baseprecv(2)%iprcparm(f_type_))
|
||||
select case(p%baseprecv(2)%iprcparm(f_type_))
|
||||
case(f_ilu_n_)
|
||||
write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_)
|
||||
case(f_ilu_e_)
|
||||
write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_)
|
||||
case(f_slu_)
|
||||
case default
|
||||
write(iout,*) 'Should never get here!'
|
||||
end select
|
||||
write(iout,*) 'Number of Jacobi sweeps: ', &
|
||||
& (p%baseprecv(2)%iprcparm(jac_sweeps_))
|
||||
|
||||
end if
|
||||
end if
|
||||
|
||||
else
|
||||
write(iout,*) 'No Base preconditioner available, something is wrong!'
|
||||
return
|
||||
endif
|
||||
|
||||
end subroutine psb_file_prec_descr
|
||||
|
||||
function is_legal_base_prec(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_base_prec
|
||||
|
||||
is_legal_base_prec = ((ip>=noprec_).and.(ip<=rash_))
|
||||
return
|
||||
end function is_legal_base_prec
|
||||
function is_legal_n_ovr(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_n_ovr
|
||||
|
||||
is_legal_n_ovr = (ip >=0)
|
||||
return
|
||||
end function is_legal_n_ovr
|
||||
function is_legal_jac_sweeps(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_jac_sweeps
|
||||
|
||||
is_legal_jac_sweeps = (ip >= 1)
|
||||
return
|
||||
end function is_legal_jac_sweeps
|
||||
function is_legal_prolong(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_prolong
|
||||
|
||||
is_legal_prolong = ((ip>=none_).and.(ip<=square_root_))
|
||||
return
|
||||
end function is_legal_prolong
|
||||
function is_legal_restrict(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_restrict
|
||||
|
||||
is_legal_restrict = ((ip==nohalo_).or.(ip==halo_))
|
||||
return
|
||||
end function is_legal_restrict
|
||||
function is_legal_ml_type(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_type
|
||||
|
||||
is_legal_ml_type = ((ip>=no_ml_).and.(ip<=max_ml_))
|
||||
return
|
||||
end function is_legal_ml_type
|
||||
function is_legal_ml_aggr_kind(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_aggr_kind
|
||||
|
||||
is_legal_ml_aggr_kind = ((ip>=loc_aggr_).and.(ip<=max_aggr_))
|
||||
return
|
||||
end function is_legal_ml_aggr_kind
|
||||
function is_legal_ml_smooth_pos(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_smooth_pos
|
||||
|
||||
is_legal_ml_smooth_pos = ((ip>=pre_smooth_).and.(ip<=max_smooth_))
|
||||
return
|
||||
end function is_legal_ml_smooth_pos
|
||||
function is_legal_ml_smth_kind(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_smth_kind
|
||||
|
||||
is_legal_ml_smth_kind = ((ip>=no_smth_).and.(ip<=smth_biz_))
|
||||
return
|
||||
end function is_legal_ml_smth_kind
|
||||
function is_legal_ml_coarse_mat(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_coarse_mat
|
||||
|
||||
is_legal_ml_coarse_mat = ((ip>=mat_distr_).and.(ip<=mat_repl_))
|
||||
return
|
||||
end function is_legal_ml_coarse_mat
|
||||
function is_legal_ml_fact(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_fact
|
||||
|
||||
is_legal_ml_fact = ((ip>=f_ilu_n_).and.(ip<=f_slu_))
|
||||
return
|
||||
end function is_legal_ml_fact
|
||||
function is_legal_ml_lev(ip)
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_lev
|
||||
|
||||
is_legal_ml_lev = (ip>=0)
|
||||
return
|
||||
end function is_legal_ml_lev
|
||||
function is_legal_omega(ip)
|
||||
real(kind(1.d0)), intent(in) :: ip
|
||||
logical :: is_legal_omega
|
||||
|
||||
is_legal_omega = ((ip>=0.0d0).and.(ip<=2.0d0))
|
||||
return
|
||||
end function is_legal_omega
|
||||
function is_legal_ml_eps(ip)
|
||||
real(kind(1.d0)), intent(in) :: ip
|
||||
logical :: is_legal_ml_eps
|
||||
|
||||
is_legal_ml_eps = (ip>=0.0d0)
|
||||
return
|
||||
end function is_legal_ml_eps
|
||||
|
||||
|
||||
subroutine psb_icheck_def(ip,name,id,is_legal)
|
||||
integer, intent(inout) :: ip
|
||||
integer, intent(in) :: id
|
||||
character(len=*), intent(in) :: name
|
||||
interface
|
||||
function is_legal(i)
|
||||
integer, intent(in) :: i
|
||||
logical :: is_legal
|
||||
end function is_legal
|
||||
end interface
|
||||
|
||||
if (.not.is_legal(ip)) then
|
||||
write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
|
||||
ip = id
|
||||
end if
|
||||
end subroutine psb_icheck_def
|
||||
|
||||
subroutine psb_dcheck_def(ip,name,id,is_legal)
|
||||
real(kind(1.d0)), intent(inout) :: ip
|
||||
real(kind(1.d0)), intent(in) :: id
|
||||
character(len=*), intent(in) :: name
|
||||
interface
|
||||
function is_legal(i)
|
||||
real(kind(1.d0)), intent(in) :: i
|
||||
logical :: is_legal
|
||||
end function is_legal
|
||||
end interface
|
||||
|
||||
if (.not.is_legal(ip)) then
|
||||
write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
|
||||
ip = id
|
||||
end if
|
||||
end subroutine psb_dcheck_def
|
||||
|
||||
subroutine psb_dbase_precfree(p,info)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod
|
||||
type(psb_dbase_prec), intent(inout) :: p
|
||||
integer, intent(out) :: info
|
||||
integer :: i
|
||||
|
||||
info = 0
|
||||
|
||||
if (associated(p%d)) then
|
||||
deallocate(p%d,stat=info)
|
||||
end if
|
||||
|
||||
if (associated(p%av)) then
|
||||
do i=1,size(p%av)
|
||||
call psb_spfree(p%av(i),info)
|
||||
if (info /= 0) then
|
||||
! Actually, we don't care here about this.
|
||||
! Just let it go.
|
||||
! return
|
||||
end if
|
||||
enddo
|
||||
deallocate(p%av,stat=info)
|
||||
p%av => null()
|
||||
end if
|
||||
if (associated(p%desc_data)) then
|
||||
if (associated(p%desc_data%matrix_data)) then
|
||||
call psb_dscfree(p%desc_data,info)
|
||||
end if
|
||||
deallocate(p%desc_data)
|
||||
endif
|
||||
if (associated(p%dprcparm)) then
|
||||
deallocate(p%dprcparm,stat=info)
|
||||
end if
|
||||
if (associated(p%aorig)) then
|
||||
! This is a pointer to something else, must not free it here.
|
||||
nullify(p%aorig)
|
||||
endif
|
||||
if (associated(p%dorig)) then
|
||||
deallocate(p%dorig,stat=info)
|
||||
nullify(p%dorig)
|
||||
endif
|
||||
|
||||
if (associated(p%mlia)) then
|
||||
deallocate(p%mlia,stat=info)
|
||||
endif
|
||||
|
||||
if (associated(p%nlaggr)) then
|
||||
deallocate(p%nlaggr,stat=info)
|
||||
endif
|
||||
|
||||
if (associated(p%iprcparm)) then
|
||||
if (p%iprcparm(f_type_)==f_slu_) then
|
||||
call fort_slu_free(p%iprcparm(slu_ptr_),info)
|
||||
end if
|
||||
deallocate(p%iprcparm,stat=info)
|
||||
end if
|
||||
call psb_nullify_baseprec(p)
|
||||
end subroutine psb_dbase_precfree
|
||||
|
||||
subroutine psb_nullify_baseprec(p)
|
||||
use psb_descriptor_type
|
||||
type(psb_dbase_prec), intent(inout) :: p
|
||||
|
||||
nullify(p%av,p%d,p%iprcparm,p%dprcparm,p%perm,p%invperm,p%mlia,&
|
||||
& p%nlaggr,p%aorig,p%dorig,p%desc_data)
|
||||
|
||||
end subroutine psb_nullify_baseprec
|
||||
|
||||
|
||||
end module psb_prec_type
|
||||
@@ -0,0 +1,238 @@
|
||||
module psb_psblas_mod
|
||||
use psb_comm_mod
|
||||
|
||||
interface psb_dot
|
||||
function psb_ddotv(x, y, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) :: psb_ddotv
|
||||
real(kind(1.d0)), intent(in) :: x(:), y(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end function psb_ddotv
|
||||
function psb_ddot(x, y, desc_a, info, jx, jy)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) :: psb_ddot
|
||||
real(kind(1.d0)), intent(in) :: x(:,:), y(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, optional, intent(in) :: jx, jy
|
||||
integer, intent(out) :: info
|
||||
end function psb_ddot
|
||||
end interface
|
||||
|
||||
interface psb_dots
|
||||
subroutine psb_ddotvs(res,x, y, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(out) :: res
|
||||
real(kind(1.d0)), intent(in) :: x(:), y(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_ddotvs
|
||||
subroutine psb_dmdots(res,x, y, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(out) :: res(:)
|
||||
real(kind(1.d0)), intent(in) :: x(:,:), y(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dmdots
|
||||
end interface
|
||||
|
||||
interface psb_axpby
|
||||
subroutine psb_daxpbyv(alpha, x, beta, y,&
|
||||
& desc_a, info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
real(kind(1.d0)), intent (inout) :: y(:)
|
||||
real(kind(1.d0)), intent (in) :: alpha, beta
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_daxpbyv
|
||||
subroutine psb_daxpby(alpha, x, beta, y,&
|
||||
& desc_a, info, n, jx, jy)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (in) :: x(:,:)
|
||||
real(kind(1.d0)), intent (inout) :: y(:,:)
|
||||
real(kind(1.d0)), intent (in) :: alpha, beta
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, optional :: n, jx, jy
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_daxpby
|
||||
end interface
|
||||
|
||||
interface psb_amax
|
||||
function psb_damax(x, desc_a, info, jx)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) psb_damax
|
||||
real(kind(1.d0)), intent (in) :: x(:,:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, optional, intent (in) :: jx
|
||||
integer, intent(out) :: info
|
||||
end function psb_damax
|
||||
function psb_damaxv(x, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) psb_damaxv
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end function psb_damaxv
|
||||
end interface
|
||||
|
||||
interface psb_amaxs
|
||||
subroutine psb_damaxvs(res,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (out) :: res
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_damaxvs
|
||||
subroutine psb_dmamax(res,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (out) :: res(:)
|
||||
real(kind(1.d0)), intent (in) :: x(:,:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dmamax
|
||||
end interface
|
||||
|
||||
interface psb_asum
|
||||
function psb_dasum(x, desc_a, info, jx)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) psb_dasum
|
||||
real(kind(1.d0)), intent (in) :: x(:,:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, optional, intent (in) :: jx
|
||||
integer, intent(out) :: info
|
||||
end function psb_dasum
|
||||
function psb_dasumv(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) psb_dasumv
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end function psb_dasumv
|
||||
end interface
|
||||
|
||||
interface psb_asums
|
||||
subroutine psb_dasumvs(res,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (out) :: res
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dasumvs
|
||||
subroutine psb_dmasum(res,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (out) :: res(:)
|
||||
real(kind(1.d0)), intent (in) :: x(:,:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dmasum
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_nrm2
|
||||
function psb_dnrm2(x, desc_a, info, jx)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) psb_dnrm2
|
||||
real(kind(1.d0)), intent (in) :: x(:,:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, optional, intent (in) :: jx
|
||||
integer, intent(out) :: info
|
||||
end function psb_dnrm2
|
||||
function psb_dnrm2v(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) psb_dnrm2v
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end function psb_dnrm2v
|
||||
end interface
|
||||
|
||||
interface psb_nrm2s
|
||||
subroutine psb_dnrm2vs(res,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent (out) :: res
|
||||
real(kind(1.d0)), intent (in) :: x(:)
|
||||
type(psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dnrm2vs
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_nrmi
|
||||
function psb_dnrmi(a, desc_a,info)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)) :: psb_dnrmi
|
||||
type (psb_dspmat_type), intent (in) :: a
|
||||
type (psb_desc_type), intent (in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end function psb_dnrmi
|
||||
end interface
|
||||
|
||||
interface psb_spmm
|
||||
subroutine psb_dspmm(alpha, a, x, beta, y, desc_a, info,&
|
||||
&trans, k, jx, jy,work,doswap)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
type (psb_dspmat_type), intent(in) :: a
|
||||
real(kind(1.d0)), intent(inout) :: x(:,:)
|
||||
real(kind(1.d0)), intent(inout) :: y(:,:)
|
||||
real(kind(1.d0)), intent(in) :: alpha, beta
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
character, optional, intent(in) :: trans
|
||||
real(kind(1.d0)), optional, intent(inout) :: work(:)
|
||||
integer, optional, intent(in) :: k, jx, jy,doswap
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspmm
|
||||
subroutine psb_dspmv(alpha, a, x, beta, y,&
|
||||
& desc_a, info, trans, work,doswap)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
type (psb_dspmat_type), intent(in) :: a
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
real(kind(1.d0)), intent(inout) :: y(:)
|
||||
real(kind(1.d0)), intent(in) :: alpha, beta
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
character, optional, intent(in) :: trans
|
||||
real(kind(1.d0)), optional, intent(inout) :: work(:)
|
||||
integer, optional, intent(in) :: doswap
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspmv
|
||||
end interface
|
||||
|
||||
interface psb_spsm
|
||||
subroutine psb_dspsm(alpha, t, x, beta, y,&
|
||||
& desc_a, info, trans, unit, choice,&
|
||||
& diag, n, jx, jy, work)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
type (psb_dspmat_type), intent(in) :: t
|
||||
real(kind(1.d0)), intent(in) :: x(:,:)
|
||||
real(kind(1.d0)), intent(inout) :: y(:,:)
|
||||
real(kind(1.d0)), intent(in) :: alpha, beta
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
character, optional, intent(in) :: trans, unit
|
||||
integer, optional, intent(in) :: n, jx, jy
|
||||
integer, optional, intent(in) :: choice
|
||||
real(kind(1.d0)), optional, intent(in) :: work(:), diag(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspsm
|
||||
subroutine psb_dspsv(alpha, t, x, beta, y,&
|
||||
& desc_a, info, trans, unit, choice,&
|
||||
& diag, work)
|
||||
use psb_serial_mod
|
||||
use psb_descriptor_type
|
||||
type (psb_dspmat_type), intent(in) :: t
|
||||
real(kind(1.d0)), intent(in) :: x(:)
|
||||
real(kind(1.d0)), intent(inout) :: y(:)
|
||||
real(kind(1.d0)), intent(in) :: alpha, beta
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
character, optional, intent(in) :: trans, unit
|
||||
integer, optional, intent(in) :: choice
|
||||
real(kind(1.d0)), optional, intent(in) :: work(:), diag(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspsv
|
||||
end interface
|
||||
|
||||
|
||||
end module psb_psblas_mod
|
||||
@@ -0,0 +1,398 @@
|
||||
module psb_realloc_mod
|
||||
implicit none
|
||||
|
||||
Interface psb_realloc
|
||||
module procedure psb_dreallocate1i
|
||||
module procedure psb_dreallocate2i
|
||||
module procedure psb_dreallocate2i1d
|
||||
module procedure psb_dreallocate1d
|
||||
module procedure psb_dreallocated2
|
||||
end Interface
|
||||
|
||||
Interface psb_realloc1it
|
||||
module procedure psb_dreallocate1it
|
||||
end Interface
|
||||
|
||||
Contains
|
||||
|
||||
Subroutine psb_dreallocate1i(len,rrax,info,pad)
|
||||
use psb_error_mod
|
||||
|
||||
! ...Subroutine Arguments
|
||||
Integer,Intent(in) :: len
|
||||
Integer,pointer :: rrax(:)
|
||||
integer :: info
|
||||
integer, optional, intent(in) :: pad
|
||||
! ...Local Variables
|
||||
Integer,Pointer :: tmp(:)
|
||||
Integer :: dim, err_act, err,i
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dreallocate1i'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info=0
|
||||
if (associated(rrax)) then
|
||||
dim=size(rrax)
|
||||
If (dim /= len) Then
|
||||
Allocate(tmp(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
!!$ write(0,*) 'IA: copying ',len,dim
|
||||
if (.true.) then
|
||||
do i=1, min(len,dim)
|
||||
tmp(i)=rrax(i)
|
||||
end do
|
||||
else
|
||||
tmp(1:min(len,dim))=rrax(1:min(len,dim))
|
||||
end if
|
||||
!!$ write(0,*) 'IA: copying done'
|
||||
Deallocate(rrax,stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
!!$ write(0,*) 'IA: allocating ',len
|
||||
allocate(rrax(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
if (present(pad)) then
|
||||
!!$ write(0,*) 'IA: padding'
|
||||
rrax(dim+1:len) = pad
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
|
||||
End Subroutine psb_dreallocate1i
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Subroutine psb_dreallocate1d(len,rrax,info,pad)
|
||||
use psb_error_mod
|
||||
|
||||
! ...Subroutine Arguments
|
||||
Integer,Intent(in) :: len
|
||||
Real(kind(1.d0)),pointer :: rrax(:)
|
||||
integer :: info
|
||||
real(kind(1.d0)), optional, intent(in) :: pad
|
||||
|
||||
! ...Local Variables
|
||||
Real(kind(1.d0)),Pointer :: tmp(:)
|
||||
Integer :: dim,err_act,err,i, m
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dreallocate1d'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (associated(rrax)) then
|
||||
dim=size(rrax)
|
||||
|
||||
If (dim /= len) Then
|
||||
Allocate(tmp(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
m = min(dim,len)
|
||||
!!$ write(0,*) 'DA: copying ',min(len,dim)
|
||||
if (.true.) then
|
||||
do i=1,m
|
||||
tmp(i) = rrax(i)
|
||||
end do
|
||||
else
|
||||
tmp(1:m) = rrax(1:m)
|
||||
end if
|
||||
!!$ write(0,*) 'DA: copying done ',m
|
||||
Deallocate(rrax,stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
dim = 0
|
||||
Allocate(rrax(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
if (present(pad)) then
|
||||
rrax(dim+1:len) = pad
|
||||
endif
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
End Subroutine psb_dreallocate1d
|
||||
|
||||
|
||||
|
||||
Subroutine psb_dreallocated2(len1,len2,rrax,info,pad)
|
||||
use psb_error_mod
|
||||
! ...Subroutine Arguments
|
||||
Integer,Intent(in) :: len1,len2
|
||||
Real(kind(1.d0)),pointer :: rrax(:,:)
|
||||
integer :: info
|
||||
real(kind(1.d0)), optional, intent(in) :: pad
|
||||
|
||||
! ...Local Variables
|
||||
Real(kind(1.d0)),Pointer :: tmp(:,:)
|
||||
Integer :: dim,err_act,err,i, m
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dreallocated2'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (associated(rrax)) then
|
||||
dim=size(rrax,1)
|
||||
|
||||
If (dim /= len1) Then
|
||||
Allocate(tmp(len1,len2),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
m = min(dim,len1)
|
||||
!!$ write(0,*) 'DA: copying ',min(len,dim)
|
||||
if (.true.) then
|
||||
do i=1,m
|
||||
tmp(i,:) = rrax(i,:)
|
||||
end do
|
||||
else
|
||||
tmp(1:m,:) = rrax(1:m,:)
|
||||
end if
|
||||
!!$ write(0,*) 'DA: copying done ',m
|
||||
Deallocate(rrax,stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
dim = 0
|
||||
Allocate(rrax(len1,len2),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
if (present(pad)) then
|
||||
rrax(dim+1:len1,:) = pad
|
||||
endif
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
End Subroutine psb_dreallocated2
|
||||
|
||||
|
||||
Subroutine psb_dreallocate2i(len,rrax,y,info,pad)
|
||||
use psb_error_mod
|
||||
! ...Subroutine Arguments
|
||||
|
||||
Integer,Intent(in) :: len
|
||||
Integer,pointer :: rrax(:),y(:)
|
||||
integer :: info
|
||||
integer, optional, intent(in) :: pad
|
||||
character(len=20) :: name
|
||||
integer :: err_act, err
|
||||
|
||||
name='psb_dreallocate2i'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info=0
|
||||
call psb_dreallocate1i(len,rrax,info,pad=pad)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_dreallocate1i(len,y,info,pad=pad)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
End Subroutine psb_dreallocate2i
|
||||
|
||||
|
||||
|
||||
|
||||
Subroutine psb_dreallocate2i1d(len,rrax,y,z,info)
|
||||
use psb_error_mod
|
||||
! ...Subroutine Arguments
|
||||
Integer,Intent(in) :: len
|
||||
Integer,pointer :: rrax(:),y(:)
|
||||
Real(Kind(1.d0)),pointer :: z(:)
|
||||
integer :: info
|
||||
character(len=20) :: name
|
||||
integer :: err_act, err
|
||||
|
||||
name='psb_dreallocate2i1d'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
info = 0
|
||||
call psb_dreallocate1i(len,rrax,info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_dreallocate1i(len,y,info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_dreallocate1d(len,z,info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
End Subroutine psb_dreallocate2i1d
|
||||
|
||||
|
||||
Subroutine psb_dreallocate1it(len,rrax,info,pad)
|
||||
use psb_error_mod
|
||||
! ...Subroutine Arguments
|
||||
Integer,Intent(in) :: len
|
||||
Integer,pointer :: rrax(:)
|
||||
integer :: info
|
||||
integer, optional, intent(in) :: pad
|
||||
! ...Local Variables
|
||||
Integer,Pointer :: tmp(:)
|
||||
Integer :: dim,err_act,err
|
||||
character(len=20) :: name
|
||||
|
||||
name='psb_dreallocate1it'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info=0
|
||||
if (associated(rrax)) then
|
||||
dim=size(rrax)
|
||||
If (dim /= len) Then
|
||||
Allocate(tmp(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
!!$ write(0,*) 'IA: copying ',min(len,dim)
|
||||
tmp(1:min(len,dim))=rrax(1:min(len,dim))
|
||||
!!$ write(0,*) 'IA: copying done'
|
||||
Deallocate(rrax,stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
rrax=>tmp
|
||||
End If
|
||||
else
|
||||
allocate(rrax(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
if (present(pad)) then
|
||||
!!$ write(0,*) 'IA: padding'
|
||||
rrax(dim+1:len) = pad
|
||||
endif
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
end if
|
||||
return
|
||||
|
||||
End Subroutine psb_dreallocate1it
|
||||
|
||||
|
||||
end module psb_realloc_mod
|
||||
@@ -0,0 +1,211 @@
|
||||
module psb_serial_mod
|
||||
use psb_spmat_type
|
||||
use psb_string_mod
|
||||
|
||||
interface psb_csdp
|
||||
subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_dspmat_type), intent(inout) :: b
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: ifc
|
||||
character, intent(in), optional :: check,trans,unitd
|
||||
end subroutine psb_dcsdp
|
||||
end interface
|
||||
|
||||
interface psb_csrws
|
||||
subroutine psb_dcsrws(rw,a,info,trans)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: a
|
||||
real(kind(1.d0)), pointer :: rw(:)
|
||||
integer :: info
|
||||
character, optional :: trans
|
||||
end subroutine psb_dcsrws
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
interface psb_cssm
|
||||
subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: t
|
||||
real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:)
|
||||
integer :: info
|
||||
character, optional :: trans, unitd
|
||||
real(kind(1.d0)), optional, target :: d(:)
|
||||
end subroutine psb_dcssm
|
||||
subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: t
|
||||
real(kind(1.d0)) :: alpha, beta, b(:), c(:)
|
||||
integer :: info
|
||||
character, optional :: trans, unitd
|
||||
real(kind(1.d0)), optional, target :: d(:)
|
||||
end subroutine psb_dcssv
|
||||
end interface
|
||||
|
||||
interface psb_csmm
|
||||
subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: a
|
||||
real(kind(1.d0)) :: alpha, beta, b(:), c(:)
|
||||
integer :: info
|
||||
character, optional :: trans
|
||||
end subroutine psb_dcsmv
|
||||
subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: a
|
||||
real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:)
|
||||
integer :: info
|
||||
character, optional :: trans
|
||||
end subroutine psb_dcsmm
|
||||
end interface
|
||||
|
||||
interface psb_fixcoo
|
||||
subroutine psb_dfixcoo(a,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dfixcoo
|
||||
end interface
|
||||
|
||||
interface psb_ipcoo2csr
|
||||
subroutine psb_dipcoo2csr(a,info,rwshr)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
logical, optional :: rwshr
|
||||
end subroutine psb_dipcoo2csr
|
||||
end interface
|
||||
|
||||
interface psb_ipcsr2coo
|
||||
subroutine psb_dipcsr2coo(a,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dipcsr2coo
|
||||
end interface
|
||||
|
||||
interface psb_csprt
|
||||
subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
|
||||
use psb_spmat_type
|
||||
integer, intent(in) :: iout
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
integer, intent(in), optional :: iv(:)
|
||||
integer, intent(in), optional :: irs,ics
|
||||
character(len=*), optional :: head
|
||||
integer, intent(in), optional :: ivr(:),ivc(:)
|
||||
end subroutine psb_dcsprt
|
||||
end interface
|
||||
|
||||
interface psb_spgtdiag
|
||||
subroutine psb_dspgtdiag(a,d,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
real(kind(1.d0)), intent(inout) :: d(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspgtdiag
|
||||
end interface
|
||||
|
||||
interface psb_spscal
|
||||
subroutine psb_dspscal(a,d,info)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
real(kind(1.d0)), intent(in) :: d(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspscal
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spinfo
|
||||
subroutine psb_dspinfo(ireq,a,ires,info,iaux)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
integer, intent(in) :: ireq
|
||||
integer, intent(out) :: ires
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iaux
|
||||
end subroutine psb_dspinfo
|
||||
end interface
|
||||
|
||||
interface psb_spgtrow
|
||||
subroutine psb_dspgtrow(irw,a,b,info,append,iren,lrw)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
integer, intent(in) :: irw
|
||||
type(psb_dspmat_type), intent(inout) :: b
|
||||
logical, intent(in), optional :: append
|
||||
integer, intent(in), target, optional :: iren(:)
|
||||
integer, intent(in), optional :: lrw
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspgtrow
|
||||
end interface
|
||||
|
||||
interface psb_neigh
|
||||
subroutine psb_dneigh(a,idx,neigh,n,info,lev)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
integer, intent(in) :: idx
|
||||
integer, intent(out) :: n
|
||||
integer, pointer :: neigh(:)
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: lev
|
||||
end subroutine psb_dneigh
|
||||
end interface
|
||||
|
||||
interface psb_coins
|
||||
subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
|
||||
use psb_spmat_type
|
||||
integer, intent(in) :: nz, imin,imax,jmin,jmax
|
||||
integer, intent(in) :: ia(:),ja(:),gtl(:)
|
||||
real(kind(1.d0)), intent(in) :: val(:)
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dcoins
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_symbmm
|
||||
subroutine psb_dsymbmm(a,b,c)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: a,b,c
|
||||
end subroutine psb_dsymbmm
|
||||
end interface
|
||||
|
||||
interface psb_numbmm
|
||||
subroutine psb_dnumbmm(a,b,c)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: a,b,c
|
||||
end subroutine psb_dnumbmm
|
||||
end interface
|
||||
|
||||
interface psb_transp
|
||||
subroutine psb_dtransp(a,b,c,fmt)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type) :: a,b
|
||||
integer, optional :: c
|
||||
character(len=*), optional :: fmt
|
||||
end subroutine psb_dtransp
|
||||
end interface
|
||||
|
||||
interface psb_rwextd
|
||||
subroutine psb_drwextd(nr,a,info,b)
|
||||
use psb_spmat_type
|
||||
integer, intent(in) :: nr
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(out) :: info
|
||||
type(psb_dspmat_type), intent(in), optional :: b
|
||||
end subroutine psb_drwextd
|
||||
end interface
|
||||
|
||||
interface psb_csnmi
|
||||
real(kind(1.d0)) function psb_dcsnmi(a,info,trans)
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
integer, intent(out) :: info
|
||||
character, optional :: trans
|
||||
end function psb_dcsnmi
|
||||
end interface
|
||||
|
||||
end module psb_serial_mod
|
||||
|
||||
@@ -0,0 +1,16 @@
|
||||
module psb_sparse_mod
|
||||
use psb_typedesc
|
||||
use psb_typeprec
|
||||
use psb_serial_mod
|
||||
use psb_tools_mod
|
||||
use psb_psblas_mod
|
||||
use psb_prec_mod
|
||||
use psb_methd_mod
|
||||
use psb_error_mod
|
||||
use psb_string
|
||||
end module psb_sparse_mod
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,341 @@
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
!! Module to define D_SPMAT, structure !!
|
||||
!! for sparse matrix. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
module psb_spmat_type
|
||||
use psb_error_mod
|
||||
use psb_realloc_mod
|
||||
use psb_const_mod
|
||||
! Typedef: psb_dspmat_type
|
||||
! Contains a sparse matrix
|
||||
type psb_dspmat_type
|
||||
! Rows & columns
|
||||
integer :: m, k
|
||||
! Identify the representation method. Es: CSR, JAD, ...
|
||||
character(len=5) :: fida
|
||||
! describe some chacteristics of sparse matrix
|
||||
character(len=11) :: descra
|
||||
! Contains some additional informations on sparse matrix
|
||||
integer :: infoa(10)
|
||||
! Contains sparse matrix coefficients
|
||||
real(kind(1.d0)), pointer :: aspk(:)=>null()
|
||||
! Contains indeces that describes sparse matrix structure
|
||||
integer, pointer :: ia1(:)=>null(), ia2(:)=>null()
|
||||
! Permutations matrix
|
||||
integer, pointer :: pl(:)=>null(), pr(:)=>null()
|
||||
end type psb_dspmat_type
|
||||
|
||||
interface psb_nullify_sp
|
||||
module procedure psb_nullify_dsp
|
||||
end interface
|
||||
|
||||
interface psb_spclone
|
||||
module procedure psb_dspclone
|
||||
end interface
|
||||
|
||||
interface psb_spreall
|
||||
module procedure psb_dspreallocate, psb_dspreall3
|
||||
end interface
|
||||
|
||||
interface psb_spall
|
||||
module procedure psb_dspallocate, psb_dspall3, psb_dspallmk, psb_dspallmknz
|
||||
end interface
|
||||
|
||||
interface psb_spfree
|
||||
module procedure psb_dspfree
|
||||
end interface
|
||||
|
||||
interface psb_spreinit
|
||||
module procedure psb_dspreinit
|
||||
end interface
|
||||
|
||||
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
|
||||
mat%fida=''
|
||||
mat%descra=''
|
||||
|
||||
end subroutine psb_nullify_dsp
|
||||
|
||||
Subroutine psb_dspreinit(a)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
if (debug) write(0,*) 'spreinit init ',a%fida,a%infoa(psb_nnz_)
|
||||
if (a%fida=='COO') a%infoa(psb_nnz_) = 0
|
||||
if (associated(a%aspk)) a%aspk(:) = 0.d0
|
||||
if (debug) write(0,*) 'spreinit end ',a%fida,a%infoa(psb_nnz_)
|
||||
|
||||
end Subroutine psb_dspreinit
|
||||
|
||||
Subroutine psb_dspallocate(a, nnz,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
Integer, intent(in) :: nnz
|
||||
integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
if (nnz.lt.0) then
|
||||
info=45
|
||||
return
|
||||
Endif
|
||||
if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k
|
||||
call psb_spreall(a,nnz,info)
|
||||
|
||||
a%pl(1)=0
|
||||
a%pr(1)=0
|
||||
! set INFOA fields
|
||||
a%fida = 'COO'
|
||||
a%descra = 'GUN'
|
||||
a%infoa(:) = 0
|
||||
a%m = 0
|
||||
a%k = 0
|
||||
if (debug) write(0,*) 'SPALL : end'
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspallocate
|
||||
|
||||
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
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
integer :: nnz
|
||||
|
||||
INFO = 0
|
||||
nnz = 2*max(1,m,k)
|
||||
if (debug) write(0,*) 'SPALL : NNZ ',nnz,a%m,a%k
|
||||
a%m=max(0,m)
|
||||
a%k=max(0,k)
|
||||
call psb_spreall(a,nnz,info)
|
||||
|
||||
a%pl(1)=0
|
||||
a%pr(1)=0
|
||||
! set INFOA fields
|
||||
a%fida = 'COO'
|
||||
a%descra = 'GUN'
|
||||
a%infoa(:) = 0
|
||||
if (debug) write(0,*) 'SPALL : end'
|
||||
Return
|
||||
|
||||
end subroutine psb_dspallmk
|
||||
|
||||
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
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
if (nnz.lt.0) then
|
||||
info=45
|
||||
return
|
||||
endif
|
||||
if (debug) write(0,*) 'spall : nnz ',nnz,a%m,a%k
|
||||
a%m=max(0,m)
|
||||
a%k=max(0,k)
|
||||
call psb_spreall(a,nnz,info)
|
||||
|
||||
a%pl(1)=0
|
||||
a%pr(1)=0
|
||||
! set infoa fields
|
||||
a%fida = 'COO'
|
||||
a%descra = 'GUN'
|
||||
a%infoa(:) = 0
|
||||
if (debug) write(0,*) 'spall : end'
|
||||
return
|
||||
|
||||
end subroutine psb_dspallmknz
|
||||
|
||||
|
||||
subroutine psb_dspall3(a, ni1,ni2,nd,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
Integer, intent(in) :: ni1,ni2,nd
|
||||
Integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
|
||||
call psb_spreall(a, ni1,ni2,nd,info)
|
||||
|
||||
a%pl(1)=0
|
||||
a%pr(1)=0
|
||||
! set INFOA fields
|
||||
a%fida = 'COO'
|
||||
a%descra = 'GUN'
|
||||
a%infoa(:) = 0
|
||||
a%m = 0
|
||||
a%k = 0
|
||||
if (debug) write(0,*) 'SPALL : end'
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspall3
|
||||
|
||||
|
||||
subroutine psb_dspreallocate(a, nnz,info,ifc)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
Integer, intent(in) :: NNZ
|
||||
Integer, intent(out) :: info
|
||||
!
|
||||
! ifc is used here to allocate space in IA1 for smart
|
||||
! regeneration. This probably ought to be changed,
|
||||
! by adding a new component to d_spmat, or by making
|
||||
! infoa a pointer.
|
||||
!
|
||||
Integer, intent(in), optional :: ifc
|
||||
integer :: ifc_
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
if (nnz.lt.0) then
|
||||
info=45
|
||||
return
|
||||
endif
|
||||
if (present(ifc)) then
|
||||
ifc_ = max(1,ifc)
|
||||
else
|
||||
ifc_ = 1
|
||||
endif
|
||||
|
||||
if (ifc_ == 1) then
|
||||
call psrealloc(nnz,a%ia1,a%ia2,a%aspk,info)
|
||||
else
|
||||
call psrealloc(nnz,a%aspk,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(nnz,a%ia2,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(ifc*nnz+200,a%ia1,info)
|
||||
if (info /= 0) return
|
||||
end if
|
||||
if (info /= 0) return
|
||||
call psrealloc(max(1,a%m),a%pl,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(max(1,a%k),a%pr,info)
|
||||
if (info /= 0) return
|
||||
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspreallocate
|
||||
|
||||
subroutine psb_dspreall3(a, ni1,ni2,nd,info)
|
||||
implicit none
|
||||
!....Parameters...
|
||||
Type(psb_dspmat_type), intent(inout) :: A
|
||||
Integer, intent(in) :: ni1,ni2,nd
|
||||
Integer, intent(inout) :: info
|
||||
|
||||
!locals
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
call psrealloc(nd,a%aspk,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(ni2,a%ia2,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(ni1,a%ia1,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(max(1,a%m),a%pl,info)
|
||||
if (info /= 0) return
|
||||
call psrealloc(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...
|
||||
Type(psb_dspmat_type), intent(in) :: A
|
||||
Type(psb_dspmat_type), intent(out) :: B
|
||||
Integer, intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer :: nza,nz1, nz2, nzl, nzr
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
INFO = 0
|
||||
|
||||
nza = size(a%aspk)
|
||||
nz1 = size(a%ia1)
|
||||
nz2 = size(a%ia2)
|
||||
nzl = size(a%pl)
|
||||
nzr = size(a%pr)
|
||||
allocate(b%aspk(nza),b%ia1(nz1),b%ia2(nz2),&
|
||||
& b%pl(nzl),b%pr(nzr),stat=info)
|
||||
if (info /= 0) then
|
||||
info=2023
|
||||
return
|
||||
Endif
|
||||
b%aspk(:) = a%aspk(:)
|
||||
b%ia1(:) = a%ia1(:)
|
||||
b%ia2(:) = a%ia2(:)
|
||||
b%pl(:) = a%pl(:)
|
||||
b%pr(:) = a%pr(:)
|
||||
b%infoa(:) = a%infoa(:)
|
||||
b%fida = a%fida
|
||||
b%descra = a%descra
|
||||
b%m = a%m
|
||||
b%k = a%k
|
||||
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspclone
|
||||
|
||||
|
||||
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)
|
||||
|
||||
Return
|
||||
|
||||
End Subroutine psb_dspfree
|
||||
|
||||
|
||||
end module psb_spmat_type
|
||||
|
||||
@@ -0,0 +1,20 @@
|
||||
module psb_string_mod
|
||||
interface tolower
|
||||
function tolowerc(string)
|
||||
character(len=*), intent(in) :: string
|
||||
character(len=len(string)) :: tolowerc
|
||||
end function tolowerc
|
||||
end interface
|
||||
interface toupper
|
||||
function toupperc(string)
|
||||
character(len=*), intent(in) :: string
|
||||
character(len=len(string)) :: toupperc
|
||||
end function toupperc
|
||||
end interface
|
||||
interface touppers
|
||||
subroutine sub_toupperc(string,strout)
|
||||
character(len=*), intent(in) :: string
|
||||
character(len=*), intent(out) :: strout
|
||||
end subroutine sub_toupperc
|
||||
end interface
|
||||
end module psb_string_mod
|
||||
@@ -0,0 +1,504 @@
|
||||
Module psb_tools_mod
|
||||
use psb_const_mod
|
||||
|
||||
interface psb_alloc
|
||||
! 2-D double precision version
|
||||
subroutine psb_dalloc(m, n, x, desc_a, info, js)
|
||||
use psb_descriptor_type
|
||||
implicit none
|
||||
integer, intent(in) :: m,n
|
||||
real(kind(1.d0)), pointer :: x(:,:)
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer :: info
|
||||
integer, optional, intent(in) :: js
|
||||
end subroutine psb_dalloc
|
||||
! 1-D double precision version
|
||||
subroutine psb_dallocv(m, x, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m
|
||||
real(kind(1.d0)), pointer :: x(:)
|
||||
type(psb_desc_type), intent(in):: desc_a
|
||||
integer :: info
|
||||
end subroutine psb_dallocv
|
||||
! 2-D integer version
|
||||
subroutine psb_ialloc(m, n, x, desc_a, info,js)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m,n
|
||||
integer, pointer :: x(:,:)
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: js
|
||||
end subroutine psb_ialloc
|
||||
subroutine psb_iallocv(m, x, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m
|
||||
integer, pointer :: x(:)
|
||||
type(psb_desc_type), intent(in):: desc_a
|
||||
integer :: info
|
||||
end subroutine psb_iallocv
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_asb
|
||||
! 2-D double precision version
|
||||
subroutine psb_dasb(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), pointer :: x(:,:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dasb
|
||||
! 1-D double precision version
|
||||
subroutine psb_dasbv(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), pointer :: x(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dasbv
|
||||
! 2-D integer version
|
||||
subroutine psb_iasb(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, pointer :: x(:,:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_iasb
|
||||
! 1-D integer version
|
||||
subroutine psb_iasbv(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, pointer :: x(:)
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_iasbv
|
||||
end interface
|
||||
|
||||
interface psb_csrovr
|
||||
Subroutine psb_dcsrovr(a,desc_a,blk,info,rwcnv,clcnv,outfmt)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
Type(psb_dspmat_type),Intent(in) :: a
|
||||
Type(psb_dspmat_type),Intent(inout) :: blk
|
||||
Type(psb_desc_type),Intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
logical, optional, intent(in) :: rwcnv,clcnv
|
||||
character(len=5), optional :: outfmt
|
||||
end Subroutine psb_dcsrovr
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_csrp
|
||||
subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(inout) :: iperm(:), info
|
||||
character, intent(in) :: trans
|
||||
end subroutine psb_dcsrp
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_descasb
|
||||
Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
|
||||
& l_tmp_halo,l_tmp_ovr_idx,lworks,lworkr,info)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type),intent(in) :: a
|
||||
type(psb_desc_type),intent(in) :: desc_a
|
||||
type(psb_desc_type),intent(inout) :: desc_p
|
||||
integer,intent(in) :: n_ovr
|
||||
Integer, Intent(in) :: l_tmp_halo,l_tmp_ovr_idx
|
||||
Integer, Intent(inout) :: lworks, lworkr
|
||||
integer, intent(out) :: info
|
||||
end Subroutine psb_descasb
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_descprt
|
||||
subroutine psb_descprt(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_descprt
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_free
|
||||
! 2-D double precision version
|
||||
subroutine psb_dfree(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)),pointer :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer :: info
|
||||
end subroutine psb_dfree
|
||||
! 1-D double precision version
|
||||
subroutine psb_dfreev(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)),pointer :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer :: info
|
||||
end subroutine psb_dfreev
|
||||
! 2-D integer version
|
||||
subroutine psb_ifree(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
integer,pointer :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer :: info
|
||||
end subroutine psb_ifree
|
||||
! 1-D integer version
|
||||
subroutine psb_ifreev(x, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
integer, pointer :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer :: info
|
||||
end subroutine psb_ifreev
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_gelp
|
||||
! 2-D version
|
||||
subroutine psb_dgelp(trans,iperm,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), intent(inout) :: x(:,:)
|
||||
integer, intent(inout) :: iperm(:),info
|
||||
character, intent(in) :: trans
|
||||
end subroutine psb_dgelp
|
||||
! 1-D version
|
||||
subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
integer, intent(inout) :: iperm(:), info
|
||||
character, intent(in) :: trans
|
||||
end subroutine psb_dgelpv
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_ins
|
||||
! 2-D double precision version
|
||||
subroutine psb_dins(m, n, x, ix, jx, blck, desc_a, info,&
|
||||
& iblck, jblck)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m,n
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)),pointer :: x(:,:)
|
||||
integer, intent(in) :: ix,jx
|
||||
real(kind(1.d0)), intent(in) :: blck(:,:)
|
||||
integer,intent(out) :: info
|
||||
integer, optional, intent(in) :: iblck,jblck
|
||||
end subroutine psb_dins
|
||||
! 2-D double precision square version
|
||||
subroutine psb_dinsvm(m, x, ix, jx, blck, desc_a,info,&
|
||||
& iblck)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)),pointer :: x(:,:)
|
||||
integer, intent(in) :: ix,jx
|
||||
real(kind(1.d0)), intent(in) :: blck(:)
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: iblck
|
||||
end subroutine psb_dinsvm
|
||||
! 1-D double precision version
|
||||
subroutine psb_dinsvv(m, x, ix, blck, desc_a, info,&
|
||||
& iblck,insflag)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
real(kind(1.d0)),pointer :: x(:)
|
||||
integer, intent(in) :: ix
|
||||
real(kind(1.d0)), intent(in) :: blck(:)
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: iblck
|
||||
integer, optional, intent(in) :: insflag
|
||||
end subroutine psb_dinsvv
|
||||
! 2-D integer version
|
||||
subroutine psb_iins(m, n, x, ix, jx, blck, desc_a, info,&
|
||||
& iblck, jblck)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m,n
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,pointer :: x(:,:)
|
||||
integer, intent(in) :: ix,jx
|
||||
integer, intent(in) :: blck(:,:)
|
||||
integer,intent(out) :: info
|
||||
integer, optional, intent(in) :: iblck,jblck
|
||||
end subroutine psb_iins
|
||||
! 2-D integer square version
|
||||
subroutine psb_iinsvm(m, x, ix, jx, blck, desc_a,info,&
|
||||
& iblck)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, pointer :: x(:,:)
|
||||
integer, intent(in) :: ix,jx
|
||||
integer, intent(in) :: blck(:)
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: iblck
|
||||
end subroutine psb_iinsvm
|
||||
! 1-D integer version
|
||||
subroutine psb_iinsvv(m, x, ix, blck, desc_a, info,&
|
||||
& iblck,insflag)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, pointer :: x(:)
|
||||
integer, intent(in) :: ix
|
||||
integer, intent(in) :: blck(:)
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: iblck
|
||||
integer, optional, intent(in) :: insflag
|
||||
end subroutine psb_iinsvv
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
interface psb_ptins
|
||||
subroutine psb_dptins(ia,ja,blck,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer, intent(in) :: ia,ja
|
||||
type(psb_dspmat_type), intent(in) :: blck
|
||||
integer,intent(out) :: info
|
||||
end subroutine psb_dptins
|
||||
end interface
|
||||
|
||||
interface psb_dscall
|
||||
subroutine psb_dscall(m, n, parts, icontxt, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
Integer, intent(in) :: M,N,ICONTXT
|
||||
Type(psb_desc_type), intent(out) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dscall
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_scalv
|
||||
subroutine psb_dscalv(m, v, icontxt, desc_a, info, flag)
|
||||
use psb_descriptor_type
|
||||
Integer, intent(in) :: m,icontxt, v(:)
|
||||
integer, intent(in), optional :: flag
|
||||
integer, intent(out) :: info
|
||||
Type(psb_desc_type), intent(out) :: desc_a
|
||||
end subroutine psb_dscalv
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_dscasb
|
||||
subroutine psb_dscasb(desc_a,info)
|
||||
use psb_descriptor_type
|
||||
Type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dscasb
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
interface psb_dsccpy
|
||||
subroutine psb_dsccpy(desc_out, desc_a, info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(out) :: desc_out
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dsccpy
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_dscfree
|
||||
subroutine psb_dscfree(desc_a,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dscfree
|
||||
end interface
|
||||
|
||||
interface psb_dscins
|
||||
subroutine psb_dscins(nz,ia,ja,desc_a,info,is,js)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
Integer, intent(in) :: nz,IA(:),JA(:)
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: is,js
|
||||
end subroutine psb_dscins
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_dscov
|
||||
Subroutine psb_dscov(a,desc_a,novr,desc_ov,info)
|
||||
use psb_descriptor_type
|
||||
Use psb_spmat_type
|
||||
integer, intent(in) :: novr
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in) :: desc_a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_ov
|
||||
integer, intent(out) :: info
|
||||
end Subroutine psb_dscov
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_dscren
|
||||
subroutine psb_dscren(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_dscren
|
||||
end interface
|
||||
|
||||
interface psb_spalloc
|
||||
subroutine psb_dspalloc(a, desc_a, info, nnz)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_dspmat_type), intent(out) :: a
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: nnz
|
||||
end subroutine psb_dspalloc
|
||||
end interface
|
||||
|
||||
interface psb_spasb
|
||||
subroutine psb_dspasb(a,desc_a, info, afmt, up, dup)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent (inout) :: a
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer,optional, intent(in) :: dup
|
||||
character, optional, intent(in) :: afmt*5, up
|
||||
end subroutine psb_dspasb
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spcnv
|
||||
subroutine psb_dspcnv(a,b,desc_a,info)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_dspmat_type), intent(out) :: b
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dspcnv
|
||||
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
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spins
|
||||
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
|
||||
use psb_descriptor_type
|
||||
use psb_spmat_type
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
integer, intent(in) :: nz,ia(:),ja(:)
|
||||
real(kind(1.d0)), intent(in) :: val(:)
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: is,js
|
||||
end subroutine psb_dspins
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_sprn
|
||||
subroutine psb_dsprn(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_dsprn
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_spupdate
|
||||
subroutine psb_dspupdate(a, ia, ja, blck, desc_a,info,ix,jx,updflag)
|
||||
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(in) :: ia,ja
|
||||
type(psb_dspmat_type), intent(in) :: blck
|
||||
integer, intent(out) :: info
|
||||
integer, optional, intent(in) :: ix,jx
|
||||
integer, optional, intent(in) :: updflag
|
||||
end subroutine psb_dspupdate
|
||||
end interface
|
||||
|
||||
interface psb_glob_to_loc
|
||||
subroutine psb_glob_to_loc2(x,y,desc_a,info,iact)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(in) :: x(:)
|
||||
integer,intent(out) :: y(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_glob_to_loc2
|
||||
subroutine psb_glob_to_loc(x,desc_a,info,iact)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(inout) :: x(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_glob_to_loc
|
||||
end interface
|
||||
|
||||
interface psb_loc_to_glob
|
||||
subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(in) :: x(:)
|
||||
integer,intent(out) :: y(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_loc_to_glob2
|
||||
subroutine psb_loc_to_glob(x,desc_a,info,iact)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(inout) :: x(:)
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
end subroutine psb_loc_to_glob
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_ptasb
|
||||
subroutine psb_ptasb(desc_a,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer,intent(out) :: info
|
||||
end subroutine psb_ptasb
|
||||
end interface
|
||||
|
||||
|
||||
interface psb_dscrep
|
||||
subroutine psb_dscrep(m, icontxt, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
Integer, intent(in) :: m,icontxt
|
||||
Type(psb_desc_type), intent(out) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dscrep
|
||||
end interface
|
||||
|
||||
interface psb_dscdec
|
||||
subroutine psb_dscdec(nloc, icontxt, desc_a,info)
|
||||
use psb_descriptor_type
|
||||
Integer, intent(in) :: nloc,icontxt
|
||||
Type(psb_desc_type), intent(out) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psb_dscdec
|
||||
end interface
|
||||
|
||||
|
||||
end module psb_tools_mod
|
||||
@@ -0,0 +1,161 @@
|
||||
! Module containing interfaces for subroutine in SRC/F90/INTERNALS
|
||||
|
||||
module psi_mod
|
||||
|
||||
use psb_descriptor_type
|
||||
|
||||
interface
|
||||
subroutine psi_compute_size(desc_data,&
|
||||
& index_in, dl_lda, info)
|
||||
integer :: info, dl_lda
|
||||
integer :: desc_data(:), index_in(:)
|
||||
end subroutine psi_compute_size
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psi_crea_bnd_elem(desc_a,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
end subroutine psi_crea_bnd_elem
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in) :: index_in(:)
|
||||
integer, intent(out) :: index_out(:)
|
||||
logical :: glob_idx
|
||||
end subroutine psi_crea_index
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psi_crea_ovr_elem(desc_overlap,ovr_elem)
|
||||
integer :: desc_overlap(:)
|
||||
integer, pointer :: ovr_elem(:)
|
||||
end subroutine psi_crea_ovr_elem
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psi_desc_index(desc_data,index_in,dep_list,&
|
||||
& length_dl,loc_to_glob,glob_to_loc,desc_index,&
|
||||
& isglob_in,info)
|
||||
integer :: desc_data(:),index_in(:),dep_list(:)
|
||||
integer :: loc_to_glob(:),glob_to_loc(:)
|
||||
integer,pointer :: desc_index(:)
|
||||
integer :: length_dl, info
|
||||
logical :: isglob_in
|
||||
end subroutine psi_desc_index
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
|
||||
integer :: np,dep_list(:,:), l_dep_list(:), info
|
||||
end subroutine psi_sort_dl
|
||||
end interface
|
||||
|
||||
interface psi_swapdata
|
||||
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag, n
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)) :: y(:,:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_dswapdatam
|
||||
subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)) :: y(:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_dswapdatav
|
||||
subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag, n
|
||||
integer, intent(out) :: info
|
||||
integer :: y(:,:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_iswapdatam
|
||||
subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag
|
||||
integer, intent(out) :: info
|
||||
integer :: y(:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_iswapdatav
|
||||
end interface
|
||||
|
||||
|
||||
interface psi_swaptran
|
||||
subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag, n
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)) :: y(:,:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_dswaptranm
|
||||
subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)) :: y(:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_dswaptranv
|
||||
subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag, n
|
||||
integer, intent(out) :: info
|
||||
integer :: y(:,:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_iswaptranm
|
||||
subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info)
|
||||
use psb_descriptor_type
|
||||
integer, intent(in) :: flag
|
||||
integer, intent(out) :: info
|
||||
integer :: y(:), beta, work(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
end subroutine psi_iswaptranv
|
||||
end interface
|
||||
|
||||
|
||||
interface psi_gth
|
||||
subroutine psi_dgthm(n,k,idx,x,y)
|
||||
integer :: n, k, idx(:)
|
||||
real(kind(1.d0)) :: x(:,:), y(:)
|
||||
end subroutine psi_dgthm
|
||||
subroutine psi_dgthv(n,idx,x,y)
|
||||
integer :: n, idx(:)
|
||||
real(kind(1.d0)) :: x(:), y(:)
|
||||
end subroutine psi_dgthv
|
||||
subroutine psi_igthm(n,k,idx,x,y)
|
||||
integer :: n, k, idx(:)
|
||||
integer :: x(:,:), y(:)
|
||||
end subroutine psi_igthm
|
||||
subroutine psi_igthv(n,idx,x,y)
|
||||
integer :: n, idx(:)
|
||||
integer :: x(:), y(:)
|
||||
end subroutine psi_igthv
|
||||
end interface
|
||||
|
||||
interface psi_sct
|
||||
subroutine psi_dsctm(n,k,idx,x,beta,y)
|
||||
integer :: n, k, idx(:)
|
||||
real(kind(1.d0)) :: beta, x(:), y(:,:)
|
||||
end subroutine psi_dsctm
|
||||
subroutine psi_dsctv(n,idx,x,beta,y)
|
||||
integer :: n, idx(:)
|
||||
real(kind(1.d0)) :: beta, x(:), y(:)
|
||||
end subroutine psi_dsctv
|
||||
subroutine psi_isctm(n,k,idx,x,beta,y)
|
||||
integer :: n, k, idx(:)
|
||||
integer :: beta, x(:), y(:,:)
|
||||
end subroutine psi_isctm
|
||||
subroutine psi_isctv(n,idx,x,beta,y)
|
||||
integer :: n, idx(:)
|
||||
integer :: beta, x(:), y(:)
|
||||
end subroutine psi_isctv
|
||||
end interface
|
||||
|
||||
end module psi_mod
|
||||
@@ -0,0 +1,26 @@
|
||||
INTEGER MINJDROWS, MAXJDROWS
|
||||
PARAMETER (MINJDROWS=4, MAXJDROWS=8)
|
||||
DOUBLE PRECISION PERCENT
|
||||
INTEGER DBLEINT_
|
||||
INTEGER DCMPLXINT_
|
||||
C ... This parameter represent sizeof(DOUBLE)/sizeof(INTEGER) ...
|
||||
PARAMETER (PERCENT=0.7,DBLEINT_=2)
|
||||
PARAMETER (DCMPLXINT_ = 4)
|
||||
character fidef*5
|
||||
parameter (fidef='CSR')
|
||||
integer, parameter :: nnz_=1
|
||||
integer, parameter :: del_bnd_=6, srtd_=7
|
||||
integer, parameter :: state_=8, upd_=9
|
||||
integer, parameter :: upd_pnt_=10, ifasize_=10
|
||||
integer, parameter :: spmat_null=0, spmat_bld=1
|
||||
integer, parameter :: spmat_asb=2, spmat_upd=4
|
||||
|
||||
integer perm_update
|
||||
parameter (perm_update=98765)
|
||||
integer isrtdcoo
|
||||
parameter (isrtdcoo=98764)
|
||||
integer ireg_flgs
|
||||
parameter (ireg_flgs=10)
|
||||
integer ip2_, iflag_, ipc_, ichk_, nnzt_, zero_
|
||||
parameter (ip2_=0, iflag_=2, ichk_=3)
|
||||
parameter ( nnzt_=4, zero_=5,ipc_=6)
|
||||
Reference in New Issue
Block a user