fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3-integer8:

Browse Source 
base/modules/psi_penv_mod.F90

Restepping through longint changes.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 84e1bd365e
commit 3a23d2ea62
1 changed files with 125 additions and 34 deletions
Show Stats Download Patch File Download Diff File

159
base/modules/psi_penv_mod.F90
Unescape Escape View File

@ -22,23 +22,45 @@ module psi_penv_mod
module procedure psb_barrier module procedure psb_barrier
end interface 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 interface psb_wtime
module procedure psb_wtime module procedure psb_wtime
end interface end interface
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
integer(psb_ipk_), private, save :: nctxt=0 integer(psb_mpik_), private, save :: nctxt=0
#else #else
integer(psb_ipk_), save :: mpi_iamx_op, mpi_iamn_op integer(psb_mpik_), save :: mpi_iamx_op, mpi_iamn_op
integer(psb_ipk_), save :: mpi_i8amx_op, mpi_i8amn_op integer(psb_mpik_), save :: mpi_i8amx_op, mpi_i8amn_op
integer(psb_ipk_), save :: mpi_samx_op, mpi_samn_op integer(psb_mpik_), save :: mpi_samx_op, mpi_samn_op
integer(psb_ipk_), save :: mpi_damx_op, mpi_damn_op integer(psb_mpik_), save :: mpi_damx_op, mpi_damn_op
integer(psb_ipk_), save :: mpi_camx_op, mpi_camn_op integer(psb_mpik_), save :: mpi_camx_op, mpi_camn_op
integer(psb_ipk_), save :: mpi_zamx_op, mpi_zamn_op integer(psb_mpik_), save :: mpi_zamx_op, mpi_zamn_op
integer(psb_ipk_), save :: mpi_snrm2_op, mpi_dnrm2_op integer(psb_mpik_), save :: mpi_snrm2_op, mpi_dnrm2_op
type(psb_buffer_queue), save :: psb_mesg_queue type(psb_buffer_queue), save :: psb_mesg_queue
@ -83,8 +105,7 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_) :: info integer(psb_mpik_) :: info
info = 0
#if defined(LONG_INTEGERS) #if defined(LONG_INTEGERS)
psb_mpi_integer = mpi_integer8 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_snrm2_op,.true.,mpi_snrm2_op,info)
if (info == 0) call mpi_op_create(psi_dnrm2_op,.true.,mpi_dnrm2_op,info) if (info == 0) call mpi_op_create(psi_dnrm2_op,.true.,mpi_dnrm2_op,info)
#endif #endif
end subroutine psi_register_mpi_extras 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) subroutine psb_init(ictxt,np,basectxt,ids)
use psi_comm_buffers_mod use psi_comm_buffers_mod
@ -124,16 +215,16 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(out) :: ictxt integer(psb_mpik_), intent(out) :: ictxt
integer(psb_ipk_), intent(in), optional :: np, basectxt, ids(:) integer(psb_mpik_), intent(in), optional :: np, basectxt, ids(:)
integer(psb_ipk_) :: i, isnullcomm integer(psb_mpik_) :: i, isnullcomm
integer(psb_ipk_), allocatable :: iids(:) integer(psb_mpik_), allocatable :: iids(:)
logical :: initialized 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' character(len=20), parameter :: name='psb_init'
integer(psb_ipk_) :: iinfo
call psb_set_debug_unit(psb_err_unit) call psb_set_debug_unit(psb_err_unit)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
@ -161,16 +252,16 @@ contains
if (present(np)) then if (present(np)) then
if (np < 1) then if (np < 1) then
info=psb_err_initerror_neugh_procs_ iinfo=psb_err_initerror_neugh_procs_
call psb_errpush(info,name) call psb_errpush(iinfo,name)
call psb_error() call psb_error()
ictxt = mpi_comm_null ictxt = mpi_comm_null
return return
endif endif
call mpi_comm_size(basecomm,np_,info) call mpi_comm_size(basecomm,np_,info)
if (np_ < np) then if (np_ < np) then
info=psb_err_initerror_neugh_procs_ iinfo=psb_err_initerror_neugh_procs_
call psb_errpush(info,name) call psb_errpush(iinfo,name)
call psb_error() call psb_error()
ictxt = mpi_comm_null ictxt = mpi_comm_null
return return
@ -249,10 +340,10 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(inout) :: ictxt integer(psb_mpik_), intent(inout) :: ictxt
logical, intent(in), optional :: close logical, intent(in), optional :: close
logical :: close_ logical :: close_
integer(psb_ipk_) :: info integer(psb_mpik_) :: info
character(len=20), parameter :: name='psb_exit' character(len=20), parameter :: name='psb_exit'
info = 0 info = 0
@ -300,9 +391,9 @@ contains
#ifdef MPI_H #ifdef MPI_H
include 'mpif.h' include 'mpif.h'
#endif #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 !defined(SERIAL_MPI)
if (ictxt /= mpi_comm_null) then if (ictxt /= mpi_comm_null) then
call mpi_barrier(ictxt, info) call mpi_barrier(ictxt, info)
@ -328,10 +419,10 @@ contains
subroutine psb_abort(ictxt,errc) subroutine psb_abort(ictxt,errc)
use psi_comm_buffers_mod use psi_comm_buffers_mod
integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in), optional :: errc integer(psb_mpik_), intent(in), optional :: errc
integer(psb_ipk_) :: code, info integer(psb_mpik_) :: code, info
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
stop stop
@ -358,9 +449,9 @@ contains
include 'mpif.h' include 'mpif.h'
#endif #endif
integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(out) :: iam, np integer(psb_mpik_), intent(out) :: iam, np
integer(psb_ipk_) :: info integer(psb_mpik_) :: info
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
iam = 0 iam = 0
@ -381,26 +472,26 @@ contains
subroutine psb_set_coher(ictxt,isvch) subroutine psb_set_coher(ictxt,isvch)
integer(psb_ipk_) :: ictxt, isvch integer(psb_mpik_) :: ictxt, isvch
! Ensure global repeatability for convergence checks. ! Ensure global repeatability for convergence checks.
! Do nothing. Obsolete. ! Do nothing. Obsolete.
end subroutine psb_set_coher end subroutine psb_set_coher
subroutine psb_restore_coher(ictxt,isvch) subroutine psb_restore_coher(ictxt,isvch)
integer(psb_ipk_) :: ictxt, isvch integer(psb_mpik_) :: ictxt, isvch
! Ensure global coherence for convergence checks. ! Ensure global coherence for convergence checks.
! Do nothing. Obsolete. ! Do nothing. Obsolete.
end subroutine psb_restore_coher end subroutine psb_restore_coher
subroutine psb_get_mpicomm(ictxt,comm) subroutine psb_get_mpicomm(ictxt,comm)
integer(psb_ipk_) :: ictxt, comm integer(psb_mpik_) :: ictxt, comm
comm = ictxt comm = ictxt
end subroutine psb_get_mpicomm end subroutine psb_get_mpicomm
subroutine psb_get_rank(rank,ictxt,id) subroutine psb_get_rank(rank,ictxt,id)
integer(psb_ipk_) :: rank,ictxt,id integer(psb_mpik_) :: rank,ictxt,id
rank = id rank = id
end subroutine psb_get_rank end subroutine psb_get_rank

Write Preview
Loading…
Cancel
Save