From 3a23d2ea62a40fa186c1a0bc356028fdd9bf618d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 30 Jan 2012 16:22:08 +0000 Subject: [PATCH] psblas3-integer8: base/modules/psi_penv_mod.F90 Restepping through longint changes. --- base/modules/psi_penv_mod.F90 | 159 ++++++++++++++++++++++++++-------- 1 file changed, 125 insertions(+), 34 deletions(-) diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index a3c3003e..012f3b16 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -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