mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 02:49:03 +00:00
psblas3-integer8:
base/modules/psi_penv_mod.F90 Restepping through longint changes.
This commit is contained in:
Salvatore Filippone
+125
-34
@@ -22,23 +22,45 @@ module psi_penv_mod
|
||||
module procedure psb_barrier
|
||||
end interface
|
||||
|
||||
#if defined(LONG_INTEGERS)
|
||||
interface psb_init
|
||||
module procedure psb_init_ipk
|
||||
end interface
|
||||
|
||||
interface psb_exit
|
||||
module procedure psb_exit_ipk
|
||||
end interface
|
||||
|
||||
interface psb_abort
|
||||
module procedure psb_abort_ipk
|
||||
end interface
|
||||
|
||||
interface psb_info
|
||||
module procedure psb_info_ipk
|
||||
end interface
|
||||
|
||||
interface psb_barrier
|
||||
module procedure psb_barrier_ipk
|
||||
end interface
|
||||
#endif
|
||||
|
||||
interface psb_wtime
|
||||
module procedure psb_wtime
|
||||
end interface
|
||||
|
||||
|
||||
#if defined(SERIAL_MPI)
|
||||
integer(psb_ipk_), private, save :: nctxt=0
|
||||
integer(psb_mpik_), private, save :: nctxt=0
|
||||
|
||||
#else
|
||||
|
||||
integer(psb_ipk_), save :: mpi_iamx_op, mpi_iamn_op
|
||||
integer(psb_ipk_), save :: mpi_i8amx_op, mpi_i8amn_op
|
||||
integer(psb_ipk_), save :: mpi_samx_op, mpi_samn_op
|
||||
integer(psb_ipk_), save :: mpi_damx_op, mpi_damn_op
|
||||
integer(psb_ipk_), save :: mpi_camx_op, mpi_camn_op
|
||||
integer(psb_ipk_), save :: mpi_zamx_op, mpi_zamn_op
|
||||
integer(psb_ipk_), save :: mpi_snrm2_op, mpi_dnrm2_op
|
||||
integer(psb_mpik_), save :: mpi_iamx_op, mpi_iamn_op
|
||||
integer(psb_mpik_), save :: mpi_i8amx_op, mpi_i8amn_op
|
||||
integer(psb_mpik_), save :: mpi_samx_op, mpi_samn_op
|
||||
integer(psb_mpik_), save :: mpi_damx_op, mpi_damn_op
|
||||
integer(psb_mpik_), save :: mpi_camx_op, mpi_camn_op
|
||||
integer(psb_mpik_), save :: mpi_zamx_op, mpi_zamn_op
|
||||
integer(psb_mpik_), save :: mpi_snrm2_op, mpi_dnrm2_op
|
||||
|
||||
type(psb_buffer_queue), save :: psb_mesg_queue
|
||||
|
||||
@@ -83,8 +105,7 @@ contains
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_ipk_) :: info
|
||||
info = 0
|
||||
integer(psb_mpik_) :: info
|
||||
|
||||
#if defined(LONG_INTEGERS)
|
||||
psb_mpi_integer = mpi_integer8
|
||||
@@ -109,8 +130,78 @@ contains
|
||||
if (info == 0) call mpi_op_create(psi_snrm2_op,.true.,mpi_snrm2_op,info)
|
||||
if (info == 0) call mpi_op_create(psi_dnrm2_op,.true.,mpi_dnrm2_op,info)
|
||||
#endif
|
||||
|
||||
end subroutine psi_register_mpi_extras
|
||||
|
||||
#if defined(LONG_INTEGERS)
|
||||
subroutine psb_init_ipk(ictxt,np,basectxt,ids)
|
||||
integer(psb_ipk_), intent(out) :: ictxt
|
||||
integer(psb_ipk_), intent(in), optional :: np, basectxt
|
||||
|
||||
integer(psb_mpik_) :: iictxt
|
||||
integer(psb_mpik_) :: inp, ibasectxt
|
||||
|
||||
if (present(np).and.present(basectxt)) then
|
||||
inp = np
|
||||
ibasectxt = basectxt
|
||||
call psb_init(iictxt,np=inp,basectxt=ibasectxt)
|
||||
else if (present(np)) then
|
||||
inp = np
|
||||
call psb_init(iictxt,np=inp)
|
||||
else if (present(basectxt)) then
|
||||
ibasectxt = basectxt
|
||||
call psb_init(iictxt,basectxt=ibasectxt)
|
||||
else
|
||||
call psb_init(iictxt)
|
||||
end if
|
||||
ictxt = iictxt
|
||||
end subroutine psb_init_ipk
|
||||
|
||||
subroutine psb_exit_ipk(ictxt,close)
|
||||
integer(psb_ipk_), intent(inout) :: ictxt
|
||||
logical, intent(in), optional :: close
|
||||
integer(psb_mpik_) :: iictxt
|
||||
|
||||
iictxt = ictxt
|
||||
call psb_exit(iictxt, close)
|
||||
end subroutine psb_exit_ipk
|
||||
|
||||
subroutine psb_barrier_ipk(ictxt)
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
integer(psb_mpik_) :: iictxt
|
||||
|
||||
iictxt = ictxt
|
||||
call psb_barrier(iictxt)
|
||||
end subroutine psb_barrier_ipk
|
||||
|
||||
subroutine psb_abort_ipk(ictxt,errc)
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
integer(psb_ipk_), intent(in), optional :: errc
|
||||
integer(psb_mpik_) :: iictxt, ierrc
|
||||
|
||||
iictxt = ictxt
|
||||
if (present(errc)) then
|
||||
ierrc = errc
|
||||
call psb_abort(iictxt,ierrc)
|
||||
else
|
||||
call psb_abort(iictxt)
|
||||
end if
|
||||
end subroutine psb_abort_ipk
|
||||
|
||||
subroutine psb_info_ipk(ictxt,iam,np)
|
||||
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
integer(psb_ipk_), intent(out) :: iam, np
|
||||
|
||||
integer(psb_mpik_) :: iictxt, iiam, inp
|
||||
iictxt = ictxt
|
||||
call psb_info(iictxt,iiam,inp)
|
||||
iam = iiam
|
||||
np = inp
|
||||
end subroutine psb_info_ipk
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
subroutine psb_init(ictxt,np,basectxt,ids)
|
||||
use psi_comm_buffers_mod
|
||||
@@ -124,16 +215,16 @@ contains
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_ipk_), intent(out) :: ictxt
|
||||
integer(psb_ipk_), intent(in), optional :: np, basectxt, ids(:)
|
||||
integer(psb_mpik_), intent(out) :: ictxt
|
||||
integer(psb_mpik_), intent(in), optional :: np, basectxt, ids(:)
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i, isnullcomm
|
||||
integer(psb_ipk_), allocatable :: iids(:)
|
||||
integer(psb_mpik_) :: i, isnullcomm
|
||||
integer(psb_mpik_), allocatable :: iids(:)
|
||||
logical :: initialized
|
||||
integer(psb_ipk_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup
|
||||
integer(psb_mpik_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup
|
||||
character(len=20), parameter :: name='psb_init'
|
||||
|
||||
integer(psb_ipk_) :: iinfo
|
||||
call psb_set_debug_unit(psb_err_unit)
|
||||
|
||||
#if defined(SERIAL_MPI)
|
||||
@@ -161,16 +252,16 @@ contains
|
||||
|
||||
if (present(np)) then
|
||||
if (np < 1) then
|
||||
info=psb_err_initerror_neugh_procs_
|
||||
call psb_errpush(info,name)
|
||||
iinfo=psb_err_initerror_neugh_procs_
|
||||
call psb_errpush(iinfo,name)
|
||||
call psb_error()
|
||||
ictxt = mpi_comm_null
|
||||
return
|
||||
endif
|
||||
call mpi_comm_size(basecomm,np_,info)
|
||||
if (np_ < np) then
|
||||
info=psb_err_initerror_neugh_procs_
|
||||
call psb_errpush(info,name)
|
||||
iinfo=psb_err_initerror_neugh_procs_
|
||||
call psb_errpush(iinfo,name)
|
||||
call psb_error()
|
||||
ictxt = mpi_comm_null
|
||||
return
|
||||
@@ -249,10 +340,10 @@ contains
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_ipk_), intent(inout) :: ictxt
|
||||
integer(psb_mpik_), intent(inout) :: ictxt
|
||||
logical, intent(in), optional :: close
|
||||
logical :: close_
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_mpik_) :: info
|
||||
character(len=20), parameter :: name='psb_exit'
|
||||
|
||||
info = 0
|
||||
@@ -300,9 +391,9 @@ contains
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_mpik_) :: info
|
||||
#if !defined(SERIAL_MPI)
|
||||
if (ictxt /= mpi_comm_null) then
|
||||
call mpi_barrier(ictxt, info)
|
||||
@@ -328,10 +419,10 @@ contains
|
||||
subroutine psb_abort(ictxt,errc)
|
||||
use psi_comm_buffers_mod
|
||||
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
integer(psb_ipk_), intent(in), optional :: errc
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(in), optional :: errc
|
||||
|
||||
integer(psb_ipk_) :: code, info
|
||||
integer(psb_mpik_) :: code, info
|
||||
|
||||
#if defined(SERIAL_MPI)
|
||||
stop
|
||||
@@ -358,9 +449,9 @@ contains
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
|
||||
integer(psb_ipk_), intent(in) :: ictxt
|
||||
integer(psb_ipk_), intent(out) :: iam, np
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_mpik_), intent(in) :: ictxt
|
||||
integer(psb_mpik_), intent(out) :: iam, np
|
||||
integer(psb_mpik_) :: info
|
||||
|
||||
#if defined(SERIAL_MPI)
|
||||
iam = 0
|
||||
@@ -381,26 +472,26 @@ contains
|
||||
|
||||
|
||||
subroutine psb_set_coher(ictxt,isvch)
|
||||
integer(psb_ipk_) :: ictxt, isvch
|
||||
integer(psb_mpik_) :: ictxt, isvch
|
||||
! Ensure global repeatability for convergence checks.
|
||||
! Do nothing. Obsolete.
|
||||
end subroutine psb_set_coher
|
||||
|
||||
subroutine psb_restore_coher(ictxt,isvch)
|
||||
integer(psb_ipk_) :: ictxt, isvch
|
||||
integer(psb_mpik_) :: ictxt, isvch
|
||||
! Ensure global coherence for convergence checks.
|
||||
! Do nothing. Obsolete.
|
||||
|
||||
end subroutine psb_restore_coher
|
||||
|
||||
subroutine psb_get_mpicomm(ictxt,comm)
|
||||
integer(psb_ipk_) :: ictxt, comm
|
||||
integer(psb_mpik_) :: ictxt, comm
|
||||
|
||||
comm = ictxt
|
||||
end subroutine psb_get_mpicomm
|
||||
|
||||
subroutine psb_get_rank(rank,ictxt,id)
|
||||
integer(psb_ipk_) :: rank,ictxt,id
|
||||
integer(psb_mpik_) :: rank,ictxt,id
|
||||
|
||||
rank = id
|
||||
end subroutine psb_get_rank
|
||||
|
||||
Reference in New Issue
Block a user